minor changes
This commit is contained in:
parent
7da8d89a5c
commit
f62fcdded6
@ -1 +1 @@
|
||||
keter_uni2work.yml
|
||||
keter_testworx.yml
|
||||
@ -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
|
||||
|
||||
@ -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]
|
||||
|
||||
Reference in New Issue
Block a user