Filter Submissions by Course

routes

@@ -69,6 +69,7 @@
   /users                      CUsersR         GET
   /users/#CryptoUUIDUser      CUserR          GET             !lecturerANDparticipant
   /correctors                 CHiWisR         GET
+  /notes                      CNotesR         GET POST        !corrector
   /subs                       CCorrectionsR   GET POST
   /ex                         SheetListR      GET             !registered !materials !corrector
   !/ex/new                    SheetNewR       GET POST

src/Handler/Corrections.hs

@@ -13,18 +13,19 @@ import Handler.Utils.Delete
 
 import Utils.Lens
 
+import Data.List (nub)
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Map (Map, (!))
 import qualified Data.Map as Map
 
 import qualified Data.Text as Text
+import qualified Data.CaseInsensitive as CI
 
 import Data.Semigroup (Sum(..))
 import Data.Monoid (All(..))
 
 -- import Data.Time
--- import qualified Data.Text as T
 -- import Data.Function ((&))
 --
 -- import Colonnade hiding (fromMaybe, singleton, bool)
@@ -91,6 +92,11 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm)
           -- cell [whamlet| _{untermKey $ course ^. _3}|]   -- lange, internationale Semester
           textCell $ termToText $ unTermKey $ course ^. _3 -- kurze Semsterkürzel
 
+colSchool :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
+colSchool = sortable (Just "school") (i18nCell MsgCourseSchool)
+          $ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
+            anchorCell (TermSchoolCourseListR (course ^. _3) (course ^. _4)) [whamlet|#{unSchoolKey (course ^. _4)}|]
+
 colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
 colCourse = sortable (Just "course") (i18nCell MsgCourse)
         $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid), _, _) } -> courseCellCL (tid,sid,csh)
@@ -192,8 +198,8 @@ colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell id
 
 
 makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
-                     => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> PSValidator m x -> _ -> DBParams m x -> DB (DBResult m x)
-makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = do
+                     => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> _ -> PSValidator m x -> _ -> DBParams m x -> DB (DBResult m x)
+makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' dbtParams = do
   let dbtSQLQuery :: CorrectionTableExpr -> E.SqlQuery _
       dbtSQLQuery = correctionsTableQuery whereClause
           (\((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) ->
@@ -237,6 +243,9 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = d
       , ( "rating"
         , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints
         )
+      , ( "israted"
+        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
+        )
       , ( "ratingtime"
         , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingTime
         )
@@ -276,8 +285,8 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = d
                            E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False)
         )
       ]
-    , dbtFilterUI  = mempty
-    , dbtStyle     = def
+    , dbtFilterUI  = fromMaybe mempty dbtFilterUI
+    , dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
     , dbtParams
     , dbtIdent     = "corrections" :: Text
     }
@@ -299,8 +308,8 @@ data ActionCorrectionsData = CorrDownloadData
                            | CorrAutoSetCorrectorData SheetId
                            | CorrDeleteData
 
-correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent
-correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
+correctionsR :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent
+correctionsR whereClause (formColonnade -> displayColumns) dbtFilterUI psValidator actions = do
   Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler
 
   postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords)
@@ -310,7 +319,7 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
 
   ((actionRes', table), statistics) <- runDB $ do
     -- Query for Table
-    tableRes <- makeCorrectionsTable whereClause displayColumns psValidator return def
+    tableRes <- makeCorrectionsTable whereClause displayColumns dbtFilterUI psValidator return def
       { dbParamsFormAction = Just $ SomeRoute currentRoute
       , dbParamsFormAddSubmit = True
       , dbParamsFormAdditional = \frag -> do
@@ -466,6 +475,7 @@ postCorrectionsR = do
       colonnade = mconcat
         [ colSelect
         , dbRow
+        , colSchool
         , colTerm
         , colCourse
         , colSheet
@@ -475,10 +485,19 @@ postCorrectionsR = do
         , colRating
         , colRated
         ] -- Continue here
+      filterUI = Just $ \mPrev -> mconcat
+        [ Map.singleton "course" . maybeToList <$> aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse) (Just <$> listToMaybe =<< Map.lookup "course" =<< mPrev)
+
+        ]
+      courseOptions = runDB $ do
+        courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)
+        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses
+
       psValidator = def
         & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
         & restrictSorting (\name _ -> name /= "corrector")
-  correctionsR whereClause colonnade psValidator $ Map.fromList
+        & defaultSorting [SortAscBy "israted", SortDescBy "ratingTime", SortAscBy "assignedtime" ]
+  correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
     [ downloadAction
     ]
 
@@ -500,7 +519,7 @@ postCCorrectionsR tid ssh csh = do
         , colAssigned
         ] -- Continue here
       psValidator = def
-  correctionsR whereClause colonnade psValidator $ Map.fromList
+  correctionsR whereClause colonnade Nothing psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Left cid)
     , deleteAction
@@ -523,7 +542,7 @@ postSSubsR tid ssh csh shn = do
         , colAssigned
         ]
       psValidator = def
-  correctionsR whereClause colonnade psValidator $ Map.fromList
+  correctionsR whereClause colonnade Nothing psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Right shid)
     , autoAssignAction shid
@@ -811,6 +830,7 @@ postCorrectionsGradeR = do
   let whereClause = ratedBy uid
       displayColumns = mconcat -- should match getSSubsR for consistent UX
         [ dbRow
+        , colSchool
         , colTerm
         , colCourse
         , colSheet
@@ -829,7 +849,7 @@ postCorrectionsGradeR = do
         void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True
         return i
 
-  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns psValidator dbtProj' $ def
+  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns mempty psValidator dbtProj' $ def
     { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
     , dbParamsFormAddSubmit = True
     }

src/Handler/Course.hs

@@ -620,3 +620,8 @@ getCUserR _tid _ssh _csh uCId = do
 
 getCHiWisR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCHiWisR = error "CHiWisR: Not implemented"
+
+getCNotesR, postCNotesR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
+-- NOTE: The route getNotesR is abused for correctorORlecturer access rights!
+getCNotesR = error "CNotesR: Not implemented"
+postCNotesR = error "CNotesR: Not implemented"

src/Utils/Form.hs

@@ -149,7 +149,7 @@ noValidate = addAttr "formnovalidate" ""
 
 inputDisabled :: FieldSettings site -> FieldSettings site
 inputDisabled = addAttr "disabled" ""
-  
+
 inputReadonly :: FieldSettings site -> FieldSettings site
 inputReadonly = addAttr "readonly" ""
 
@@ -340,7 +340,7 @@ reorderField :: ( MonadHandler m
                 , HandlerSite m ~ site
                 , Eq a
                 , Show a
-                ) => HandlerT site IO (OptionList a) -> Field m [a] 
+                ) => HandlerT site IO (OptionList a) -> Field m [a]
 -- ^ Allow the user to enter a /permutation/ of the given options (every option must occur exactly once in the result)
 reorderField optList = Field{..}
   where
@@ -437,3 +437,13 @@ runInputPostMaybe form = do
     FormSuccess suc -> Just suc
     _other -> Nothing
 runInputMaybe form = runMaybeT $ MaybeT (runInputPostMaybe form) <|> MaybeT (runInputGetMaybe form)
+
+hoistAForm :: HandlerSite m ~ HandlerSite n => (forall a. m a -> n a) -> AForm m b -> AForm n b
+hoistAForm f (AForm g) = AForm (\x y z ->f $ g x y z)
+
+hoistField :: HandlerSite m ~ HandlerSite n => (forall a. m a -> n a) -> Field m b -> Field n b
+hoistField f Field{..} = Field
+  { fieldParse = \x y -> f $ fieldParse x y
+  , fieldView
+  , fieldEnctype
+  }

templates/table/layout-filter-default.hamlet

@@ -2,5 +2,7 @@ $newline never
 <section>
   <form method=GET action=#{filterAction} enctype=#{filterEnctype}>
     ^{filterWgdt}
+    <button>
+      ^{label BtnSubmit}
 <section>
   ^{scrolltable}