Fix supportanfrage

This commit is contained in:
SJost 2019-01-09 10:44:03 +01:00
parent 447e30b1d9
commit 509e7f974c

View File

@ -5,37 +5,11 @@ import Handler.Utils
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Time hiding (formatTime)
-- import qualified Data.Text as T
-- import Yesod.Form.Bootstrap3
-- import Web.PathPieces (showToPathPiece, readFromPathPiece)
-- import Control.Lens
-- import Colonnade hiding (fromMaybe, singleton)
-- import Yesod.Colonnade
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
import Jobs import Jobs
-- import Text.Shakespeare.Text
import Development.GitRev import Development.GitRev
-- import qualified Data.UUID.Cryptographic as UUID
-- CONSTANTS: TODO: make configurable elsewhere
offSheetDeadlines :: NominalDiffTime
offSheetDeadlines = 15
offCourseDeadlines :: NominalDiffTime
offCourseDeadlines = 15
--offExamDeadlines :: NominalDiffTime
--offExamDeadlines = 15
getHomeR :: Handler Html getHomeR :: Handler Html
getHomeR = do getHomeR = do
@ -112,9 +86,7 @@ homeAnonymous = do
homeUser :: Key User -> Handler Html homeUser :: Key User -> Handler Html
homeUser uid = do homeUser uid = do
cTime <- liftIO getCurrentTime cTime <- liftIO getCurrentTime
let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime let tableData :: E.LeftOuterJoin
tableData :: E.LeftOuterJoin
(E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) (E.SqlExpr (Entity Course))) (E.SqlExpr (Entity Sheet))) (E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) (E.SqlExpr (Entity Course))) (E.SqlExpr (Entity Sheet)))
(E.InnerJoin (E.SqlExpr (Maybe (Entity Submission))) (E.SqlExpr (Maybe (Entity SubmissionUser)))) (E.InnerJoin (E.SqlExpr (Maybe (Entity Submission))) (E.SqlExpr (Maybe (Entity SubmissionUser))))
-> E.SqlQuery ( E.SqlExpr (E.Value (Key Term)) -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
@ -131,8 +103,6 @@ homeUser uid = do
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
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.limit nrSheetDeadlines -- arbitrary limits are not intuitive
return return
( course E.^. CourseTerm ( course E.^. CourseTerm
, course E.^. CourseSchool , course E.^. CourseSchool
@ -251,10 +221,10 @@ helpForm mReferer mUid = HelpForm
<* submitButton <* submitButton
where where
identActions :: Map _ (AForm _ (Either (Maybe Address) UserId)) identActions :: Map _ (AForm _ (Either (Maybe Address) UserId))
identActions = Map.fromList $ case mUid of identActions = Map.fromList $ case mUid of
(Just uid) -> (HIUser, pure $ Right uid):defaultActions (Just uid) -> (HIUser, pure $ Right uid):defaultActions
Nothing -> defaultActions Nothing -> defaultActions
defaultActions = defaultActions =
[ (HIEmail, Left . Just <$> (Address <$> aopt textField (fslI MsgName) Nothing <*> apreq emailField (fslI MsgEMail) Nothing)) [ (HIEmail, Left . Just <$> (Address <$> aopt textField (fslI MsgName) Nothing <*> apreq emailField (fslI MsgEMail) Nothing))
, (HIAnonymous, pure $ Left Nothing) , (HIAnonymous, pure $ Left Nothing)
@ -295,7 +265,7 @@ postAuthPredsR = do
taForm authTag taForm authTag
| authTag `Set.member` blacklist = aforced checkBoxField (fslI authTag) (authTagIsActive def authTag) | authTag `Set.member` blacklist = aforced checkBoxField (fslI authTag) (authTagIsActive def authTag)
| otherwise = fromMaybe False <$> aopt checkBoxField (fslI authTag) (Just . Just $ authTagCurrentActive authTag) | otherwise = fromMaybe False <$> aopt checkBoxField (fslI authTag) (Just . Just $ authTagCurrentActive authTag)
((authActiveRes, authActiveWidget), authActiveEnctype) <- runFormPost . renderAForm FormStandard ((authActiveRes, authActiveWidget), authActiveEnctype) <- runFormPost . renderAForm FormStandard
$ AuthTagActive $ AuthTagActive
<$> funcForm taForm (fslI MsgActiveAuthTags) True <$> funcForm taForm (fslI MsgActiveAuthTags) True