diff --git a/models b/models index 7736ff9de..ab99fc582 100644 --- a/models +++ b/models @@ -8,7 +8,8 @@ Term json start Day end Day holidays [Day] - -- UniqueTerm shorthand + active Bool + UniqueTerm name Primary name deriving Show School json diff --git a/routes b/routes index 133c66add..ee2df1f02 100644 --- a/routes +++ b/routes @@ -9,4 +9,6 @@ /profile ProfileR GET -/assist/newcourse NewCourseR GET POST \ No newline at end of file +/assist/newcourse NewCourseR GET POST +/assist/newterm NewTermR GET POST +/assist/showterm ShowTermR GET diff --git a/src/Foundation.hs b/src/Foundation.hs index b31b50669..7f135afab 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -168,6 +168,8 @@ instance Yesod UniWorX where isAuthorized ProfileR _ = isAuthenticated -- TODO: change to Assistants isAuthorized NewCourseR _ = return Authorized + isAuthorized NewTermR _ = return Authorized + isAuthorized ShowTermR _ = return Authorized -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows diff --git a/src/Handler/Assist.hs b/src/Handler/Assist.hs index 89823a678..889cc68b2 100644 --- a/src/Handler/Assist.hs +++ b/src/Handler/Assist.hs @@ -8,9 +8,35 @@ module Handler.Assist where import Import import qualified Data.Text as T +import Data.Maybe import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3) +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 + 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 $ Key ti -- TODO: membershiptest instead? + term <- runDB $ getBy $ UniqueTerm ti -- TODO: use get instead of getBy? + return $ if isNothing term + then Left $ errTextFreigabe ti + else res + + + +-- Handler for Assistants + data NewCourseForm = NewCourseForm { ncf_user :: UserId , ncf_term :: TermIdentifier @@ -21,57 +47,6 @@ data NewCourseForm = NewCourseForm , ncf_html :: Html , ncf_capacity :: Maybe Int } --- Handler for Assistants - -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 Daten erhalten." - $(widgetFile "newcourse") - FormFailure errorMsgs -> defaultLayout $ do - setMessage [shamlet| Fehler: -