formCell

src/Handler/Utils/Table/Pagination.hs

@@ -26,6 +26,7 @@ module Handler.Utils.Table.Pagination
   , dbTable
   , widgetColonnade, formColonnade
   , textCell, stringCell, anchorCell
+  , formCell, DBFormResult, getDBFormResult
   ) where
 
 import Handler.Utils.Table.Pagination.Types
@@ -342,3 +343,25 @@ anchorCell mkRoute mkWidget val = cell $(widgetFile "table/cell/link")
   where
     route = mkRoute val
     widget = mkWidget val
+
+newtype DBFormResult r i a = DBFormResult (Map i (r, a -> a))
+
+instance Ord i => Monoid (DBFormResult r i a) where
+  mempty = DBFormResult Map.empty
+  (DBFormResult m1) `mappend` (DBFormResult m2) = DBFormResult $ Map.unionWith (\(r, f1) (_, f2) -> (r, f2 . f1)) m1 m2
+
+getDBFormResult :: Ord i => (r -> a) -> DBFormResult r i a -> Map i a
+getDBFormResult initial (DBFormResult m) = Map.map (\(r, f) -> f $ initial r) m
+
+formCell :: Ord i
+         => (r -> MForm (HandlerT UniWorX IO) i)
+         -> (r -> MForm (HandlerT UniWorX IO) (FormResult (a -> a), Widget))
+         -> (r -> DBCell ((RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO))) (FormResult (DBFormResult r i a)))
+formCell genIndex genForm input = FormCell
+  { formCellAttrs    = []
+  , formCellContents = do -- MForm (HandlerT UniWorX IO) (FormResult (Map i (Endo a)), Widget)
+      i <- genIndex input
+      (edit, w) <- genForm input
+      return (DBFormResult . Map.singleton i . (input,) <$> edit, w)
+  }
+