From 0bd86730d398f307f8c6f3168628f8bce3f11ceb Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 18 Jul 2018 13:58:33 +0200 Subject: [PATCH 1/4] Minor comment --- src/Handler/Sheet.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 534cb49f2..8d70902bb 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -88,6 +88,7 @@ data SheetForm = SheetForm makeSheetForm :: Maybe SheetId -> Maybe SheetForm -> Form SheetForm makeSheetForm msId template = identForm FIDsheet $ \html -> do + -- TODO: SJ to refactor this; extract Code from getSEditR to joint code piece let oldFileIds fType | Just sId <- msId = fmap setFromList . fmap (map E.unValue) . runDB . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile From cb0ac4b7e9085bc3e2ab640b9a38606027b067f9 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 18 Jul 2018 14:52:41 +0200 Subject: [PATCH 2/4] Fix PSLimitNonPositive --- src/Handler/Utils/Table/Pagination.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 1b6f19ba2..1a6e2df4b 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -204,7 +204,7 @@ instance Default (PSValidator m x) where l <- asks piLimit case l of Just l' - | l' >= 0 -> tell . pure $ SomeMessage MsgPSLimitNonPositive + | l' <= 0 -> tell . pure $ SomeMessage MsgPSLimitNonPositive | otherwise -> modify $ \ps -> ps { psLimit = l' } Nothing -> return () From 984b325dcd9d1682f6669f0ba16d7346541c0473 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 18 Jul 2018 15:05:28 +0200 Subject: [PATCH 3/4] dbTable now handles form csrf & identification Fixes #124 --- src/Handler/Corrections.hs | 2 +- src/Handler/Utils/Table/Pagination.hs | 20 ++++++++++---------- templates/table/layout-standalone.hamlet | 1 + templates/table/layout-wrapper.hamlet | 4 +++- templates/table/layout.hamlet | 17 ++++++++--------- 5 files changed, 23 insertions(+), 21 deletions(-) create mode 100644 templates/table/layout-standalone.hamlet diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 40b2eff15..7379ae4c0 100644 --- a/src/Handler/Corrections.hs +++ b/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) diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 1a6e2df4b..26acd65dc 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -242,10 +242,10 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *) cellContents :: DBCell m x -> WriterT x m Widget 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)) @@ -413,16 +416,13 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent), pageNumbers = [0..pred pageCount] return $(widgetFile "table/layout") - - dbWidget' :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBResult m x -> m' Widget - dbWidget' = dbWidget (Proxy :: Proxy m) (Proxy :: Proxy x) - bool return (sendResponse <=< tblLayout <=< dbWidget') psShortcircuit <=< runDBTable . fmap swap $ runWriterT table' + bool (dbHandler dbtable $ \table -> $(widgetFile "table/layout-wrapper")) (sendResponse <=< tblLayout <=< dbWidget dbtable) 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 ] diff --git a/templates/table/layout-standalone.hamlet b/templates/table/layout-standalone.hamlet new file mode 100644 index 000000000..34b53ce1f --- /dev/null +++ b/templates/table/layout-standalone.hamlet @@ -0,0 +1 @@ +^{pageBody tbl} diff --git a/templates/table/layout-wrapper.hamlet b/templates/table/layout-wrapper.hamlet index 34b53ce1f..bfa000765 100644 --- a/templates/table/layout-wrapper.hamlet +++ b/templates/table/layout-wrapper.hamlet @@ -1 +1,3 @@ -^{pageBody tbl} +$newline never +
+ ^{table} diff --git a/templates/table/layout.hamlet b/templates/table/layout.hamlet index 46e1da27a..1c2fbf863 100644 --- a/templates/table/layout.hamlet +++ b/templates/table/layout.hamlet @@ -2,12 +2,11 @@ $newline never $if null wRows && (dbsEmptyStyle == DBESNoHeading) _{dbsEmptyMessage} $else -
-
- ^{table} - $if pageCount > 1 -