100 lines
3.1 KiB
Haskell
100 lines
3.1 KiB
Haskell
{-# 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")
|
|
-}
|