Minor. Puny attempts to resuse corrections table in several ways.
This commit is contained in:
parent
a3afbbc26d
commit
c6784a0b13
@ -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
|
||||
|
||||
|
||||
@ -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|<a href=@{CSheetR tid csh shn (SubmissionR cid)}>#{display cid}|]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user