fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

Minor Refactor

Browse Source
This commit is contained in:
SJost 2019-01-30 10:58:57 +01:00
parent 3ef6c08ac1
commit 02a0dc1435
3 changed files with 31 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Foundation.hs
View File

@ -1287,21 +1287,9 @@ pageActions (CourseR tid ssh csh SheetListR) =
, menuItemIcon = Nothing , menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetCurrentR , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetCurrentR
, menuItemModal = False , menuItemModal = False
, menuItemAccessCallback' = do , menuItemAccessCallback' = runDB . maybeT (return False) $ do
now <- liftIO getCurrentTime void . MaybeT $ sheetCurrent tid ssh csh
sheets <- runDB . E.select . E.from $ \(course `E.InnerJoin` sheet) -> do return True
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.where_ $ sheet E.^. SheetActiveTo E.>. E.val now
E.&&. sheet E.^. SheetActiveFrom E.<=. E.val now
E.&&. course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
E.orderBy [E.asc $ sheet E.^. SheetActiveTo]
E.limit 1
return $ sheet E.^. SheetName
case sheets of
(E.Value shn):_ -> (== Authorized) <$> isAuthorized (CSheetR tid ssh csh shn SShowR) False
_ -> return False
} }
, MenuItem , MenuItem
{ menuItemType = PageActionPrime { menuItemType = PageActionPrime

22
src/Handler/Sheet.hs
View File

@ -143,25 +143,15 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
getSheetCurrentR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getSheetCurrentR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getSheetCurrentR tid ssh csh = runDB $ do getSheetCurrentR tid ssh csh = runDB $ do
now <- liftIO getCurrentTime let redi shn = redirectAccess $ CSheetR tid ssh csh shn SShowR
sheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do shn <- sheetCurrent tid ssh csh
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId maybe notFound redi shn
E.where_ $ sheet E.^. SheetActiveTo E.>. E.val now
E.&&. sheet E.^. SheetActiveFrom E.<=. E.val now
E.&&. course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
E.orderBy [E.asc $ sheet E.^. SheetActiveFrom]
E.limit 1
return $ sheet E.^. SheetName
case sheets of
(E.Value shn):_ -> redirectAccess $ CSheetR tid ssh csh shn SShowR
_ -> notFound
getSheetOldUnassigned :: TermId -> SchoolId -> CourseShorthand -> Handler () getSheetOldUnassigned :: TermId -> SchoolId -> CourseShorthand -> Handler ()
getSheetOldUnassigned tid ssh csh = runDB $ do getSheetOldUnassigned tid ssh csh = runDB $ do
shn' <- sheetOldUnassigned tid ssh csh let redi shn = redirectAccess $ CSheetR tid ssh csh shn SSubsR
maybe notFound (\shn -> redirectAccess $ CSheetR tid ssh csh shn SSubsR) shn' shn <- sheetOldUnassigned tid ssh csh
maybe notFound redi shn
getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getSheetListR tid ssh csh = do getSheetListR tid ssh csh = do

22
src/Utils/Sheet.hs
View File

@ -3,6 +3,28 @@ module Utils.Sheet where
import Import.NoFoundation import Import.NoFoundation
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
-- DB Queries for Sheets that are used in several places
sheetCurrent :: MonadIO m => TermId -> SchoolId -> CourseShorthand -> SqlReadT m (Maybe SheetName)
sheetCurrent tid ssh csh = do
now <- liftIO getCurrentTime
sheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.where_ $ sheet E.^. SheetActiveTo E.>. E.val now
E.&&. sheet E.^. SheetActiveFrom E.<=. E.val now
E.&&. course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
E.orderBy [E.asc $ sheet E.^. SheetActiveFrom]
E.limit 1
return $ sheet E.^. SheetName
return $ case sheets of
[] -> Nothing
[E.Value shn] -> Just shn
_ -> error "SQL Query with limit 1 returned more than one result"
sheetOldUnassigned :: MonadIO m => TermId -> SchoolId -> CourseShorthand -> SqlReadT m (Maybe SheetName) sheetOldUnassigned :: MonadIO m => TermId -> SchoolId -> CourseShorthand -> SqlReadT m (Maybe SheetName)
sheetOldUnassigned tid ssh csh = do sheetOldUnassigned tid ssh csh = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime