问题
I'm using the servant
library for my JSON API. I need some help to get a ServerT MyAPI (ReaderT a IO)
monad stack working.
Here's an example using ReaderT
, but without integrating it with servant:
-- this code works
type TestAPI =
"a" :> Get '[JSON] String
:<|> "b" :> Get '[JSON] String
test2 :: EitherT ServantErr IO String
test2 = return "asdf"
testServer :: Int -> Server TestAPI
testServer code = test :<|> test2
where
test :: EitherT ServantErr IO String
test = liftIO $ runReaderT (giveMeAMessage) code
-- this is contrived. In my real application I want to use a Reader for the database connection.
giveMeAMessage :: ReaderT Int IO String
giveMeAMessage = do
code <- ask
name <- liftIO $ getProgName
return $ show code <> name
So, now I would like to get it working with ServerT, following the example in this article.
-- this code doesn't compile
testServerT :: ServerT TestAPI (ReaderT Int IO)
testServerT = test :<|> test
where
test :: EitherT ServantErr (ReaderT Int IO) String
test = lift $ giveMeAMessage
testServer' :: Int -> Server TestAPI
testServer' code = enter (Nat $ liftIO . (`runReaderT` code)) testServerT
I get the following error:
server/Serials/Route/Test.hs:43:15:
Couldn't match type ‘EitherT ServantErr (ReaderT Int IO) String’
with ‘ReaderT Int IO [Char]’
Expected type: ServerT TestAPI (ReaderT Int IO)
Actual type: EitherT ServantErr (ReaderT Int IO) String
:<|> EitherT ServantErr (ReaderT Int IO) String
In the expression: test :<|> test
In an equation for ‘testServerT’:
testServerT
= test :<|> test
where
test :: EitherT ServantErr (ReaderT Int IO) String
test = lift $ giveMeAMessage
Failed, modules loaded: none.
How can I get rid of the error?
Followup question: I understand monad transformers generally, but I'm lost. What topics or links should I study to know enough to answer my own question?
回答1:
You were almost there, test should be:
test :: ReaderT Int IO String
test = giveMeAMessage
As for your other questions, I don't have time to answer just now but us servant developers should probably make it easier or better documented.
Could you please read through the source for whichever part confuses you, and then ask specific questions?
回答2:
After help from lots of folks and hours of reading random things here's a complete example of using Servant with ReaderT, done as fancy as I can (using newtype, and GeneralizedNewtypeDeriving, I also added ExceptT for exceptions).
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Serials.Route.Test where
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Either
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.Monoid
import Data.Text (Text, pack)
import Data.Text.Lazy (fromStrict)
import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Servant.Server
import Servant
import Database.RethinkDB.NoClash
import System.Environment
data AppError = Invalid Text | NotFound | ServerError Text
newtype App a = App {
runApp :: ReaderT Int (ExceptT AppError IO) a
} deriving (Monad, Functor, Applicative, MonadReader Int, MonadError AppError, MonadIO)
type TestAPI =
"a" :> Get '[JSON] String
:<|> "b" :> Get '[JSON] String
:<|> "c" :> Get '[JSON] String
giveMeAMessage :: App String
giveMeAMessage = do
code <- ask
name <- getProgName'
throwError $ Invalid "your input is invalid. not really, just to test"
return $ show code <> name
testMaybe :: App (Maybe String)
testMaybe = return $ Nothing
testErr :: App (Either String String)
testErr = return $ Left "Oh no!"
getProgName' :: MonadIO m => m String
getProgName' = liftIO $ getProgName
hello :: IO String
hello = return "hello"
---------------------------------------------------------------
-- return a 404 if Nothing
isNotFound :: App (Maybe a) -> App a
isNotFound action = do
res <- action
case res of
Nothing -> throwError $ NotFound
Just v -> return v
-- map to a generic error
isError :: Show e => App (Either e a) -> App a
isError action = do
res <- action
case res of
Left e -> throwError $ ServerError $ pack $ show e
Right v -> return v
-- wow, it's IN My monad here! that's swell
testServerT ::ServerT TestAPI App
testServerT = getA :<|> getB :<|> getC
where
getA :: App String
getA = giveMeAMessage
-- you can also lift IO functions
--getA = liftIO $ hello
-- I can map app functions that return Maybes and Eithers to
-- app exceptions using little functions like this
getB :: App String
getB = isNotFound $ testMaybe
getC :: App String
getC = isError $ testErr
-- this is awesome because I can easily map error codes here
runAppT :: Int -> App a -> EitherT ServantErr IO a
runAppT code action = do
res <- liftIO $ runExceptT $ runReaderT (runApp action) code
-- branch based on the error or value
EitherT $ return $ case res of
Left (Invalid text) -> Left err400 { errBody = textToBSL text }
Left (NotFound) -> Left err404
Left (ServerError text) -> Left err500 { errBody = textToBSL text }
Right a -> Right a
textToBSL :: Text -> ByteString
textToBSL = encodeUtf8 . fromStrict
testServer' :: Int -> Server TestAPI
testServer' code = enter (Nat $ (runAppT code)) testServerT
回答3:
Recent versions of servant have simplified this a lot. See Using a custom monad in the servant cookbook.
nt :: State -> AppM a -> Handler a
nt s x = runReaderT x s
app :: State -> Application
app s = serve api $ hoistServer api (nt s) server
来源:https://stackoverflow.com/questions/31279943/using-servant-with-readert-io-a