diff --git a/fill-db.hs b/fill-db.hs index dd8f42c62..cc16924c7 100755 --- a/fill-db.hs +++ b/fill-db.hs @@ -75,9 +75,10 @@ main = db $ do void . insert $ UserLecturer gkleen ifi void . insert $ UserLecturer fhamann ifi void . insert $ UserLecturer jost ifi - ifiBsc <- insert $ Degree "Bachelor Informatik" ifi - ifiMsc <- insert $ Degree "Master Informatik" ifi - miBsc <- insert $ Degree "Bachelor Mathematik" mi + sdBsc <- insert $ StudyDegree 82 (Just "BSc") (Just "Bachelor" ) + sdMst <- insert $ StudyDegree 88 (Just "MSc") (Just "Master" ) + sdInf <- insert $ StudyTerms 79 (Just "Inf") (Just "Informatik") + sdMath <- insert $ StudyTerms 105 (Just "M" ) (Just "Mathematik") -- FFP ffp <- insert Course { courseName = "Fortgeschrittene Funktionale Programmierung" @@ -92,8 +93,9 @@ main = db $ do , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now ) } insert_ $ CourseEdit jost now ffp - void . insert $ DegreeCourse ifiBsc ffp - void . insert $ DegreeCourse ifiMsc ffp + void . insert $ DegreeCourse ffp sdBsc sdInf + void . insert $ DegreeCourse ffp sdMst sdInf + void . insert $ Lecturer jost ffp void . insert $ Lecturer gkleen ffp insert_ $ Corrector gkleen ffp (ByProportion 1) sheetkey <- insert $ Sheet ffp "Blatt 1" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing @@ -112,8 +114,7 @@ main = db $ do , courseRegisterTo = Nothing } insert_ $ CourseEdit fhamann now eip - void . insert $ DegreeCourse ifiBsc eip - void . insert $ DegreeCourse ifiMsc eip + void . insert $ DegreeCourse eip sdBsc sdInf void . insert $ Lecturer fhamann eip -- interaction design ixd <- insert Course @@ -129,7 +130,7 @@ main = db $ do , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now ) } insert_ $ CourseEdit fhamann now ixd - void . insert $ DegreeCourse ifiBsc ixd + void . insert $ DegreeCourse ixd sdBsc sdInf void . insert $ Lecturer fhamann ixd -- concept development ux3 <- insert Course @@ -145,7 +146,7 @@ main = db $ do , courseRegisterTo = Nothing } insert_ $ CourseEdit fhamann now ux3 - void . insert $ DegreeCourse ifiBsc ux3 + void . insert $ DegreeCourse ux3 sdBsc sdInf void . insert $ Lecturer fhamann ux3 -- promo pmo <- insert Course @@ -161,7 +162,7 @@ main = db $ do , courseRegisterTo = Nothing } insert_ $ CourseEdit jost now pmo - void . insert $ DegreeCourse ifiBsc pmo + void . insert $ DegreeCourse pmo sdBsc sdInf void . insert $ Lecturer jost pmo -- datenbanksysteme dbs <- insert Course @@ -177,6 +178,7 @@ main = db $ do , courseRegisterTo = Nothing } insert_ $ CourseEdit gkleen now dbs - void . insert $ DegreeCourse ifiBsc dbs + void . insert $ DegreeCourse dbs sdBsc sdInf + void . insert $ DegreeCourse dbs sdBsc sdMath void . insert $ Lecturer gkleen dbs void . insert $ Lecturer jost dbs diff --git a/messages/de.msg b/messages/de.msg index 5ff819035..c3bfe568f 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}