minor changes

This commit is contained in:
SJost 2018-07-08 22:49:22 +02:00
parent 7da8d89a5c
commit f62fcdded6
3 changed files with 19 additions and 18 deletions

View File

@ -1 +1 @@
keter_uni2work.yml keter_testworx.yml

View File

@ -32,16 +32,13 @@ import Text.Shakespeare.Text
-- import qualified Data.UUID.Cryptographic as UUID -- import qualified Data.UUID.Cryptographic as UUID
-- Some constants: -- CONSTANTS: TODO: make configurable elsewhere
-- nrSheetDeadlines :: Int64
-- nrSheetDeadlines = 10
offSheetDeadlines :: NominalDiffTime offSheetDeadlines :: NominalDiffTime
offSheetDeadlines = 15 offSheetDeadlines = 15
--nrExamDeadlines = 10 offCourseDeadlines :: NominalDiffTime
offCourseDeadlines = 15
--offExamDeadlines :: NominalDiffTime
--offExamDeadlines = 15 --offExamDeadlines = 15
-- nrCourseDeadlines :: Int64
-- nrCourseDeadlines = 12
--offCourseDeadlines = 15
@ -56,7 +53,7 @@ getHomeR = do
homeAnonymous :: Handler Html homeAnonymous :: Handler Html
homeAnonymous = do homeAnonymous = do
cTime <- liftIO getCurrentTime cTime <- liftIO getCurrentTime
let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime let fTime = addUTCTime (offCourseDeadlines * nominalDay) cTime
let tableData :: E.SqlExpr (Entity Course) let tableData :: E.SqlExpr (Entity Course)
-> E.SqlQuery (E.SqlExpr (Entity Course)) -> E.SqlQuery (E.SqlExpr (Entity Course))
tableData course = do tableData course = do
@ -64,7 +61,6 @@ homeAnonymous = do
E.&&. (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime)) E.&&. (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime))
E.&&. ((E.isNothing $ course E.^. CourseRegisterTo) E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime))) E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
-- E.limit nrCourseDeadlines
return course return course
colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (WidgetT UniWorX IO) ()) colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (WidgetT UniWorX IO) ())
@ -129,7 +125,7 @@ homeUser uid = do
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime
-- E.limit nrSheetDeadlines -- E.limit nrSheetDeadlines -- arbitrary limits are not intuitive
return return
( course E.^. CourseTerm ( course E.^. CourseTerm
, course E.^. CourseShorthand , course E.^. CourseShorthand

View File

@ -1,6 +1,7 @@
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
@ -11,7 +12,6 @@
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE MultiWayIf, LambdaCase #-} {-# LANGUAGE MultiWayIf, LambdaCase #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
@ -101,7 +101,9 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
<*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template) <*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template)
<*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template) <*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template)
<*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template) <*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template)
<*> aopt utcTimeField (fsb "Sichtbar ab") (sfVisibleFrom <$> template) <*> aopt utcTimeField (fsb "Sichtbar ab"
# setTooltip "Falls angegeben, wird das Blatt vor dem angegebenen Datum versteckt")
(sfVisibleFrom <$> template)
<*> areq utcTimeField (fsb "Abgabe ab") (sfActiveFrom <$> template) <*> areq utcTimeField (fsb "Abgabe ab") (sfActiveFrom <$> template)
<*> areq utcTimeField (fsb "Abgabefrist") (sfActiveTo <$> template) <*> areq utcTimeField (fsb "Abgabefrist") (sfActiveTo <$> template)
<*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template) <*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template)
@ -139,14 +141,17 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
-- TODO: continue validation here!!! -- TODO: continue validation here!!!
] ] ] ]
-- List Sheets
-- getSheetListCID :: CourseId -> Handler Html
-- getSheetListCID cid = getSheetList =<< -- colShn :: IsDBTable
-- (Entity cid) <$> (runDB $ get404 cid)
makeSheetTableUser :: ( IsDBTable m x, DBOutput CorrectionTableData r', ToSortable h, Functor h )
=> _ -> Colonnade h r' (DBCell m x) -> PSValidator m x -> Handler (DBResult m x)
makeCorrectionsTable whereClause colChoices psValidator = do
getSheetListR :: TermId -> Text -> Handler Html getSheetListR :: TermId -> Text -> Handler Html
getSheetListR tid csh = do getSheetListR tid csh = do
-- mbAid <- maybeAuthId
(Entity cid course, sheets) <- runDB $ do (Entity cid course, sheets) <- runDB $ do
entCourse <- getBy404 $ CourseTermShort tid csh entCourse <- getBy404 $ CourseTermShort tid csh
rawSheets <- selectList [SheetCourse ==. entityKey entCourse] [Desc SheetActiveFrom] rawSheets <- selectList [SheetCourse ==. entityKey entCourse] [Desc SheetActiveFrom]