diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs new file mode 100644 index 000000000..55f0ad589 --- /dev/null +++ b/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") + + diff --git a/templates/corrections.hamlet b/templates/corrections.hamlet new file mode 100644 index 000000000..2d2943787 --- /dev/null +++ b/templates/corrections.hamlet @@ -0,0 +1,2 @@ +