fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'feat/exercises' into feat/pagination

Browse Source
This commit is contained in:
Gregor Kleen 2018-06-27 15:05:00 +02:00
commit 3c8f13b4dc
11 changed files with 207 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
messages/de.msg
View File

@ -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

2
routes
View File

@ -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

1
src/Application.hs
View File

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

12
src/Foundation.hs
View File

@ -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

164
src/Handler/Corrections.hs Normal file
View File

@ -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")

2
src/Handler/Term.hs
View File

@ -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

5
src/Handler/Utils/Table.hs
View File

@ -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)
)

12
src/Handler/Utils/Table/Pagination.hs
View File

@ -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

2
src/Utils/Common.hs
View File

@ -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

2
templates/corrections.hamlet Normal file
View File

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

6
templates/table/colonnade.hamlet
View File

@ -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}