fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cleanup

Browse Source
This commit is contained in:
Gregor Kleen 2018-10-13 16:23:39 +02:00
parent a7cfb86419
commit 3297b56ebf
2 changed files with 41 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
src/Handler/Corrections.hs
View File

@ -1,7 +1,6 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiWayIf, LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
{-# LANGUAGE TemplateHaskell #-}
@ -190,44 +189,46 @@ makeCorrectionsTable whereClause colChoices psValidator = do
{ dbtSQLQuery
, dbtColonnade = colChoices
, dbtProj
, dbtSorting = [ ( "term"
, SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseTerm
)
, ( "course"
, SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseShorthand
)
, ( "sheet"
, SortColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _) -> sheet E.^. SheetName
)
, ( "corrector"
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserSurname
)
, ( "rating"
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints
)
]
, dbtFilter = [ ( "term"
, FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) tids -> if
| Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
)
, ( "course"
, FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) cshs -> if
| Set.null cshs -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> course E.^. CourseShorthand `E.in_` E.valList (Set.toList cshs)
)
, ( "sheet"
, FilterColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) shns -> if
| Set.null shns -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> sheet E.^. SheetName `E.in_` E.valList (Set.toList shns)
)
, ( "corrector"
, FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector :: CorrectionTableExpr) emails -> if
| Set.null emails -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> corrector E.?. UserEmail `E.in_` E.justList (E.valList . catMaybes $ Set.toList emails)
E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False)
)
]
, dbtSorting = Map.fromList
[ ( "term"
, SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseTerm
)
, ( "course"
, SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseShorthand
)
, ( "sheet"
, SortColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _) -> sheet E.^. SheetName
)
, ( "corrector"
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserSurname
)
, ( "rating"
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints
)
]
, dbtFilter = Map.fromList
[ ( "term"
, FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) tids -> if
| Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
)
, ( "course"
, FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) cshs -> if
| Set.null cshs -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> course E.^. CourseShorthand `E.in_` E.valList (Set.toList cshs)
)
, ( "sheet"
, FilterColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) shns -> if
| Set.null shns -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> sheet E.^. SheetName `E.in_` E.valList (Set.toList shns)
)
, ( "corrector"
, FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector :: CorrectionTableExpr) emails -> if
| Set.null emails -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> corrector E.?. UserEmail `E.in_` E.justList (E.valList . catMaybes $ Set.toList emails)
E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False)
)
]
, dbtStyle = def
, dbtIdent = "corrections" :: Text
}

2
src/Jobs.hs
View File

@ -239,7 +239,7 @@ handleJobs' wNum = C.mapM_ $ \jctl -> do
runDB $ delete jId
handleCmd JobCtlDetermineCrontab = do
newCTab <- liftHandlerT . runDB $ setSerializable determineCrontab
$logDebugS logIdent $ tshow newCTab
-- $logDebugS logIdent $ tshow newCTab
mapReaderT (liftIO . atomically) $
lift . flip writeTVar newCTab =<< asks jobCrontab