diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 2180e28e8..943e34e9a 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 (\_ _ _ -> Set.empty) buttonAction defaultMiLayout) "" True Nothing + ((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|] diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 13da90fbf..55ad19245 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -763,6 +763,9 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do -> Widget miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "course/lecturerMassInput/layout") + miIdent :: Text + miIdent = "lecturers" + 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/Sheet.hs b/src/Handler/Sheet.hs index e5c86ed26..b0e11604f 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -730,6 +730,9 @@ correctorForm shid = wFormToAForm $ do -> Widget miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "sheetCorrectors/layout") + miIdent :: Text + miIdent = "correctors" + postProcess :: Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)) -> Set (Either SheetCorrectorInvitation SheetCorrector) postProcess = Set.fromList . map postProcess' . Map.elems where diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index abf1421bd..08e960581 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -256,7 +256,7 @@ newTermForm template html = do = 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 & setTooltip MsgMassInputTip) True (tftHolidays template) mempty + holidayForm = formToAForm . over (mapped._2) pure $ massInputList dayField (const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder)) (const Nothing) ("holidays" :: Text) (fslI MsgTermHolidays & setTooltip MsgMassInputTip) True (tftHolidays template) mempty (result, widget) <- flip (renderAForm FormStandard) html $ Term <$> tidForm <*> areq dayField (fslI MsgTermStartDay & setTooltip MsgTermStartDayTooltip) (tftStart template) diff --git a/src/Handler/Tutorial.hs b/src/Handler/Tutorial.hs index 93b09166c..7a07c6a55 100644 --- a/src/Handler/Tutorial.hs +++ b/src/Handler/Tutorial.hs @@ -213,7 +213,7 @@ tutorialForm cid template html = do uid <- liftHandlerT requireAuthId let - tutorForm = Set.fromList <$> massInputAccumA miAdd' miCell' (\p -> Just . SomeRoute $ cRoute :#: p) miLayout' (fslI MsgTutorialTutors & setTooltip MsgMassInputTip) True (Set.toList . tfTutors <$> template) + tutorForm = Set.fromList <$> massInputAccumA miAdd' miCell' (\p -> Just . SomeRoute $ cRoute :#: p) miLayout' ("tutors" :: Text) (fslI MsgTutorialTutors & setTooltip MsgMassInputTip) True (Set.toList . tfTutors <$> template) where miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([UserId] -> FormResult [UserId]) miAdd' nudge submitView csrf = do @@ -245,7 +245,7 @@ tutorialForm cid template html = do <*> areq (ciField & addDatalist tutTypeDatalist) (fslpI MsgTutorialType $ mr MsgTutorialType) (tfType <$> template) <*> aopt (natFieldI MsgTutorialCapacityNonPositive) (fslpI MsgTutorialCapacity (mr MsgTutorialCapacity) & setTooltip MsgTutorialCapacityTip) (tfCapacity <$> template) <*> areq textField (fslpI MsgTutorialRoom $ mr MsgTutorialRoomPlaceholder) (tfRoom <$> template) - <*> occurencesAForm (tfTime <$> template) + <*> occurencesAForm ("occurences" :: Text) (tfTime <$> template) <*> fmap (assertM (not . Text.null . CI.original) . fmap (CI.map Text.strip)) (aopt ciField (fslI MsgTutorialRegGroup & setTooltip MsgTutorialRegGroupTip) ((tfRegGroup <$> template) <|> Just (Just "tutorial"))) <*> aopt utcTimeField (fslpI MsgRegisterFrom (mr MsgDate) & setTooltip MsgCourseRegisterFromTip diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs index 9ca46ae15..c82c574ee 100644 --- a/src/Handler/Utils/Communication.hs +++ b/src/Handler/Utils/Communication.hs @@ -165,6 +165,8 @@ commR CommunicationRoute{..} = do miDelete :: MapLiveliness (EnumLiveliness RecipientCategory) ListLength -> (EnumPosition RecipientCategory, ListPosition) -> MaybeT (MForm Handler) (Map (EnumPosition RecipientCategory, ListPosition) (EnumPosition RecipientCategory, ListPosition)) -- miDelete liveliness@(MapLiveliness lMap) (EnumPosition RecipientCustom, delPos) = mappend (Map.fromSet id . Set.filter (\(EnumPosition c, _) -> c /= RecipientCustom) $ review liveCoords liveliness) . fmap (EnumPosition RecipientCustom, ) . Map.mapKeysMonotonic (EnumPosition RecipientCustom, ) <$> miDeleteList (lMap ! EnumPosition RecipientCustom) delPos miDelete _ _ = mzero + miIdent :: Text + miIdent = "recipients" postProcess :: Map (EnumPosition RecipientCategory, ListPosition) (Either UserEmail UserId, Bool) -> Set (Either UserEmail UserId) postProcess = Set.fromList . map fst . filter snd . Map.elems diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs index 31696d224..664b0f3c7 100644 --- a/src/Handler/Utils/Form/MassInput.hs +++ b/src/Handler/Utils/Form/MassInput.hs @@ -234,7 +234,7 @@ data MassInputException = MassInputInvalidShape instance Exception MassInputException -data MassInput handler liveliness cellData cellResult = MassInput +data MassInput handler liveliness cellData cellResult = forall i. PathPiece i => MassInput { miAdd :: BoxCoord liveliness -- Position (dimensions after @dimIx@ are zero) -> Natural -- Zero-based dimension index @dimIx@ -> (Text -> Text) -- Nudge deterministic field ids @@ -258,6 +258,7 @@ data MassInput handler liveliness cellData cellResult = MassInput -> Set (BoxCoord liveliness) -- ^ Usually addition widgets are only provided for dimension 0 and all _lines_ that have at least one live coordinate. `miAddEmpty` allows specifying when to provide additional widgets , 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 :: MassInputLayout liveliness cellData cellResult + , miIdent :: i } type MassInputLayout liveliness cellData cellResult @@ -279,7 +280,7 @@ massInput :: forall handler cellData cellResult liveliness. -> Bool -- ^ Required? -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult)) -> (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX)) -massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do +massInput MassInput{ miIdent = toPathPiece -> miIdent, ..} FieldSettings{..} fvRequired initialResult csrf = do let initialShape = fmap fst <$> initialResult miName <- maybe newFormIdent return fsName @@ -415,7 +416,7 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do MsgRenderer mr <- getMsgRenderer - whenM ((== Just fvId) <$> lookupCustomHeader HeaderMassInputShortcircuit) . liftHandlerT $ do + whenM ((== Just miIdent) <$> lookupCustomHeader HeaderMassInputShortcircuit) . liftHandlerT $ do PageContent{..} <- widgetToPageContent $(widgetFile "widgets/massinput/massinput-standalone") ur <- getUrlRenderParams @@ -454,18 +455,20 @@ listMiLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/mas -- | Wrapper around `massInput` for the common case, that we just want an arbitrary list of single fields without any constraints -massInputList :: forall handler cellResult. +massInputList :: forall handler cellResult ident. ( MonadHandler handler, HandlerSite handler ~ UniWorX , MonadLogger handler + , PathPiece ident ) => Field handler cellResult -> (ListPosition -> FieldSettings UniWorX) -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) + -> ident -> 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 +massInputList field fieldSettings miButtonAction miIdent 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 -> @@ -475,26 +478,29 @@ massInputList field fieldSettings miButtonAction miSettings miRequired miPrevRes , miAddEmpty = \_ _ _ -> Set.empty , miButtonAction , miLayout = listMiLayout + , miIdent } miSettings miRequired (Map.fromList . zip [0..] . map ((), ) <$> miPrevResult) -- | Wrapper around `massInput` for the common case, that we just want a list of data with no option to modify it except deletion and addition -massInputAccum :: forall handler cellData. +massInputAccum :: forall handler cellData ident. ( MonadHandler handler, HandlerSite handler ~ UniWorX , MonadLogger handler , ToJSON cellData, FromJSON cellData + , PathPiece ident ) => ((Text -> Text) -> FieldView UniWorX -> (Markup -> MForm handler (FormResult ([cellData] -> FormResult [cellData]), Widget))) -> (cellData -> Widget) -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> MassInputLayout ListLength cellData () + -> ident -> FieldSettings UniWorX -> Bool -> Maybe [cellData] -> (Markup -> MForm handler (FormResult [cellData], FieldView UniWorX)) -massInputAccum miAdd' miCell' miButtonAction miLayout fSettings fRequired mPrev csrf +massInputAccum miAdd' miCell' miButtonAction miLayout miIdent fSettings fRequired mPrev csrf = over (_1 . mapped) (map fst . Map.elems) <$> massInput MassInput{..} fSettings fRequired (Map.fromList . zip [0..] . map (, ()) <$> mPrev) csrf where miAdd :: ListPosition -> Natural @@ -518,21 +524,23 @@ massInputAccum miAdd' miCell' miButtonAction miLayout fSettings fRequired mPrev miAddEmpty _ _ _ = Set.empty -massInputAccumA :: forall handler cellData. +massInputAccumA :: forall handler cellData ident. ( MonadHandler handler, HandlerSite handler ~ UniWorX , MonadLogger handler , ToJSON cellData, FromJSON cellData + , PathPiece ident ) => ((Text -> Text) -> FieldView UniWorX -> (Markup -> MForm handler (FormResult ([cellData] -> FormResult [cellData]), Widget))) -> (cellData -> Widget) -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> MassInputLayout ListLength cellData () + -> ident -> FieldSettings UniWorX -> Bool -> Maybe [cellData] -> AForm handler [cellData] -massInputAccumA miAdd' miCell' miButtonAction' miLayout' fSettings fRequired mPrev - = formToAForm $ over _2 pure <$> massInputAccum miAdd' miCell' miButtonAction' miLayout' fSettings fRequired mPrev mempty +massInputAccumA miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev + = formToAForm $ over _2 pure <$> massInputAccum miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev mempty massInputA :: forall handler cellData cellResult liveliness. diff --git a/src/Handler/Utils/Form/Occurences.hs b/src/Handler/Utils/Form/Occurences.hs index 4c5905b6b..d010c6a5e 100644 --- a/src/Handler/Utils/Form/Occurences.hs +++ b/src/Handler/Utils/Form/Occurences.hs @@ -34,8 +34,8 @@ nullaryPathPiece ''OccurenceExceptionKind $ camelToPathPiece' 2 embedRenderMessage ''UniWorX ''OccurenceExceptionKind id -occurencesAForm :: Maybe Occurences -> AForm Handler Occurences -occurencesAForm mPrev = wFormToAForm $ do +occurencesAForm :: PathPiece ident => ident -> Maybe Occurences -> AForm Handler Occurences +occurencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do Just cRoute <- getCurrentRoute let @@ -45,6 +45,7 @@ occurencesAForm mPrev = wFormToAForm $ do miCell' (\p -> Just . SomeRoute $ cRoute :#: p) miLayout' + (miIdent' <> "__scheduled" :: Text) (fslI MsgScheduleRegular & setTooltip MsgMassInputTip) False (Set.toList . occurencesScheduled <$> mPrev) @@ -80,6 +81,7 @@ occurencesAForm mPrev = wFormToAForm $ do miCell' (\p -> Just . SomeRoute $ cRoute :#: p) miLayout' + (miIdent' <> "__exceptions" :: Text) (fslI MsgScheduleExceptions & setTooltip (UniWorXMessages [SomeMessage MsgScheduleExceptionsTip, SomeMessage MsgMassInputTip])) False (Set.toList . occurencesExceptions <$> mPrev) diff --git a/static/js/utils/massInput.js b/static/js/utils/massInput.js index 85e7049cb..8e15a4f79 100644 --- a/static/js/utils/massInput.js +++ b/static/js/utils/massInput.js @@ -38,7 +38,7 @@ throw new Error('Mass Input utility cannot be setup without an element!'); } - massInputId = element.id; + massInputId = element.dataset.massInputIdent || '_'; massInputForm = element.closest('form'); if (!massInputForm) { diff --git a/templates/widgets/massinput/massinput.hamlet b/templates/widgets/massinput/massinput.hamlet index 9a8ef2534..e07aa1f71 100644 --- a/templates/widgets/massinput/massinput.hamlet +++ b/templates/widgets/massinput/massinput.hamlet @@ -1,5 +1,5 @@ $newline never -