Handling multiple IO operations that return optional values

Question

The following Haskell code reads a Pandoc document from the DB and then serves it to the user after making a transformation, after the first run it is stored in memory via IORef State, inside a [(String, Pandoc)] so the document can be quickly looked up again, without hitting the DB or doing the transformation. I don't feel like this code reflects that this is what is happening that well, there is a lot of handling Maybe's that I feel clouds the actual steps that make up this action.

module Api.ReadDocument (Route, action) where

import Control.Monad.Reader
import Data.Aeson.Types
import Data.Int
import Data.IORef
import Data.List
import Database.Persist.Postgresql (ConnectionPool, fromSqlKey, runSqlPool)
import Servant
import Servant.Auth.Server
import Text.Pandoc (Pandoc, def, readHtml, writeJSON)
--
import Config
import Queries
import State
import Types.DB
import Types.Pandoc

type Route = "read" :> Capture "id" Int64 :> Get '[JSON] Pandoc

action :: IORef State -> ConnectionPool -> AuthResult Account -> Int64 -> Handler Pandoc
action state pool (Authenticated _) id = viaCache state pool id
action _ _ _ = throwAll err401

viaCache :: IORef State -> ConnectionPool -> Int64 -> Handler Pandoc
viaCache state pool id = do
  let key = show id
  state' <- liftIO $ readIORef state
  maybe (retrieve state pool id) (return . snd) $ find ((== key) . fst) (cached state')

retrieve :: IORef State -> ConnectionPool -> Int64 -> Handler Pandoc
retrieve state pool id = do
  doc <- runSqlPool (Queries.getDocumentFromId id) pool
  maybe (throwError err404) (loadDocument state id) doc

loadDocument :: IORef State -> Int64 -> Document -> Handler Pandoc
loadDocument state id doc = do
  let key = show id
      pd = transform . documentBody $ doc
  _ <- liftIO $ updateState (CacheFile (key, pd)) state
  return pd

Previously this was one function, which contained nested case statements like so (pseudo code):

action state pool (Authenticated _) id = do
  state' <- fromState state              -- get the state
  case find id state of                  -- find the data
    Just (_, doc) ->
      return doc                         -- return cached document
    Nothing -> do
      doc <- getDocumentFromId id pool   -- get document from db
      case doc of
        Just d -> do
          let doc = performOp $ d        -- perform computation on doc
          _ <- saveToState state doc     -- save the document to in memory cache
          return doc                     -- serve document
        Nothing ->                       -- document not actually in DB
          throwError err404

This is obviously much more explicit but I didn't like the nested case statements, and obviously there is a bit more to the code than what I have typed out here.

Answer 1

Here's how your pseudocode can be rewritten with bounded indentation using MaybeT.

action state pool (Authenticated _) id = cached <|> retrieve <|!> throwError err404 where
  cached = snd <$> MaybeT (find id <$> fromState state)
  retrieve = do 
    doc <- performOp <$> MaybeT (getDocumentFromId id pool)
    _ <- lift $ saveToState state doc
    return doc

infix 2 <|!>
(<|!>) :: Monad m => MaybeT m a -> m a -> m a
mx <|!> y = runMaybeT mx >>= maybe y pure