From 9f5406d284beb29caae5d145a0beb5725160e9f8 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 17 Apr 2019 14:06:41 +0200 Subject: [PATCH 1/3] Custom styling for massInput --- src/Handler/Admin.hs | 2 +- src/Handler/Course.hs | 30 ++++------ src/Handler/Utils/Form/MassInput.hs | 56 +++++++++++++------ templates/course/lecturerMassInput/add.hamlet | 6 ++ .../lecturerMassInput/cellInvitation.hamlet | 12 ++++ .../course/lecturerMassInput/cellKnown.hamlet | 6 ++ .../course/lecturerMassInput/layout.hamlet | 11 ++++ .../widgets/massinput/list/layout.hamlet | 14 +++++ 8 files changed, 101 insertions(+), 36 deletions(-) create mode 100644 templates/course/lecturerMassInput/add.hamlet create mode 100644 templates/course/lecturerMassInput/cellInvitation.hamlet create mode 100644 templates/course/lecturerMassInput/cellKnown.hamlet create mode 100644 templates/course/lecturerMassInput/layout.hamlet create mode 100644 templates/widgets/massinput/list/layout.hamlet diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 32f8db822..a47cce3b7 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -205,7 +205,7 @@ postAdminTestR = do -- 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 + ((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd buttonAction defaultMiLayout) "" True Nothing let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|] diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index c084c139f..3b9dd0790 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -27,6 +27,7 @@ import Data.Monoid (Last(..)) import Data.Maybe (fromJust) import qualified Data.Set as Set +import Data.Map ((!)) import qualified Data.Map as Map import qualified Database.Esqueleto as E @@ -637,34 +638,18 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do | otherwise -> FormSuccess $ Map.singleton (maybe 0 succ . fmap fst $ Map.lookupMax prev) new FormFailure errs -> FormFailure errs FormMissing -> FormMissing - addView' = toWidget csrf >> fvInput addView >> fvInput btn + addView' = $(widgetFile "course/lecturerMassInput/add") return (addRes'', addView') miCell :: ListPosition -> Either UserEmail UserId -> Maybe (Maybe LecturerType) -> (Text -> Text) -> Form (Maybe LecturerType) miCell _ (Right lid) defType nudge = \csrf -> do (lrwRes,lrwView) <- mreq (selectField optionsFinite) ("" & addName (nudge "lecturer-type")) (join defType) User{userEmail, userDisplayName, userSurname} <- liftHandlerT . runDB $ get404 lid - let lrwView' = [whamlet|$newline never - #{csrf} - ^{nameEmailWidget userEmail userDisplayName userSurname} # - ^{fvInput lrwView} - |] + let lrwView' = $(widgetFile "course/lecturerMassInput/cellKnown") return (Just <$> lrwRes,lrwView') miCell _ (Left lEmail) defType nudge = \csrf -> do (lrwRes,lrwView) <- mopt (selectField optionsFinite) ("" & addName (nudge "lecturer-type")) defType - let lrwView' = [whamlet| - $newline never - #{csrf} - - #{lEmail} - # -
-
-
- _{MsgEmailInvitationWarning} - # - ^{fvInput lrwView} - |] + let lrwView' = $(widgetFile "course/lecturerMassInput/cellInvitation") return (lrwRes,lrwView') miDelete :: ListLength -- ^ Current shape @@ -675,6 +660,13 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do miAllowAdd :: ListPosition -> Natural -> ListLength -> Bool miAllowAdd _ _ _ = True + miLayout :: ListLength + -> Map ListPosition Widget -- ^ Cell widgets + -> Map ListPosition (FieldView UniWorX) -- ^ Deletion buttons + -> Map (Natural, ListPosition) Widget -- ^ Addition widgets + -> Widget + miLayout lLength cellWdgts delButtons addWdgts = $(widgetFile "course/lecturerMassInput/layout") + lecturerForm :: AForm Handler [Either (UserEmail, Maybe LecturerType) (UserId, LecturerType)] lecturerForm = formToAForm . over (mapped._2) pure . over (mapped._1.mapped) (map liftEither . Map.elems) $ massInput diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs index d1c403ec7..a30c5010b 100644 --- a/src/Handler/Utils/Form/MassInput.hs +++ b/src/Handler/Utils/Form/MassInput.hs @@ -2,6 +2,7 @@ module Handler.Utils.Form.MassInput ( MassInput(..) + , defaultMiLayout , massInput , massInputList , BoxDimension(..) @@ -24,6 +25,7 @@ import Text.Blaze (Markup) import qualified Data.Text as Text import qualified Data.Set as Set +import Data.Map ((!)) import qualified Data.Map as Map import qualified Data.Foldable as Fold import Data.List (genericLength, genericIndex, iterate) @@ -206,6 +208,11 @@ data MassInput handler liveliness cellData cellResult = MassInput -> liveliness -> Bool -- ^ Decide whether an addition-operation should be permitted , miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX) -- ^ Override form-tag route for `massInput`-Buttons to keep the user closer to the Widget, the `PathPiece` Argument is to be used for constructiong a `Fragment` + , miLayout :: liveliness + -> Map (BoxCoord liveliness) Widget -- ^ Cell Widgets + -> Map (BoxCoord liveliness) (FieldView UniWorX) -- ^ Delete buttons + -> Map (Natural, BoxCoord liveliness) Widget -- ^ Addition forms + -> Widget } massInput :: forall handler cellData cellResult liveliness. @@ -342,22 +349,12 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do guard $ not shapeChanged for cellResults $ \(cData, (cResult, _)) -> (cData, ) <$> cResult - let miWidget' :: BoxCoord liveliness -> [(Natural, BoxDimension (BoxCoord liveliness))] -> Widget - miWidget' _ [] = mempty - miWidget' miCoord ((dimIx, BoxDimension dim) : remDims) = - let coords = takeWhile (\c -> review (liveCoord c) liveliness) $ iterate (over dim succ) miCoord - cells - | [] <- remDims = do - coord <- coords - Just (_data, (_cellRes, cellWdgt)) <- return $ Map.lookup coord cellResults - let deleteButton = snd <$> Map.lookup coord delResults - return (coord, $(widgetFile "widgets/massinput/cell")) - | otherwise = - [ (coord, miWidget' coord remDims) | coord <- coords ] - addWidget = (\(_, mWgt) -> mWgt <* guard (miAllowAdd miCoord dimIx liveliness)) =<< Map.lookup (dimIx, miCoord) addResults - in $(widgetFile "widgets/massinput/row") - - miWidget = miWidget' boxOrigin $ zip [0..] boxDimensions + let miWidget + = miLayout + liveliness + (fmap (view $ _2 . _2) cellResults) + (fmap (view _2) delResults) + (Map.mapMaybeWithKey (\(dimIx, miCoord) (_, wdgt) -> wdgt <* guard (miAllowAdd miCoord dimIx liveliness)) addResults) MsgRenderer mr <- getMsgRenderer @@ -368,6 +365,31 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do fvErrors = Nothing in return (result, FieldView{..}) +defaultMiLayout :: forall liveliness. + Liveliness liveliness + => liveliness + -> Map (BoxCoord liveliness) Widget + -> Map (BoxCoord liveliness) (FieldView UniWorX) + -> Map (Natural, BoxCoord liveliness) Widget + -> Widget +-- | Generic `miLayout` using recursively nested lists +defaultMiLayout liveliness cellResults delResults addResults = miWidget' boxOrigin $ zip [0..] boxDimensions + where + miWidget' :: BoxCoord liveliness -> [(Natural, BoxDimension (BoxCoord liveliness))] -> Widget + miWidget' _ [] = mempty + miWidget' miCoord ((dimIx, BoxDimension dim) : remDims) = + let coords = takeWhile (\c -> review (liveCoord c) liveliness) $ iterate (over dim succ) miCoord + cells + | [] <- remDims = do + coord <- coords + Just cellWdgt <- return $ Map.lookup coord cellResults + let deleteButton = Map.lookup coord delResults + return (coord, $(widgetFile "widgets/massinput/cell")) + | otherwise = + [ (coord, miWidget' coord remDims) | coord <- coords ] + addWidget = Map.lookup (dimIx, miCoord) addResults + in $(widgetFile "widgets/massinput/row") + -- | Wrapper around `massInput` for the common case, that we just want an arbitrary list of single fields without any constraints massInputList :: forall handler cellResult. @@ -389,6 +411,8 @@ massInputList field fieldSettings miButtonAction miSettings miRequired miPrevRes , miDelete = miDeleteList , miAllowAdd = \_ _ _ -> True , miButtonAction + , miLayout = \lLength cellWdgts delButtons addWdgts + -> $(widgetFile "widgets/massinput/list/layout") } miSettings miRequired diff --git a/templates/course/lecturerMassInput/add.hamlet b/templates/course/lecturerMassInput/add.hamlet new file mode 100644 index 000000000..da5411bc4 --- /dev/null +++ b/templates/course/lecturerMassInput/add.hamlet @@ -0,0 +1,6 @@ +$newline never + + #{csrf} + ^{fvInput addView} + + ^{fvInput btn} diff --git a/templates/course/lecturerMassInput/cellInvitation.hamlet b/templates/course/lecturerMassInput/cellInvitation.hamlet new file mode 100644 index 000000000..523d9577b --- /dev/null +++ b/templates/course/lecturerMassInput/cellInvitation.hamlet @@ -0,0 +1,12 @@ + $newline never + + #{csrf} + + #{lEmail} + +
+
+
+ _{MsgEmailInvitationWarning} + + ^{fvInput lrwView} diff --git a/templates/course/lecturerMassInput/cellKnown.hamlet b/templates/course/lecturerMassInput/cellKnown.hamlet new file mode 100644 index 000000000..0b55c7902 --- /dev/null +++ b/templates/course/lecturerMassInput/cellKnown.hamlet @@ -0,0 +1,6 @@ +$newline never + + #{csrf} + ^{nameEmailWidget userEmail userDisplayName userSurname} # + + ^{fvInput lrwView} diff --git a/templates/course/lecturerMassInput/layout.hamlet b/templates/course/lecturerMassInput/layout.hamlet new file mode 100644 index 000000000..8dc00bc90 --- /dev/null +++ b/templates/course/lecturerMassInput/layout.hamlet @@ -0,0 +1,11 @@ +$newline never + + + $forall coord <- review liveCoords lLength + + ^{cellWdgts ! coord} + + + ^{addWdgts ! (0, 0)} diff --git a/templates/widgets/massinput/list/layout.hamlet b/templates/widgets/massinput/list/layout.hamlet new file mode 100644 index 000000000..5f5676bb6 --- /dev/null +++ b/templates/widgets/massinput/list/layout.hamlet @@ -0,0 +1,14 @@ +$newline never +
+ ^{fvInput (delButtons ! coord)} +
+ + + $forall coord <- review liveCoords lLength + + +
+ ^{cellWdgts ! coord} + + ^{fvInput (delButtons ! coord)} +
+ + ^{addWdgts ! (0, 0)} From e4acc2653a480ef7604875376dcae6c269f5fa41 Mon Sep 17 00:00:00 2001 From: Felix Hamann Date: Thu, 18 Apr 2019 21:05:43 +0200 Subject: [PATCH 2/3] make interactive fieldsets js util work with checkboxes --- static/js/utils/form.js | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/static/js/utils/form.js b/static/js/utils/form.js index cb7cdd9f9..e7e6401aa 100644 --- a/static/js/utils/form.js +++ b/static/js/utils/form.js @@ -124,8 +124,10 @@ * Selector for the input that this fieldset watches for changes * data-conditional-value: string * The value the conditional input needs to be set to for this fieldset to be shown + * Can be omitted if conditionalInput is a checkbox * * Example usage: + * ## example with text input * *
...
*
...
@@ -135,6 +137,11 @@ *