schoolField & termField in Utils

models

@@ -200,6 +200,6 @@ Exam
 ExamUser
     userId              UserId
     examId              ExamId
-    -- CONTINUE HERE: Inlcude rating in this table or seperatly?
+    -- CONTINUE HERE: Include rating in this table or separately?
     UniqueExamUser userId examId
  -- By default this file is used in Model.hs (which is imported by Foundation.hs)

src/Handler/Course.hs

@@ -277,8 +277,8 @@ newCourseForm template = identForm FIDcourse $ \html -> do
             -- & addAttr "disabled" "disabled"
             & setTooltip "Muss innerhalb des Semesters eindeutig sein")
                                                 (cfShort  <$> template)
-      <*> areq termExistsField        (fsb "Semester")       (cfTerm     <$> template)
-      <*> areq (selectField schools)  (fsb "Institut")       (cfSchool   <$> template)
+      <*> areq termActiveField        (fsb "Semester")       (cfTerm     <$> template)
+      <*> areq schoolField            (fsb "Institut")       (cfSchool   <$> template)
       <*> aopt (natField "Kapazität") (fsb "Kapazität")      (cfCapacity <$> template)
       <*> areq checkBoxField          (fsb "Anmeldung")      (cfHasReg   <$> template)
       <*> aopt utcTimeField           (fsb "Anmeldung von:") (cfRegFrom  <$> template)
@@ -302,11 +302,6 @@ newCourseForm template = identForm FIDcourse $ \html -> do
   where     
 --     cid :: Maybe CourseId    
 --     cid = join $ cfCourseId <$> template
---     
---     schools :: GHandler UniWorX UniWorX (OptionList SchoolId)
-    schools = do
-        entities <- runDB $ selectList [] [Asc SchoolShorthand]
-        optionsPairs $ map (\school -> (schoolShorthand $ entityVal school, entityKey school)) entities
                            
 validateCourse :: CourseForm -> [Text]
 validateCourse (CourseForm{..}) = 

src/Handler/Utils/Form.hs

@@ -218,9 +218,12 @@ posIntField d = checkBool (>= 1) (T.append  d " muss eine positive Zahl sein.")
 minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i
 minIntField m d = checkBool (>= m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) $ intField
 
+--termField: see Utils.Term
 
-schoolField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m SchoolId
-schoolField = undefined -- TODO
+schoolField :: Field Handler SchoolId
+schoolField = selectField schools
+  where
+    schools = optionsPersistKey [] [Asc SchoolName] schoolName
 
 utcTimeField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m UTCTime
 -- StackOverflow: dayToUTC <$> (areq (jqueryDayField def {...}) settings Nothing)
@@ -229,19 +232,20 @@ utcTimeField = Field
     , fieldView = \theId name attrs val isReq ->
         [whamlet|
           $newline never
-          <input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id showTime val}">
+          <input id="#{theId}" name="#{name}" *{attrs} type="datetime-local" :isReq:required value="#{either id showTime val}">
         |]
     , fieldEnctype = UrlEncoded
     }
   where 
     fieldTimeFormat :: String
-    fieldTimeFormat = "%e.%m.%y %k:%M"
+    --fieldTimeFormat = "%e.%m.%y %k:%M"
+    fieldTimeFormat = "%Y-%m-%eT%H:%M"
     
     readTime :: Text -> Either FormMessage UTCTime
     readTime t = 
       case parseTimeM True germanTimeLocale fieldTimeFormat (T.unpack t) of
         (Just time) -> Right time
-        Nothing -> Left $ MsgInvalidEntry "Datum/Zeit Format: tt.mm.yy hh:mm"
+        Nothing -> Left $ MsgInvalidEntry $ "Datum/Zeit Format: tt.mm.yy hh:mm " ++ t
         
     showTime :: UTCTime -> Text 
     showTime = fromString . (formatTime germanTimeLocale fieldTimeFormat)

src/Handler/Utils/Term.hs

@@ -13,15 +13,11 @@ import Model.Types
 -- import Data.Maybe
 
 
-termExistsField :: Field Handler TermIdentifier
-termExistsField = termField True
-  -- TODO: Change this to an option list of active terms
+termActiveField :: Field Handler TermIdentifier
+termActiveField = convertField unTermKey TermKey $ selectField $ optionsPersistKey [TermActive ==. True] [Desc TermStart] termName
 
 termNewField :: Field Handler TermIdentifier
-termNewField = termField False 
-
-termField :: Bool -> Field Handler TermIdentifier
-termField mustexist = checkMMap checkTerm termToText textField
+termNewField = checkMMap checkTerm termToText textField
   where 
     errTextParse :: Text
     errTextParse = "Semester: S oder W gefolgt von Jahreszahl"
@@ -31,12 +27,8 @@ termField mustexist = checkMMap checkTerm termToText textField
     
     checkTerm :: Text -> HandlerT UniWorX IO (Either Text TermIdentifier)
     checkTerm t = case termFromText t of
-      Left  _        -> return $ Left errTextParse
-      res@(Right ti) -> do
-        term <- runDB $ get $ TermKey ti -- TODO: membershiptest instead?
-        return $ if mustexist && isNothing term 
-          then Left $ errTextFreigabe ti
-          else res 
+      Left  _       -> return $ Left errTextParse
+      res@(Right _) -> return res
 
 validateTerm :: Term -> [Text]        
 validateTerm (Term{..}) = 

src/Import/NoFoundation.hs

@@ -11,6 +11,7 @@ import Yesod.Auth            as Import
 import Yesod.Core.Types      as Import (loggerSet)
 import Yesod.Default.Config2 as Import
 
+
 import Data.Fixed            as Import
 
 import CryptoID              as Import

src/Model/Types.hs

@@ -4,6 +4,9 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+
 module Model.Types where
 
 import ClassyPrelude
@@ -22,6 +25,7 @@ import Data.Text (Text)
 import qualified Data.Text as Text
 
 import Text.Read (readMaybe)
+import Text.Shakespeare.I18N
 
 -- import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
@@ -113,6 +117,9 @@ instance ToJSON TermIdentifier where
 instance FromJSON TermIdentifier where
   parseJSON = withText "Term" $ either (fail . Text.unpack) return . termFromText
   
+instance RenderMessage site TermIdentifier where -- TODO: I18N
+  renderMessage _ _ = termToText
+
 {- Must be defined in a later module:
 termField :: Field (HandlerT UniWorX IO) TermIdentifier
 termField = checkMMap (return . termFromText) termToText textField