Course Form works; display not yet.

models

@@ -29,17 +29,19 @@ DegreeCourse json
     UniqueDegreeCourse degreeId courseId
 Course 
     name         Text
-    shorthand    Text
     description  Html Maybe
-    linkexternal Text Maybe    
+    linkExternal Text Maybe    
+    shorthand    Text
+    termId       TermIdentifier
     schoolId     SchoolId    
-    termId       TermId -- TermId ist jetzt Text als Typ
     capacity     Int Maybe    
     created      UTCTime
     changed      UTCTime
-    registerFrom UTCTime
+    createdBy    UserId
-    registerTo   UTCTime
+    changedBy    UserId    
-    UniqueTermShorthand shorthand termId
+    registerFrom UTCTime Maybe
+    registerTo   UTCTime Maybe
+    CourseTermShort termId shorthand 
 Lecturer 
     userId       UserId
     courseId     CourseId
@@ -113,7 +115,7 @@ TutorialUser
     tutorialId  TutorialId
     UniqueTutorialUser userId tutorialId
 Booking
-    termId      TermId
+    termId      TermIdentifier
     begin       UTCTime
     end         UTCTime
     weekly      Bool

routes

@@ -8,8 +8,11 @@
 
 /profile ProfileR GET
 
-/term                       ShowTermsR      GET 
+/term                       TermShowR         GET 
-/term/edit                  EditTermR       GET POST
+/term/edit                  TermEditR         GET POST
-/term/#TermIdentifier/edit  EditTermExistR  GET
+/term/#TermIdentifier/edit  TermEditExistR    GET
+
+/course                      CourseShowR      GET
+/course/edit                 CourseEditR      GET POST
+/course/#TermIdentifier/#Text/edit CourseEditExistR GET
 
-/assist/newcourse                NewCourseR      GET POST

src/Application.hs

@@ -43,7 +43,7 @@ import Handler.Common
 import Handler.Home
 import Handler.Profile
 import Handler.Term
-import Handler.Assist
+import Handler.Course
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

src/Common.hs

@@ -39,3 +39,14 @@ permuteFun perm = lamE pat rhs
         xs  = [ mkName $ "x" ++ show j | j <- [1..ln] ]
         ps  = [ xs !! (j-1) | j <- perm ]
         fn  = mkName "fn" 
+
+altFun :: [Int] -> ExpQ -- generic permutation/repetition of function arguments, i.e. $(permuteFun [2,1]) == flip
+altFun perm = lamE pat rhs
+  where pat = map varP $ fn:xs
+        rhs = foldl appE (varE fn) $ map varE ps
+--         rhs = appE (varE fn) (varE $ xs!!1)        
+        mx  = maximum perm
+        xs  = [ mkName $ "x" ++ show j | j <- [1..mx] ]
+        ps  = [ xs !! (j-1) | j <- perm ]
+        fn  = mkName "fn" 
+        

src/Foundation.hs

@@ -166,11 +166,16 @@ instance Yesod UniWorX where
     isAuthorized (StaticR _) _ = return Authorized
 
     isAuthorized ProfileR _ = isAuthenticated
+    
+    -- TODO: all?
+    isAuthorized TermShowR          _ = return Authorized
+    isAuthorized CourseShowR          _ = return Authorized    
     -- TODO: change to Assistants    
-    isAuthorized NewCourseR         _ = return Authorized    
+    isAuthorized TermEditR          _ = return Authorized
-    isAuthorized EditTermR          _ = return Authorized
+    isAuthorized (TermEditExistR _) _ = return Authorized    
-    isAuthorized (EditTermExistR _) _ = return Authorized
+    isAuthorized CourseEditR          _ = return Authorized
-    isAuthorized ShowTermsR         _ = return Authorized
+    isAuthorized (CourseEditExistR _ _) _ = return Authorized
+    
 
     -- This function creates static content files in the static folder
     -- and names them based on a hash of their content. This allows

src/Handler/Assist.hs

@@ -1,99 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-module Handler.Assist where
-
-import Import
-import Handler.Utils
-import qualified Data.Text as T
--- import Data.Maybe
-import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
--- import Text.Julius (RawJS (..))
-
--- TODO: Move elsewhere
-
-        
-      
-       
--- Handler for Assistants
-
-data NewCourseForm = NewCourseForm 
-  {   ncf_user        :: UserId
-  ,   ncf_term        :: TermIdentifier
-  ,   ncf_name        :: Text 
-  ,   ncf_short       :: Text 
-  ,   ncf_description :: Textarea 
-  ,   ncf_homepage    :: Maybe Text 
-  ,   ncf_html        :: Html 
-  ,   ncf_capacity    :: Maybe Int
-  }
-
-newCourseForm :: UserId -> Form NewCourseForm 
-newCourseForm uid = renderBootstrap3 BootstrapBasicForm $ NewCourseForm
-    <$> pure uid 
-    <*> areq termExistsField (set "Semester") Nothing
---     <*> areq textField (set "Semester") Nothing
-    <*> areq textField (set "Name des Kurses")           Nothing
-    <*> areq textField (set "Kurs Kürzel (3-4 Zeichen)") Nothing
-    <*> areq textareaField (set "Beschreibung des Kurses")       Nothing
-    <*> aopt urlField  (set "Externe Kurshomepage")       Nothing
-    <*> areq htmlField (set "Beschreibung in HTML")       Nothing
-    <*> aopt intField  (set "Maximale Teilnehmer")       Nothing
-    -- Add attributes like the placeholder and CSS classes.
-   where set txt = FieldSettings
-            { fsLabel = txt
-            , fsTooltip = Nothing
-            , fsId = Nothing
-            , fsName = Nothing
-            , fsAttrs =
-                [ ("class", "form-control")                
-                ]
-            }
-
-getShowCourseR :: CourseId -> Handler Html 
-getShowCourseR courseId = do
-    defaultLayout $ do
-        [whamlet|
-            TODO unfinished
-        |]
-
-getNewCourseR :: Handler Html
-getNewCourseR = do
-    aid <- requireAuthId
-    (formWidget, formEnctype) <- generateFormPost $ newCourseForm aid
-    defaultLayout $ do
-        setTitle "Neuen Kurs anlegen"
-        [whamlet|
-            User: #{show aid}
-        |]        
-        $(widgetFile "newCourse")
-
-postNewCourseR :: Handler Html
-postNewCourseR = do
-    aid <- requireAuthId
-    ((result, formWidget), formEnctype) <- runFormPost $ newCourseForm aid
-    case result of
-       FormSuccess res -> defaultLayout $ do
-            setMessage "Got something!"
-            $(widgetFile "newCourse")
-       FormMissing -> defaultLayout $ do
-            setMessage "Keine Formulardaten erhalten."
-            $(widgetFile "newCourse")
-       FormFailure errorMsgs -> defaultLayout $ do
-            setMessage [shamlet| <span .error>Fehler:
-                            <ul>
-                                $forall errmsg <- errorMsgs
-                                    <li> #{errmsg} 
-                        |]
-            $(widgetFile "newCourse")
-
-{-
-    defaultLayout $ do
-        let (commentFormId, commentTextareaId, commentListId) = commentIds
-        aDomId <- newIdent
-        setTitle "Welcome To Yesod!"
-        $(widgetFile "homepage")
--}

src/Handler/Course.hs

@@ -0,0 +1,220 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Handler.Course where
+
+import Import 
+import Handler.Utils
+
+import Data.Time
+import qualified Data.Text as T
+import Yesod.Form.Bootstrap3 
+
+import Colonnade
+import Yesod.Colonnade
+
+
+getCourseShowR :: Handler TypedContent
+getCourseShowR = do
+  terms <- runDB $ selectList [] [Desc TermStart]
+  selectRep $ do
+    provideRep $ return $ toJSON terms
+    provideRep $ do      
+      let colonnadeTerms = mconcat 
+            [ headed "Kürzel" $ (\t -> let tn = termName t in do
+                adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tn) False
+                [whamlet| 
+                  $if adminLink == Authorized
+                    <a href=@{TermEditExistR tn}>
+                      #{termToText tn}
+                  $else 
+                      #{termToText tn}
+                |] )        
+            , headed "Beginn Vorlesungen" $ fromString.formatTimeGerWD.termLectureStart
+            , headed "Ende Vorlesungen"   $ fromString.formatTimeGerWD.termLectureEnd
+            , headed "Aktiv"  (\t -> if termActive t then tickmark else "")
+    --         , Colonnade.bool (Headed "Aktiv") termActive (const tickmark) (const "")
+            , headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart
+            , headed "Semesterende"   $ fromString.formatTimeGerWD.termEnd
+            , headed "Feiertage im Semester" $ 
+            fromString.(intercalate ", ").(map formatTimeGerWD).termHolidays
+            ]  
+      defaultLayout $ do
+        setTitle "Freigeschaltete Semester"            
+        encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
+
+    
+getCourseEditR :: Handler Html
+getCourseEditR = do
+  -- TODO: Defaults für Semester hier ermitteln und übergeben
+  courseEditHandler Nothing
+  
+postCourseEditR :: Handler Html
+postCourseEditR = courseEditHandler Nothing
+  
+getCourseEditExistR :: TermIdentifier -> Text -> Handler Html  
+getCourseEditExistR tid csh = do  
+  course <- runDB $ getBy $ CourseTermShort tid csh
+  courseEditHandler course
+
+     
+courseEditHandler :: Maybe (Entity Course) -> Handler Html
+courseEditHandler course = do
+    aid <- requireAuthId
+    ((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course
+    action <- lookupPostParam "formaction"
+    case (result,action) of
+      (FormSuccess res, fAct) 
+        | fAct == formActionDelete
+        , Just cid <- cfCourseId res -> do 
+            runDB $ delete cid -- TODO Sicherheitsabfrage einbauen!
+            let cti = termToText $ cfTerm res
+            setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde gelöscht! |]
+            redirect CourseShowR
+        | fAct == formActionSave 
+        , Just cid <- cfCourseId res -> do 
+            actTime <- liftIO getCurrentTime
+            runDB $ do
+              update cid 
+                [ CourseName         =. cfName     res
+                , CourseDescription  =. cfDesc     res
+                , CourseLinkExternal =. cfLink     res
+                , CourseSchoolId     =. cfSchool   res
+                , CourseCapacity     =. cfCapacity res
+                , CourseRegisterFrom =. cfRegFrom  res
+                , CourseRegisterTo   =. cfRegTo    res
+                , CourseChangedBy    =. aid
+                , CourseChanged      =. actTime
+                ]
+            let cti = termToText $ cfTerm res
+            setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde geändert. |]
+        | fAct == formActionSave
+        , Nothing <- cfCourseId res -> do
+            actTime <- liftIO getCurrentTime
+            insertOkay <- runDB $ insertUnique $ Course 
+                { courseName         = cfName     res
+                , courseDescription  = cfDesc     res
+                , courseLinkExternal = cfLink     res
+                , courseShorthand    = cfShort    res
+                , courseTermId       = cfTerm     res
+                , courseSchoolId     = cfSchool   res
+                , courseCapacity     = cfCapacity res
+                , courseRegisterFrom = cfRegFrom  res
+                , courseRegisterTo   = cfRegTo    res
+                , courseCreated      = actTime
+                , courseChanged      = actTime
+                , courseCreatedBy    = aid
+                , courseChangedBy    = aid
+                } 
+            case insertOkay of 
+                (Just cid) -> do
+                  runDB $ insert_ $ Lecturer aid cid 
+                  let cti = termToText $ cfTerm res
+                  setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde angelegt. |]
+                  redirect CourseShowR
+                Nothing -> do
+                  let cti = termToText $ cfTerm res
+                  setMessage $ [shamlet|
+                      <div .alert .alert-danger>
+                        Es gibt bereits einen Kurs #{cfShort res} in Semester #{cti}. 
+                    |]      
+      (FormFailure _,_) -> setMessage "Bitte Eingabe korrigieren."            
+      _other -> return ()
+    let formTitle   = "Kurs editieren/anlegen" :: Text
+    let actionUrl   = TermEditR
+    let formActions = defaultFormActions
+    defaultLayout $ do
+      setTitle [shamlet| #{formTitle} |]
+      $(widgetFile "generic_form")
+      
+      
+data CourseForm = CourseForm 
+        { cfCourseId :: Maybe CourseId
+        , cfName     :: Text 
+        , cfDesc     :: Maybe Html
+        , cfLink     :: Maybe Text 
+        , cfShort    :: Text 
+        , cfTerm     :: TermIdentifier
+        , cfSchool   :: SchoolId
+        , cfCapacity :: Maybe Int 
+        , cfRegFrom  :: Maybe UTCTime 
+        , cfRegTo    :: Maybe UTCTime 
+        }  
+        
+courseToForm :: Entity Course -> CourseForm
+courseToForm cEntity = CourseForm 
+        { cfCourseId = Just $ entityKey cEntity
+        , cfName     = courseName          course
+        , cfDesc     = courseDescription   course
+        , cfLink     = courseLinkExternal  course
+        , cfShort    = courseShorthand     course
+        , cfTerm     = courseTermId        course
+        , cfSchool   = courseSchoolId      course
+        , cfCapacity = courseCapacity      course
+        , cfRegFrom  = courseRegisterFrom  course 
+        , cfRegTo    = courseRegisterTo    course 
+        }
+  where
+    course = entityVal cEntity
+      
+newCourseForm :: Maybe CourseForm -> Form CourseForm
+newCourseForm template html = do       
+    (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ CourseForm
+      <$> pure Nothing -- $ join (cfCourseId <$> template)
+      <*> areq textField (set "Name")           (cfName   <$> template)
+      <*> aopt htmlField (set "Beschreibung")   (cfDesc   <$> template)
+      <*> aopt urlField  (set "Homepage")       (cfLink   <$> template)
+      <*> areq textField (setToolt "Kürzel" "Muss innerhalb des Semesters eindeutig sein")       (cfShort  <$> template)
+      <*> areq termExistsField        (set "Semester")       (cfTerm   <$> template)
+      <*> areq (selectField schools)  (set "Institut")       (cfSchool <$> template)
+      <*> aopt (natField "Kapazität") (set "Kapazität")      (cfCapacity <$> template)
+      <*> aopt utcTimeField           (set "Anmeldung von:") (cfRegFrom <$> template)
+      <*> aopt utcTimeField           (set "Anmeldung bis:") (cfRegTo   <$> template)
+    return $ case result of  
+      FormSuccess courseResult 
+        | errorMsgs <- validateCourse courseResult
+        , not $ null errorMsgs ->
+          (FormFailure errorMsgs,
+                [whamlet|
+                  <div class="alert alert-danger">
+                    <h4> Fehler:
+                    <ul>
+                      $forall errmsg <- errorMsgs
+                        <li> #{errmsg} 
+                  ^{widget}
+                |]
+              )        
+      _ -> (result, widget)
+  where     
+    set :: Text -> FieldSettings site 
+    set = bfs 
+
+    setAttrs :: Text -> [(Text,Text)] -> FieldSettings site 
+    setAttrs t attrs = 
+      let ifs = bfs t in ifs { fsAttrs= attrs++(fsAttrs ifs) }
+          
+    setToolt :: Text -> String -> FieldSettings site
+    setToolt t tt =
+      let ifs = bfs t in ifs { fsTooltip= Just $ fromString tt }
+          
+--     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{..}) = 
+  [ msg | (False, msg) <-
+    [
+      ( cfRegFrom <= cfRegTo
+      , "Ende der Anmeldungszeit muss nach dem Anfang liegen"
+      )
+  ] ]
+
+                           

src/Handler/Term.hs

@@ -18,18 +18,18 @@ import Colonnade
 import Yesod.Colonnade
 
 
-getShowTermsR :: Handler TypedContent
+getTermShowR :: Handler TypedContent
-getShowTermsR = do
+getTermShowR = do
   terms <- runDB $ selectList [] [Desc TermStart]
   selectRep $ do
     provideRep $ return $ toJSON terms
     provideRep $ do      
       let colonnadeTerms = mconcat 
             [ headed "Kürzel" $ (\t -> let tn = termName t in do
-                adminLink <- handlerToWidget $ isAuthorized (EditTermExistR tn) False
+                adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tn) False
                 [whamlet| 
                   $if adminLink == Authorized
-                    <a href=@{EditTermExistR tn}>
+                    <a href=@{TermEditExistR tn}>
                       #{termToText tn}
                   $else 
                       #{termToText tn}
@@ -48,16 +48,16 @@ getShowTermsR = do
         encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
 
     
-getEditTermR :: Handler Html
+getTermEditR :: Handler Html
-getEditTermR = do
+getTermEditR = do
   -- TODO: Defaults für Semester hier ermitteln und übergeben
   termEditHandler Nothing
   
-postEditTermR :: Handler Html
+postTermEditR :: Handler Html
-postEditTermR = termEditHandler Nothing
+postTermEditR = termEditHandler Nothing
   
-getEditTermExistR :: TermIdentifier -> Handler Html  
+getTermEditExistR :: TermIdentifier -> Handler Html  
-getEditTermExistR tid = do
+getTermEditExistR tid = do
   term <- runDB $ get $ TermKey tid
   termEditHandler term
 
@@ -73,19 +73,19 @@ termEditHandler term = do
           let tid = termToText $ termName res
           let msg = "Semester " `T.append` tid `T.append` " erfolgreich gelöscht."            
           setMessage $ [shamlet| #{msg} |]
-          redirect ShowTermsR
+          redirect TermShowR
         | fAct == formActionSave -> do
           -- term <- runDB $ get $ TermKey termName 
           runDB $ repsert (TermKey $ termName res) res
           let tid = termToText $ termName res
           let msg = "Semester " `T.append` tid `T.append` " erfolgreich editiert."            
           setMessage [shamlet| #{msg} |]
-          redirect ShowTermsR   
+          redirect TermShowR   
-        | otherwise -> redirect ShowTermsR      
+        | otherwise -> redirect TermShowR      
       (FormMissing,_)   -> return ()
       (FormFailure _,_) -> setMessage "Bitte Eingabe korrigieren."            
     let formTitle   = "Semester editieren/anlegen" :: Text
-    let actionUrl   = EditTermR
+    let actionUrl   = TermEditR
     let formActions = defaultFormActions
     defaultLayout $ do
       setTitle [shamlet| #{formTitle} |]
@@ -95,7 +95,7 @@ termEditHandler term = do
 wdgtTermForm :: (ToWidget UniWorX a) => a -> Enctype ->  Handler Html              
 wdgtTermForm formWidget formEnctype = do
     let formTitle   = "Semester editieren/anlegen" :: Text
-    let actionUrl   = EditTermR
+    let actionUrl   = TermEditR
     let formActions = defaultFormActions
     defaultLayout $ do
       setTitle [shamlet| #{formTitle} |]
@@ -107,11 +107,11 @@ newTermForm template html = do
     (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ Term
       <$> areq termNewField (bfs ("Semester" :: Text)) (termName  <$> template)
       <*> areq dayField  (bfs ("Erster Tag" :: Text)) (termStart <$> template)
-      <*> areq dayField  (set "Letzer Tag") (termEnd   <$> template)
+      <*> areq dayField  (bfs ("Letzer Tag" :: Text)) (termEnd   <$> template)
       <*> pure [] -- TODO: List of Day field required, must probably be done as its own form and then combined
       <*> areq dayField  (bfs ("Beginn Vorlesungen" :: Text)) (termLectureStart <$> template)
-      <*> areq dayField  (set "Ende Vorlesungen") (termLectureEnd   <$> template)
+      <*> areq dayField  (bfs ("Ende Vorlesungen" :: Text)) (termLectureEnd   <$> template)
-      <*> areq checkBoxField (set "Aktiv") (termActive <$> template)
+      <*> areq checkBoxField (bfs ("Aktiv" :: Text)) (termActive <$> template)
       -- <*  bootstrapSubmit (bsSubmit "Semester bearbeiten")      
     return $ case result of  
       FormSuccess termResult 
@@ -128,12 +128,8 @@ newTermForm template html = do
                 |]
               )        
       _ -> (result, widget)
-  where set txt = FieldSettings
+{-      
-            { fsLabel = txt
+  where 
-            , fsTooltip = Nothing
+    set :: Text -> FieldSettings site 
-            , fsId = Nothing
+    set = bfs 
-            , fsName = Nothing
+-}    
-            , fsAttrs =
-                [ ("class", "form-control")                
-                ]
-            }

src/Handler/Utils/DateTime.hs

@@ -2,6 +2,7 @@ module Handler.Utils.DateTime where
 
 import Data.Time
 
+
 germanTimeLocale :: TimeLocale 
 germanTimeLocale = TimeLocale 
   { wDays   = [("Montag"     ,"Mo")

src/Handler/Utils/Form.hs

@@ -1,16 +1,24 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Handler.Utils.Form where 
 
 import Import
+-- import Data.Time
+import Handler.Utils.DateTime
 import Data.String (IsString(..))
+
 -- import Yesod.Core
--- import qualified Data.Text as T
+import qualified Data.Text as T
 -- import Yesod.Form.Types
--- import Yesod.Form.Functions
+import Yesod.Form.Functions (parseHelper)
+
+
 
 formBtnSave  :: (Text,Text,Text)
 formBtnSave   = ("save"  ,"Speichern"  ,"btn-primary")
@@ -35,3 +43,44 @@ defaultFormActions =  [ formBtnDelete
                       , formBtnAbort
                       , formBtnSave
                       ]
+
+------------
+-- Fields --
+------------
+
+natField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
+natField d = checkBool (>= 0) (T.append  d " muss eine natürliche Zahl sein.") $ intField
+
+posIntField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
+posIntField d = checkBool (>= 1) (T.append  d " muss eine positive Zahl sein.") $ intField
+
+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
+
+
+schoolField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m SchoolId
+schoolField = undefined -- TODO
+
+utcTimeField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m UTCTime
+-- StackOverflow: dayToUTC <$> (areq (jqueryDayField def {...}) settings Nothing)
+utcTimeField = Field 
+    { fieldParse = parseHelper $ readTime
+    , fieldView = \theId name attrs val isReq ->
+        [whamlet|
+          $newline never
+          <input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id showTime val}">
+        |]
+    , fieldEnctype = UrlEncoded
+    }
+  where 
+    fieldTimeFormat :: String
+    fieldTimeFormat = "%e.%m.%y %k:%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"
+        
+    showTime :: UTCTime -> Text 
+    showTime = fromString . (formatTime germanTimeLocale fieldTimeFormat)

src/Handler/Utils/Term.hs

@@ -15,6 +15,7 @@ import Model.Types
 
 termExistsField :: Field (HandlerT UniWorX IO) TermIdentifier
 termExistsField = termField True
+  -- TODO: Change this to an option list of active terms
 
 termNewField :: Field (HandlerT UniWorX IO) TermIdentifier
 termNewField = termField False 

templates/generic_form.hamlet

@@ -7,7 +7,7 @@
                       #{formTitle}
 
         <div .row>
-            <div .col-lg-6>
+            <div .col-md-10 .col-lg-9>
                 <div .bs-callout bs-callout-info well>
                     <form .form-horizontal method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
                         ^{formWidget}