Creating and editing terms: basic functionality, still bery ugly

models

@@ -8,8 +8,7 @@ Term json
     start       Day
     end         Day
     holidays    [Day]
-    active      Bool
-    UniqueTerm name
+    active      Bool    
     Primary name
     deriving Show
 School json

src/Handler/Assist.hs

@@ -14,8 +14,14 @@ import Database.Persist.Class as K (Key)
 -- import Text.Julius (RawJS (..))
 
 -- TODO: Move elsewhere
-termField :: Field (HandlerT UniWorX IO) TermIdentifier
-termField = checkMMap checkTerm termToText textField
+termExistsField :: Field (HandlerT UniWorX IO) TermIdentifier
+termExistsField = termField True
+
+termNewField :: Field (HandlerT UniWorX IO) TermIdentifier
+termNewField = termField False 
+
+termField :: Bool -> Field (HandlerT UniWorX IO) TermIdentifier
+termField mustexist = checkMMap checkTerm termToText textField
   where 
     errTextParse :: Text
     errTextParse = "Semester: S oder W gefolgt von Jahreszahl"
@@ -27,9 +33,8 @@ termField = checkMMap checkTerm termToText textField
     checkTerm t = case termFromText t of
       Left  _        -> return $ Left errTextParse
       res@(Right ti) -> do
---         term <- runDB $ get $ Key ti -- TODO: membershiptest instead?
-        term <- runDB $ getBy $ UniqueTerm ti -- TODO: use get instead of getBy?        
-        return $ if isNothing term 
+        term <- runDB $ get $ TermKey ti -- TODO: membershiptest instead?
+        return $ if mustexist && isNothing term 
           then Left $ errTextFreigabe ti
           else res 
         
@@ -51,7 +56,7 @@ data NewCourseForm = NewCourseForm
 newCourseForm :: UserId -> Form NewCourseForm 
 newCourseForm uid = renderBootstrap3 BootstrapBasicForm $ NewCourseForm
     <$> pure uid 
-    <*> areq termField (set "Semester") Nothing
+    <*> 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
@@ -121,15 +126,23 @@ getShowTermR = do
   terms <- runDB $ selectList [] [Desc TermStart]
   defaultLayout $ do
     setTitle "Freigeschaltete Semester"
+    -- TODO: provide common utility function for formatting Times
+    -- TODO: turn into proper table
     [whamlet|
       <h2>
-        Liste der freigeschalteten Semeser:
+        Liste der freigeschalteten Semester:
       $if null terms 
         <p> Es wurden noch kein Semester freigeschaltetet.
       $else 
         <ul>
-          $forall term <- terms
-            <li> #{show term}
+          $forall Entity _ term <- terms
+            <li>
+              <a href=@{NewTermR}>
+                #{termToText $ termName term}               
+              from  #{formatTime defaultTimeLocale "%d.%m.%Y" $ termStart term}
+              to: #{formatTime defaultTimeLocale "%d.%m.%Y" $ termEnd term}
+              $if termActive term 
+                (Semester ist aktiv)
     |]
 
 getNewTermR :: Handler Html
@@ -152,8 +165,8 @@ postNewTermR = do
     ((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing
     case result of
        FormSuccess res -> do
-          -- term <- runDB $ getBy UniqueTerm $ termName 
-          runDB $ insert res
+          -- term <- runDB $ get $ TermKey termName 
+          runDB $ repsert (TermKey $ termName res) res
           let tid = termToText $ termName res
           let msg = "Semester " `T.append` tid `T.append` " wurde angelegt!"        
           -- setMessage $ toHtml msg -- FIXME
@@ -173,7 +186,7 @@ postNewTermR = do
 newTermForm :: Maybe Term -> Form Term
 newTermForm template = 
     renderBootstrap3 BootstrapBasicForm $ Term
-      <$> areq termField (set "Semester")   (termName  <$> template)
+      <$> areq termNewField (set "Semester")   (termName  <$> template)
       <*> areq dayField  (set "Erster Tag") (termStart <$> template)
       <*> areq dayField  (set "Letzer Tag") (termEnd   <$> template)
       <*> pure [] -- TODO: List of Day field required, must probably be done as its own form and then combined