Merge branch 'formgroups' into 'master'
Form sections See merge request !140
This commit is contained in:
Steffen Jost
commit
beda7f7015
@ -355,6 +355,9 @@ TimeFormat: Uhrzeitformat
|
||||
DownloadFiles: Dateien automatisch herunterladen
|
||||
DownloadFilesTip: Wenn gesetzt werden Dateien von Abgaben und Übungsblättern automatisch als Download behandelt, ansonsten ist das Verhalten browserabhängig (es können z.B. PDFs im Browser geöffnet werden).
|
||||
NotificationSettings: Erwünschte Benachrichtigungen
|
||||
FormNotifications: Benachrichtigungen
|
||||
FormBehaviour: Verhalten
|
||||
FormCosmetics: Oberfläche
|
||||
|
||||
ActiveAuthTags: Aktivierte Authorisierungsprädikate
|
||||
|
||||
|
||||
@ -54,6 +54,24 @@ emailTestForm = (,)
|
||||
SelFormatDate -> d
|
||||
SelFormatTime -> t
|
||||
|
||||
makeDemoForm :: Int -> Form (Int,Bool,Double)
|
||||
makeDemoForm n = identifyForm "adminTestForm" $ \html -> do -- Important: used identForm instead!
|
||||
(result, widget) <- flip (renderAForm FormStandard) html $ (,,)
|
||||
<$> areq (minIntField n "Zahl") (fromString $ "Ganzzahl > " ++ show n) Nothing
|
||||
<* aformSection MsgFormBehaviour
|
||||
<*> areq checkBoxField "Muss nächste Zahl größer sein?" (Just True)
|
||||
<*> areq doubleField "Fliesskommazahl" Nothing
|
||||
<* submitButton
|
||||
return $ case result of
|
||||
FormSuccess fsres
|
||||
| errorMsgs <- validateResult fsres
|
||||
, not $ null errorMsgs -> (FormFailure errorMsgs, widget)
|
||||
_otherwise -> (result, widget)
|
||||
where
|
||||
validateResult :: (Int,Bool,Double) -> [Text]
|
||||
validateResult (i,True,d) | (fromIntegral i) >= d = [tshow d <> " ist nicht größer als " <> tshow i, "Zweite Fehlermeldung", "Dritte Fehlermeldung"]
|
||||
validateResult _other = []
|
||||
|
||||
|
||||
getAdminTestR, postAdminTestR :: Handler Html -- Demo Page. Referenzimplementierungen sollte hier gezeigt werden!
|
||||
getAdminTestR = postAdminTestR
|
||||
@ -81,10 +99,43 @@ postAdminTestR = do
|
||||
^{emailWidget}
|
||||
|]
|
||||
|
||||
defaultLayout $
|
||||
-- setTitle "Uni2work Admin Testpage"
|
||||
|
||||
let demoFormAction (_i,_b,_d) = addMessage Info "All ok."
|
||||
((demoResult, formWidget),formEnctype) <- runFormPost $ makeDemoForm 7
|
||||
formResult demoResult demoFormAction
|
||||
let actionUrl = AdminTestR
|
||||
let showDemoResult = [whamlet|
|
||||
$maybe (i,b,d) <- formResult' demoResult
|
||||
Received values:
|
||||
<ul>
|
||||
<li>#{show i}
|
||||
<li>#{show b}
|
||||
<li>#{show d}
|
||||
$nothing
|
||||
No form values received, due to #
|
||||
$# Using formResult' above means that we usually to not distinguish the following two cases here, sind formResult does this already:
|
||||
$case demoResult
|
||||
$of FormSuccess _
|
||||
$# Already dealt with above, to showecase usage of formResult' as normally done.
|
||||
success, which should not happen here.
|
||||
$of FormMissing
|
||||
Form data missing, probably empty.
|
||||
$of FormFailure msgs
|
||||
<ul>
|
||||
$forall m <- msgs
|
||||
<li>#{m}
|
||||
|]
|
||||
|
||||
let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
|
||||
siteLayout locallyDefinedPageHeading $ do
|
||||
-- defaultLayout $ do
|
||||
setTitle "Uni2work Admin Testpage"
|
||||
$(widgetFile "adminTest")
|
||||
|
||||
[whamlet|<h2>Formular Demonstration|]
|
||||
$(widgetFile "formPage")
|
||||
showDemoResult
|
||||
|
||||
|
||||
getAdminErrMsgR, postAdminErrMsgR :: Handler Html
|
||||
getAdminErrMsgR = postAdminErrMsgR
|
||||
|
||||
@ -34,10 +34,10 @@ colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
|
||||
[whamlet|#{display courseName}|]
|
||||
|
||||
colCourseDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) $ do
|
||||
course <- view $ _dbrOutput . _1 . _entityVal
|
||||
return $ courseCell course
|
||||
-- colCourseDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
-- colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) $ do
|
||||
-- course <- view $ _dbrOutput . _1 . _entityVal
|
||||
-- return $ courseCell course
|
||||
|
||||
colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colDescription = sortable Nothing mempty
|
||||
@ -51,19 +51,19 @@ colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|]
|
||||
|
||||
colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend
|
||||
( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
|
||||
( case courseDescription of
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell
|
||||
[whamlet|
|
||||
$newline never
|
||||
<div>
|
||||
^{modal "Beschreibung" (Right $ toWidget descr)}
|
||||
|]
|
||||
)
|
||||
-- colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
-- colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
-- $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend
|
||||
-- ( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
|
||||
-- ( case courseDescription of
|
||||
-- Nothing -> mempty
|
||||
-- (Just descr) -> cell
|
||||
-- [whamlet|
|
||||
-- $newline never
|
||||
-- <div>
|
||||
-- ^{modal "Beschreibung" (Right $ toWidget descr)}
|
||||
-- |]
|
||||
-- )
|
||||
|
||||
colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colTerm = sortable (Just "term") (i18nCell MsgTerm)
|
||||
@ -221,7 +221,8 @@ getTermSchoolCourseListR tid ssh = do
|
||||
muid <- maybeAuthId
|
||||
let colonnade = widgetColonnade $ mconcat
|
||||
[ dbRow
|
||||
, colCShortDescr
|
||||
, colCShort
|
||||
, colDescription
|
||||
, colRegFrom
|
||||
, colRegTo
|
||||
, colMembers
|
||||
@ -244,7 +245,8 @@ getTermCourseListR tid = do
|
||||
muid <- maybeAuthId
|
||||
let colonnade = widgetColonnade $ mconcat
|
||||
[ dbRow
|
||||
, colCShortDescr
|
||||
, colCShort
|
||||
, colDescription
|
||||
, colSchoolShort
|
||||
, colRegFrom
|
||||
, colRegTo
|
||||
|
||||
@ -206,7 +206,8 @@ getDataProtR = -- do
|
||||
-- | Allgemeine Informationen
|
||||
getInfoR :: Handler TypedContent
|
||||
getInfoR = selectRep $ do
|
||||
provideRep . defaultLayout $ do
|
||||
let infoHeading = [whamlet|Re-Implementierung von <a href="https://uniworx.ifi.lmu.de/">UniWorX</a>|]
|
||||
provideRep . siteLayout infoHeading $ do
|
||||
let features = $(widgetFile "featureList")
|
||||
gitInfo :: Text
|
||||
gitInfo = $gitDescribe <> " (" <> $gitCommitDate <> ")"
|
||||
|
||||
@ -28,24 +28,54 @@ data SettingsForm = SettingsForm
|
||||
|
||||
makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
|
||||
makeSettingForm template = identForm FIDsettings $ \html -> do
|
||||
let themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
|
||||
(result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
|
||||
<$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
|
||||
<$ aformSection MsgFormCosmetics
|
||||
<*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
|
||||
(fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
|
||||
<*> areq (selectField . return $ mkOptionList themeList)
|
||||
<*> areq (selectField . return $ mkOptionList themeList)
|
||||
(fslI MsgTheme) { fsId = Just "theme-select" } (stgTheme <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
|
||||
<*> areq checkBoxField (fslI MsgDownloadFiles
|
||||
& setTooltip MsgDownloadFilesTip
|
||||
) (stgDownloadFiles <$> template)
|
||||
<*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
|
||||
<* submitButton
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
|
||||
<* aformSection MsgFormBehaviour
|
||||
<*> areq checkBoxField (fslI MsgDownloadFiles
|
||||
& setTooltip MsgDownloadFilesTip
|
||||
) (stgDownloadFiles <$> template)
|
||||
<* aformSection MsgFormNotifications
|
||||
<*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
|
||||
<* submitButton
|
||||
return (result, widget) -- no validation required here
|
||||
where
|
||||
themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
|
||||
nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)
|
||||
|
||||
--
|
||||
-- Version with proper grouping:
|
||||
--
|
||||
-- makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
|
||||
-- makeSettingForm template = identForm FIDsettings $ \html -> do
|
||||
-- (result, widget) <- flip (renderAForm FormStandard) html $ settingsFormT5T2
|
||||
-- <$> aFormGroup "Cosmetics" cosmeticsForm
|
||||
-- <*> aFormGroup "Notifications" notificationsForm
|
||||
-- <* submitButton
|
||||
-- return (result, widget) -- no validation required here
|
||||
-- where
|
||||
-- settingsFormT5T2 :: (Int,Theme,DateTimeFormat,DateTimeFormat,DateTimeFormat) -> (Bool,NotificationSettings) -> SettingsForm
|
||||
-- settingsFormT5T2 = $(uncurryN 2) . $(uncurryN 5) SettingsForm
|
||||
-- themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
|
||||
-- cosmeticsForm = (,,,,)
|
||||
-- <$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
|
||||
-- (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
|
||||
-- <*> areq (selectField . return $ mkOptionList themeList)
|
||||
-- (fslI MsgTheme) { fsId = Just "theme-select" } (stgTheme <$> template)
|
||||
-- <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
|
||||
-- <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
|
||||
-- <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
|
||||
-- notificationsForm = (,)
|
||||
-- <$> areq checkBoxField (fslI MsgDownloadFiles
|
||||
-- & setTooltip MsgDownloadFilesTip
|
||||
-- ) (stgDownloadFiles <$> template)
|
||||
-- <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
|
||||
-- nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)
|
||||
|
||||
getProfileR, postProfileR :: Handler Html
|
||||
getProfileR = postProfileR
|
||||
|
||||
@ -148,7 +148,7 @@ getTermEditR = do
|
||||
mbLastTerm <- runDB $ selectFirst [] [Desc TermName]
|
||||
let template = case mbLastTerm of
|
||||
Nothing -> mempty
|
||||
(Just Entity{ entityVal=Term{..} }) -> let
|
||||
(Just Entity{ entityVal=Term{..}}) -> let
|
||||
ntid = succ termName
|
||||
seas = season ntid
|
||||
yr = year ntid
|
||||
|
||||
@ -156,10 +156,11 @@ natIntField ::(Monad m, RenderMessage (HandlerSite m) FormMessage) => Text -> Fi
|
||||
natIntField = natField
|
||||
|
||||
posIntField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
|
||||
posIntField d = checkBool (>= 1) (T.append d " muss eine positive Zahl sein.") intField
|
||||
posIntField d = checkBool (> 0) (T.append d " muss eine positive Zahl sein.") intField
|
||||
|
||||
-- | Field to request integral number > 'm'
|
||||
minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i
|
||||
minIntField m d = checkBool (>= m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) intField
|
||||
minIntField m d = checkBool (> m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) intField
|
||||
|
||||
pointsField :: (Monad m, HandlerSite m ~ UniWorX) => Field m Points --TODO allow fractions
|
||||
pointsField = checkBool (>= 0) MsgPointsNotPositive Field{..}
|
||||
@ -289,7 +290,6 @@ multiFileField permittedFiles' = Field{..}
|
||||
Right _ -> return ()
|
||||
Left r -> yield r
|
||||
|
||||
|
||||
data SheetGrading' = Points' | PassPoints' | PassBinary'
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded)
|
||||
|
||||
|
||||
@ -18,7 +18,7 @@ modal modalTrigger modalContent = do
|
||||
<a .modal__trigger href=#{route'} ##{triggerId}>
|
||||
<span .modal__trigger-label>^{modalTrigger}
|
||||
|]
|
||||
Right _ -> -- do
|
||||
Right _ ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
<div .modal__trigger ##{triggerId}>
|
||||
|
||||
@ -5,6 +5,7 @@ module Utils.Form where
|
||||
import ClassyPrelude.Yesod hiding (addMessage, cons, Proxy(..))
|
||||
import Settings
|
||||
|
||||
-- import Text.Blaze (toMarkup) -- for debugging
|
||||
import qualified Text.Blaze.Internal as Blaze (null)
|
||||
import qualified Data.Text as T
|
||||
|
||||
@ -44,6 +45,38 @@ renderAForm formLayout aform fragment = do
|
||||
let widget = $(widgetFile "widgets/form/form")
|
||||
return (res, widget)
|
||||
|
||||
-- | special id to identify form section headers, see 'aformSection' and 'formSection'
|
||||
-- currently only treated by form generation through 'renderAForm'
|
||||
idFormSectionNoinput :: Text
|
||||
idFormSectionNoinput = "form-section-noinput"
|
||||
|
||||
-- | Generates a form having just a form-section-header and no input title.
|
||||
-- Currently only correctly rendered by 'renderAForm' and mforms using 'widget/form.hamlet'
|
||||
-- Usage:
|
||||
-- @
|
||||
-- (,) <$ formSection MsgInt
|
||||
-- <*> areq intField "int here" Nothing
|
||||
-- <* formSection MsgDouble
|
||||
-- <*> areq doubleField "double there " Nothing
|
||||
-- <* submitButton
|
||||
-- @
|
||||
-- If tooltips or other attributes are required, see 'formSection\'' instead.
|
||||
aformSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> AForm m ()
|
||||
aformSection = formToAForm . fmap (second pure) . formSection
|
||||
|
||||
formSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
|
||||
formSection formSectionTitle = do
|
||||
mr <- getMessageRender
|
||||
return (FormSuccess (), FieldView
|
||||
{ fvLabel = toHtml $ mr formSectionTitle
|
||||
, fvTooltip = Nothing
|
||||
, fvId = idFormSectionNoinput
|
||||
, fvErrors = Nothing
|
||||
, fvRequired = False
|
||||
, fvInput = mempty
|
||||
})
|
||||
|
||||
|
||||
--------------------
|
||||
-- Field Settings --
|
||||
--------------------
|
||||
@ -323,6 +356,13 @@ submitButtonView = do
|
||||
-- Custom Fields --
|
||||
-------------------
|
||||
|
||||
-- | empty field that has no view and always succeeds, useful for form sections having only a label
|
||||
noinputField :: Monad m => Field m ()
|
||||
noinputField = Field { fieldEnctype = UrlEncoded
|
||||
, fieldParse = const $ const $ return $ Right $ Just ()
|
||||
, fieldView = \_theId _name _attrs _val _isReq -> mempty
|
||||
}
|
||||
|
||||
ciField :: ( Textual t
|
||||
, CI.FoldCase t
|
||||
, Monad m
|
||||
@ -386,6 +426,24 @@ optionsFinite = do
|
||||
}
|
||||
return . mkOptionList $ mkOption <$> universeF
|
||||
|
||||
-------------------
|
||||
-- Special Forms --
|
||||
-------------------
|
||||
|
||||
-- | Alternative implementation for 'aformSection' in a more standard that
|
||||
-- allows tooltips and arbitrary attributs. Section header must be given through `fsLabel`
|
||||
aformSection' :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site FormMessage) => FieldSettings site -> AForm m ()
|
||||
aformSection' = formToAForm . fmap (second pure) . formSection'
|
||||
|
||||
-- | Alternative implementation for 'formSection' in a more standard that
|
||||
-- allows tooltips and arbitrary attributs. Section header must be given through `fsLabel`
|
||||
formSection' :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site FormMessage) =>
|
||||
FieldSettings site -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
|
||||
formSection' formSectionTitleSettings = mreq noinputField sectionSettings Nothing
|
||||
where
|
||||
sectionSettings = formSectionTitleSettings { fsId = Just idFormSectionNoinput }
|
||||
|
||||
|
||||
|
||||
---------------------
|
||||
-- Form evaluation --
|
||||
@ -453,3 +511,5 @@ prismAForm :: Monad m => Prism' s a -> Maybe s -> (Maybe a -> AForm m a) -> AFo
|
||||
prismAForm p outer form = review p <$> form inner
|
||||
where
|
||||
inner = outer >>= preview p
|
||||
|
||||
|
||||
|
||||
@ -24,7 +24,7 @@ projNI n i = lamE [pat] rhs
|
||||
where pat = tupP (map varP xs)
|
||||
rhs = varE (xs !! (i - 1))
|
||||
xs = [ mkName $ "x" ++ show j | j <- [1..n] ]
|
||||
|
||||
|
||||
---------------
|
||||
-- Functions --
|
||||
---------------
|
||||
@ -34,21 +34,38 @@ permuteFun perm = lamE pat rhs
|
||||
where pat = map varP $ fn:xs
|
||||
rhs = foldl appE (varE fn) $ map varE ps
|
||||
-- rhs = appE (varE fn) (varE $ xs!!1)
|
||||
ln = length perm
|
||||
ln = length perm
|
||||
xs = [ mkName $ "x" ++ show j | j <- [1..ln] ]
|
||||
ps = [ xs !! (j-1) | j <- perm ]
|
||||
fn = mkName "fn"
|
||||
fn = mkName "fn"
|
||||
|
||||
altFun :: [Int] -> ExpQ -- generic permutation/repetition of function arguments, i.e. $(permuteFun [2,1]) == flip
|
||||
altFun perm = lamE pat rhs
|
||||
where pat = map varP $ fn:xs
|
||||
rhs = foldl appE (varE fn) $ map varE ps
|
||||
-- rhs = appE (varE fn) (varE $ xs!!1)
|
||||
-- rhs = appE (varE fn) (varE $ xs!!1)
|
||||
mx = maximum $ impureNonNull perm
|
||||
xs = [ mkName $ "x" ++ show j | j <- [1..mx] ]
|
||||
ps = [ xs !! (j-1) | j <- perm ]
|
||||
fn = mkName "fn"
|
||||
|
||||
fn = mkName "fn"
|
||||
|
||||
-- |
|
||||
curryN :: Int -> ExpQ
|
||||
curryN n = do
|
||||
fn <- newName "foo"
|
||||
xs <- replicateM n $ newName "x"
|
||||
let pat = map VarP (fn:xs)
|
||||
let tup = TupE (map VarE xs)
|
||||
let rhs = AppE (VarE fn) tup
|
||||
return $ LamE pat rhs
|
||||
|
||||
uncurryN :: Int -> ExpQ
|
||||
uncurryN n = do
|
||||
fn <- newName "foo"
|
||||
xs <- replicateM n $ newName "x"
|
||||
let pat = [VarP fn, TupP (map VarP xs)]
|
||||
let rhs = foldl AppE (VarE fn) (map VarE xs)
|
||||
return $ LamE pat rhs
|
||||
|
||||
|
||||
-- Special Show-Instances for Themes
|
||||
@ -105,10 +122,10 @@ embedRenderMessage f inner mangle = do
|
||||
|
||||
f' <- newName "f"
|
||||
ls <- newName "ls"
|
||||
|
||||
|
||||
pure <$> instanceD (cxt []) [t|RenderMessage $(conT f) $(conT inner)|]
|
||||
[ funD 'renderMessage
|
||||
[ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) []
|
||||
[ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) []
|
||||
]
|
||||
]
|
||||
|
||||
@ -129,13 +146,13 @@ embedRenderMessageVariant f newT mangle = do
|
||||
|
||||
f' <- newName "f"
|
||||
ls <- newName "ls"
|
||||
|
||||
|
||||
pure <$> instanceD (cxt []) [t|RenderMessage $(conT f) $(conT newT)|]
|
||||
[ funD 'renderMessage
|
||||
[ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) []
|
||||
[ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) []
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
dispatchTH :: Name -- ^ Datatype to pattern match
|
||||
-> ExpQ
|
||||
|
||||
@ -11,6 +11,12 @@ fieldset {
|
||||
margin-bottom: 0;
|
||||
}
|
||||
|
||||
@media (min-width: 769px) {
|
||||
.form-group__input {
|
||||
grid-column: 2;
|
||||
}
|
||||
}
|
||||
|
||||
[data-autosubmit][type="submit"] {
|
||||
animation: fade-in 500ms ease-in-out backwards;
|
||||
animation-delay: 500ms;
|
||||
|
||||
@ -13,8 +13,16 @@
|
||||
border-left: 2px solid transparent;
|
||||
|
||||
+ .form-group {
|
||||
margin-top: 13px;
|
||||
margin-top: 7px;
|
||||
}
|
||||
|
||||
+ .form-section-title {
|
||||
margin-top: 40px;
|
||||
}
|
||||
}
|
||||
|
||||
.form-section-title {
|
||||
color: var(--color-fontsec);
|
||||
}
|
||||
|
||||
.form-group__label {
|
||||
@ -22,6 +30,12 @@
|
||||
padding-top: 6px;
|
||||
}
|
||||
|
||||
.form-group__hint {
|
||||
margin-top: 7px;
|
||||
color: var(--color-fontsec);
|
||||
font-size: 0.9rem;
|
||||
}
|
||||
|
||||
.form-group--required {
|
||||
|
||||
.form-group__label::after {
|
||||
|
||||
@ -14,7 +14,7 @@
|
||||
<h4>
|
||||
neue geplante Features:
|
||||
<ul>
|
||||
<li> Stundenplan/Kalender
|
||||
<li> Stundenplan/Kalender mit Veranstaltungen und Klausuren
|
||||
<li> Vollständige Vorlesungshomepages
|
||||
<li> Vollständige Internationalisierung deutsch/englisch/...
|
||||
|
||||
|
||||
@ -1,2 +1,5 @@
|
||||
$newline never
|
||||
$#TODO: anchor must be generic for working with multiple forms
|
||||
<a id="forms">
|
||||
<form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
|
||||
^{formWidget}
|
||||
|
||||
@ -1,5 +1,8 @@
|
||||
$newline never
|
||||
$maybe text <- formText
|
||||
<h3>
|
||||
<h2>
|
||||
_{text}
|
||||
$#TODO: anchor must be generic for working with multiple forms
|
||||
<a id="forms">
|
||||
<form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
|
||||
^{formWidget}
|
||||
^{formWidget}
|
||||
|
||||
@ -1,6 +1,4 @@
|
||||
<div .container>
|
||||
<h3>
|
||||
Re-Implementierung von <a href="https://uniworx.ifi.lmu.de/">UniWorX</a>
|
||||
|
||||
<section>
|
||||
^{features}
|
||||
@ -8,13 +6,13 @@
|
||||
<section>
|
||||
<h2>
|
||||
Bekannte Bugs
|
||||
<h3>
|
||||
Stand: Februar 2019
|
||||
<ul>
|
||||
<li>
|
||||
Login ist u.U. anders als im alten System, z.B. <span style="font-family:monospace">@campus.lmu.de</span> statt <span style="font-family:monospace">@lmu.de</span>
|
||||
Login ist u.U. anders als im alten System, z.B. momentan geht nur <span style="font-family:monospace">@campus.lmu.de</span> aber nicht die Abkürzung <span style="font-family:monospace">@lmu.de</span>
|
||||
<li>
|
||||
Favicon ist default des Frameworks
|
||||
<li>
|
||||
Format von Bewertungsdateien ist provisorisch
|
||||
Format von Bewertungsdateien ist noch provisorisch
|
||||
|
||||
<section>
|
||||
<h2>
|
||||
|
||||
@ -7,14 +7,17 @@ $case formLayout
|
||||
^{fvInput view}
|
||||
$of _
|
||||
$forall view <- fieldViews
|
||||
$# TODO: add class 'form-group--submit' if this is the submit-button view
|
||||
<div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
|
||||
$if not (Blaze.null $ fvLabel view)
|
||||
<label .form-group__label for=#{fvId view}>
|
||||
#{fvLabel view}
|
||||
$maybe tooltip <- fvTooltip view
|
||||
<div .tooltip>
|
||||
<div .tooltip__handle>
|
||||
<div .tooltip__content>^{tooltip}
|
||||
<div .form-group__input>
|
||||
^{fvInput view}
|
||||
$if fvId view == idFormSectionNoinput
|
||||
<h3 .form-section-title>
|
||||
^{fvLabel view}
|
||||
$else
|
||||
<div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
|
||||
$if not (Blaze.null $ fvLabel view)
|
||||
<label .form-group__label for=#{fvId view}>
|
||||
#{fvLabel view}
|
||||
$maybe hint <- fvTooltip view
|
||||
<div .form-group__hint>^{hint}
|
||||
<div .form-group__input>
|
||||
^{fvInput view}
|
||||
$maybe err <- fvErrors view
|
||||
<div .form-error>#{err}
|
||||
|
||||
@ -218,9 +218,22 @@ fillDb = do
|
||||
repsert sdInf $ StudyTerms 79 (Just "IfI") (Just "Institut für Informatik")
|
||||
repsert sdMath $ StudyTerms 105 (Just "MI" ) (Just "Mathematisches Institut")
|
||||
-- FFP
|
||||
let nbrs :: [Int]
|
||||
nbrs = [1,2,3,27,7,1]
|
||||
ffp <- insert' Course
|
||||
{ courseName = "Fortgeschrittene Funktionale Programmierung"
|
||||
, courseDescription = Just "<h2>It is fun!</h2>Come to where the functional is!"
|
||||
, courseDescription = Just [shamlet|
|
||||
<h2>It is fun!
|
||||
<p>Come to where the functional is!
|
||||
<section>
|
||||
<h3>Functional programming can be done in Haskell!
|
||||
<p>This is not a joke, this is serious!
|
||||
<section>
|
||||
<h3>Consider some numbers
|
||||
<ul>
|
||||
$forall n <- nbrs
|
||||
<li>Number #{n}
|
||||
|]
|
||||
, courseLinkExternal = Nothing
|
||||
, courseShorthand = "FFP"
|
||||
, courseTerm = TermKey summer2018
|
||||
|
||||
Loading…
Reference in New Issue
Block a user