diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 269c07d97..05ae4e04b 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -187,7 +187,7 @@ getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!! whereClause = const $ E.val True validator = def & defaultSorting [("course", SortAsc), ("term", SortDesc)] - coursesTable <- makeCourseTable whereClause colonnade validator + ((), coursesTable) <- makeCourseTable whereClause colonnade validator defaultLayout $ do setTitleI MsgCourseListTitle [whamlet|TODO: Such-/Filterfunktion hier einbauen|] -- TODO @@ -217,7 +217,7 @@ getTermCourseListR tid = do whereClause = \(course, _, _) -> course E.^. CourseTerm E.==. E.val tid validator = def & defaultSorting [("cshort", SortAsc)] - coursesTable <- makeCourseTable whereClause colonnade validator + ((), coursesTable) <- makeCourseTable whereClause colonnade validator defaultLayout $ do setTitleI . MsgTermCourseListTitle $ tid $(widgetFile "courses") diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 960ff2757..adca2c28a 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -65,7 +65,7 @@ homeAnonymous = do E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime))) return course - colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (WidgetT UniWorX IO) ()) + colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ()) colonnade = mconcat [ -- dbRow sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do @@ -77,7 +77,7 @@ homeAnonymous = do , sortable (Just "deadline") (textCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget ] - courseTable <- dbTable def $ DBTable + ((), courseTable) <- dbTable def $ DBTable { dbtSQLQuery = tableData , dbtColonnade = colonnade , dbtProj = return @@ -144,7 +144,7 @@ homeUser uid = do , E.Value UTCTime , E.Value (Maybe SubmissionId) )) - (DBCell (WidgetT UniWorX IO) ()) + (DBCell (HandlerT UniWorX IO) ()) colonnade = mconcat [ -- dbRow sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _, _) } -> @@ -162,7 +162,7 @@ homeUser uid = do tickmark ] let validator = def & defaultSorting [("done",SortDesc), ("deadline",SortDesc)] - sheetTable <- dbTable validator $ DBTable + ((), sheetTable) <- dbTable validator $ DBTable { dbtSQLQuery = tableData , dbtColonnade = colonnade , dbtProj = \dbRow@DBRow{ dbrOutput = (E.Value tid, E.Value csh, E.Value shn, _, _) } diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 5e9973f2e..c27ee142a 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -56,6 +56,8 @@ import qualified Data.Map as Map import Data.Map (Map, (!), (!?)) import qualified Data.Map as Map +import Data.Monoid (Sum(..)) + import Control.Lens import Utils.Lens @@ -199,7 +201,8 @@ getSheetListR tid csh = do mkRoute = do cid <- mkCid return $ CSubmissionR tid csh sheetName cid CorrectionR - in anchorCellM mkRoute $(widgetFile "widgets/rating") + protoCell = anchorCellM mkRoute $(widgetFile "widgets/rating") + in protoCell & cellContents %~ (<* tell (sheetTypeSum (sheetType, submissionRatingPoints))) , sortable Nothing -- (Just "percent") (i18nCell MsgRatingPercent) $ \(Entity _ Sheet{sheetType=sType}, _, mbSub) -> case mbSub of @@ -214,7 +217,7 @@ getSheetListR tid csh = do ] psValidator = def & defaultSorting [("submission-since", SortAsc)] - table <- dbTable psValidator $ DBTable + (SheetTypeSummary{..}, table) <- dbTable psValidator $ DBTable { dbtSQLQuery = sheetData , dbtColonnade = sheetCol , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) } @@ -248,19 +251,6 @@ getSheetListR tid csh = do , dbtStyle = def , dbtIdent = "sheets" :: Text } - cTime <- Just <$> liftIO getCurrentTime -- TODO: HACK - remove me and the 2 next TODOs, see issue #142 - rawStats <- runDB $ do -- compute the values of the table once again, since dbTable does not provide a list of raw values for summation/statistics - E.select $ E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do - E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission - E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet - E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid - E.where_ $ sheet E.^. SheetCourse E.==. E.val cid - E.&&. (E.not_ $ E.isNothing $ sheet E.^. SheetVisibleFrom) -- TODO see above #142 - E.&&. sheet E.^. SheetVisibleFrom E.<=. E.val cTime -- TODO see above #142 - return $ (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints) - - let sheetTypeSummary = foldl' sumSheetTypes emptySheetTypeSummary - $ map (\(st,mp) -> (E.unValue st, join $ E.unValue mp)) rawStats defaultLayout $ do $(widgetFile "sheetList") $(widgetFile "widgets/sheetTypeSummary") @@ -301,7 +291,7 @@ getSShowR tid csh shn = do ] let psValidator = def & defaultSorting [("type", SortAsc), ("path", SortAsc)] - fileTable <- dbTable psValidator $ DBTable + ((), fileTable) <- dbTable psValidator $ DBTable { dbtSQLQuery = fileData , dbtColonnade = colonnadeFiles , dbtProj = \DBRow{ dbrOutput = dbrOutput@(E.Value fName, _, E.Value fType) } diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index c25381e42..8c1987bf5 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -246,7 +246,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- Maybe construct a table to display uploaded archive files - let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ()) + let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerT UniWorX IO) ()) colonnadeFiles cid = mconcat [ sortable (Just "path") (textCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let Just fileTitle' = fileTitle . entityVal . snd <$> (mOrig <|> mCorr) @@ -299,7 +299,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do ] , dbtFilter = [] } - mFileTable <- traverse (dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid + mFileTable <- traverse (fmap snd . dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid defaultLayout $ do setTitleI $ MsgSubmissionEditHead tid csh shn diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 20f12eaa3..27e66a957 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -78,7 +78,7 @@ getTermShowR = do -- #{termToText termName} -- |] -- ] - table <- dbTable def $ DBTable + ((), table) <- dbTable def $ DBTable { dbtSQLQuery = termData , dbtColonnade = colonnadeTerms , dbtProj = return . dbrOutput diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index ef9d012e1..ae6e07c64 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -4,7 +4,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, NamedFieldPuns #-} module Handler.Users where @@ -12,6 +12,8 @@ import Import -- import Data.Text import Handler.Utils +import Utils.Lens + import qualified Data.Map as Map import qualified Data.Set as Set @@ -29,7 +31,7 @@ hijackUserForm uid csrf = do getUsersR :: Handler Html getUsersR = do let - colonnadeUsers = dbColonnade . mconcat $ + dbtColonnade = dbColonnade . mconcat $ [ dbRow , sortable (Just "display-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM (AdminUserR <$> encrypt uid) @@ -40,32 +42,28 @@ getUsersR = do -- , sortable (Just "last-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM -- (AdminUserR <$> encrypt uid) -- (toWidget . display $ last $ impureNonNull $ words $ userDisplayName) - , sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty - { dbCellContents = do - schools <- E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do - E.on $ school E.^. SchoolId E.==. userAdmin E.^. UserAdminSchool - E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid - E.orderBy [E.asc $ school E.^. SchoolShorthand] - return $ school E.^. SchoolShorthand - return [whamlet| -