From 8901ec0eb440da36bf859edf4e9eb05f2113db31 Mon Sep 17 00:00:00 2001
From: Paul Brinkmeier <hallo@pbrinkmeier.de>
Date: Fri, 16 Sep 2022 22:20:43 +0200
Subject: [PATCH] Add rudimentary error handler thingy

---
 src/Lisa.hs | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/src/Lisa.hs b/src/Lisa.hs
index fefad2a..4a2924f 100644
--- a/src/Lisa.hs
+++ b/src/Lisa.hs
@@ -9,7 +9,7 @@ module Lisa
 import Control.Monad.IO.Class (MonadIO)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
-import Network.HTTP.Types.Status (badRequest400)
+import Network.HTTP.Types.Status (Status, badRequest400, internalServerError500)
 import Text.Blaze.Html (Html)
 import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
 import Web.Internal.HttpApiData (FromHttpApiData)
@@ -38,6 +38,13 @@ requiredParam k = param k >>= \case
     Just val ->
         pure val
 
+-- TODO: Generalize, introduce some sort of Lisa.Types.Error type
+-- TODO: Make more readable
+onLeft :: MonadIO m => (ActionCtxT ctx m (Either e a)) -> (Status, Text) -> ActionCtxT ctx m a
+onLeft f (status, message) = f >>= (flip either pure $ \_ -> do
+    setStatus status
+    text message)
+
 -- Exports
 
 mkConfig :: IO (SpockCfg () Session State)
@@ -51,9 +58,9 @@ app = do
         blaze Views.viewIndex
     
     get ("lectures" <//> var) $ \lid -> do
-        lecture <- getLectureByIdCached lid
-        documents <- Squeak.getDocumentsByLectureId lid
-        blaze $ either Views.viewSqueakError id $ Views.viewLecture <$> lecture <*> documents
+        lecture <- getLectureByIdCached lid `onLeft` (internalServerError500, "Failed to retrieve lectures")
+        documents <- Squeak.getDocumentsByLectureId lid `onLeft` (internalServerError500, "Failed to retrieve documents")
+        blaze $ Views.viewLecture lecture documents
 
     get "lectures" $ do
         query <- fromMaybe "" <$> param "query"