From 02a0dc14359c9ef048c08ba40dfe1c717f207b60 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 30 Jan 2019 10:58:57 +0100
Subject: [PATCH] Minor Refactor

---
 src/Foundation.hs    | 18 +++---------------
 src/Handler/Sheet.hs | 22 ++++++----------------
 src/Utils/Sheet.hs   | 22 ++++++++++++++++++++++
 3 files changed, 31 insertions(+), 31 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 901c6c124..4840003f7 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1287,21 +1287,9 @@ pageActions (CourseR tid ssh csh SheetListR) =
       , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetCurrentR
       , menuItemModal = False
-      , menuItemAccessCallback' = do
-          now <- liftIO getCurrentTime
-          sheets <- runDB . 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.^. 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
+      , menuItemAccessCallback' = runDB . maybeT (return False) $ do
+          void . MaybeT $ sheetCurrent tid ssh csh
+          return True
       }
   , MenuItem
       { menuItemType = PageActionPrime
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index ef30c1293..454b90a09 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -143,25 +143,15 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
 
 getSheetCurrentR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getSheetCurrentR tid ssh csh = runDB $ 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
-  case sheets of
-    (E.Value shn):_ -> redirectAccess $ CSheetR tid ssh csh shn SShowR
-    _ -> notFound
+  let redi shn = redirectAccess $ CSheetR tid ssh csh shn SShowR
+  shn <- sheetCurrent tid ssh csh
+  maybe notFound redi shn
 
 getSheetOldUnassigned :: TermId -> SchoolId -> CourseShorthand -> Handler ()
 getSheetOldUnassigned tid ssh csh = runDB $ do
-  shn' <- sheetOldUnassigned tid ssh csh
-  maybe notFound (\shn -> redirectAccess $ CSheetR tid ssh csh shn SSubsR) shn'
+  let redi shn = redirectAccess $ CSheetR tid ssh csh shn SSubsR
+  shn <- sheetOldUnassigned tid ssh csh
+  maybe notFound redi shn
 
 getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getSheetListR tid ssh csh = do
diff --git a/src/Utils/Sheet.hs b/src/Utils/Sheet.hs
index 21f4ab310..93924d98d 100644
--- a/src/Utils/Sheet.hs
+++ b/src/Utils/Sheet.hs
@@ -3,6 +3,28 @@ module Utils.Sheet where
 import Import.NoFoundation
 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 tid ssh csh = do
   now <- liftIO getCurrentTime