Merge branch 'feat/exercises' into feat/pagination

messages/de.msg

@@ -1,4 +1,4 @@
-  SummerTerm year@Integer: Sommersemester #{tshow year}
+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: #{tshow n}
@@ -9,12 +9,13 @@ Term: Semester
 TermPlaceholder: W/S + vierstellige Jahreszahl
 TermEditHeading: Semester editieren/anlegen
 
+LectureStart: Beginn Vorlesungen
+
 Course: Kurs
 CourseNewOk        tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich erstellt.
 CourseEditOk       tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich geändert.
 CourseNewDupShort  tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
 CourseEditDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
-FFSheetName: Name
 TermCourseListHeading tid@TermIdentifier: Kursübersicht #{termToText tid}
 TermCourseListTitle tid@TermIdentifier: Kurse #{termToText tid}
 CourseEditHeading: Kurs editieren/anlegen
@@ -51,6 +52,7 @@ DeprecatedRoute: Diese Ansicht ist obsolet und könnte in Zukunft entfallen.
 UnfreeMaterials: Die Materialien für diese Veranstaltung sind nicht allgemein freigegeben.
 UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung
 
+Submission: Abgabenummer
 SubmissionWrongSheet: Abgabenummer gehört nicht zum angegebenen Übungsblatt.
 SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt.
 SubmissionTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen
@@ -59,6 +61,10 @@ SubmissionArchive: Zip-Archiv der Abgabedatei(en)
 SubmissionFile: Datei zur Abgabe
 SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem bÜbungsblatt.
 
+CorrectionsTitle: Zugewiesene Korrekturen
+CourseCorrectionsTitle: Korrekturen für diesen Kurs
+Corrector: Korrektor
+
 EMail: E-Mail
 EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer.
 NotAParticipant user@Text tid@TermIdentifier csh@Text: #{user} ist nicht im Kurs #{termToText tid}-#{csh} angemeldet.
@@ -86,3 +92,5 @@ SheetSolution: Lösung
 SheetMarking: Korrekturhinweise
 
 MultiFileUploadInfo: (Mehrere Dateien mit Shift oder Strg auswählen)
+
+NrColumn: Nr

routes

@@ -49,6 +49,7 @@
 /course/#TermId/#Text       CourseR                           !lecturer:
   /show                       CShowR          GET POST        !free
   /edit                       CEditR          GET POST
+  /corrections                CourseCorrectionsR   GET
   /ex                         SheetListR      GET             !registered !materials
   !/ex/new                    SheetNewR       GET POST
   /ex/#Text SheetR:
@@ -60,6 +61,7 @@
     !/sub/own                   SubmissionOwnR GET             !free
     !/sub/#CryptoFileNameSubmission SubmissionR    GET POST        !owner !corrector
 
+/corrections  CorrectionsR GET !free
 
 -- TODO below
 !/#{ZIPArchiveName SubmissionId} SubmissionDownloadArchiveR GET !deprecated

src/Application.hs

@@ -48,6 +48,7 @@ import Handler.Term
 import Handler.Course
 import Handler.Sheet
 import Handler.Submission
+import Handler.Corrections
 import Handler.CryptoIDDispatch
 
 

src/Foundation.hs

@@ -40,6 +40,8 @@ import Data.ByteArray (convert)
 import Crypto.Hash (Digest, SHAKE256)
 import Crypto.Hash.Conduit (sinkHash)
 
+import qualified Data.CryptoID (CryptoID) -- for DisplayAble instance only
+
 import qualified Data.ByteString.Base64.URL as Base64 (encode)
 
 import Data.ByteString (ByteString)
@@ -73,13 +75,19 @@ import Handler.Utils.DateTime
 import Control.Lens
 import Utils.Lens
 
--- -- TODO: Move me to appropriate Place
+
+-- -- TODO: Move the following to the appropriate place, if DisplayAble is kept
 instance DisplayAble TermId where
   display = termToText . unTermKey
 
 instance DisplayAble UTCTime where
   display = pack . formatTimeGerDT2 -- default Time Format to be used: 00.00.00 00:00
 
+instance (PathPiece b) => DisplayAble (Data.CryptoID.CryptoID a b) where
+  display = toPathPiece -- requires import of Data.CryptoID here
+-- -- MOVE ABOVE
+
+
 -- infixl 9 :$:
 -- pattern a :$: b = a b
 
@@ -693,6 +701,8 @@ pageHeading (CourseR tid csh CShowR)
   = Just $ do
     Entity _ Course{..} <- handlerToWidget . runDB . getBy404 $ CourseTermShort tid csh
     toWidget courseName
+pageHeading CorrectionsR
+  = Just $ i18nHeading MsgCorrectionsTitle
 -- TODO: add headings for more single course- and single term-pages
 pageHeading _
   = Nothing

src/Handler/Corrections.hs

@@ -0,0 +1,164 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Handler.Corrections where
+
+import Import
+-- import System.FilePath (takeFileName)
+
+import Handler.Utils
+-- import Handler.Utils.Zip
+
+-- import qualified Data.Set as Set
+-- import qualified Data.Map as Map
+
+-- import Data.Time
+-- import qualified Data.Text as T
+-- import Data.Function ((&))
+--
+import Colonnade hiding (fromMaybe, singleton)
+-- import Yesod.Colonnade
+--
+-- import qualified Data.UUID.Cryptographic as UUID
+-- import qualified Data.Conduit.List as C
+
+import qualified Database.Esqueleto as E
+-- import qualified Database.Esqueleto.Internal.Sql as E
+
+import Control.Lens
+-- import Control.Monad.Writer (MonadWriter(..), execWriterT)
+
+-- import Network.Mime
+
+
+
+type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) =>
+            (expr (Entity Course), expr (Entity Sheet), expr (Entity Submission))
+            -> expr (E.Value Bool)
+
+ratedBy :: Key User -> CorrectionsWhere
+ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
+
+courseIs :: Key Course -> CorrectionsWhere
+courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid
+
+
+type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School)))
+
+colTerm :: Colonnade _ CorrectionTableData _
+colTerm = widgetColonnade $ sortable (Just "term") (i18nCell MsgTerm)
+        $ \DBRow{ dbrOutput=(_, _, course) } ->
+          -- cell [whamlet| _{untermKey $ course ^. _3}|]   -- lange, internationale Semester
+          textCell $ termToText $ unTermKey $ E.unValue $ course ^. _3 -- kurze Semsterkürzel
+
+colCourse :: Colonnade _ CorrectionTableData _
+colCourse = widgetColonnade $ sortable (Just "course") (i18nCell MsgCourse)
+        $ \DBRow{ dbrOutput=(_, _, course) } -> cell $
+          let tid = E.unValue $ course ^. _3
+              csh = E.unValue $ course ^. _2
+          in [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
+
+colSheet :: Colonnade _ CorrectionTableData _
+colSheet = widgetColonnade $ sortable (Just "sheet") (i18nCell MsgSheet)
+        $ \DBRow{ dbrOutput=(_, sheet, course) } -> cell $
+          let tid = E.unValue $ course ^. _3
+              csh = E.unValue $ course ^. _2
+              shn = sheetName $ entityVal sheet
+          in [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
+          -- textCell $ sheetName $ entityVal sheet
+
+colCorrector :: Colonnade _ CorrectionTableData _
+colCorrector = widgetColonnade $ sortable (Just "corrector") (i18nCell MsgCorrector)
+        $ \DBRow{ dbrOutput=(submission, _, _) } ->
+          textCell $ display $ submissionRatingBy $ entityVal submission
+
+colSubmissionLink :: Colonnade _ CorrectionTableData _
+colSubmissionLink = widgetColonnade $ sortable Nothing (i18nCell MsgSubmission)
+        $ \DBRow{ dbrOutput=(submission, sheet, course) } -> cell $ do
+          let tid = E.unValue $ course ^. _3
+              csh = E.unValue $ course ^. _2
+              shn = sheetName $ entityVal sheet
+          cid <- encrypt (entityKey submission :: SubmissionId)
+          [whamlet|<a href=@{CSheetR tid csh shn (SubmissionR cid)}>#{display cid}|]
+
+makeCorrectionsTable whereClause colChoices = do
+  let tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity Course))
+                                            (E.SqlExpr (Entity Sheet )))
+                               (E.SqlExpr (Entity Submission))
+                    -> E.SqlQuery _
+      tableData (course `E.InnerJoin` sheet `E.InnerJoin` submission) = do
+        E.on $ sheet  E.^. SheetId  E.==. submission E.^. SubmissionSheet
+        E.on $ course E.^. CourseId E.==. sheet      E.^. SheetCourse
+        E.where_ $ whereClause (course,sheet,submission)
+        let crse =  ( course E.^. CourseName      :: E.SqlExpr (E.Value Text)
+                    , course E.^. CourseShorthand
+                    , course E.^. CourseTerm
+                    , course E.^. CourseSchool    :: E.SqlExpr (E.Value SchoolId)
+                    )
+        return (submission, sheet, crse)
+  dbTable def $ DBTable
+    { dbtSQLQuery  = tableData
+    , dbtColonnade = colChoices
+    , dbtSorting   =  [ ( "term"
+                        , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseTerm
+                        )
+                      , ( "course"
+                        , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseShorthand
+                        )
+                        -- TODO
+                      ]
+    , dbtFilter    =  mempty {- [ ( "term"
+                        , FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if
+                            | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
+                            | otherwise     -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
+                        )
+                        ] -}
+    , dbtAttrs     = tableDefault
+    , dbtIdent     = "corrections" :: Text
+    }
+
+
+getCorrectionsR :: Handler Html
+getCorrectionsR = do
+  uid <- requireAuthId
+  let whereClause    = ratedBy uid
+      displayColumns = mconcat
+        [ dbRow
+        , colTerm
+        , colCourse
+        , colSheet
+        , colSubmissionLink
+        ] -- Continue here
+  table <- makeCorrectionsTable whereClause displayColumns
+  defaultLayout $ do
+    setTitleI MsgCourseCorrectionsTitle
+    $(widgetFile "corrections")
+
+getCourseCorrectionsR ::  TermId -> Text -> Handler Html
+getCourseCorrectionsR tid csh = do
+  cid <- runDB $ getBy404 $ CourseTermShort tid csh
+  let whereClause    = courseIs $ entityKey cid
+      displayColumns = mconcat
+        [ dbRow
+        , colSheet
+        , colCorrector
+        , colSubmissionLink
+        ] -- Continue here
+  table <- makeCorrectionsTable whereClause displayColumns
+  defaultLayout $ do
+    setTitleI MsgCorrectionsTitle
+    $(widgetFile "corrections")
+
+

src/Handler/Term.hs

@@ -52,7 +52,7 @@ getTermShowR = do
                   $else
                       #{termToText termName}
                 |]
-            , sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) ->
+            , sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_) ->
                 stringCell $ formatTimeGerWD termLectureStart
             , sortable (Just "lecture-end") "Ende Vorlesungen"   $ \(Entity _ Term{..},_) ->
                 stringCell $ formatTimeGerWD termLectureEnd

src/Handler/Utils/Table.hs

@@ -35,9 +35,6 @@ numberColonnade = headed "Nr" (fromString.show)
 pairColonnade :: (Functor h) =>  Colonnade h a c -> Colonnade h b c ->  Colonnade h (a,b) c
 pairColonnade a b = mconcat [ lmap fst a, lmap snd b]
 
-i18nCell :: RenderMessage site a => a -> Cell site
-i18nCell msg = cell [whamlet|_{msg}|]
-
 
 -- Table Modification
 encodeHeadedWidgetTableNumbered :: Attribute -> Colonnade Headed a (WidgetT site IO ()) -> [a] -> WidgetT site IO ()
@@ -94,3 +91,5 @@ headedRowSelector toExternal fromExternal attrs colonnade tdata = do
   return ( catMaybes <$> collectResult selectionResults
          , encodeCellTable attrs (pairColonnade selColonnade colonnade) (zip [0..] tdata)
          )
+
+

src/Handler/Utils/Table/Pagination.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE NoImplicitPrelude
            , ExistentialQuantification
            , RecordWildCards
+           , NamedFieldPuns
            , OverloadedStrings
            , TemplateHaskell
            , QuasiQuotes
@@ -18,14 +19,14 @@
 module Handler.Utils.Table.Pagination
   ( SortColumn(..), SortDirection(..)
   , FilterColumn(..), IsFilterColumn
-  , DBRow(..), DBOutput
+  , DBRow(..), dbRow, DBOutput
   , DBTable(..), IsDBTable(..)
   , PaginationSettings(..)
   , PSValidator(..)
   , Sortable(..), sortable
   , dbTable
   , widgetColonnade, formColonnade
-  , textCell, stringCell, anchorCell
+  , textCell, stringCell, i18nCell, anchorCell
   , formCell, DBFormResult, getDBFormResult
   ) where
 
@@ -55,6 +56,7 @@ import qualified Data.Map as Map
 import Data.Profunctor (lmap)
 
 import Colonnade hiding (bool, fromMaybe, singleton)
+import qualified Colonnade (singleton)
 import Colonnade.Encode
 
 import Text.Hamlet (hamletFile)
@@ -112,6 +114,9 @@ data DBRow r = DBRow
   , dbrOutput :: r
   }
 
+dbRow :: (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a)
+dbRow = Colonnade.singleton (headednessPure $ textCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex
+
 class DBOutput r r' where
   dbProj :: r -> r'
 
@@ -331,8 +336,9 @@ formColonnade :: (Headedness h, Monoid a)
               -> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a))
 formColonnade = id
 
-textCell, stringCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
+textCell, stringCell, i18nCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
 stringCell = textCell
+i18nCell = textCell
 textCell msg = cell [whamlet|_{msg}|]
 
 anchorCell :: IsDBTable m a

src/Utils/Common.hs

@@ -16,7 +16,7 @@ import Language.Haskell.TH
 -- Tuples --
 ------------
 
-
+-- Alternatively uses lenses: "^. _3" projects the 3rd component of an n-tuple for any n >=3, requires import Control.Lens
 projNI :: Int -> Int -> ExpQ -- generic projection gives I-th element of N-tuple, i.e. snd3 = $(projNI 3 2)  --ghci -fth
 -- $(projN n m) :: (t1,..,tn) -> tm (for m<=n)
 projNI n i = lamE [pat] rhs

templates/corrections.hamlet

@@ -0,0 +1,2 @@
+<div .container>
+  ^{table}

templates/table/colonnade.hamlet

@@ -4,7 +4,8 @@ $newline never
     <thead>
       <tr .table__row.table__row--head>
         $forall widget <- wHeaders'
-          ^{widget} $# cell/header.hamlet
+          $# cell/header.hamlet
+          ^{widget}
   $nothing
   <tbody>
     $if null wRows
@@ -15,4 +16,5 @@ $newline never
       $forall row <- wRows
         <tr .table__row>
           $forall widget <- row
-            ^{widget} $# cell/body.hamlet
+            $# cell/body.hamlet 
+            ^{widget}