Fix supportanfrage
This commit is contained in:
parent
447e30b1d9
commit
509e7f974c
@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user