Compare commits
2 Commits
d389e78ddc
...
6763d3ffa1
Author | SHA1 | Date | |
---|---|---|---|
6763d3ffa1 | |||
8901ec0eb4 |
@ -8,3 +8,4 @@ Webserver that offers an HTML-only interface to Squeak.
|
||||
|
||||
- Improve error handling: Write functions that turn `Maybe` and `Either` `SpockAction`s that return `4xx` or `5xx`.
|
||||
- Document JSON stuff
|
||||
- Record times: How long did HTTP requests take?
|
||||
|
15
src/Lisa.hs
15
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"
|
||||
|
Loading…
x
Reference in New Issue
Block a user