From 1d116814cba9e396d7ea10dfc224ccadc6288b7e Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 27 Jun 2018 14:22:54 +0200 Subject: [PATCH] formCell --- src/Handler/Utils/Table/Pagination.hs | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index f0b683dce..fff153338 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/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) + } +