(Semi-)Working Prototype

2019-03-20 15:13:41 +01:00 · 2019-03-20 15:13:41 +01:00 · 4b2d6d3aa2
commit 4b2d6d3aa2
parent 705fdec695
6 changed files with 238 additions and 44 deletions
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@ -2,6 +2,7 @@ module Handler.Admin where

 import Import
 import Handler.Utils
+import Handler.Utils.Form.MassInput
 import Jobs

 import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
@ -15,6 +16,12 @@ import Control.Monad.Trans.Except

 import Database.Persist.Sql (fromSqlKey)

+import qualified Data.Text as Text
+import Data.Char (isDigit)
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
 -- import Colonnade hiding (fromMaybe)
 -- import Yesod.Colonnade

@ -125,6 +132,45 @@ postAdminTestR = do
                    <li>#{m}
        |]

+  let
+    -- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell)
+    --
+    -- This /needs/ to use @nudge@ (for deterministic field naming) and to replace all occurances of @mreq@ with @mpreq@ (no fields should be /actually/ required)
+    mkAddForm :: ListPosition -- ^ Approximate position of the add-widget
+              -> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3
+              -> ListLength -- ^ Liveliness
+              -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
+              -> FieldView UniWorX -- ^ Submit-Button for this add-widget
+              -> Maybe (Form (ListPosition, Int)) -- ^ Nothing if no further cells should be added; returns index of new cell and data needed to initialize cell
+    mkAddForm 0 0 listLength nudge submitBtn
+      | listLength >= 7 = Nothing
+      | otherwise = Just $ \csrf -> do
+        (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing
+        let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes
+        return ((fromIntegral listLength, ) <$> 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@ for deterministic field naming
+    mkCellForm :: ListPosition -- ^ Position of this cell
+               -> Int -- ^ Data needed to initialize the cell (see return of @mkAddForm@)
+               -> 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
+      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)]
+      | otherwise = return Map.empty
+    
+  ((miResult, (fvInput -> miForm)), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell) "" True Nothing
+
+
  let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
  siteLayout locallyDefinedPageHeading $ do
  -- defaultLayout $ do
@ -135,6 +181,22 @@ postAdminTestR = do
    $(widgetFile "formPage")
    showDemoResult

+    [whamlet|
+      <h2>Mass-Input
+      <form enctype=#{miEnc} method=POST>
+        ^{miForm}
+        ^{submitButtonView}
+      $case miResult
+        $of FormMissing
+        $of FormFailure errs
+          <ul>
+            $forall err <- errs
+              <li>#{err}
+        $of FormSuccess res
+          <pre>
+            #{tshow res}
+    |]
+

 getAdminErrMsgR, postAdminErrMsgR :: Handler Html
 getAdminErrMsgR = postAdminErrMsgR
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@ -1,20 +1,23 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Handler.Utils.Form.MassInput
-  ( massInput
+  ( MassInput(..)
+  , massInput
  , BoxDimension(..)
  , IsBoxCoord(..), boxDimension
  , Liveliness(..)
+  , ListLength(..), ListPosition(..)
  ) where

 import Import
 import Utils.Form
+import Utils.Lens
 import Handler.Utils.Form (secretJsonField)

 import Data.Aeson

 import Algebra.Lattice

-import Control.Lens hiding (universe)
-
 import Text.Blaze (Markup)

 import qualified Data.Text as Text
@ -23,6 +26,9 @@ import qualified Data.Set as Set
 import qualified Data.Map as Map
 import Data.List (genericLength, genericIndex, iterate)

+import Control.Monad.Trans.Maybe
+import Control.Monad.Fix
+

 data BoxDimension x = forall n. (Enum n, Num n) => BoxDimension (Lens' x n)
  
@ -44,29 +50,71 @@ class (IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveline
  type BoxCoord a :: *
  liveCoords :: Prism' (Set (BoxCoord a)) a
  liveCoord :: BoxCoord a -> Prism' Bool a
+  liveCoord bC = prism' (\l -> bC `Set.member` review liveCoords l) (bool (Just bottom) (preview liveCoords $ Set.singleton bC))


+newtype ListLength = ListLength { unListLength :: Natural }
+  deriving newtype (Num, Integral, Real, Enum, PathPiece)
+  deriving (Eq, Ord, Generic, Typeable, Read, Show)
+
+makeWrapped ''ListLength
+
+instance JoinSemiLattice ListLength where
+  (\/) = max
+instance MeetSemiLattice ListLength where
+  (/\) = min
+instance Lattice ListLength
+instance BoundedJoinSemiLattice ListLength where
+  bottom = 0
+
+newtype ListPosition = ListPosition { unListPosition :: Natural }
+  deriving newtype (Num, Integral, Real, Enum, PathPiece, ToJSONKey, FromJSONKey)
+  deriving (Eq, Ord, Generic, Typeable, Read, Show)
+
+makeWrapped ''ListPosition
+
+instance IsBoxCoord ListPosition where
+  boxDimensions = [BoxDimension id]
+  boxOrigin = 0
+
+instance Liveliness ListLength where
+  type BoxCoord ListLength = ListPosition
+  liveCoords = prism' toSet fromSet
+    where
+      toSet n
+        | n > 0     = Set.fromList [0..pred (fromIntegral n)]
+        | otherwise = Set.empty
+
+      fromSet ns
+        | ns == maybe Set.empty (\n -> Set.fromList [0..n]) max'
+        = fmap (succ . fromIntegral) max' <|> Just 0
+        | otherwise
+        = Nothing
+        where
+          max' = Set.lookupMax ns
+  liveCoord (ListPosition n) = prism' (\(ListLength l) -> n < l) (bool (Just 0) (1 <$ guard (n == 0)))
+
 data ButtonMassInput coord
-  = MassInputAddDimension Natural
+  = MassInputAddDimension Natural coord
  | MassInputDeleteCell coord
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

 instance PathPiece coord => PathPiece (ButtonMassInput coord) where
  toPathPiece = \case
-    MassInputAddDimension n -> "add__" <> toPathPiece n
+    MassInputAddDimension n c -> "add__" <> toPathPiece n <> "__" <> toPathPiece c
    MassInputDeleteCell c -> "delete__" <> toPathPiece c
  fromPathPiece t = addDim <|> delCell
    where
      addDim = do
-        nT <- stripPrefix "add__" t
-        MassInputAddDimension <$> fromPathPiece nT
+        (dimT, Text.stripPrefix "__" -> Just coordT) <- Text.breakOn "__" <$> stripPrefix "add__" t
+        MassInputAddDimension <$> fromPathPiece dimT <*> fromPathPiece coordT
      delCell = do
        coordT <- stripPrefix "delete__" t
        MassInputDeleteCell <$> fromPathPiece coordT

 instance RenderMessage UniWorX (ButtonMassInput coord) where
  renderMessage f ls = \case
-    MassInputAddDimension _ -> mr MsgMassInputAddDimension
+    MassInputAddDimension _ _ -> mr MsgMassInputAddDimension
    MassInputDeleteCell _ -> mr MsgMassInputDeleteCell
    where
      mr = renderMessage f ls
@ -74,21 +122,25 @@ instance RenderMessage UniWorX (ButtonMassInput coord) where
 instance PathPiece coord => Button UniWorX (ButtonMassInput coord) where
  btnValidate _ _ = False

-  btnClasses (MassInputAddDimension _) = [BCIsButton, BCDefault]
+  btnClasses (MassInputAddDimension _ _) = [BCIsButton, BCDefault]
  btnClasses (MassInputDeleteCell _) = [BCIsButton, BCWarning]


 data MassInputFieldName coord
  = MassInputShape { miName :: Text }
  | MassInputAddWidget { miName :: Text, miCoord :: coord, miAddWidgetField :: Text }
+  | MassInputAddButton { miName :: Text, miCoord :: coord }
+  | MassInputDeleteButton { miName :: Text, miCoord :: coord }
  | MassInputCell { miName :: Text, miCoord :: coord, miCellField :: Text }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

 instance IsBoxCoord coord => PathPiece (MassInputFieldName coord) where
  toPathPiece = \case
    MassInputShape{..} -> [st|#{miName}__shape|]
-    MassInputAddWidget{..} -> [st|#{miName}__#{toPathPiece miCoord}__#{miAddWidgetField}|]
-    MassInputCell{..} -> [st|#{miName}__#{toPathPiece miCoord}__#{miCellField}|]
+    MassInputAddWidget{..} -> [st|#{miName}__add__#{toPathPiece miCoord}__fields__#{miAddWidgetField}|]
+    MassInputAddButton{..} -> [st|#{miName}__add__#{toPathPiece miCoord}__submit|]
+    MassInputDeleteButton{..} -> [st|#{miName}__delete__#{toPathPiece miCoord}|]
+    MassInputCell{..} -> [st|#{miName}__cells__#{toPathPiece miCoord}__#{miCellField}|]

  fromPathPiece t = do
    (miName, Text.stripPrefix "__" -> Just t') <- return $ Text.breakOn "__" t
@ -97,11 +149,26 @@ instance IsBoxCoord coord => PathPiece (MassInputFieldName coord) where
          guard $ t' == "shape"
          return MassInputShape{..}
      , do
-          (coordT, Text.stripPrefix "__" -> Just miAddWidgetField) <- return $ Text.breakOn "__" t'
+          t'' <- Text.stripPrefix "add__" t'
+          (coordT, Text.stripPrefix "__" -> Just rest) <- return $ Text.breakOn "__" t''
+          miAddWidgetField <- Text.stripPrefix "fields__" rest
          miCoord <- fromPathPiece coordT
          return MassInputAddWidget{..}
      , do
-          (coordT, Text.stripPrefix "__" -> Just miCellField) <- return $ Text.breakOn "__" t'
+          t'' <- Text.stripPrefix "add__" t'
+          (coordT, Text.stripPrefix "__" -> Just ident) <- return $ Text.breakOn "__" t''
+          guard $ ident == "submit"
+          miCoord <- fromPathPiece coordT
+          return MassInputAddButton{..}
+      , do
+          t'' <- Text.stripPrefix "delete__" t'
+          (coordT, rest) <- return $ Text.breakOn "__" t''
+          guard $ Text.null rest
+          miCoord <- fromPathPiece coordT
+          return MassInputDeleteButton{..}
+      , do
+          t'' <- Text.stripPrefix "cells__" t'
+          (coordT, Text.stripPrefix "__" -> Just miCellField) <- return $ Text.breakOn "__" t''
          miCoord <- fromPathPiece coordT
          return MassInputCell{..}
      ]
@ -111,49 +178,50 @@ data MassInputException = MassInputInvalidShape

 instance Exception MassInputException

+data MassInput handler liveliness cellData cellResult = MassInput
+  { miAdd :: BoxCoord liveliness -- Position (dimensions after @dimIx@ are zero)
+          -> Natural -- Zero-based dimension index @dimIx@
+          -> liveliness
+          -> (Text -> Text) -- Nudge deterministic field ids
+          -> FieldView UniWorX -- Submit button
+          -> Maybe (Markup -> MForm handler (FormResult (BoxCoord liveliness, cellData), Widget))
+  , miCell :: BoxCoord liveliness -- Position
+           -> cellData -- Initialisation data
+           -> Maybe cellResult -- Previous result
+           -> (Text -> Text) -- Nudge deterministic field ids
+           -> (Markup -> MForm handler (FormResult cellResult, Widget))
+  , miDelete :: liveliness -> BoxCoord liveliness -> MaybeT (MForm handler) (Map (BoxCoord liveliness) (BoxCoord liveliness))
+  }
+
 massInput :: forall handler cellData cellResult liveliness.
           ( MonadHandler handler, HandlerSite handler ~ UniWorX
           , ToJSON cellData, FromJSON cellData
           , Liveliness liveliness
+           , MonadFix handler, MonadLogger handler
           )
-          => (    Natural -- ^ Zero-based dimension index
-               -> liveliness -- ^ Currently live positions
-               -> (Text -> Text) -- ^ Nudge deterministic field ids 
-               -> Maybe (Markup -> MForm handler (FormResult (BoxCoord liveliness, cellData), Widget))
-             ) -- ^ Generate a cell-addition widget
-          -> (    BoxCoord liveliness
-               -> cellData
-               -> Maybe cellResult
-               -> (Text -> Text) -- ^ Nudge deterministic field ids
-               -> (Markup -> MForm handler (FormResult cellResult, Widget))
-             ) -- ^ Cell-Widget
+          => MassInput handler liveliness cellData cellResult
          -> FieldSettings UniWorX
          -> Bool -- ^ Required?
          -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult))
-          -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX)
-massInput mkAddWidget mkCellWidget FieldSettings{..} fvRequired initialResult = do
+          -> (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX))
+massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
  let initialShape = fmap fst <$> initialResult
  
  miName <- maybe newFormIdent return fsName
  let
    shapeName :: MassInputFieldName (BoxCoord liveliness)
    shapeName = MassInputShape{..}
-  (shape', _shapeWdgt) <- mreq secretJsonField ("" & addName shapeName) $ initialShape 
-  shape <- if
-    | FormSuccess s <- shape' -> return s
+    shapeField = secretJsonField
+  sentShape <- runMaybeT $ do
+    ts <- fromMaybe [] . Map.lookup (toPathPiece shapeName) <$> MaybeT askParams
+    fs <- fromMaybe [] . Map.lookup (toPathPiece shapeName) <$> MaybeT askFiles
+    MaybeT $ either (const Nothing) id <$> lift (fieldParse shapeField ts fs)
+  sentShape' <- if
+    | Just s <- sentShape -> return s
    | Just iS <- initialShape -> return iS
    | Set.null $ review liveCoords (bottom :: liveliness) -> return Map.empty
    | otherwise -> throwM MassInputInvalidShape
-
-  cellResults <- flip Map.traverseWithKey shape $ \miCoord cData -> do
-    let
-      nudgeCellName :: Text -> Text
-      nudgeCellName miCellField = toPathPiece (MassInputCell{..} :: MassInputFieldName (BoxCoord liveliness))
-    (cData, ) <$> mkCellWidget miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
-
-  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords
-  let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
-      result = traverse (\(cData, (cResult, _)) -> (cData, ) <$> cResult) cellResults
+  sentLiveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet sentShape' ^? liveCoords :: MForm handler liveliness

  let addForm :: [BoxDimension (BoxCoord liveliness)] -> MForm handler (Map (Natural, BoxCoord liveliness) (FormResult (BoxCoord liveliness, cellData), Widget))
      addForm = addForm' boxOrigin . zip [0..]
@ -162,18 +230,66 @@ massInput mkAddWidget mkCellWidget FieldSettings{..} fvRequired initialResult =
          addForm' miCoord ((dimIx, _) : remDims) = do
            let nudgeAddWidgetName :: Text -> Text
                nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
-            dimRes <- traverse ($ mempty) $ mkAddWidget dimIx liveliness nudgeAddWidgetName
+            dimRes <- runMaybeT $ do
+              (btnRes, btnView) <- lift $ mpreq (buttonField $ MassInputAddDimension dimIx miCoord) ("" & addName MassInputAddButton{..}) Nothing
+              (addRes, addView) <- MaybeT . traverse ($ mempty) $ miAdd miCoord dimIx sentLiveliness nudgeAddWidgetName btnView
+              return (btnRes *> addRes, addView)
            let dimRes' = maybe Map.empty (Map.singleton (dimIx, miCoord)) dimRes
            case remDims of
              [] -> return dimRes'
              ((_, BoxDimension dim) : _) -> do
                let
-                  miCoords = Set.fromList . takeWhile (\c -> review (liveCoord c) liveliness) $ iterate (over dim succ) miCoord
+                  miCoords = Set.fromList . takeWhile (\c -> review (liveCoord c) sentLiveliness) $ iterate (over dim succ) miCoord
                dimRess <- sequence $ Map.fromSet (\c -> addForm' c remDims) miCoords
                return $ dimRes' `Map.union` fold dimRess

  addResults <- addForm boxDimensions
+  let addShape
+        | [FormSuccess (bCoord, cData)] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst addResults = Just $ Map.insert bCoord cData sentShape'
+        | otherwise = Nothing
+
+  addedShape <- if
+    | Just s <- addShape -> return s
+    | otherwise -> return sentShape'
+  addedLiveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet addedShape ^? liveCoords :: MForm handler liveliness
+
+  let
+    delForm :: BoxCoord liveliness -> MaybeT (MForm handler) (FormResult (Map (BoxCoord liveliness) (BoxCoord liveliness)), FieldView UniWorX)
+    delForm miCoord = do
+      (delRes, delView) <- lift $ mpreq (buttonField $ MassInputDeleteCell miCoord) ("" & addName MassInputDeleteButton{..}) Nothing
+      $logDebugS "delForm" . tshow $ fmap toPathPiece delRes
+      shapeUpdate <- miDelete addedLiveliness miCoord
+      guard $ isJust (Map.keysSet shapeUpdate ^? liveCoords :: Maybe liveliness)
+      return (shapeUpdate <$ delRes, delView)
+
+  delResults <- fmap (Map.mapMaybe id) . sequence $ Map.fromSet (runMaybeT . delForm) (Map.keysSet addedShape)
+  let delShape
+        | [FormSuccess shapeUpdate'] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst delResults = traverse (flip Map.lookup addedShape) shapeUpdate'
+        | otherwise = Nothing
+
+
+  shape <- if
+    | Just s <- delShape -> return s 
+    | Just s <- addShape -> return s 
+    | otherwise          -> return sentShape'
+
+  shapeId <- newIdent
  
+  let
+    shapeInput = fieldView shapeField shapeId (toPathPiece shapeName) [] (Right shape) True
+
+  cellResults <- flip Map.traverseWithKey shape $ \miCoord cData -> do
+    let
+      nudgeCellName :: Text -> Text
+      nudgeCellName miCellField = toPathPiece (MassInputCell{..} :: MassInputFieldName (BoxCoord liveliness))
+    (cData, ) <$> miCell miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
+  let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
+      result
+        | isJust addShape || isJust delShape = 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) =
@ -182,6 +298,7 @@ massInput mkAddWidget mkCellWidget FieldSettings{..} fvRequired initialResult =
              | [] <- 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 ]
@ -194,6 +311,10 @@ massInput mkAddWidget mkCellWidget FieldSettings{..} fvRequired initialResult =
  let
    fvLabel = toHtml $ mr fsLabel
    fvTooltip = toHtml . mr <$> fsTooltip
-    fvInput = miWidget boxOrigin $ zip [0..] boxDimensions
+    fvInput = mconcat
+      [ toWidget csrf
+      , shapeInput
+      , miWidget boxOrigin $ zip [0..] boxDimensions
+      ]
    fvErrors = Nothing
-  return (result, FieldView{..})
+    in return (result, FieldView{..})
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -497,7 +497,7 @@ assertM f x = x >>= assertM' f
 assertM_ :: MonadPlus m => (a -> Bool) -> m a -> m ()
 assertM_ f x = guard . f =<< x

-assertM' :: MonadPlus m => (a -> Bool) -> a -> m a
+assertM' :: Alternative m => (a -> Bool) -> a -> m a
 assertM' f x = x <$ guard (f x)

 -- Some Utility Functions from Agda.Utils.Monad
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@ -249,6 +249,7 @@ identifyForm' resLens identVal form fragment = do

 identifyForm :: (Monad m, PathPiece ident, Eq ident) => ident -> (Html -> MForm m (FormResult a, widget)) -> (Html -> MForm m (FormResult a, widget))
 identifyForm = identifyForm' id
+  

 {- Hinweise zur Erinnerung:
  - identForm primär, wenn es mehr als ein Formular pro Handler gibt
@ -573,6 +574,12 @@ apreq f fs mx = formToAForm $ do
  mr <- getMessageRender
  over _1 (maybe (FormFailure [mr MsgValueRequired]) return =<<) . over _2 (pure . (\fv -> fv { fvRequired = True } )) <$> mopt f fs (Just <$> mx)

+mpreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
+      => Field m a -> FieldSettings site -> Maybe a -> MForm m (FormResult a, FieldView site)
+mpreq f fs mx = do
+  mr <- getMessageRender
+  over _1 (maybe (FormFailure [mr MsgValueRequired]) return =<<) . over _2 (\fv -> fv { fvRequired = True } ) <$> mopt f fs (Just <$> mx)
+
 wpreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
      => Field m a -> FieldSettings site -> Maybe a -> WForm m (FormResult a)
 wpreq f fs mx = mFormToWForm $ do
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@ -80,6 +80,8 @@ makeLenses_ ''SheetType

 makePrisms ''AuthResult

+makePrisms ''FormResult
+
 -- makeClassy_ ''Load


--- a/templates/widgets/massinput/cell.hamlet
+++ b/templates/widgets/massinput/cell.hamlet
@ -1 +1,3 @@
 ^{cellWdgt}
+$maybe delWdgt <- fmap fvInput deleteButton
+  ^{delWdgt}