From 7a4f1cb76efebd298030ab175b69bb87d994e2aa Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 29 May 2019 13:27:04 +0200
Subject: [PATCH] massInputAccumEdit

---
 src/Handler/Utils/Form/MassInput.hs | 78 +++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)

diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index dab7f1d51..ae87527bf 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -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