Handler and Monads

Question

I'm struggling to compose Servant's Handler and Monad:

class Monad p => Persist p where
  data Configuration p :: *
  runPersistance       :: Configuration p -> p a -> IO a
  initPersistence      :: p ()
  newKind              :: Kind -> p NewKindStatus
  -- ...

kind :: P.Persist p => KindUid -> KindBody -> p (Handler ())
kind (KindUid uid) (KindBody actions) = undefined

subject :: P.Persist p => KindUid -> SubjectUid -> EventData -> p (Handler EventUid)
subject kind subject body = undefined

event = post :<|> get
where post :: P.Persist p => KindUid -> SubjectUid -> Action -> EventData -> p (Handler EventUid)
        post kind subject action body = undefined
        get :: P.Persist p => KindUid -> SubjectUid -> p (Handler [Event])
        get kind subject = undefined

server :: P.Persist p => p (Server HermesAPI)
server = do
    k <- kind
    s <- subject
    e <- event
    return $ k :<|> s :<|> e

app :: P.Persist p => p (Application)
app = serve hermesAPI server

In order to answer to a route I have to use P.Persist, which is Monad doing IO.

I did not found a way to make server compile:

/app/Main.hs:55:3: error:
    • Couldn't match type ‘KindUid
                        -> SubjectUid -> p0 (Handler [Event])’
                    with ‘(KindUid
                            -> SubjectUid -> Action -> EventData -> Handler EventUid)
                        :<|> (KindUid -> SubjectUid -> Handler [Event])’
    Expected type: p (Server HermesAPI)
        Actual type: p ((KindUid -> KindBody -> Handler ())
                        :<|> ((KindUid -> SubjectUid -> EventData -> Handler EventUid)
                            :<|> (KindUid -> SubjectUid -> p0 (Handler [Event]))))
    • In a stmt of a 'do' block: k <- kind
    In the expression:
        do k <- kind
        s <- subject
        e <- event
        return $ k :<|> s :<|> e
    In an equation for ‘server’:
        server
            = do k <- kind
                s <- subject
                e <- event
                ....
   |
55 |   k <- kind
   |   ^^^^^^^^^

app/Main.hs:55:8: error:
    • Couldn't match type ‘KindBody’ with ‘KindUid’
    Expected type: p (KindUid -> KindBody -> Handler ())
        Actual type: KindUid -> KindBody -> KindBody -> Handler ()
    • In a stmt of a 'do' block: k <- kind
    In the expression:
        do k <- kind
        s <- subject
        e <- event
        return $ k :<|> s :<|> e
    In an equation for ‘server’:
        server
            = do k <- kind
                s <- subject
                e <- event
                ....
   |
55 |   k <- kind
   |        ^^^^

Since Handler is already a newtype, I'm stuck. How can I compose Handler and my Monad in order to run it in Servant?

Edit:

I did a step thanks to Mark Seemann, lifting the Handler in order to leverage ServerT:

newtype LiftHandler p a = LiftHandler (p (Handler a))
server :: P.Persist p => ServerT HermesAPI (LiftHandler p)
server = LiftHandler kind :<|> LiftHandler subject :<|> LiftHandler event

Leading to:

app/Main.hs:55:22: error:
    • Couldn't match type ‘KindBody -> p2 (Handler ())’
                    with ‘Handler a2’
    Expected type: KindUid -> Handler a2
        Actual type: KindUid -> KindBody -> p2 (Handler ())
    • Probable cause: ‘kind’ is applied to too few arguments
        In the first argument of ‘LiftHandler’, namely ‘kind’
        In the first argument of ‘(:<|>)’, namely ‘LiftHandler kind’
        In the expression:
            LiftHandler kind :<|> LiftHandler subject :<|> LiftHandler event
   |
55 | server = LiftHandler kind :<|> LiftHandler subject :<|> LiftHandler event

Thanks.

Answer 1

This is only a sketch of a solution, but perhaps you'll find these hints useful. Handler is a newtype wrapper around ExceptT ServerError IO a, but sometimes, you may not be able to produce such a type directly.

However, if you have another Monad (like your Persist) you may be able to first define your API using that Monad, and then use hoistServer to translate to ExceptT ServerError IO a.

So, imagine, for example, that you define server with this type:

server :: ServerT API P.Persist

You should be able to transform it into a Server and run it like this:

run port $ serve api $ hoistServer api (Handler . trans) $ server

where trans is your transformation from P.Persist to ExceptT ServerError IO.

As the documentation of hoistServer says:

Sometimes our cherished Handler monad isn't quite the type you'd like for your handlers.

I haven't tried to compile any of my code sketches, so there could be type errors. I don't know what P.Persist is, so I can't repro the issue.

You may alternatively want to define server as

server :: ServerT API (ExceptT ServantErr P.Persist)

so that you can use throwError to communicate HTTP (error) status codes. That might also make it easier to write the transformation from ExceptT ServantErr P.Persist to ExceptT ServerError IO, because now you just need to figure out how to transform P.Persist to IO.