dbTable now handles form csrf & identification

Fixes #124

src/Handler/Corrections.hs

@@ -195,7 +195,7 @@ data ActionCorrectionsData = CorrDownloadData
 correctionsR :: _ -> _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Maybe Widget)) -> Handler TypedContent
 correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
   tableForm <- makeCorrectionsTable whereClause displayColumns psValidator
-  ((actionRes, table), tableEncoding) <- runFormPost . identForm FIDcorrectorTable $ \csrf -> do
+  ((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
     ((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf
     (actionRes, action) <- multiAction actions
     return ((,) <$> actionRes <*> selectionRes, table <> action)

src/Handler/Utils/Table/Pagination.hs

@@ -243,9 +243,9 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *)
 
   cell :: Widget -> DBCell m x
     
-    
   -- dbWidget :: Proxy m -> Proxy x -> Iso' (DBResult m x) (Widget, DBResult' m x)
-  dbWidget :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Proxy m -> Proxy x -> DBResult m x -> m' Widget
+  dbWidget :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> DBResult m x -> m' Widget
+  dbHandler :: forall m'. (MonadHandler m' , HandlerSite m' ~ UniWorX) => DBTable m x -> (Widget -> Widget) -> DBResult m x -> m' (DBResult m x)
   runDBTable :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => m (x, Widget) -> ReaderT SqlBackend m' (DBResult m x)
 
 instance IsDBTable (WidgetT UniWorX IO) () where
@@ -262,7 +262,8 @@ instance IsDBTable (WidgetT UniWorX IO) () where
   cell = WidgetCell []
   
   -- dbWidget Proxy Proxy = iso (, ()) $ view _1
-  dbWidget Proxy Proxy = return
+  dbWidget _ = return
+  dbHandler _ f x = return $ f x
   runDBTable = return . join . fmap (view _2)
 
 instance Monoid (DBCell (WidgetT UniWorX IO) ()) where
@@ -282,7 +283,8 @@ instance IsDBTable (ReaderT SqlBackend (HandlerT UniWorX IO)) () where
 
   cell = DBCell [] . return
 
-  dbWidget Proxy Proxy = return
+  dbWidget _ = return
+  dbHandler _ f x = return $ f x
   -- runDBTable :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX) => ReaderT SqlBackend (HandlerT UniWorX IO) ((), Widget) -> m (Widget)
   runDBTable = fmap snd . mapReaderT liftHandlerT
 
@@ -306,7 +308,8 @@ instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc
   
   -- dbWidget Proxy Proxy = iso ((,) <$> view (_1._2) <*> ((,) <$> view (_1._1) <*> view _2))
   --                            ((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2))
-  dbWidget Proxy Proxy = liftHandlerT . fmap (view $ _1 . _2) . runFormPost
+  dbWidget DBTable{ dbtIdent = (toPathPiece -> dbtIdent) } = liftHandlerT . fmap (view $ _1 . _2) . runFormPost . identifyForm dbtIdent
+  dbHandler DBTable{ dbtIdent = (toPathPiece -> dbtIdent) } f form = return $ \csrf -> over _2 f <$> identifyForm dbtIdent form csrf
   -- runDBTable :: MForm (HandlerT UniWorX IO) (FormResult a, Widget) -> m ((FormResult a, Widget), Enctype)
   -- runDBTable form = liftHandlerT . runFormPost $ \html -> over _2 (<> toWidget html) <$> form
   -- runDBTable :: MForm (HandlerT UniWorX IO) (FormResult a, Widget) -> m (Html -> MForm (HandleT UniWorX IO) (FormResult a, Widget))
@@ -414,15 +417,12 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
 
         return $(widgetFile "table/layout")
 
-      dbWidget' :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBResult m x -> m' Widget
+    bool (dbHandler dbtable $ \table -> $(widgetFile "table/layout-wrapper")) (sendResponse <=< tblLayout <=< dbWidget dbtable) psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
-      dbWidget' = dbWidget (Proxy :: Proxy m) (Proxy :: Proxy x)
-
-    bool return (sendResponse <=< tblLayout <=< dbWidget') psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
   where
     tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html
     tblLayout tbl' = do
       tbl <- liftHandlerT $ widgetToPageContent tbl'
-      withUrlRenderer $(hamletFile "templates/table/layout-wrapper.hamlet")
+      withUrlRenderer $(hamletFile "templates/table/layout-standalone.hamlet")
 
     setParam :: Text -> Maybe Text -> QueryText -> QueryText
     setParam key v qt = (key, v) : [ i | i@(key', _) <- qt, key' /= key ]

templates/table/layout-standalone.hamlet

@@ -0,0 +1 @@
+^{pageBody tbl}

templates/table/layout-wrapper.hamlet

@@ -1 +1,3 @@
-^{pageBody tbl}
+$newline never
+<div ##{wIdent "table-wrapper"}>
+  ^{table}

templates/table/layout.hamlet

@@ -2,12 +2,11 @@ $newline never
 $if null wRows && (dbsEmptyStyle == DBESNoHeading)
   _{dbsEmptyMessage}
 $else
-  <div ##{wIdent "table-wrapper"}>
+  <div .scrolltable>
-    <div .scrolltable>
+    ^{table}
-      ^{table}
+  $if pageCount > 1
-    $if pageCount > 1
+    <ul ##{wIdent "pagination"} .pagination>
-      <ul ##{wIdent "pagination"} .pagination>
+      $forall p <- pageNumbers
-        $forall p <- pageNumbers
+        <li .pagination-link :p == psPage:.current>
-          <li .pagination-link :p == psPage:.current>
+          <a href=#{tblLink $ setParam (wIdent "page") (Just $ tshow p)}>
-            <a href=#{tblLink $ setParam (wIdent "page") (Just $ tshow p)}>
+            _{MsgPage (succ p)}
-              _{MsgPage (succ p)}