diff --git a/messages/de.msg b/messages/de.msg index 163ca0cfb..d56678c38 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -1,6 +1,7 @@ SummerTerm year@Integer: Sommersemester #{tshow year} WinterTerm year@Integer: Wintersemester #{tshow year}/#{tshow $ succ year} PSLimitNonPositive: “pagesize” muss größer als null sein +Page n@Int64 num@Int64: Seite #{tshow n} von #{tshow num} TermEdited tid@TermIdentifier: Semester #{termToText tid} erfolgreich editiert. TermNewTitle: Semester editiere/anlegen. InvalidInput: Eingaben bitte korrigieren. diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index f8155da8c..9d85edbee 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 428810362..28fcb1073 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -3,30 +3,51 @@ , RecordWildCards , OverloadedStrings , TemplateHaskell + , QuasiQuotes , LambdaCase , 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 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 import Text.Hamlet (hamletFile) +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 @@ -45,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 @@ -74,23 +95,21 @@ 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 | otherwise = n + dbtAttrs' + | not $ null dbtIdent = Html5.id (fromString $ unpack dbtIdent) <> dbtAttrs + | 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") @@ -105,17 +124,22 @@ 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 <- 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 + pageCount = max 1 . ceiling $ rowCount % psLimit + $(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..d268dad12 100644 --- a/templates/table-layout.hamlet +++ b/templates/table-layout.hamlet @@ -1 +1,4 @@ -^{pageBody tbl} +
+ ^{table} +

+ _{MsgPage (succ psPage) pageCount}