Add rudimentary error handler thingy

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"