Dispatch async-massinput by custom ident

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|]

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

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

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)

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

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
 

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
+massInputAccumA miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev
-  = formToAForm $ over _2 pure <$> massInputAccum miAdd' miCell' miButtonAction' miLayout' fSettings fRequired mPrev mempty
+  = formToAForm $ over _2 pure <$> massInputAccum miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev mempty
 
 
 massInputA :: forall handler cellData cellResult liveliness.

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 :: PathPiece ident => ident -> Maybe Occurences -> AForm Handler Occurences
-occurencesAForm mPrev = wFormToAForm $ do
+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)

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) {

templates/widgets/massinput/massinput.hamlet

@@ -1,5 +1,5 @@
 $newline never
-<div .massinput uw-mass-input ##{fvId}>
+<div .massinput uw-mass-input data-mass-input-ident=#{miIdent} ##{fvId}>
   #{csrf}
   ^{shapeInput}
   ^{miWidget}