paul/lisa
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add rudimentary error handler thingy

Browse Source
This commit is contained in:
Paul Brinkmeier 2022-09-16 22:20:43 +02:00
parent d389e78ddc
commit 8901ec0eb4
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Lisa.hs
View File

@ -9,7 +9,7 @@ module Lisa
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Text (Text) 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 (Html)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml) import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Web.Internal.HttpApiData (FromHttpApiData) import Web.Internal.HttpApiData (FromHttpApiData)
@ -38,6 +38,13 @@ requiredParam k = param k >>= \case
Just val -> Just val ->
pure 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 -- Exports
mkConfig :: IO (SpockCfg () Session State) mkConfig :: IO (SpockCfg () Session State)
@ -51,9 +58,9 @@ app = do
blaze Views.viewIndex blaze Views.viewIndex
get ("lectures" <//> var) $ \lid -> do get ("lectures" <//> var) $ \lid -> do
lecture <- getLectureByIdCached lid lecture <- getLectureByIdCached lid `onLeft` (internalServerError500, "Failed to retrieve lectures")
documents <- Squeak.getDocumentsByLectureId lid documents <- Squeak.getDocumentsByLectureId lid `onLeft` (internalServerError500, "Failed to retrieve documents")
blaze $ either Views.viewSqueakError id $ Views.viewLecture <$> lecture <*> documents blaze $ Views.viewLecture lecture documents
get "lectures" $ do get "lectures" $ do
query <- fromMaybe "" <$> param "query" query <- fromMaybe "" <$> param "query"