diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 6edcbf05f..a79faabb9 100644 --- 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
  • #{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| +

    Mass-Input +
    + ^{miForm} + ^{submitButtonView} + $case miResult + $of FormMissing + $of FormFailure errs +
      + $forall err <- errs +
    • #{err} + $of FormSuccess res +
      +            #{tshow res}
      +    |]
      +
       
       getAdminErrMsgR, postAdminErrMsgR :: Handler Html
       getAdminErrMsgR = postAdminErrMsgR
      diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
      index b135e3a6c..3375f5a24 100644
      --- 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{..})
      diff --git a/src/Utils.hs b/src/Utils.hs
      index 4e2b5c6de..fa4ec109c 100644
      --- 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
      diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
      index cb7daeb8e..049217701 100644
      --- 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
      diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
      index b8ac05e63..dcb8f6590 100644
      --- a/src/Utils/Lens.hs
      +++ b/src/Utils/Lens.hs
      @@ -80,6 +80,8 @@ makeLenses_ ''SheetType
       
       makePrisms ''AuthResult
       
      +makePrisms ''FormResult
      +
       -- makeClassy_ ''Load
       
       
      diff --git a/templates/widgets/massinput/cell.hamlet b/templates/widgets/massinput/cell.hamlet
      index de6e44d7a..8a9654357 100644
      --- a/templates/widgets/massinput/cell.hamlet
      +++ b/templates/widgets/massinput/cell.hamlet
      @@ -1 +1,3 @@
       ^{cellWdgt}
      +$maybe delWdgt <- fmap fvInput deleteButton
      +  ^{delWdgt}