fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

massInputAccumEdit

Browse Source
This commit is contained in:
Gregor Kleen 2019-05-29 13:27:04 +02:00
parent 99061a89c4
commit 7a4f1cb76e
1 changed files with 78 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
src/Handler/Utils/Form/MassInput.hs
View File

@ -9,6 +9,7 @@ module Handler.Utils.Form.MassInput
, massInputA, massInputW
, massInputList
, massInputAccum, massInputAccumA, massInputAccumW
, massInputAccumEdit, massInputAccumEditA, massInputAccumEditW
, ListLength(..), ListPosition(..), miDeleteList
, EnumLiveliness(..), EnumPosition(..)
, MapLiveliness(..)
@ -564,6 +565,83 @@ massInputAccumW :: forall handler cellData ident.
massInputAccumW miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev
= mFormToWForm $ massInputAccum miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev mempty
-- | Wrapper around `massInput` for the common case, that we just want a list of data with existing data modified the same way as new data is added
massInputAccumEdit :: 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)))
-> ((Text -> Text) -> cellData -> (Markup -> MForm handler (FormResult cellData, Widget)))
-> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
-> MassInputLayout ListLength cellData cellData
-> ident
-> FieldSettings UniWorX
-> Bool
-> Maybe [cellData]
-> (Markup -> MForm handler (FormResult [cellData], FieldView UniWorX))
massInputAccumEdit miAdd' miCell' miButtonAction miLayout miIdent fSettings fRequired mPrev csrf
= over (_1 . mapped) (map snd . Map.elems) <$> massInput MassInput{..} fSettings fRequired (Map.fromList . zip [0..] . map (\x -> (x, x)) <$> mPrev) csrf
where
miAdd :: ListPosition -> Natural
-> (Text -> Text) -> FieldView UniWorX
-> Maybe (Markup -> MForm handler (FormResult (Map ListPosition cellData -> FormResult (Map ListPosition cellData)), Widget))
miAdd _pos _dim nudge submitView = Just $ \csrf' -> over (_1 . mapped) doAdd <$> miAdd' nudge submitView csrf'
doAdd :: ([cellData] -> FormResult [cellData]) -> (Map ListPosition cellData -> FormResult (Map ListPosition cellData))
doAdd f prevData = Map.fromList . zip [startKey..] <$> f prevElems
where
prevElems = Map.elems prevData
startKey = maybe 0 succ $ fst <$> Map.lookupMax prevData
miCell :: ListPosition -> cellData -> Maybe cellData -> (Text -> Text)
-> (Markup -> MForm handler (FormResult cellData, Widget))
miCell _pos dat _mPrev nudge = miCell' nudge dat
miDelete = miDeleteList
miAllowAdd _ _ _ = True
miAddEmpty _ _ _ = Set.empty
massInputAccumEditA :: 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)))
-> ((Text -> Text) -> cellData -> (Markup -> MForm handler (FormResult cellData, Widget)))
-> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
-> MassInputLayout ListLength cellData cellData
-> ident
-> FieldSettings UniWorX
-> Bool
-> Maybe [cellData]
-> AForm handler [cellData]
massInputAccumEditA miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev
= formToAForm $ over _2 pure <$> massInputAccumEdit miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev mempty
massInputAccumEditW :: 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)))
-> ((Text -> Text) -> cellData -> (Markup -> MForm handler (FormResult cellData, Widget)))
-> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
-> MassInputLayout ListLength cellData cellData
-> ident
-> FieldSettings UniWorX
-> Bool
-> Maybe [cellData]
-> WForm handler (FormResult [cellData])
massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev
= mFormToWForm $ massInputAccumEdit miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev mempty
massInputA :: forall handler cellData cellResult liveliness.
( MonadHandler handler, HandlerSite handler ~ UniWorX