diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 6a16862f2..d89257eee 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -207,9 +207,9 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
E.orderBy [E.asc $ user E.^. UserId]
return (user, pseudonym E.?. SheetPseudonymPseudonym)
let
- submittorMap = foldr (\((Entity userId user, E.Value pseudo)) -> Map.insert userId (user, pseudo)) Map.empty submittors
+ submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, submittorMap)
- dbTable psValidator $ DBTable
+ dbTable psValidator DBTable
{ dbtSQLQuery
, dbtColonnade
, dbtProj
@@ -284,7 +284,7 @@ correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO
correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
tableForm <- makeCorrectionsTable whereClause displayColumns psValidator return
((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
- ((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf
+ (fmap $ Map.keysSet . Map.filter id . getDBFormResult (const False) -> selectionRes, table) <- tableForm csrf
(actionRes, action) <- multiAction actions Nothing
return ((,) <$> actionRes <*> selectionRes, table <> action)
@@ -301,12 +301,12 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
now <- liftIO getCurrentTime
runDB $ do
alreadyAssigned <- selectList [SubmissionId <-. subs, SubmissionRatingBy !=. Nothing] []
- when (not $ null alreadyAssigned) $ do
+ unless (null alreadyAssigned) $ do
mr <- (toHtml . ) <$> getMessageRender
alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission)
addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
- when (not $ null unassigned) $ do
+ unless (null unassigned) $ do
num <- updateWhereCount [SubmissionId <-. Set.toList unassigned]
[ SubmissionRatingBy =. Just uid
, SubmissionRatingAssigned =. Just now -- save, since only applies to unassigned
@@ -335,18 +335,18 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
subs <- mapM decrypt $ Set.toList subs'
runDB $ do
alreadyAssigned <- selectList [SubmissionId <-. subs, SubmissionRatingBy !=. Nothing] []
- when (not $ null alreadyAssigned) $ do
+ unless (null alreadyAssigned) $ do
mr <- (toHtml . ) <$> getMessageRender
alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission)
addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
- when (not $ null unassigned) $ do
+ unless (null unassigned) $ do
(assigned, stillUnassigned) <- assignSubmissions shid (Just unassigned)
- when (not $ null assigned) $
+ unless (null assigned) $
addMessageI Success $ MsgUpdatedAssignedCorrectorsAuto (fromIntegral $ Set.size assigned)
- when (not $ null stillUnassigned) $ do
+ unless (null stillUnassigned) $ do
mr <- (toHtml . ) <$> getMessageRender
- unassigned' <- forM (Set.toList stillUnassigned) $ \sid -> (encrypt sid :: DB CryptoFileNameSubmission)
+ unassigned' <- forM (Set.toList stillUnassigned) $ \sid -> encrypt sid :: DB CryptoFileNameSubmission
addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
redirect currentRoute
@@ -485,7 +485,7 @@ postCorrectionR tid ssh csh shn cid = do
NotGraded -> pure Nothing
_otherwise -> aopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType)
(fslpI MsgRatingPoints "Punktezahl")
- (Just $ submissionRatingPoints)
+ (Just submissionRatingPoints)
((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ (,,)
<$> areq checkBoxField (fslI MsgRatingDone) (Just $ submissionRatingDone Submission{..})
@@ -548,7 +548,7 @@ getCorrectionUserR tid ssh csh shn cid = do
mr <- getMessageRender
let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
sheetTypeDesc = mr sheetType
- defaultLayout $ do
+ defaultLayout $
$(widgetFile "correction-user")
_ -> notFound
@@ -574,7 +574,7 @@ postCorrectionsUploadR = do
addMessage Success =<< withUrlRenderer ($(ihamletFile "templates/messages/correctionsUploaded.hamlet") mr)
- defaultLayout $ do
+ defaultLayout $
$(widgetFile "corrections-upload")
getCorrectionsCreateR, postCorrectionsCreateR :: Handler Html
@@ -587,7 +587,7 @@ postCorrectionsCreateR = do
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
E.&&. sheet E.^. SheetSubmissionMode E.==. E.val CorrectorSubmissions
E.orderBy [E.desc $ course E.^. CourseTerm, E.asc $ course E.^. CourseShorthand, E.desc $ sheet E.^. SheetActiveFrom]
- return $ (sheet E.^. SheetId, course E.^. CourseTerm, course E.^. CourseShorthand, sheet E.^. SheetName)
+ return (sheet E.^. SheetId, course E.^. CourseTerm, course E.^. CourseShorthand, sheet E.^. SheetName)
mkOptList :: [(E.Value SheetId, E.Value TermId, E.Value CourseShorthand, E.Value SheetName)] -> Handler (OptionList SheetId)
mkOptList opts = do
opts' <- mapM (\v@(E.Value sid, _, _, _) -> (, v) <$> encrypt sid) opts
@@ -631,12 +631,12 @@ postCorrectionsCreateR = do
, submissionRatingAssigned = Just now
, submissionRatingTime = Nothing
}
- when (not $ null duplicate)
+ unless (null duplicate)
$(addMessageFile Warning "templates/messages/submissionCreateDuplicates.hamlet")
existingSubUsers <- E.select . E.from $ \submissionUser -> do
E.where_ $ submissionUser E.^. SubmissionUserUser `E.in_` E.valList (sheetPseudonymUser <$> concat sps')
return submissionUser
- when (not $ null existingSubUsers) $ do
+ unless (null existingSubUsers) $ do
(Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: DB CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers
$(addMessageFile Warning "templates/messages/submissionCreateExisting.hamlet")
let sps'' = filter (not . null) $ filter (\spGroup -> not . flip any spGroup $ \SheetPseudonym{sheetPseudonymUser} -> sheetPseudonymUser `elem` map (submissionUserUser . entityVal) existingSubUsers) sps'
@@ -692,7 +692,7 @@ postCorrectionsCreateR = do
redirect CorrectionsGradeR
- defaultLayout $ do
+ defaultLayout $
$(widgetFile "corrections-create")
where
partitionEithers' :: [[Either a b]] -> ([[b]], [a])
@@ -735,7 +735,7 @@ postCorrectionsGradeR = do
cID <- encrypt subId
void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True
return i
- (((fmap unFormResult -> tableRes), table), tableEncoding) <- runFormPost tableForm
+ ((fmap unFormResult -> tableRes, table), tableEncoding) <- runFormPost tableForm
case tableRes of
FormMissing -> return ()
@@ -751,9 +751,9 @@ postCorrectionsGradeR = do
, SubmissionRatingBy =. Just uid
, SubmissionRatingTime =. now <$ guard rated
]
- | otherwise -> return $ Nothing
+ | otherwise -> return Nothing
subs' <- traverse encrypt subs :: Handler [CryptoFileNameSubmission]
unless (null subs') $(addMessageFile Success "templates/messages/correctionsUploaded.hamlet")
- defaultLayout $ do
+ defaultLayout $
$(widgetFile "corrections-grade")
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 89b6a9e86..161ebcd1d 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -105,7 +105,7 @@ course2Participants (course `E.InnerJoin` _school) = E.sub_select . E.from $ \co
return (E.countRows :: E.SqlExpr (E.Value Int64))
course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
-course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant -> do
+course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant ->
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
@@ -122,7 +122,7 @@ makeCourseTable whereClause colChoices psValidator = do
return (course, participants, registered, school)
dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> return (course, participants, registered, school)
- dbTable psValidator $ DBTable
+ dbTable psValidator DBTable
{ dbtSQLQuery
, dbtColonnade = colChoices
, dbtProj
@@ -134,7 +134,7 @@ makeCourseTable whereClause colChoices psValidator = do
, ( "schoolshort", SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolShorthand)
, ( "register-from", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterFrom)
, ( "register-to", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterTo)
- , ( "participants", SortColumn $ course2Participants )
+ , ( "participants", SortColumn course2Participants )
, ( "registered", SortColumn $ course2Registered muid)
]
, dbtFilter = Map.fromList -- OverloadedLists does not work with the templates here
@@ -206,9 +206,9 @@ getTermSchoolCourseListR tid ssh = do
, colParticipants
, maybe mempty (const colRegistered) muid
]
- whereClause = \(course, _, _) ->
- course E.^. CourseTerm E.==. E.val tid
- E.&&. course E.^. CourseSchool E.==. E.val ssh
+ whereClause (course, _, _) =
+ course E.^. CourseTerm E.==. E.val tid
+ E.&&. course E.^. CourseSchool E.==. E.val ssh
validator = def
& defaultSorting [("cshort", SortAsc)]
((), coursesTable) <- makeCourseTable whereClause colonnade validator
@@ -230,7 +230,7 @@ getTermCourseListR tid = do
, colParticipants
, maybe mempty (const colRegistered) muid
]
- whereClause = \(course, _, _) -> course E.^. CourseTerm E.==. E.val tid
+ whereClause (course, _, _) = course E.^. CourseTerm E.==. E.val tid
validator = def
& defaultSorting [("cshort", SortAsc)]
((), coursesTable) <- makeCourseTable whereClause colonnade validator
@@ -254,21 +254,21 @@ getCShowR tid ssh csh = do
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
return $ user E.^. UserDisplayName
- return $ (courseEnt,dependent,E.unValue <$> lecturers)
+ return (courseEnt,dependent,E.unValue <$> lecturers)
let course = entityVal courseEnt
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
defaultLayout $ do
- setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|]
+ setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
$(widgetFile "course")
registerForm :: Bool -> Maybe Text -> Form Bool
registerForm registered msecret extra = do
(msecretRes', msecretView) <- case msecret of
- (Just _) | not registered -> bimap Just Just <$> (mreq textField (fslpI MsgCourseSecret "Code") Nothing)
+ (Just _) | not registered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
_ -> return (Nothing,Nothing)
(btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing
let widget = $(widgetFile "widgets/registerForm")
@@ -282,7 +282,7 @@ postCRegisterR tid ssh csh = do
aid <- requireAuthId
(cid, course, registered) <- runDB $ do
(Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh
- registered <- isJust <$> (getBy $ UniqueParticipant aid cid)
+ registered <- isJust <$> getBy (UniqueParticipant aid cid)
return (cid, course, registered)
((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
case regResult of
@@ -291,11 +291,11 @@ postCRegisterR tid ssh csh = do
runDB $ deleteBy $ UniqueParticipant aid cid
addMessageI Info MsgCourseDeregisterOk
| codeOk -> do
- actTime <- liftIO $ getCurrentTime
+ actTime <- liftIO getCurrentTime
regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
when (isJust regOk) $ addMessageI Success MsgCourseRegisterOk
| otherwise -> addMessageI Warning MsgCourseSecretWrong
- (_other) -> return () -- TODO check this!
+ _other -> return () -- TODO check this!
redirect $ CourseR tid ssh csh CShowR
@@ -316,20 +316,20 @@ getCourseNewR = do
let noTemplateAction = courseEditHandler True Nothing
case params of -- DO NOT REMOVE: without this distinction, lecturers would never see an empty newCourseForm any more!
FormMissing -> noTemplateAction
- FormFailure msgs -> forM_ msgs ((addMessage Error) . toHtml) >>
+ FormFailure msgs -> forM_ msgs (addMessage Error . toHtml) >>
noTemplateAction
FormSuccess (fmap TermKey -> mbTid, fmap SchoolKey -> mbSsh, mbCsh) -> do
- oldCourses <- runDB $ do
+ oldCourses <- runDB $
E.select $ E.from $ \course -> do
whenIsJust mbTid $ \tid -> E.where_ $ course E.^. CourseTerm E.==. E.val tid
whenIsJust mbSsh $ \ssh -> E.where_ $ course E.^. CourseSchool E.==. E.val ssh
whenIsJust mbCsh $ \csh -> E.where_ $ course E.^. CourseShorthand E.==. E.val csh
let lecturersCourse =
- E.exists $ E.from $ \lecturer -> do
+ E.exists $ E.from $ \lecturer ->
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
let lecturersSchool =
- E.exists $ E.from $ \user -> do
+ E.exists $ E.from $ \user ->
E.where_ $ user E.^. UserLecturerUser E.==. E.val uid
E.&&. user E.^. UserLecturerSchool E.==. course E.^. CourseSchool
let courseCreated c =
@@ -343,7 +343,7 @@ getCourseNewR = do
return course
template <- case listToMaybe oldCourses of
(Just oldTemplate) ->
- let newTemplate = (courseToForm oldTemplate) in
+ let newTemplate = courseToForm oldTemplate in
return $ Just $ newTemplate
{ cfCourseId = Nothing
, cfTerm = TermKey $ TermIdentifier 0 Winter -- invalid, will be ignored; undefined won't work due to strictness
@@ -355,7 +355,7 @@ getCourseNewR = do
(tidOk,sshOk,cshOk) <- runDB $ (,,)
<$> ifMaybeM mbTid True existsKey
<*> ifMaybeM mbSsh True existsKey
- <*> ifMaybeM mbCsh True (\csh -> (not . null) <$> selectKeysList [CourseShorthand ==. csh] [LimitTo 1])
+ <*> ifMaybeM mbCsh True (\csh -> not . null <$> selectKeysList [CourseShorthand ==. csh] [LimitTo 1])
unless tidOk $ addMessageI Warning $ MsgNoSuchTerm $ fromJust mbTid -- safe, since tidOk==True otherwise
unless sshOk $ addMessageI Warning $ MsgNoSuchSchool $ fromJust mbSsh -- safe, since sshOk==True otherwise
unless cshOk $ addMessageI Warning $ MsgNoSuchCourseShorthand $ fromJust mbCsh
@@ -400,14 +400,14 @@ courseEditHandler _isGet mbCourseForm = do
aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
((result, formWidget), formEnctype) <- runFormPost $ newCourseForm mbCourseForm
case result of
- (FormSuccess res@(
- CourseForm { cfCourseId = Nothing
- , cfShort = csh
- , cfSchool = ssh
- , cfTerm = tid
- })) -> do -- create new course
+ (FormSuccess res@CourseForm
+ { cfCourseId = Nothing
+ , cfShort = csh
+ , cfSchool = ssh
+ , cfTerm = tid
+ }) -> do -- create new course
now <- liftIO getCurrentTime
- insertOkay <- runDB $ insertUnique $ Course
+ insertOkay <- runDB $ insertUnique Course
{ courseName = cfName res
, courseDescription = cfDesc res
, courseLinkExternal = cfLink res
@@ -431,12 +431,12 @@ courseEditHandler _isGet mbCourseForm = do
Nothing ->
addMessageI Warning $ MsgCourseNewDupShort tid ssh csh
- (FormSuccess res@(
- CourseForm { cfCourseId = Just cid
- , cfShort = csh
- , cfSchool = ssh
- , cfTerm = tid
- })) -> do -- edit existing course
+ (FormSuccess res@CourseForm
+ { cfCourseId = Just cid
+ , cfShort = csh
+ , cfSchool = ssh
+ , cfTerm = tid
+ }) -> do -- edit existing course
now <- liftIO getCurrentTime
-- addMessage "debug" [shamlet| #{show res}|]
success <- runDB $ do
@@ -444,21 +444,20 @@ courseEditHandler _isGet mbCourseForm = do
case old of
Nothing -> addMessageI Error MsgInvalidInput $> False
(Just _) -> do
- updOkay <- myReplaceUnique cid ( -- replaceUnique requires Eq Course, which we cannot have
- Course { courseName = cfName res
- , courseDescription = cfDesc res
- , courseLinkExternal = cfLink res
- , courseShorthand = cfShort res
- , courseTerm = cfTerm res -- dangerous
- , courseSchool = cfSchool res
- , courseCapacity = cfCapacity res
- , courseRegisterSecret = cfSecret res
- , courseMaterialFree = cfMatFree res
- , courseRegisterFrom = cfRegFrom res
- , courseRegisterTo = cfRegTo res
- , courseDeregisterUntil = cfDeRegUntil res
- }
- )
+ updOkay <- myReplaceUnique cid Course
+ { courseName = cfName res
+ , courseDescription = cfDesc res
+ , courseLinkExternal = cfLink res
+ , courseShorthand = cfShort res
+ , courseTerm = cfTerm res -- dangerous
+ , courseSchool = cfSchool res
+ , courseCapacity = cfCapacity res
+ , courseRegisterSecret = cfSecret res
+ , courseMaterialFree = cfMatFree res
+ , courseRegisterFrom = cfRegFrom res
+ , courseRegisterTo = cfRegTo res
+ , courseDeregisterUntil = cfDeRegUntil res
+ }
case updOkay of
(Just _) -> addMessageI Warning (MsgCourseEditDupShort tid ssh csh) $> False
Nothing -> do
@@ -468,7 +467,7 @@ courseEditHandler _isGet mbCourseForm = do
when success $ redirect $ CourseR tid ssh csh CShowR
(FormFailure _) -> addMessageI Warning MsgInvalidInput
- (FormMissing) -> return ()
+ FormMissing -> return ()
actionUrl <- fromMaybe CourseNewR <$> getCurrentRoute
defaultLayout $ do
setTitleI MsgCourseEditTitle
@@ -570,7 +569,7 @@ newCourseForm template = identForm FIDcourse $ \html -> do
validateCourse :: CourseForm -> [Text]
-validateCourse (CourseForm{..}) =
+validateCourse CourseForm{..} =
[ msg | (False, msg) <-
[
( NTop cfRegFrom <= NTop cfRegTo
@@ -604,7 +603,7 @@ getCUserR _tid _ssh _csh uCId = do
-- - User is lecturer for course (?)
uid <- decrypt uCId
User{..} <- runDB $ get404 uid
- defaultLayout $ -- TODO
+ defaultLayout -- TODO
[whamlet|
^{nameWidget userDisplayName userSurname}
|]
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index 03b0d3843..479e50a97 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -55,43 +55,44 @@ homeAnonymous = do
let tableData :: E.SqlExpr (Entity Course)
-> E.SqlQuery (E.SqlExpr (Entity Course))
tableData course = do
- E.where_ $ (E.not_ $ E.isNothing $ course E.^. CourseRegisterFrom) -- DO: do this with isAuthorized in dbtProj
+ E.where_ $ E.not_ (E.isNothing $ course E.^. CourseRegisterFrom) -- DO: do this with isAuthorized in dbtProj
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.&&. ( E.isNothing (course E.^. CourseRegisterTo)
+ E.||. course E.^. CourseRegisterTo E.>=. E.val (Just cTime)
+ )
return course
colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
colonnade = mconcat
[ -- dbRow
- sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
+ sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
textCell $ display $ courseTerm course
- , sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
+ , sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
textCell $ display $ courseSchool course
- , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
+ , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=Entity{entityVal = course} } -> do
let tid = courseTerm course
ssh = courseSchool course
csh = courseShorthand course
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
- , sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
+ , sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
]
- ((), courseTable) <- dbTable def $ DBTable
+ ((), courseTable) <- dbTable def DBTable
{ dbtSQLQuery = tableData
, dbtColonnade = colonnade
, dbtProj = return
, dbtSorting = Map.fromList
[ ( "term"
- , SortColumn $ \(course) -> course E.^. CourseTerm
+ , SortColumn $ \course -> course E.^. CourseTerm
)
, ( "school"
- , SortColumn $ \(course) -> course E.^. CourseSchool
+ , SortColumn $ \course -> course E.^. CourseSchool
)
, ( "course"
- , SortColumn $ \(course) -> course E.^. CourseShorthand
+ , SortColumn $ \course -> course E.^. CourseShorthand
)
, ( "deadline"
- , SortColumn $ \(course) -> course E.^. CourseRegisterTo
+ , SortColumn $ \course -> course E.^. CourseRegisterTo
)
]
, dbtFilter = mempty {- [ ( "term"
@@ -105,7 +106,7 @@ homeAnonymous = do
}
-- let features = $(widgetFile "featureList")
-- addMessage Warning "Vorabversion! Die Implementierung von Uni2work ist noch nicht abgeschlossen!"
- defaultLayout $ do
+ defaultLayout
-- $(widgetFile "dsgvDisclaimer")
$(widgetFile "home")
@@ -125,7 +126,7 @@ homeUser uid = do
, E.SqlExpr (E.Value (Maybe SubmissionId)))
tableData ((participant `E.InnerJoin` course `E.InnerJoin` sheet) `E.LeftOuterJoin` (submission `E.InnerJoin` subuser)) = do
E.on $ submission E.?. SubmissionId E.==. subuser E.?. SubmissionUserSubmission
- E.&&. (E.just $ E.val uid) E.==. subuser E.?. SubmissionUserUser
+ E.&&. E.just (E.val uid) E.==. subuser E.?. SubmissionUserUser
E.on $ submission E.?. SubmissionSheet E.==. E.just(sheet E.^. SheetId)
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
@@ -163,14 +164,14 @@ homeUser uid = do
anchorCell (CSheetR tid ssh csh shn SShowR) (toWidget $ display shn)
, sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
cell $ formatTime SelFormatDateTime deadline >>= toWidget
- , sortable (Just "done") (i18nCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
+ , sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) } ->
case mbsid of
Nothing -> mempty
(Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
tickmark
]
let validator = def & defaultSorting [("done",SortDesc), ("deadline",SortDesc)]
- ((), sheetTable) <- dbTable validator $ DBTable
+ ((), sheetTable) <- dbTable validator DBTable
{ dbtSQLQuery = tableData
, dbtColonnade = colonnade
, dbtProj = \row@DBRow{ dbrOutput = (E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) }
@@ -205,7 +206,7 @@ homeUser uid = do
, dbtIdent = "upcomingdeadlines" :: Text
}
-- addMessage Warning "Vorabversion! Die Implementierung von Uni2work ist noch nicht abgeschlossen."
- defaultLayout $ do
+ defaultLayout $
-- setTitle "Willkommen zum Uni2work Test!"
$(widgetFile "homeUser")
-- $(widgetFile "dsgvDisclaimer")
@@ -275,12 +276,14 @@ postHelpR = do
((res,formWidget),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mReferer mUid
case res of
- FormSuccess (HelpForm{..}) -> do
+ FormSuccess HelpForm{..} -> do
now <- liftIO getCurrentTime
- queueJob' $ JobHelpRequest { jSender = hfUserId
- , jHelpRequest = hfRequest
- , jRequestTime = now
- , jReferer = hfReferer }
+ queueJob' JobHelpRequest
+ { jSender = hfUserId
+ , jHelpRequest = hfRequest
+ , jRequestTime = now
+ , jReferer = hfReferer
+ }
-- redirect $ HelpR
addMessageI Success MsgHelpSent
return ()
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index 3b16c186d..fbbdff58f 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -67,7 +67,7 @@ getProfileR, postProfileR :: Handler Html
getProfileR = postProfileR
postProfileR = do
(uid, User{..}) <- requireAuthPair
- let settingsTemplate = Just $ SettingsForm
+ let settingsTemplate = Just SettingsForm
{ stgMaxFavourties = userMaxFavourites
, stgTheme = userTheme
, stgDateTime = userDateTimeFormat
@@ -92,13 +92,13 @@ postProfileR = do
-- prune Favourites to user-defined size
oldFavs <- selectKeysList [ CourseFavouriteUser ==. uid]
[ Desc CourseFavouriteTime
- , OffsetBy $ stgMaxFavourties
+ , OffsetBy stgMaxFavourties
]
mapM_ delete oldFavs
- addMessageI Info $ MsgSettingsUpdate
+ addMessageI Info MsgSettingsUpdate
redirect ProfileR -- TODO: them change does not happen without redirect
- (FormFailure msgs) -> forM_ msgs $ (addMessage Warning) . toHtml
+ (FormFailure msgs) -> forM_ msgs $ addMessage Warning . toHtml
_ -> return ()
let formText = Nothing :: Maybe UniWorXMessage
@@ -109,7 +109,7 @@ postProfileR = do
postProfileDataR :: Handler Html
postProfileDataR = do
- ((btnResult,_), _) <- runFormPost $ buttonForm
+ ((btnResult,_), _) <- runFormPost buttonForm
case btnResult of
(FormSuccess BtnDelete) -> do
(uid, User{..}) <- requireAuthPair
@@ -119,7 +119,7 @@ postProfileDataR = do
$(addMessageFile Success "templates/deletedUser.hamlet") -- USE THIS ONE
-- addMessageI Success $ MsgDeleteUser deletedSubmissions
-- when (groupSubmissions > 0) $ addMessageI Info $ MsgDeleteUserGroupSubmissions groupSubmissions
- defaultLayout $ do
+ defaultLayout
$(widgetFile "deletedUser")
(FormSuccess BtnAbort ) -> do
@@ -156,72 +156,76 @@ deleteUser duid = do
E.&&. subUsers E.^. SubmissionUserUser E.!=. E.val duid
return E.countRows
E.where_ $ suser E.^. SubmissionUserUser E.==. E.val duid
- E.&&. (whereBuddies numBuddies)
+ E.&&. whereBuddies numBuddies
return $ submission E.^. SubmissionId
getSubmissionFiles :: SubmissionId -> DB [E.Value (Key File)]
getSubmissionFiles subId = E.select $ E.from $ \file -> do
- E.where_ $ E.exists $ E.from $ \submissionFile -> do
+ E.where_ $ E.exists $ E.from $ \submissionFile ->
E.where_ $ submissionFile E.^. SubmissionFileSubmission E.==. E.val subId
E.&&. submissionFile E.^. SubmissionFileFile E.==. file E.^. FileId
return $ file E.^. FileId
deleteSingleSubmissionGroups = E.deleteCount $ E.from $ \submissionGroup -> do
- E.where_ $ E.exists $ E.from $ \subGroupUser -> do
+ E.where_ $ E.exists $ E.from $ \subGroupUser ->
E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
- E.&&. subGroupUser E.^. SubmissionGroupUserUser E.==. E.val duid
- E.where_ $ E.notExists $ E.from $ \subGroupUser -> do
+ E.&&. subGroupUser E.^. SubmissionGroupUserUser E.==. E.val duid
+ E.where_ $ E.notExists $ E.from $ \subGroupUser ->
E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
- E.&&. subGroupUser E.^. SubmissionGroupUserUser E.!=. E.val duid
+ E.&&. subGroupUser E.^. SubmissionGroupUserUser E.!=. E.val duid
-getProfileDataR :: Handler Html
+getProfileDataR :: Handler Html
getProfileDataR = do
(uid, User{..}) <- requireAuthPair
-- mr <- getMessageRender
(admin_rights,lecturer_rights,lecture_corrector,studies) <- runDB $ (,,,) <$>
- (E.select $ E.from $ \(adright `E.InnerJoin` school) -> do
- E.where_ $ adright E.^. UserAdminUser E.==. E.val uid
- E.on $ adright E.^. UserAdminSchool E.==. school E.^. SchoolId
- return (school E.^. SchoolShorthand)
- )
+ E.select
+ ( E.from $ \(adright `E.InnerJoin` school) -> do
+ E.where_ $ adright E.^. UserAdminUser E.==. E.val uid
+ E.on $ adright E.^. UserAdminSchool E.==. school E.^. SchoolId
+ return (school E.^. SchoolShorthand)
+ )
<*>
- (E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do
- E.where_ $ lecright E.^. UserLecturerUser E.==. E.val uid
- E.on $ lecright E.^. UserLecturerSchool E.==. school E.^. SchoolId
- return (school E.^. SchoolShorthand)
- )
+ E.select
+ ( E.from $ \(lecright `E.InnerJoin` school) -> do
+ E.where_ $ lecright E.^. UserLecturerUser E.==. E.val uid
+ E.on $ lecright E.^. UserLecturerSchool E.==. school E.^. SchoolId
+ return (school E.^. SchoolShorthand)
+ )
<*>
- (E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
- E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
- E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
- E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
- return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
- )
+ E.select
+ ( E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
+ E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
+ E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
+ E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
+ return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
+ )
<*>
- (E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
- E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
- E.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId
- E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
- return ( ( studydegree E.^. StudyDegreeName
- , studydegree E.^. StudyDegreeKey
- )
- , ( studyterms E.^. StudyTermsName
- , studyterms E.^. StudyTermsKey
- )
- , studyfeat E.^. StudyFeaturesType
- , studyfeat E.^. StudyFeaturesSemester)
- )
+ E.select
+ ( E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
+ E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
+ E.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId
+ E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
+ return ( ( studydegree E.^. StudyDegreeName
+ , studydegree E.^. StudyDegreeKey
+ )
+ , ( studyterms E.^. StudyTermsName
+ , studyterms E.^. StudyTermsKey
+ )
+ , studyfeat E.^. StudyFeaturesType
+ , studyfeat E.^. StudyFeaturesSemester)
+ )
-- Tabelle mit eigenen Kursen
(hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
enrolledCoursesTable <- mkEnrolledCoursesTable uid
-- Tabelle mit allen Klausuren und Noten
- examTable <- return [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|]
+ let examTable = [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|]
-- Tabelle mit allen Abgaben und Abgabe-Gruppen
submissionTable <- mkSubmissionTable uid
-- Tabelle mit allen Abgabegruppen
@@ -229,42 +233,14 @@ getProfileDataR = do
-- Tabelle mit allen Korrektor-Aufgaben
correctionsTable <- mkCorrectionsTable uid
-- Tabelle mit allen eigenen Tutorials
- ownTutorialTable <- return [whamlet| Übungsgruppen werden momentan leider noch nicht unterstützt.|]
+ let ownTutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
-- Tabelle mit allen Tutorials
- tutorialTable <- return [whamlet| Übungsgruppen werden momentan leider noch nicht unterstützt.|]
+ let tutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
-- Delete Button
(btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form BtnDelete)
-- TODO: move this into a Message and/or Widget-File
- let delWdgt = [whamlet|
-