From ba918129c9e288cae2da3e837cc2286128973c84 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 16 Mar 2018 13:30:58 +0100 Subject: [PATCH 1/4] Identify paginated table with html-id --- src/Handler/Utils/Table/Pagination.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 428810362..2f67bf522 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -13,6 +13,7 @@ import Import import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect) import Text.Blaze (Attribute) +import qualified Text.Blaze.Html5.Attributes as Html5 import Control.Monad.RWS hiding ((<>), Foldable(..), mapM_) @@ -88,6 +89,9 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do wIdent n | not $ null dbtIdent = dbtIdent <> "-" <> n | otherwise = n + dbtAttrs' + | not $ null dbtIdent = Html5.id (fromString $ unpack dbtIdent) <> dbtAttrs + | otherwise = dbtAttrs psResult <- runInputGetResult $ PaginationSettings <$> ireq sortingField (wIdent "sorting") @@ -115,7 +119,7 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do rows <- runDB $ E.select sqlQuery' bool return (sendResponse <=< tblLayout) psShortcircuit $ do - encodeCellTable dbtAttrs dbtColonnade rows + encodeCellTable dbtAttrs' dbtColonnade rows where tblLayout :: Widget -> Handler Html tblLayout = widgetToPageContent >=> (\tbl -> withUrlRenderer $(hamletFile "templates/table-layout.hamlet")) From 2cfd87de87835a9bdfbc4f18e6da49e58d1fb89e Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 16 Mar 2018 14:09:12 +0100 Subject: [PATCH 2/4] Page indicator --- messages/de.msg | 3 ++- src/Handler/Term.hs | 2 +- src/Handler/Utils/Table/Pagination.hs | 10 +++++++--- templates/table-layout-wrapper.hamlet | 1 + templates/table-layout.hamlet | 5 ++++- 5 files changed, 15 insertions(+), 6 deletions(-) create mode 100644 templates/table-layout-wrapper.hamlet diff --git a/messages/de.msg b/messages/de.msg index 0f6ec28bb..710f73cae 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -1,3 +1,4 @@ SummerTerm year@Integer: Sommersemester #{tshow year} WinterTerm year@Integer: Wintersemester #{tshow year}/#{tshow $ succ year} -PSLimitNonPositive: “pagesize” muss größer als null sein \ No newline at end of file +PSLimitNonPositive: “pagesize” muss größer als null sein +Page n@Int64 num@Int64: Seite #{tshow n} von #{tshow num} \ No newline at end of file diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 60776bbef..0ec926787 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -30,7 +30,7 @@ getTermShowR = do -- let termData = E.from $ \term -> do - E.orderBy [E.desc $ term E.^. TermStart ] + -- E.orderBy [E.desc $ term E.^. TermStart ] let courseCount :: E.SqlExpr (E.Value Int) courseCount = E.sub_select . E.from $ \course -> do E.where_ $ term E.^. TermId E.==. course E.^. CourseTermId diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 2f67bf522..76a988ddb 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -3,6 +3,7 @@ , RecordWildCards , OverloadedStrings , TemplateHaskell + , QuasiQuotes , LambdaCase , ViewPatterns #-} @@ -116,10 +117,13 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do mapM_ (addMessageI "warning") errs - rows <- runDB $ E.select sqlQuery' + (rows, [E.Value rowCount]) <- runDB $ (,) <$> E.select sqlQuery' <*> E.select (E.countRows <$ dbtSQLQuery :: E.SqlQuery (E.SqlExpr (E.Value Int64))) bool return (sendResponse <=< tblLayout) psShortcircuit $ do - encodeCellTable dbtAttrs' dbtColonnade rows + let table = encodeCellTable dbtAttrs' dbtColonnade rows + $(widgetFile "table-layout") where tblLayout :: Widget -> Handler Html - tblLayout = widgetToPageContent >=> (\tbl -> withUrlRenderer $(hamletFile "templates/table-layout.hamlet")) + tblLayout tbl' = do + tbl <- widgetToPageContent tbl' + withUrlRenderer $(hamletFile "templates/table-layout-wrapper.hamlet") diff --git a/templates/table-layout-wrapper.hamlet b/templates/table-layout-wrapper.hamlet new file mode 100644 index 000000000..34b53ce1f --- /dev/null +++ b/templates/table-layout-wrapper.hamlet @@ -0,0 +1 @@ +^{pageBody tbl} diff --git a/templates/table-layout.hamlet b/templates/table-layout.hamlet index 34b53ce1f..323be24bb 100644 --- a/templates/table-layout.hamlet +++ b/templates/table-layout.hamlet @@ -1 +1,4 @@ -^{pageBody tbl} +
+ ^{table} +

+ _{MsgPage (succ psPage) (succ $ div rowCount psLimit)} From 170442cff0c476d8e81df9a770c87801b0fce017 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 16 Mar 2018 14:22:33 +0100 Subject: [PATCH 3/4] Fix page indicator --- src/Handler/Utils/Table/Pagination.hs | 3 +++ templates/table-layout.hamlet | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 76a988ddb..f00426e45 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -25,6 +25,8 @@ import Yesod.Colonnade import Text.Hamlet (hamletFile) +import Data.Ratio ((%)) + data SortColumn = forall a. PersistField a => SortColumn { getSortColumn :: E.SqlExpr (E.Value a) } data SortDirection = SortAsc | SortDesc @@ -121,6 +123,7 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do bool return (sendResponse <=< tblLayout) psShortcircuit $ do let table = encodeCellTable dbtAttrs' dbtColonnade rows + pageCount = max 1 . ceiling $ rowCount % psLimit $(widgetFile "table-layout") where tblLayout :: Widget -> Handler Html diff --git a/templates/table-layout.hamlet b/templates/table-layout.hamlet index 323be24bb..d268dad12 100644 --- a/templates/table-layout.hamlet +++ b/templates/table-layout.hamlet @@ -1,4 +1,4 @@

^{table}

- _{MsgPage (succ psPage) (succ $ div rowCount psLimit)} + _{MsgPage (succ psPage) pageCount} From 28d9c5c95bc1acd00459bf791e8143dcfb08d247 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 19 Mar 2018 12:29:55 +0100 Subject: [PATCH 4/4] Cleanup --- src/Handler/Utils/Table/Pagination.hs | 41 ++++++++++++++++++--------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index f00426e45..28fcb1073 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -8,7 +8,13 @@ , ViewPatterns #-} -module Handler.Utils.Table.Pagination where +module Handler.Utils.Table.Pagination + ( SortColumn(..), SortDirection(..) + , DBTable(..) + , PaginationSettings(..) + , PSValidator(..) + , dbTable + ) where import Import import qualified Database.Esqueleto as E @@ -16,9 +22,12 @@ import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect) import Text.Blaze (Attribute) import qualified Text.Blaze.Html5.Attributes as Html5 +import Data.CaseInsensitive (CI) +import qualified Data.CaseInsensitive as CI + import Control.Monad.RWS hiding ((<>), Foldable(..), mapM_) -import Data.Map (Map) +import Data.Map (Map, (!)) import Colonnade hiding (bool, fromMaybe) import Yesod.Colonnade @@ -29,8 +38,16 @@ import Data.Ratio ((%)) data SortColumn = forall a. PersistField a => SortColumn { getSortColumn :: E.SqlExpr (E.Value a) } + data SortDirection = SortAsc | SortDesc deriving (Eq, Ord, Enum, Show, Read) +instance PathPiece SortDirection where + toPathPiece SortAsc = "asc" + toPathPiece SortDesc = "desc" + fromPathPiece (CI.mk -> t) + | t == "asc" = Just SortAsc + | t == "desc" = Just SortDesc + | otherwise = Nothing sqlSortDirection :: (SortColumn, SortDirection) -> E.SqlExpr E.OrderBy sqlSortDirection (SortColumn e, SortAsc ) = E.asc e @@ -49,7 +66,7 @@ data DBTable = forall a r h i. } data PaginationSettings = PaginationSettings - { psSorting :: [(SortColumn, SortDirection)] + { psSorting :: [(Text, SortDirection)] , psLimit :: Int64 , psPage :: Int64 , psShortcircuit :: Bool @@ -78,16 +95,11 @@ dbTable :: PSValidator -> DBTable -> Handler Widget dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do let sortingOptions = mkOptionList - [ Option t' (c, d) t' - | (t, c) <- mapToList dbtSorting + [ Option t' (t, d) t' + | (t, _) <- mapToList dbtSorting , d <- [SortAsc, SortDesc] - , let t' = t <> "-" <> tshow d + , let t' = t <> "-" <> toPathPiece d ] - sortingField = Field parse (\_ _ _ _ _ -> return ()) UrlEncoded - where - parse optlist _ = case mapM (olReadExternal sortingOptions) optlist of - Nothing -> return $ Left "Error parsing values" - Just res -> return $ Right $ Just res (_, defPS) = runPSValidator Nothing wIdent n | not $ null dbtIdent = dbtIdent <> "-" <> n @@ -97,7 +109,7 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do | otherwise = dbtAttrs psResult <- runInputGetResult $ PaginationSettings - <$> ireq sortingField (wIdent "sorting") + <$> ireq (multiSelectField $ return sortingOptions) (wIdent "sorting") <*> (fromMaybe (psLimit defPS) <$> iopt intField (wIdent "pagesize")) <*> (fromMaybe (psPage defPS) <$> iopt intField (wIdent "page")) <*> ireq checkBoxField (wIdent "table-only") @@ -112,13 +124,14 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do FormSuccess ps -> runPSValidator $ Just ps FormFailure errs -> first (map SomeMessage errs <>) $ runPSValidator Nothing FormMissing -> runPSValidator Nothing + psSorting' = map (first (dbtSorting !)) psSorting sqlQuery' = dbtSQLQuery - <* E.orderBy (map sqlSortDirection psSorting) + <* E.orderBy (map sqlSortDirection psSorting') <* E.limit psLimit <* E.offset (psPage * psLimit) mapM_ (addMessageI "warning") errs - + (rows, [E.Value rowCount]) <- runDB $ (,) <$> E.select sqlQuery' <*> E.select (E.countRows <$ dbtSQLQuery :: E.SqlQuery (E.SqlExpr (E.Value Int64))) bool return (sendResponse <=< tblLayout) psShortcircuit $ do