diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 9e7b109a8..c8ca18323 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -97,8 +97,7 @@ getCourseShowR tid csh = do $(widgetFile "course") registerButton :: Bool -> Form () -registerButton registered = - renderBootstrap3 bsHorizontalDefault $ +registerButton registered = renderAForm FormStandard $ pure () <* bootstrapSubmit regMsg where msg = if registered then "Abmelden" else "Anmelden" @@ -267,7 +266,7 @@ newCourseForm template = identForm FIDcourse $ \html -> do -- courseId <- runMaybeT $ do -- cid <- cfCourseId template -- UUID.encrypt cidKey cid - (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ CourseForm + (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm -- <$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work? <$> aopt hiddenField "KursId" (cfCourseId <$> template) <*> areq textField (fsb "Name") (cfName <$> template) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 4edfaa7bb..06a7d8fb1 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -17,7 +17,6 @@ import Handler.Utils.Zip -- import Data.Time import qualified Data.Text as T -- import Data.Function ((&)) -import Yesod.Form.Bootstrap3 -- import Colonnade -- hiding (fromMaybe) import Yesod.Colonnade @@ -54,7 +53,7 @@ makeSheetForm :: CourseId -> Maybe SheetForm -> Form SheetForm makeSheetForm cid template = identForm FIDsheet $ \html -> do -- TODO: Yesod.Form.MassInput.inputList arbeitet Server-seitig :( -- Erstmal nur mit ZIP arbeiten - (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ SheetForm + (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm <$> areq textField (fsb "Name") (sfName <$> template) <*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfMarkingText <$> template) <*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template) diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index d7d3cf468..3fb482691 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -13,7 +13,7 @@ module Handler.Submission where import Import hiding (joinPath) -import Yesod.Form.Bootstrap3 +-- import Yesod.Form.Bootstrap3 import Handler.Utils @@ -72,10 +72,10 @@ submissionTable = do getSubmissionListR, postSubmissionListR :: Handler Html getSubmissionListR = postSubmissionListR postSubmissionListR = do - ((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderBootstrap3 BootstrapBasicForm $ (,) - <$> areq checkBoxField (bfs ("Dies sind Korrekturen" :: Text)) (Just False) - <*> fileAFormReq (bfs ("Archiv" :: Text)) - <* bootstrapSubmit ("Mehrere Hochladen" :: BootstrapSubmit Text) + ((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderAForm FormStandard $ (,) + <$> areq checkBoxField "Dies sind Korrekturen" (Just False) + <*> fileAFormReq "Archiv" + <* submitButton runDB $ do case uploadResult of @@ -211,10 +211,10 @@ getSubmissionR = postSubmissionR postSubmissionR cID = do submissionId <- decrypt cID - ((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderBootstrap3 BootstrapBasicForm $ (,) - <$> areq checkBoxField (bfs ("Dies ist eine Korrektur" :: Text)) (Just False) - <*> fileAFormReq (bfs ("Datei" :: Text)) - <* bootstrapSubmit ("Upload" :: BootstrapSubmit Text) + ((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderAForm FormStandard $ (,) + <$> areq checkBoxField "Dies ist eine Korrektur" (Just False) + <*> fileAFormReq "Datei" + <* submitButton (submission, files) <- runDB $ do submission <- do diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index b854655da..e41e24fc3 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -128,7 +128,7 @@ wdgtTermForm formWidget formEnctype = do newTermForm :: Maybe Term -> Form Term newTermForm template html = do - (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ Term + (result, widget) <- flip (renderAForm FormStandard) html $ Term <$> areq termNewField (bfs ("Semester" :: Text)) (termName <$> template) <*> areq dayField (bfs ("Erster Tag" :: Text)) (termStart <$> template) <*> areq dayField (bfs ("Letzer Tag" :: Text)) (termEnd <$> template) diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 8f43426b3..e8143d998 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -11,7 +11,6 @@ import Import.NoFoundation import Handler.Utils.DateTime as Handler.Utils import Handler.Utils.Term as Handler.Utils -import Handler.Utils.Bootstrap3 as Handler.Utils import Handler.Utils.Form as Handler.Utils import Handler.Utils.Table as Handler.Utils diff --git a/src/Handler/Utils/Bootstrap3.hs b/src/Handler/Utils/Bootstrap3.hs deleted file mode 100644 index cbc970061..000000000 --- a/src/Handler/Utils/Bootstrap3.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} - -module Handler.Utils.Bootstrap3 where - -import Import -import Data.String (IsString(..)) --- import Yesod.Core --- import qualified Data.Text as T --- import Yesod.Form.Types --- import Yesod.Form.Functions -import Yesod.Form.Bootstrap3 - -bsSubmit :: String -> BootstrapSubmit Text -bsSubmit msg = - BootstrapSubmit (fromString msg) " btn-default btn-primary " [] - -bsHorizontalDefault :: BootstrapFormLayout -bsHorizontalDefault = - BootstrapHorizontalForm - { bflLabelOffset = ColSm 1 - , bflLabelSize = ColSm 4 - , bflInputOffset = ColSm 1 - , bflInputSize = ColSm 6 - } - diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 3fa164fbf..b286f7a73 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -6,6 +6,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ViewPatterns #-} module Handler.Utils.Form where @@ -22,6 +23,8 @@ import qualified Data.Text as T import Yesod.Form.Functions (parseHelper) import Yesod.Form.Bootstrap3 +import qualified Text.Blaze.Internal as Blaze (null) + import Web.PathPieces (showToPathPiece, readFromPathPiece) ------------------------------------------------ @@ -35,6 +38,18 @@ data FormIdentifier = FIDcourse | FIDsheet identForm :: FormIdentifier -> Form a -> Form a identForm fid = identifyForm (T.pack $ show fid) +------------------- +-- Form Renderer -- +------------------- + +-- | Use this type to pass information to the form template +data FormLayout = FormStandard + +renderAForm :: Monad m => FormLayout -> FormRender m a +renderAForm formLayout aform fragment = do + (res, (($ []) -> views)) <- aFormToForm aform + let widget = $(widgetFile "form") + return (res, widget) ---------------------------- -- Buttons (new version ) -- @@ -70,6 +85,18 @@ instance Button StandardButton where cssClass BtnDelete = BCWarning cssClass BtnAbort = BCDefault cssClass BtnSave = BCPrimary + +data SubmitButton = BtnSubmit + deriving (Enum, Eq, Ord, Bounded, Read, Show) + +instance PathPiece SubmitButton where + toPathPiece = showToPathPiece + fromPathPiece = readFromPathPiece + +instance Button SubmitButton where + label BtnSubmit = "Submit" + + cssClass BtnSubmit = BCPrimary -- -- Looks like a button, but is just a link (e.g. for create course, etc.) -- data LinkButton = LinkButton (Route UniWorX) @@ -108,7 +135,10 @@ buttonField btn = Field {fieldParse, fieldView, fieldEnctype} combinedButtonField1 :: Button a => [a] -> AForm Handler [Maybe a] combinedButtonField1 btns = traverse b2f btns where - b2f b = aopt (buttonField b) "n/a" Nothing + b2f b = aopt (buttonField b) "" Nothing + +submitButton :: AForm Handler () +submitButton = void $ combinedButtonField1 [BtnSubmit] {- combinedButtonField :: Button a => [a] -> Form m -> Form (a,m) @@ -200,7 +230,7 @@ defaultFormActions = [ formBtnDelete postButtonForm :: Text -> Form () postButtonForm lblId = identifyForm lblId buttonF where - buttonF = renderBootstrap3 BootstrapInlineForm $ pure () <* bootstrapSubmit bProps + buttonF = renderAForm FormStandard $ pure () <* bootstrapSubmit bProps bProps :: BootstrapSubmit Text bProps = fromString $ unpack lblId diff --git a/templates/form.hamlet b/templates/form.hamlet new file mode 100644 index 000000000..b1e3cd9ee --- /dev/null +++ b/templates/form.hamlet @@ -0,0 +1,9 @@ +$newline never +#{fragment} +$case formLayout + $of FormStandard + $forall view <- views +
+ $if not (Blaze.null $ fvLabel view) +