fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into feat/transaction-log

Browse Source
This commit is contained in:
Gregor Kleen 2019-03-31 14:24:01 +02:00
commit edea0a96aa
13 changed files with 149 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
FragenSJ.txt
View File

@ -1,38 +0,0 @@
** Sicherheitsabfragen?
- Verschlüsselung des Zugriffs?
- SDelR tid csh sn : GET zeigt Sicherheitsabfrage
POST löscht.
Ist das so sinnvoll?
Sicherheitsabfrage als PopUpMessage?
- Utils.getKeyBy404 effiziente Variante, welche nur den Key liefert? Esq?
(Sheet.hs -> fetchSheet)
- Handler.Sheet.postSDelR: deleteCascade für Files? Klappt das?
Kann man abfragen, was bei deleteCascade alles gelöscht wird?
** i18n:
- i18n der
Links -> MenuItems verwenden wie bisher
Page Titles -> setTitleI
Buttons? -> Kann leicht geändert werden!
Was ist mit einfachen Text Feldern, z.B. die Beschriftung von Knöpfen wie in Handler.Course.getTermCourseListR, Zeile 66 "pageActions" für menuItemLabel?
** Page pageActions - Berechtigungen prüfen?
=> Eigener Constructor statt NavbarLeft/Right?!
** FORMS
3 - Sheets: Multiple Files -> wird später gemacht
- Versionen für Studenten/Korrektoren/Lecturers/Admins
-> ja über isAuthorizedDB siehe unten,
-> Lecturer kann gleich auf Edit-Seite gehen wie in UniWorX
Freischaltung von Teilen einer Webseite:
- Freigabe der Links über Authorisierung in der Foundation
- Anzeige der Links nach Authorisierung wie in menItemAccessCallback
- möglichst direkt isAuthorizedDB in einem runDB aufrufen!!!

16
messages/uniworx/de.msg
View File

@ -5,6 +5,9 @@ BtnRegister: Anmelden
BtnDeregister: Abmelden
BtnHijack: Sitzung übernehmen
BtnSave: Speichern
BtnCandidatesInfer: Studienfachzuordnung automatisch lernen
BtnCandidatesDeleteConflicts: Konflikte löschen
BtnCandidatesDeleteAll: Alle Beobachtungen löschen
Aborted: Abgebrochen
Remarks: Hinweise
@ -15,6 +18,11 @@ RegisterFrom: Anmeldungen von
RegisterTo: Anmeldungen bis
DeRegUntil: Abmeldungen bis
GenericKey: Schlüssel
GenericShort: Kürzel
GenericIsNew: Neu
GenericHasConflict: Konflikt
SummerTerm year@Integer: Sommersemester #{display year}
WinterTerm year@Integer: Wintersemester #{display year}/#{display $ succ year}
SummerTermShort year@Integer: SoSe #{display year}
@ -36,6 +44,8 @@ TermStartDay: Erster Tag
TermStartDayTooltip: Üblicherweise immer 1.April oder 1.Oktober
TermEndDay: Letzter Tag
TermEndDayTooltip: Üblicherweise immer 30.September oder 31.März
TermHolidays: Feiertage
TermHolidayPlaceholder: Feiertag
TermLectureStart: Beginn Vorlesungen
TermLectureEnd: Ende Vorlesungen
TermLectureEndTooltip: Meistens dauer das Sommersemester 14 Wochen und das Wintersemester 15 Wochen.
@ -439,10 +449,10 @@ StudyFeatureType:
StudyFeatureValid: Aktiv
StudyFeatureUpdate: Abgeglichen
DegreeKey: Schlüssel Abschluss
DegreeKey: Abschlussschlüssel
DegreeName: Abschluss
DegreeShort: Abschlusskürzel
StudyTermsKey: Schlüssel Studiengang
StudyTermsKey: Studiengangschlüssel
StudyTermsName: Studiengang
StudyTermsShort: Studiengangkürzel
StudyTermsChangeSuccess: Zuordnung Abschlüsse aktualisiert
@ -452,6 +462,8 @@ AmbiguousCandidatesRemoved n@Int: #{show n} #{pluralDE n "uneindeutiger Kandidat
RedundantCandidatesRemoved n@Int: #{show n} bereits #{pluralDE n "bekannter Kandidat" "bekannte Kandiaten"} entfernt
CandidatesInferred n@Int: #{show n} neue #{pluralDE n "Studiengangszuordnung" "Studiengangszuordnungen"} inferiert
NoCandidatesInferred: Keine neuen Studienganszuordnungen inferiert
AllIncidencesDeleted: Alle Beobachtungen wurden gelöscht.
IncidencesDeleted n@Int: #{show n} #{pluralDE n "Beobachtung" "Beobachtungen"} gelöscht
StudyTermIsNew: Neu
StudyFeatureConflict: Es wurden Konflikte in der Studiengang-Zuordnung gefunden

2
routes
View File

@ -59,7 +59,7 @@
/term TermShowR GET !free
/term/current TermCurrentR GET !free
/term/edit TermEditR GET POST
/term/#TermId/edit TermEditExistR GET
/term/#TermId/edit TermEditExistR GET POST
!/term/#TermId TermCourseListR GET !free
!/term/#TermId/#SchoolId TermSchoolCourseListR GET !free

8
src/Foundation.hs
View File

@ -1381,6 +1381,14 @@ pageActions (AdminR) =
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuMessageList
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute MessageListR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgErrMsgHeading

62
src/Handler/Admin.hs
View File

@ -204,7 +204,7 @@ postAdminTestR = do
buttonAction frag = Just . SomeRoute $ AdminTestR :#: frag
-- The actual call to @massInput@ is comparatively simple:
((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd buttonAction) "" True Nothing
@ -269,29 +269,34 @@ postAdminErrMsgR = do
-- BEGIN - Buttons needed only for StudyTermCandidateManagement
data ButtonInferStudyTerms = ButtonInferStudyTerms
data ButtonAdminStudyTerms
= BtnCandidatesInfer
| BtnCandidatesDeleteConflicts
| BtnCandidatesDeleteAll
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonInferStudyTerms
instance Finite ButtonInferStudyTerms
instance Universe ButtonAdminStudyTerms
instance Finite ButtonAdminStudyTerms
nullaryPathPiece ''ButtonInferStudyTerms camelToPathPiece
nullaryPathPiece ''ButtonAdminStudyTerms camelToPathPiece
embedRenderMessage ''UniWorX ''ButtonAdminStudyTerms id
instance Button UniWorX ButtonInferStudyTerms where
btnLabel ButtonInferStudyTerms = "Studienfachzuordnung automatisch lernen"
btnClasses ButtonInferStudyTerms = [BCIsButton, BCPrimary]
instance Button UniWorX ButtonAdminStudyTerms where
btnClasses BtnCandidatesInfer = [BCIsButton, BCPrimary]
btnClasses BtnCandidatesDeleteConflicts = [BCIsButton, BCDanger]
btnClasses BtnCandidatesDeleteAll = [BCIsButton, BCDanger]
-- END Button needed only here
getAdminFeaturesR, postAdminFeaturesR :: Handler Html
getAdminFeaturesR = postAdminFeaturesR
postAdminFeaturesR = do
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonInferStudyTerms)
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonAdminStudyTerms)
let btnForm = wrapForm btnWdgt def
{ formAction = Just $ SomeRoute AdminFeaturesR
, formEncoding = btnEnctype
, formSubmit = FormNoSubmit
}
(infConflicts,infAccepted) <- case btnResult of
FormSuccess ButtonInferStudyTerms -> do
FormSuccess BtnCandidatesInfer -> do
(infConflicts, infAmbiguous, infRedundant, infAccepted) <- Candidates.inferHandler
unless (null infAmbiguous) . addMessageI Info . MsgAmbiguousCandidatesRemoved $ length infAmbiguous
unless (null infRedundant) . addMessageI Info . MsgRedundantCandidatesRemoved $ length infRedundant
@ -301,6 +306,16 @@ postAdminFeaturesR = do
| otherwise
-> addMessageI Success . MsgCandidatesInferred $ length infAccepted
return (infConflicts, infAccepted)
FormSuccess BtnCandidatesDeleteConflicts -> runDB $ do
confs <- Candidates.conflicts
incis <- Candidates.getIncidencesFor (entityKey <$> confs)
deleteWhere [StudyTermCandidateIncidence <-. (E.unValue <$> incis)]
addMessageI Success $ MsgIncidencesDeleted $ length incis
return ([],[])
FormSuccess BtnCandidatesDeleteAll -> runDB $ do
deleteWhere ([] :: [Filter StudyTermCandidate])
addMessageI Success MsgAllIncidencesDeleted
(, []) <$> Candidates.conflicts
_other -> (, []) <$> runDB Candidates.conflicts
( (degreeResult,degreeTable)
@ -308,6 +323,7 @@ postAdminFeaturesR = do
, ((), candidateTable)) <- runDB $ (,,)
<$> mkDegreeTable
<*> mkStudytermsTable (Set.fromList $ map (StudyTermsKey' . fst) infAccepted)
(Set.fromList $ map entityKey infConflicts)
<*> mkCandidateTable
-- This needs to happen after calls to `dbTable` so they can short-circuit correctly
@ -352,7 +368,7 @@ postAdminFeaturesR = do
dbtRowKey = (E.^. StudyDegreeKey)
dbtProj = return
dbtColonnade = formColonnade $ mconcat
[ sortable (Just "key") (i18nCell MsgDegreeKey) (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
[ sortable (Just "key") (i18nCell MsgGenericKey) (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
, sortable (Just "name") (i18nCell MsgDegreeName) (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
, sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
, dbRow
@ -366,11 +382,12 @@ postAdminFeaturesR = do
dbtFilterUI = mempty
dbtParams = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studydegrees-table-wrapper" :: Text)
}
psValidator = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
psValidator = def -- & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
& defaultSorting [SortAscBy "key"]
in dbTable psValidator DBTable{..}
mkStudytermsTable :: Set (Key StudyTerms) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
mkStudytermsTable newKeys =
mkStudytermsTable :: Set (Key StudyTerms) -> Set (Key StudyTerms) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
mkStudytermsTable newKeys badKeys =
let dbtIdent = "admin-studyterms" :: Text
dbtStyle = def
dbtSQLQuery :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
@ -378,15 +395,18 @@ postAdminFeaturesR = do
dbtRowKey = (E.^. StudyTermsKey)
dbtProj = return
dbtColonnade = formColonnade $ mconcat
[ sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
, sortable (Just "isnew") (i18nCell MsgStudyTermIsNew) (isNewCell . flip Set.member newKeys . view (_dbrOutput . _entityKey))
, sortable (Just "name") (i18nCell MsgStudyTermsName) (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
, sortable (Just "short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
[ sortable (Just "key") (i18nCell MsgGenericKey) (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
, sortable (Just "isnew") (i18nCell MsgGenericIsNew) (isNewCell . flip Set.member newKeys . view (_dbrOutput . _entityKey))
, sortable (Just "isbad") (i18nCell MsgGenericHasConflict) (isBadCell . flip Set.member badKeys . view (_dbrOutput . _entityKey))
, sortable (Just "name") (i18nCell MsgStudyTermsName) (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
, sortable (Just "short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
, dbRow
]
dbtSorting = Map.fromList
[ ("key" , SortColumn (E.^. StudyTermsKey))
, ("isnew" , SortColumn (\studyTerm -> studyTerm E.^. StudyTermsId `E.in_` E.valList (Set.toList newKeys)))
, ("isnew" , SortColumn (\studyTerm -> studyTerm E.^. StudyTermsKey `E.in_` E.valList (unStudyTermsKey <$> Set.toList newKeys)))
-- Remember: sorting with E.in_ by StudyTermsId instead will produce esqueleto-error "unsafeSqlBinOp: non-id/composite keys not expected here"
, ("isbad" , SortColumn (\studyTerm -> studyTerm E.^. StudyTermsKey `E.in_` E.valList (unStudyTermsKey <$> Set.toList badKeys)))
, ("name" , SortColumn (E.^. StudyTermsName))
, ("short" , SortColumn (E.^. StudyTermsShorthand))
]
@ -394,7 +414,9 @@ postAdminFeaturesR = do
dbtFilterUI = mempty
dbtParams = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)
}
psValidator = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
psValidator = def
-- & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
& defaultSorting [SortDescBy "isbad", SortDescBy "isnew", SortAscBy "key"]
in dbTable psValidator DBTable{..}
mkCandidateTable =

4
src/Handler/Course.hs
View File

@ -636,9 +636,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do
miDelete :: ListLength -- ^ Current shape
-> ListPosition -- ^ Coordinate to delete
-> MaybeT (MForm (HandlerT UniWorX IO)) (Map ListPosition ListPosition)
miDelete l pos
| l >= 2 = return . Map.fromSet (\pos' -> bool pos' (succ pos') $ pos' >= pos) $ Set.fromList [0..fromIntegral (l - 2)] -- Close gap left by deleted position with values from further down the list; try prohibiting certain deletions by utilising `guard`
| otherwise = return Map.empty
miDelete = miDeleteList
miAllowAdd :: ListPosition -> Natural -> ListLength -> Bool
miAllowAdd _ _ _ = True

33
src/Handler/Term.hs
View File

@ -3,14 +3,16 @@ module Handler.Term where
import Import
import Handler.Utils
import Handler.Utils.Table.Cells
import Handler.Utils.Form.MassInput
import qualified Data.Map as Map
-- import qualified Data.Text as T
import Yesod.Form.Bootstrap3
-- import Colonnade hiding (bool)
import Utils.Lens
import qualified Database.Esqueleto as E
import qualified Data.Set as Set
-- | Default start day of term for season,
-- @True@: start of term, @False@: end of term
defaultDay :: Bool -> Season -> Day
@ -148,7 +150,7 @@ getTermShowR = do
setTitleI MsgTermsHeading
$(widgetFile "terms")
getTermEditR :: Handler Html
getTermEditR, postTermEditR :: Handler Html
getTermEditR = do
mbLastTerm <- runDB $ selectFirst [] [Desc TermName]
let template = case mbLastTerm of
@ -164,18 +166,18 @@ getTermEditR = do
, tftEnd = Just $ defaultDay False seas & setYear yr'
}
termEditHandler template
postTermEditR :: Handler Html
postTermEditR = termEditHandler mempty
getTermEditExistR :: TermId -> Handler Html
getTermEditExistR tid = do
getTermEditExistR, postTermEditExistR :: TermId -> Handler Html
getTermEditExistR = postTermEditExistR
postTermEditExistR tid = do
term <- runDB $ get tid
termEditHandler $ termToTemplate term
termEditHandler :: TermFormTemplate -> Handler Html
termEditHandler term = do
Just eHandler <- getCurrentRoute
((result, formWidget), formEnctype) <- runFormPost $ newTermForm term
case result of
(FormSuccess res) -> do
@ -196,7 +198,7 @@ termEditHandler term = do
defaultLayout $ do
setTitleI MsgTermEditHeading
wrapForm formWidget def
{ formAction = Just $ SomeRoute TermEditR
{ formAction = Just $ SomeRoute eHandler
, formEncoding = formEnctype
}
@ -249,14 +251,21 @@ termToTemplate (Just Term{..}) = TermFormTemplate
newTermForm :: TermFormTemplate -> Form Term
newTermForm template html = do
mr <- getMessageRender
let
tidForm
| Just tid <- tftName template
= aforced termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) tid
| otherwise
= areq termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) Nothing
holidayForm = formToAForm . over (mapped._2) pure $ massInputList dayField (const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder)) (const Nothing) (fslI MsgTermHolidays) True (tftHolidays template) mempty
(result, widget) <- flip (renderAForm FormStandard) html $ Term
<$> areq termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) (tftName template)
<$> tidForm
<*> areq dayField (fslI MsgTermStartDay & setTooltip MsgTermStartDayTooltip) (tftStart template)
<*> areq dayField (fslI MsgTermEndDay & setTooltip MsgTermEndDayTooltip) (tftEnd template)
<*> pure [] -- TODO: List of Day field required, must probably be done as its own form and then combined
<*> (Set.toList . Set.fromList <$> holidayForm)
<*> areq dayField (fslI MsgTermLectureStart) (tftLectureStart template)
<*> areq dayField (fslI MsgTermLectureEnd & setTooltip MsgTermLectureEndTooltip) (tftLectureEnd template)
<*> areq checkBoxField (bfs ("Aktiv" :: Text)) (tftActive template)
<*> areq checkBoxField (fslI MsgTermActive) (tftActive template)
return $ case result of
FormSuccess termResult
| errorMsgs <- validateTerm termResult

39
src/Handler/Utils/Form/MassInput.hs
View File

@ -3,10 +3,11 @@
module Handler.Utils.Form.MassInput
( MassInput(..)
, massInput
, massInputList
, BoxDimension(..)
, IsBoxCoord(..), boxDimension
, Liveliness(..)
, ListLength(..), ListPosition(..)
, ListLength(..), ListPosition(..), miDeleteList
) where
import Import
@ -29,7 +30,6 @@ import Data.List (genericLength, genericIndex, iterate)
import Control.Monad.Trans.Maybe
import Control.Monad.Reader.Class (MonadReader(local))
import Control.Monad.Fix
data BoxDimension x = forall n. (Enum n, Num n) => BoxDimension (Lens' x n)
@ -96,6 +96,13 @@ instance Liveliness ListLength where
max' = Set.lookupMax ns
liveCoord (ListPosition n) = prism' (\(ListLength l) -> n < l) (bool (Just 0) (1 <$ guard (n == 0)))
miDeleteList :: Applicative m => ListLength -> ListPosition -> m (Map ListPosition ListPosition)
miDeleteList l pos
-- Close gap left by deleted position with values from further down the list; try prohibiting certain deletions by utilising `guard`
| l >= 2 = pure . Map.fromSet (\pos' -> bool pos' (succ pos') $ pos' >= pos) $ Set.fromList [0..fromIntegral (l - 2)]
| otherwise = pure Map.empty
data ButtonMassInput coord
= MassInputAddDimension Natural coord
| MassInputDeleteCell coord
@ -205,7 +212,7 @@ massInput :: forall handler cellData cellResult liveliness.
( MonadHandler handler, HandlerSite handler ~ UniWorX
, ToJSON cellData, FromJSON cellData
, Liveliness liveliness
, MonadFix handler, MonadLogger handler
, MonadLogger handler
)
=> MassInput handler liveliness cellData cellResult
-> FieldSettings UniWorX
@ -360,3 +367,29 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
fvInput = $(widgetFile "widgets/massinput/massinput")
fvErrors = Nothing
in return (result, FieldView{..})
-- | Wrapper around `massInput` for the common case, that we just want an arbitrary list of single fields without any constraints
massInputList :: forall handler cellResult.
( MonadHandler handler, HandlerSite handler ~ UniWorX
, MonadLogger handler
)
=> Field handler cellResult
-> (ListPosition -> FieldSettings UniWorX)
-> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
-> FieldSettings UniWorX
-> Bool
-> Maybe [cellResult]
-> (Markup -> MForm handler (FormResult [cellResult], FieldView UniWorX))
massInputList field fieldSettings miButtonAction miSettings miRequired miPrevResult = over (mapped . _1 . mapped) (map snd . Map.elems) . massInput
MassInput { miAdd = \_ _ _ submitBtn -> Just $ \csrf ->
return (FormSuccess $ \pRes -> FormSuccess $ Map.singleton (maybe 0 succ . fmap fst $ Map.lookupMax pRes) (), toWidget csrf >> fvInput submitBtn)
, miCell = \pos () iRes nudge csrf ->
over _2 (\FieldView{..} -> $(widgetFile "widgets/massinput/list/cell")) <$> mreq field (fieldSettings pos & addName (nudge "field")) iRes
, miDelete = miDeleteList
, miAllowAdd = \_ _ _ -> True
, miButtonAction
}
miSettings
miRequired
(Map.fromList . zip [0..] . map ((), ) <$> miPrevResult)

4
src/Handler/Utils/Table/Cells.hs
View File

@ -57,6 +57,10 @@ sqlCell act = mempty & cellContents .~ lift act
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
tickmarkCell = cell . toWidget . hasTickmark
-- | Maybe display an icon for tainted rows
isBadCell :: (IsDBTable m a) => Bool -> DBCell m a
isBadCell = cell . toWidget . isBad
-- | Maybe display a exclamation icon
isNewCell :: (IsDBTable m a) => Bool -> DBCell m a
isNewCell = cell . toWidget . isNew

7
src/Handler/Utils/TermCandidates.hs
View File

@ -180,5 +180,8 @@ conflicts = E.select $ E.from $ \studyTerms -> do
E.where_ $ studyTerms E.^. StudyTermsName E.==. E.just (candidateTwo E.^. StudyTermCandidateName)
return studyTerms
-- | retrieve all incidence keys having containing a certain @StudyTermKey @
getIncidencesFor :: [Key StudyTerms] -> DB [E.Value TermCandidateIncidence]
getIncidencesFor stks = E.select $ E.distinct $ E.from $ \candidate -> do
E.where_ $ candidate E.^. StudyTermCandidateKey `E.in_` E.valList (unStudyTermsKey <$> stks)
return $ candidate E.^. StudyTermCandidateIncidence

7
src/Utils.hs
View File

@ -140,8 +140,13 @@ hasTickmark :: Bool -> Markup
hasTickmark True = [shamlet|<i .fas .fa-check>|]
hasTickmark False = mempty
isBad :: Bool -> Markup
-- ^ Display an icon that denotes that something™ is bad
isBad True = [shamlet|<i .fas .fa-bolt>|] -- or times?!
isBad False = mempty
isNew :: Bool -> Markup
isNew True = [shamlet|<i .fas .fa-exclamation>|]
isNew True = [shamlet|<i .fas .fa-seedling>|] -- was exclamation
isNew False = mempty

8
src/Utils/Form.hs
View File

@ -99,6 +99,11 @@ addAttrs attr valus fs = fs { fsAttrs = newAttrs $ fsAttrs fs }
| attr==a = ( a, T.intercalate " " $ v : valus ) : t
| otherwise = p : newAttrs t
addPlaceholder :: Text -> FieldSettings site -> FieldSettings site
addPlaceholder placeholder fs = fs { fsAttrs = (placeholderAttr, placeholder) : filter ((/= placeholderAttr) . fst) (fsAttrs fs) }
where
placeholderAttr = "placeholder"
addClass :: Text -> FieldSettings site -> FieldSettings site
addClass = addAttr "class"
@ -108,6 +113,9 @@ addClasses = addAttrs "class"
addName :: PathPiece p => p -> FieldSettings site -> FieldSettings site
addName nm fs = fs { fsName = Just $ toPathPiece nm }
addId :: PathPiece p => p -> FieldSettings site -> FieldSettings site
addId fid fs = fs { fsId = Just $ toPathPiece fid }
addNameClass :: Text -> Text -> FieldSettings site -> FieldSettings site
addNameClass gName gClass fs = fs { fsName = Just gName, fsAttrs = ("class",gClass) : fsAttrs fs }

3
templates/widgets/massinput/list/cell.hamlet Normal file
View File

@ -0,0 +1,3 @@
$newline never
#{csrf}
^{fvInput}