Fixup

src/Handler/Admin.hs

@@ -132,7 +132,19 @@ postAdminTestR = do
                     <li>#{m}
         |]
 
+
+  {- The following demonstrates the use of @massInput@.
+
+     @massInput@ takes as arguments:
+       - A configuration struct describing how the Widget should behave (how is the space of sub-forms structured, how many dimensions does it have, which additions/deletions are permitted, what data do they need to operate and what should their effect on the overall shape be?)
+       - Information on how the resulting field fits into the form as a whole (@FieldSettings@ and whether the @massInput@ should be marked required)
+       - An initial value to pre-fill the field with
+
+     @massInput@ then returns an @MForm@ structured for easy downstream consumption of the result
+   -}
   let
+    -- We define the fields of the configuration struct @MassInput@:
+
     -- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell)
     --
     -- This /needs/ to replace all occurances of @mreq@ with @mpreq@ (no fields should be /actually/ required)
@@ -142,10 +154,12 @@ postAdminTestR = do
               -> FieldView UniWorX -- ^ Submit-Button for this add-widget
               -> Maybe (Form (ListLength -> (ListPosition, Int))) -- ^ Nothing iff adding further cells in this position/dimension makes no sense; returns callback to determine index of new cell and data needed to initialize cell
     mkAddForm 0 0 nudge submitBtn = Just $ \csrf -> do
-      (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing
-      let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes
-      return ((\dat l -> (fromIntegral l, dat)) <$> addRes', toWidget csrf >> fvInput addView >> fvInput submitBtn)
+      (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing -- Any old field; for demonstration
+      let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes -- Do something semi-interesting on the result of the @textField@ to demonstrate that further processing can be done
+          addRes'' = (\dat l -> (fromIntegral l, dat)) <$> addRes' -- Construct the callback to determine new cell position and data within @FormResult@ as required
+      return (addRes'', toWidget csrf >> fvInput addView >> fvInput submitBtn)
     mkAddForm _pos _dim _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"
+
     -- | Make a single massInput-Cell
     --
     -- This /needs/ to use @nudge@ and deterministic field naming (this allows for correct value-shifting when cells are deleted)
@@ -154,19 +168,21 @@ postAdminTestR = do
                -> Maybe Int -- ^ Initial cell result from Argument to `massInput`
                -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
                -> Form Int
-    mkCellForm _pos initial previous nudge csrf = do
-      (intRes, intView) <- mreq intField ("" & addName (nudge "int")) $ previous <|> Just initial
+    mkCellForm _pos cData initial nudge csrf = do -- Extremely simple cell
+      (intRes, intView) <- mreq intField ("" & addName (nudge "int")) $ initial <|> Just cData
       return (intRes, toWidget csrf >> fvInput intView)
     -- | How does the shape (`ListLength`) change if a certain cell is deleted?
     deleteCell :: ListLength -- ^ Current shape
                -> ListPosition -- ^ Coordinate to delete
                -> MaybeT (MForm (HandlerT UniWorX IO)) (Map ListPosition ListPosition) -- ^ Monadically compute a set of new positions and their associated old positions
     deleteCell l pos
-      | l >= 2 = return . Map.fromSet (\pos' -> bool pos' (succ pos') $ pos' >= pos) $ Set.fromList [0..fromIntegral (l - 2)]
+      | 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
     -- | Make a decision on whether an add widget should be allowed to further cells, given the current @liveliness@ (i.e. before performing the addition)
     allowAdd :: ListPosition -> Natural -> ListLength -> Bool
-    allowAdd _ _ l = l < 7
+    allowAdd _ _ l = l < 7 -- Limit list length; much more complicated checks are possible (this could in principle be monadic, but @massInput@ is probably already complicated enough to cover just current (2019-03) usecases)
+
+  -- The actual call to @massInput@ is comparatively simple:
     
   ((miResult, (fvInput -> miForm)), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd) "" True Nothing
 

src/Handler/Utils/Form/MassInput.hs

@@ -185,14 +185,19 @@ data MassInput handler liveliness cellData cellResult = MassInput
           -> Natural -- Zero-based dimension index @dimIx@
           -> (Text -> Text) -- Nudge deterministic field ids
           -> FieldView UniWorX -- Submit button
-          -> Maybe (Markup -> MForm handler (FormResult (liveliness -> (BoxCoord liveliness, cellData)), Widget))
+          -> Maybe (Markup -> MForm handler (FormResult (liveliness -> (BoxCoord liveliness, cellData)), Widget)) -- ^ Construct a Cell-Addition Widget
   , miCell :: BoxCoord liveliness -- Position
-           -> cellData -- Initialisation data
-           -> Maybe cellResult -- Previous result
+           -> cellData -- @cellData@ from @miAdd@
+           -> Maybe cellResult -- Initial result from Argument to @massInput@
            -> (Text -> Text) -- Nudge deterministic field ids
-           -> (Markup -> MForm handler (FormResult cellResult, Widget))
-  , miDelete :: liveliness -> BoxCoord liveliness -> MaybeT (MForm handler) (Map (BoxCoord liveliness) (BoxCoord liveliness))
-  , miAllowAdd :: BoxCoord liveliness -> Natural -> liveliness -> Bool
+           -> (Markup -> MForm handler (FormResult cellResult, Widget)) -- ^ Construct a singular cell
+  , miDelete :: liveliness
+             -> BoxCoord liveliness
+             -> MaybeT (MForm handler) (Map (BoxCoord liveliness) (BoxCoord liveliness)) -- ^ Decide whether a deletion-operation should be permitted and produce a finite map of new coordinates to their old correspondants
+  , miAllowAdd :: BoxCoord liveliness
+               -> Natural
+               -> liveliness
+               -> Bool -- ^ Decide whether an addition-operation should be permitted
   }
 
 massInput :: forall handler cellData cellResult liveliness.
@@ -206,7 +211,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 = mdo
+massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
   let initialShape = fmap fst <$> initialResult
   
   miName <- maybe newFormIdent return fsName
@@ -282,12 +287,12 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = mdo
     | Just s <- addShape -> return s 
     | Just s <- delShape -> return s 
     | otherwise          -> return sentShape'
-
-  $logDebugS "massInput" [st|Current shape: #{tshow (map toPathPiece (Map.keys shape))}|]
+  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness
 
   shapeId <- newIdent
   let shapeInput = fieldView shapeField shapeId (toPathPiece shapeName) [] (Right shape) True
 
+
   let
     applyDelShapeUpdate :: Maybe (Env, FileEnv) -> Maybe (Env, FileEnv)
     applyDelShapeUpdate prevEnv
@@ -300,18 +305,26 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = mdo
               return $ toPathPiece cell{ miCoord = newCoord }
       | otherwise = prevEnv
 
+    justAdded :: Set (BoxCoord liveliness)
+    justAdded = Set.fromList . mapMaybe (addedCoord . fst) $ Map.elems addResults
+      where
+        addedCoord res
+          | FormSuccess (Just mkResult) <- res
+          = Just . fst $ mkResult sentLiveliness
+          | otherwise = Nothing
+    restrictJustAdded :: BoxCoord liveliness -> Maybe a -> Maybe a
+    restrictJustAdded miCoord env = env <* guard (not $ Set.member miCoord justAdded)
+
   cellResults <- flip Map.traverseWithKey shape $ \miCoord cData -> do
     let
       nudgeCellName :: Text -> Text
       nudgeCellName miCellField = toPathPiece (MassInputCell{..} :: MassInputFieldName (BoxCoord liveliness))
-    local (over _1 applyDelShapeUpdate) $ (cData, ) <$> miCell miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
+    local (over _1 (applyDelShapeUpdate . restrictJustAdded miCoord)) $ (cData, ) <$> miCell miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
   let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
       result
         | shapeChanged = FormMissing
         | otherwise = traverse (\(cData, (cResult, _)) -> (cData, ) <$> cResult) cellResults
 
-  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness
-
   let miWidget' :: BoxCoord liveliness -> [(Natural, BoxDimension (BoxCoord liveliness))] -> Widget
       miWidget' _ [] = mempty
       miWidget' miCoord ((dimIx, BoxDimension dim) : remDims) =