Better docs for servant-server

This commit is contained in:
Julian K. Arni 2015-05-03 01:28:13 +02:00
parent 3b4b958110
commit bdf6d9aa48
3 changed files with 65 additions and 13 deletions

View file

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

View file

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

View file

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