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

2
src/Jobs.hs
View File

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