From d6e39fb07c852c345b58d98546486c65cd0e5038 Mon Sep 17 00:00:00 2001
From: Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
Date: Tue, 13 Apr 2021 13:08:24 +0200
Subject: [PATCH] chore: unify runDB calls

---
 src/Foundation/SiteLayout.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/src/Foundation/SiteLayout.hs b/src/Foundation/SiteLayout.hs
index 063894fa0..6dd2a888f 100644
--- a/src/Foundation/SiteLayout.hs
+++ b/src/Foundation/SiteLayout.hs
@@ -151,11 +151,11 @@ siteLayout' overrideHeading widget = do
   
   now <- liftIO getCurrentTime
 
+  muid <- maybeAuthPair
   -- Lookup Favourites, Breadcrumbs, Headline, & Theme if possible
-  (favourites', (title, parents), nav', contentHeadline, mmsgs, maxFavouriteTerms, currentTheme) <- do
-    muid <- maybeAuthPair
+  (favourites', (title, parents), nav', contentHeadline, mmsgs, maxFavouriteTerms, currentTheme, storedReasonAndToggleRoute) <- do
 
-    (favCourses, breadcrumbs'', nav', contentHeadline, mmsgs) <- runDB $ do
+    (favCourses, breadcrumbs'', nav', contentHeadline, mmsgs, storedReasonAndToggleRoute) <- runDB $ do
       favCourses'' <- withReaderT (projectBackend @SqlReadBackend) . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do
         E.on $ E.just (course E.^. CourseId) E.==. courseFavourite E.?. CourseFavouriteCourse
          E.&&. courseFavourite E.?. CourseFavouriteUser E.==. E.val (view _1 <$> muid)
@@ -246,8 +246,12 @@ siteLayout' overrideHeading widget = do
             forM_ authTagPivots $
               \authTag -> addMessageWidget Info $ msgModal [whamlet|_{MsgUnauthorizedDisabledTag authTag}|] (Left $ SomeRoute (AuthPredsR, catMaybes [(toPathPiece GetReferer, ) . toPathPiece <$> mcurrentRoute]))
             getMessages
+    
+      storedReasonAndToggleRoute <- case mcurrentRoute of
+        (Just (CourseR tid ssh csh _)) -> (, Just . SomeRoute $ CourseR tid ssh csh CFavouriteR) <$> storedFavouriteReason tid ssh csh muid
+        _otherwise -> pure (Nothing, Nothing)
 
-      return (favCourses, breadcrumbs'', nav', contentHeadline, mmsgs)
+      return (favCourses, breadcrumbs'', nav', contentHeadline, mmsgs, storedReasonAndToggleRoute)
 
     return ( favCourses
            , breadcrumbs''
@@ -256,13 +260,11 @@ siteLayout' overrideHeading widget = do
            , mmsgs
            , maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid
            , maybe userDefaultTheme userTheme $ view _2 <$> muid
+           , storedReasonAndToggleRoute
            )
 
-  muid <- maybeAuthPair
-  (currentReason', maybeRoute) <- case mcurrentRoute of
-    (Just (CourseR tid ssh csh _)) -> (, Just . SomeRoute $ CourseR tid ssh csh CFavouriteR) <$> runDB (storedFavouriteReason tid ssh csh muid)
-    _otherwise -> pure (Nothing, Nothing)
-  let currentReason = case currentReason' of
+  let (currentReason', maybeRoute) = storedReasonAndToggleRoute
+      currentReason = case currentReason' of
         -- (reason, blacklist)
         (Just (_reason, True))      -> Nothing
         (Just (Just reason, False)) -> Just reason