diff --git a/src/Foundation.hs b/src/Foundation.hs index 0879610e6..345787fc5 100644 --- a/src/Foundation.hs +++ b/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 diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index e3f2ef05a..f902b90f2 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -15,16 +15,16 @@ module Handler.Corrections where import Import -import System.FilePath (takeFileName) +-- import System.FilePath (takeFileName) import Handler.Utils -- import Handler.Utils.Zip -import qualified Data.Set as Set -import qualified Data.Map as Map +-- import qualified Data.Set as Set +-- import qualified Data.Map as Map -- import Data.Time -import qualified Data.Text as T +-- import qualified Data.Text as T -- import Data.Function ((&)) -- import Colonnade hiding (fromMaybe, singleton) @@ -34,7 +34,7 @@ import Yesod.Colonnade -- import qualified Data.Conduit.List as C import qualified Database.Esqueleto as E -import qualified Database.Esqueleto.Internal.Sql as E +-- import qualified Database.Esqueleto.Internal.Sql as E import Control.Lens -- import Control.Monad.Writer (MonadWriter(..), execWriterT) @@ -42,14 +42,25 @@ import Control.Lens -- import Network.Mime +ratedBy :: E.Esqueleto query expr backend => + expr (Entity Submission) -> Key User -> expr (E.Value Bool) +ratedBy submission uid = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) + +courseIs :: E.Esqueleto query expr backend => + expr (Entity Course) -> Key Course -> expr (E.Value Bool) +courseIs course cid = course E.^. CourseId E.==. E.val cid + getCorrectionsR :: Handler Html getCorrectionsR = do uid <- requireAuthId - let tableData :: _ -> E.SqlQuery _ + 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_ $ submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) + E.where_ $ submission `ratedBy` uid let crse = ( course E.^. CourseName :: E.SqlExpr (E.Value Text) , course E.^. CourseShorthand , course E.^. CourseTerm @@ -65,15 +76,15 @@ getCorrectionsR = do [ 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 + textCell $ termToText $ unTermKey $ E.unValue $ course ^. _3 -- 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 + let tid = E.unValue $ course ^. _3 + csh = E.unValue $ course ^. _2 shn = sheetName $ entityVal sheet cid <- encrypt (entityKey submission :: SubmissionId) [whamlet|#{display cid}|] diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index aafad7369..99aa4a8e6 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -106,7 +106,7 @@ data DBRow r = DBRow } dbRow :: (Headedness h) => Colonnade h (DBRow r) (Cell site) -dbRow = Colonnade.singleton (headednessPure "nr") $ \DBRow{ dbrIndex } -> +dbRow = Colonnade.singleton (headednessPure "Nr") $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex class DBOutput r r' where diff --git a/src/Utils/Common.hs b/src/Utils/Common.hs index 3b0d537b8..8583ccf86 100644 --- a/src/Utils/Common.hs +++ b/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