Utilizzo di servant con ReaderT IO a

Question

Sto utilizzando la libreria servant per la mia API JSON. Ho bisogno di aiuto per far funzionare uno stack monad ServerT MyAPI (ReaderT a IO).

Ecco un esempio di utilizzo ReaderT, ma senza integrandola con servo:

-- 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 

Così, ora vorrei farlo funzionare con SERVERT, seguendo l'esempio di 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 

ottengo il seguente errore:

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. 

Come posso eliminare l'errore?

Domanda successiva: Capisco i trasformatori monad in generale, ma sono perso. Quali argomenti o collegamenti dovrei studiare per conoscere abbastanza per rispondere alla mia domanda?

Answer 1

Si erano quasi arrivati, test dovrebbe essere:

test :: ReaderT Int IO String 
test = giveMeAMessage 

Per quanto riguarda le vostre altre domande, non ho tempo di rispondere solo ora, ma noi sviluppatori servo probabilmente dovrei rendere più facile o meglio documentato.

Potresti leggere la fonte per qualsiasi parte ti confonda e poi fare domande specifiche?

Answer 2

Dopo l'aiuto di molte persone e ore di lettura di elementi casuali, ecco un esempio completo dell'uso di Servant with ReaderT, fatto come meglio posso (usando newtype e GeneralizedNewtypeDeriving, ho anche aggiunto ExceptT per le eccezioni).

{-# 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