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
-- Some constants:
-- nrSheetDeadlines :: Int64
-- nrSheetDeadlines = 10
-- CONSTANTS: TODO: make configurable elsewhere
offSheetDeadlines :: NominalDiffTime
offSheetDeadlines = 15
--nrExamDeadlines = 10
offCourseDeadlines :: NominalDiffTime
offCourseDeadlines = 15
--offExamDeadlines :: NominalDiffTime
--offExamDeadlines = 15
-- nrCourseDeadlines :: Int64
-- nrCourseDeadlines = 12
--offCourseDeadlines = 15
@ -56,7 +53,7 @@ getHomeR = do
homeAnonymous :: Handler Html
homeAnonymous = do
cTime <- liftIO getCurrentTime
let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime
let fTime = addUTCTime (offCourseDeadlines * nominalDay) cTime
let tableData :: E.SqlExpr (Entity Course)
-> E.SqlQuery (E.SqlExpr (Entity Course))
tableData course = do
@ -64,7 +61,6 @@ homeAnonymous = do
E.&&. (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime))
E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
-- E.limit nrCourseDeadlines
return course
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.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime
-- E.limit nrSheetDeadlines
-- E.limit nrSheetDeadlines -- arbitrary limits are not intuitive
return
( course E.^. CourseTerm
, course E.^. CourseShorthand

View File

@ -1,6 +1,7 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
@ -11,7 +12,6 @@
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE MultiWayIf, LambdaCase #-}
{-# LANGUAGE TupleSections #-}
@ -101,7 +101,9 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
<*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template)
<*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> 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 "Abgabefrist") (sfActiveTo <$> template)
<*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template)
@ -139,14 +141,17 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
-- TODO: continue validation here!!!
] ]
-- List Sheets
-- getSheetListCID :: CourseId -> Handler Html
-- getSheetListCID cid = getSheetList =<<
-- (Entity cid) <$> (runDB $ get404 cid)
-- colShn :: IsDBTable
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 tid csh = do
-- mbAid <- maybeAuthId
(Entity cid course, sheets) <- runDB $ do
entCourse <- getBy404 $ CourseTermShort tid csh
rawSheets <- selectList [SheetCourse ==. entityKey entCourse] [Desc SheetActiveFrom]