From 40fab9a3622fe86eaf40adb7ebbe2d909b65ffde Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Fri, 6 Oct 2017 22:22:30 +0200
Subject: [PATCH] Term Handler moved to its own module

---
 src/Application.hs        |   3 +-
 src/Handler/Assist.hs     | 116 +-------------------------------------
 src/Handler/Term.hs       | 108 +++++++++++++++++++++++++++++++++++
 src/Handler/Utils.hs      |   5 ++
 src/Handler/Utils/Term.hs |  35 ++++++++++++
 5 files changed, 152 insertions(+), 115 deletions(-)
 create mode 100644 src/Handler/Term.hs
 create mode 100644 src/Handler/Utils.hs
 create mode 100644 src/Handler/Utils/Term.hs

diff --git a/src/Application.hs b/src/Application.hs
index 67453bcba..c119fd8e6 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -38,10 +38,11 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
                                              toLogStr)
 
 -- Import all relevant handler modules here.
--- Don't forget to add new modules to your cabal file!
+-- Don't forget to add new modules to your cabal file! 
 import Handler.Common
 import Handler.Home
 import Handler.Profile
+import Handler.Term
 import Handler.Assist
 
 -- This line actually creates our YesodDispatch instance. It is the second half
diff --git a/src/Handler/Assist.hs b/src/Handler/Assist.hs
index 82b917a76..37a58dc2a 100644
--- a/src/Handler/Assist.hs
+++ b/src/Handler/Assist.hs
@@ -7,36 +7,14 @@
 module Handler.Assist where
 
 import Import
+import Handler.Utils
 import qualified Data.Text as T
-import Data.Maybe
+-- import Data.Maybe
 import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
-import Database.Persist.Class as K (Key)
 -- import Text.Julius (RawJS (..))
 
 -- TODO: Move elsewhere
-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"
-    
-    errTextFreigabe :: TermIdentifier -> Text
-    errTextFreigabe ti = "Semester " `T.append` (termToText ti) `T.append` " wurde noch nicht freigegeben."
-    
-    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 
         
       
        
@@ -119,93 +97,3 @@ postNewCourseR = do
         setTitle "Welcome To Yesod!"
         $(widgetFile "homepage")
 -}
-
-
-getShowTermsR :: Handler Html
-getShowTermsR = 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 Semester:
-      $if null terms 
-        <p> Es wurden noch kein Semester freigeschaltetet.
-      $else 
-        <ul>
-          $forall Entity _ term <- terms
-            <li>
-              <a href=@{EditTermExistR $ termName term}>
-                #{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
-getNewTermR = do
-  -- TODO: Defaults für Semester hier ermitteln und übergeben
-  getEditTermMaybeR Nothing
-  
-getEditTermR :: Handler Html
-getEditTermR = do
-  -- TODO: Defaults für Semester hier ermitteln und übergeben
-  getEditTermMaybeR Nothing
-  
-getEditTermExistR :: TermIdentifier -> Handler Html  
-getEditTermExistR tid = do
-  term <- runDB $ get $ TermKey tid
-  getEditTermMaybeR term
-
-getEditTermMaybeR :: Maybe Term -> Handler Html
-getEditTermMaybeR mbTerm= do 
-    aid <- requireAuthId
-    (formWidget, formEnctype) <- generateFormPost $ newTermForm mbTerm
-    defaultLayout $ do
-        setTitle "Semester editieren/anlegen"        
-        $(widgetFile "editTerm")
-        
-postEditTermR :: Handler Html
-postEditTermR = do
-    aid <- requireAuthId
-    ((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing
-    case result of
-       FormSuccess res -> 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` " wurde angelegt!"        
-          -- setMessage $ toHtml msg -- FIXME
-          setMessage "Semester wurde angelegt" 
-          redirect ShowTermsR
-       FormMissing -> defaultLayout $ do
-            setMessage "Keine Formulardaten erhalten."
-            $(widgetFile "editTerm")
-       FormFailure errorMsgs -> defaultLayout $ do
-            setMessage [shamlet| <span .error>Fehler:
-                            <ul>
-                                $forall errmsg <- errorMsgs
-                                    <li> #{errmsg} 
-                        |]
-            $(widgetFile "editTerm")
-
-newTermForm :: Maybe Term -> Form Term
-newTermForm template = 
-    renderBootstrap3 BootstrapBasicForm $ Term
-      <$> 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
-      <*> areq checkBoxField (set "Aktiv") (termActive <$> template)
-  where set txt = FieldSettings
-            { fsLabel = txt
-            , fsTooltip = Nothing
-            , fsId = Nothing
-            , fsName = Nothing
-            , fsAttrs =
-                [ ("class", "form-control")                
-                ]
-            }
diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
new file mode 100644
index 000000000..c67e0503c
--- /dev/null
+++ b/src/Handler/Term.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+module Handler.Term 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 (..))
+
+
+
+getShowTermsR :: Handler Html
+getShowTermsR = 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 Semester:
+      $if null terms 
+        <p> Es wurden noch kein Semester freigeschaltetet.
+      $else 
+        <ul>
+          $forall Entity _ term <- terms
+            <li>
+              <a href=@{EditTermExistR $ termName term}>
+                #{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)
+              $with holidays <- termHolidays term
+                $if not (null holidays)
+                  Feiertage im Semester: #{show holidays}
+    |]
+
+getNewTermR :: Handler Html
+getNewTermR = do
+  -- TODO: Defaults für Semester hier ermitteln und übergeben
+  getEditTermMaybeR Nothing
+  
+getEditTermR :: Handler Html
+getEditTermR = do
+  -- TODO: Defaults für Semester hier ermitteln und übergeben
+  getEditTermMaybeR Nothing
+  
+getEditTermExistR :: TermIdentifier -> Handler Html  
+getEditTermExistR tid = do
+  term <- runDB $ get $ TermKey tid
+  getEditTermMaybeR term
+
+getEditTermMaybeR :: Maybe Term -> Handler Html
+getEditTermMaybeR mbTerm= do 
+    aid <- requireAuthId
+    (formWidget, formEnctype) <- generateFormPost $ newTermForm mbTerm
+    defaultLayout $ do
+        setTitle "Semester editieren/anlegen"        
+        $(widgetFile "editTerm")
+        
+postEditTermR :: Handler Html
+postEditTermR = do
+    aid <- requireAuthId
+    ((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing
+    case result of
+       FormSuccess res -> 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` " wurde editiert!"        
+          -- setMessage $ toHtml msg -- FIXME
+          setMessage "Semester gespeichert" 
+          redirect ShowTermsR
+       FormMissing -> defaultLayout $ do
+            setMessage "Keine Formulardaten erhalten."
+            $(widgetFile "editTerm")
+       FormFailure errorMsgs -> defaultLayout $ do
+            setMessage [shamlet| <span .error>Fehler:
+                            <ul>
+                                $forall errmsg <- errorMsgs
+                                    <li> #{errmsg} 
+                        |]
+            $(widgetFile "editTerm")
+
+newTermForm :: Maybe Term -> Form Term
+newTermForm template = 
+    renderBootstrap3 BootstrapBasicForm $ Term
+      <$> 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
+      <*> areq checkBoxField (set "Aktiv") (termActive <$> template)
+  where set txt = FieldSettings
+            { fsLabel = txt
+            , fsTooltip = Nothing
+            , fsId = Nothing
+            , fsName = Nothing
+            , fsAttrs =
+                [ ("class", "form-control")                
+                ]
+            }
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
new file mode 100644
index 000000000..7767aa12b
--- /dev/null
+++ b/src/Handler/Utils.hs
@@ -0,0 +1,5 @@
+module Handler.Utils
+  ( module Handler.Utils 
+  ) where
+
+import Handler.Utils.Term as Handler.Utils
diff --git a/src/Handler/Utils/Term.hs b/src/Handler/Utils/Term.hs
new file mode 100644
index 000000000..57ea6bdda
--- /dev/null
+++ b/src/Handler/Utils/Term.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+module Handler.Utils.Term where
+
+import Import
+import qualified Data.Text as T
+-- import Data.Maybe
+
+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"
+    
+    errTextFreigabe :: TermIdentifier -> Text
+    errTextFreigabe ti = "Semester " `T.append` (termToText ti) `T.append` " wurde noch nicht freigegeben."
+    
+    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