{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} 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 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 -- 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| Fehler: