Missing files for Corrections Page added

src/Handler/Corrections.hs

@@ -0,0 +1,106 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# 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
+
+
+getCorrectionsR :: Handler Html
+getCorrectionsR = do
+  uid <- requireAuthId
+  let tableData :: _ -> 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_ $ submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
+        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)
+      colonnade :: Colonnade Sortable (DBRow
+                      (Entity Submission, Entity Sheet,
+                        (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School)))
+
+                      ) (Cell UniWorX)
+      colonnade = mconcat
+        [ dbRow
+        , sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(_, _, course) } ->
+            -- cell [whamlet| _{untermKey $ course ^. _3}|]   -- lange, internationale Semester
+            textCell $ termToText $ unTermKey $ E.unValue $ $(projNI 4 3) course  -- kurze Semsterkürzel
+        , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(_, _, course) } ->
+            textCell $ E.unValue $ course ^. _2
+        , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(_, sheet, _) } ->
+            textCell $ sheetName $ entityVal sheet
+        , sortable Nothing (i18nCell MsgSubmission) $ \DBRow{ dbrOutput=(submission, sheet, course) } ->
+            cell $ do
+              let tid = E.unValue $ $(projNI 4 3) course
+                  csh = E.unValue $ $(projNI 4 2) course
+                  shn = sheetName $ entityVal sheet
+              cid <- encrypt (entityKey submission :: SubmissionId)
+              [whamlet|@{CSheetR tid csh shn (SubmissionR cid)}|]
+        ]
+        -- TODO continue here
+  table <- dbTable def $ DBTable
+    { dbtSQLQuery  = tableData
+    , dbtColonnade = colonnade
+    , 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
+    }
+  defaultLayout $ do
+    setTitleI MsgCorrectionsTitle
+    $(widgetFile "corrections")
+
+

templates/corrections.hamlet

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