Better docs for servant-server
This commit is contained in:
parent
3b4b958110
commit
bdf6d9aa48
3 changed files with 65 additions and 13 deletions
|
@ -1,6 +1,7 @@
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
-- | This module lets you implement 'Server's for defined APIs. You'll
|
-- | This module lets you implement 'Server's for defined APIs. You'll
|
||||||
-- most likely just need 'serve'.
|
-- most likely just need 'serve'.
|
||||||
|
@ -17,8 +18,27 @@ module Servant.Server
|
||||||
, ServerT
|
, ServerT
|
||||||
|
|
||||||
-- * Enter
|
-- * Enter
|
||||||
-- Applying functions to all handlers
|
-- $enterDoc
|
||||||
, Enter(..)
|
|
||||||
|
-- ** Basic functions and datatypes
|
||||||
|
, enter
|
||||||
|
, (:~>)(..)
|
||||||
|
-- ** `Nat` utilities
|
||||||
|
, liftNat
|
||||||
|
, runReaderTNat
|
||||||
|
, evalStateTLNat
|
||||||
|
, evalStateTSNat
|
||||||
|
, logWriterTLNat
|
||||||
|
, logWriterTSNat
|
||||||
|
#if MIN_VERSION_mtl(2,2,1)
|
||||||
|
, fromExceptT
|
||||||
|
#endif
|
||||||
|
-- ** Functions based on <https://hackage.haskell.org/package/mmorph mmorph>
|
||||||
|
, hoistNat
|
||||||
|
, embedNat
|
||||||
|
, squashNat
|
||||||
|
, generalizeNat
|
||||||
|
|
||||||
|
|
||||||
-- * Default error type
|
-- * Default error type
|
||||||
, ServantErr(..)
|
, ServantErr(..)
|
||||||
|
@ -62,8 +82,8 @@ import Data.Proxy (Proxy)
|
||||||
import Network.Wai (Application)
|
import Network.Wai (Application)
|
||||||
import Servant.API (Canonicalize, canonicalize)
|
import Servant.API (Canonicalize, canonicalize)
|
||||||
import Servant.Server.Internal
|
import Servant.Server.Internal
|
||||||
import Servant.Server.Internal.ServantErr
|
|
||||||
import Servant.Server.Internal.Enter
|
import Servant.Server.Internal.Enter
|
||||||
|
import Servant.Server.Internal.ServantErr
|
||||||
|
|
||||||
|
|
||||||
-- * Implementing Servers
|
-- * Implementing Servers
|
||||||
|
@ -88,5 +108,30 @@ import Servant.Server.Internal.Enter
|
||||||
-- >
|
-- >
|
||||||
-- > main :: IO ()
|
-- > main :: IO ()
|
||||||
-- > main = Network.Wai.Handler.Warp.run 8080 app
|
-- > main = Network.Wai.Handler.Warp.run 8080 app
|
||||||
|
--
|
||||||
serve :: HasServer (Canonicalize layout) => Proxy layout -> Server layout -> Application
|
serve :: HasServer (Canonicalize layout) => Proxy layout -> Server layout -> Application
|
||||||
serve p server = toApplication (route (canonicalize p) server)
|
serve p server = toApplication (route (canonicalize p) server)
|
||||||
|
|
||||||
|
|
||||||
|
-- Documentation
|
||||||
|
|
||||||
|
-- $enterDoc
|
||||||
|
-- Sometimes our cherished `EitherT` monad isn't quite the type you'd like for
|
||||||
|
-- your handlers. Maybe you want to thread some configuration in a @Reader@
|
||||||
|
-- monad. Or have your types ensure that your handlers don't do any IO. Enter
|
||||||
|
-- `enter`.
|
||||||
|
--
|
||||||
|
-- With `enter`, you can provide a function, wrapped in the `(:~>)` / `Nat`
|
||||||
|
-- newtype, to convert any number of endpoints from one type constructor to
|
||||||
|
-- another. For example
|
||||||
|
--
|
||||||
|
-- >>> import Control.Monad.Reader
|
||||||
|
-- >>> import qualified Control.Category as C
|
||||||
|
-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String
|
||||||
|
-- >>> let readerServer = return 1797 :<|> ask :: ServerT ReaderAPI (Reader String)
|
||||||
|
-- >>> let mainServer = enter (generalizeNat C.. (runReaderTNat "hi")) readerServer :: Server ReaderAPI
|
||||||
|
--
|
||||||
|
|
||||||
|
-- $setup
|
||||||
|
-- >>> import Servant.API
|
||||||
|
-- >>> import Servant.Server
|
||||||
|
|
|
@ -21,7 +21,9 @@ import Control.Monad.Morph
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import qualified Control.Monad.State.Lazy as LState
|
import qualified Control.Monad.State.Lazy as LState
|
||||||
import qualified Control.Monad.State.Strict as SState
|
import qualified Control.Monad.State.Strict as SState
|
||||||
|
#if MIN_VERSION_mtl(2,2,1)
|
||||||
import Control.Monad.Trans.Either
|
import Control.Monad.Trans.Either
|
||||||
|
#endif
|
||||||
import qualified Control.Monad.Writer.Lazy as LWriter
|
import qualified Control.Monad.Writer.Lazy as LWriter
|
||||||
import qualified Control.Monad.Writer.Strict as SWriter
|
import qualified Control.Monad.Writer.Strict as SWriter
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
|
@ -41,6 +43,8 @@ instance (Enter b arg ret) => Enter (a -> b) arg (a -> ret) where
|
||||||
|
|
||||||
-- ** Useful instances
|
-- ** Useful instances
|
||||||
|
|
||||||
|
-- | A natural transformation from @m@ to @n@. Used to `enter` particular
|
||||||
|
-- datatypes.
|
||||||
newtype m :~> n = Nat { unNat :: forall a. m a -> n a} deriving Typeable
|
newtype m :~> n = Nat { unNat :: forall a. m a -> n a} deriving Typeable
|
||||||
|
|
||||||
instance C.Category (:~>) where
|
instance C.Category (:~>) where
|
||||||
|
@ -50,8 +54,9 @@ instance C.Category (:~>) where
|
||||||
instance Enter (m a) (m :~> n) (n a) where
|
instance Enter (m a) (m :~> n) (n a) where
|
||||||
enter (Nat f) = f
|
enter (Nat f) = f
|
||||||
|
|
||||||
liftNat :: (MonadTrans t, Monad m) => m :~> t m
|
-- | Like `lift`.
|
||||||
liftNat = Nat lift
|
liftNat :: (Control.Monad.Morph.MonadTrans t, Monad m) => m :~> t m
|
||||||
|
liftNat = Nat Control.Monad.Morph.lift
|
||||||
|
|
||||||
runReaderTNat :: r -> (ReaderT r m :~> m)
|
runReaderTNat :: r -> (ReaderT r m :~> m)
|
||||||
runReaderTNat a = Nat (`runReaderT` a)
|
runReaderTNat a = Nat (`runReaderT` a)
|
||||||
|
@ -86,11 +91,14 @@ fromExceptT = Nat $ \x -> EitherT $ runExceptT x
|
||||||
hoistNat :: (MFunctor t, Monad m) => (m :~> n) -> (t m :~> t n)
|
hoistNat :: (MFunctor t, Monad m) => (m :~> n) -> (t m :~> t n)
|
||||||
hoistNat (Nat n) = Nat $ hoist n
|
hoistNat (Nat n) = Nat $ hoist n
|
||||||
|
|
||||||
|
-- | Like @mmorph@'s `embed`.
|
||||||
embedNat :: (MMonad t, Monad n) => (m :~> t n) -> (t m :~> t n)
|
embedNat :: (MMonad t, Monad n) => (m :~> t n) -> (t m :~> t n)
|
||||||
embedNat (Nat n) = Nat $ embed n
|
embedNat (Nat n) = Nat $ embed n
|
||||||
|
|
||||||
|
-- | Like @mmorph@'s `squash`.
|
||||||
squashNat :: (Monad m, MMonad t) => t (t m) :~> t m
|
squashNat :: (Monad m, MMonad t) => t (t m) :~> t m
|
||||||
squashNat = Nat squash
|
squashNat = Nat squash
|
||||||
|
|
||||||
|
-- | Like @mmorph@'s `generalize`.
|
||||||
generalizeNat :: Applicative m => Identity :~> m
|
generalizeNat :: Applicative m => Identity :~> m
|
||||||
generalizeNat = Nat (pure . runIdentity)
|
generalizeNat = Nat (pure . runIdentity)
|
||||||
|
|
|
@ -9,7 +9,6 @@ import Control.Monad.Trans.Either
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
import Servant.Server.Internal.Enter
|
|
||||||
|
|
||||||
import Test.Hspec (Spec, describe, it)
|
import Test.Hspec (Spec, describe, it)
|
||||||
import Test.Hspec.Wai (get, matchStatus, post,
|
import Test.Hspec.Wai (get, matchStatus, post,
|
||||||
|
|
Loading…
Reference in a new issue