Better docs for servant-server

servant-server/src/Servant/Server.hs

@@ -1,6 +1,7 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE CPP               #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies      #-}
 
 -- | This module lets you implement 'Server's for defined APIs. You'll
 -- most likely just need 'serve'.
@@ -17,8 +18,27 @@ module Servant.Server
   , ServerT
 
     -- * 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
   , ServantErr(..)
@@ -58,12 +78,12 @@ module Servant.Server
 
   ) where
 
-import Data.Proxy (Proxy)
+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
@@ -88,5 +108,30 @@ import Servant.Server.Internal.Enter
 -- >
 -- > main :: IO ()
 -- > main = Network.Wai.Handler.Warp.run 8080 app
+--
 serve :: HasServer (Canonicalize layout) => Proxy layout -> Server layout -> Application
 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

servant-server/src/Servant/Server/Internal/Enter.hs

@@ -21,7 +21,9 @@ import           Control.Monad.Morph
 import           Control.Monad.Reader
 import qualified Control.Monad.State.Lazy    as LState
 import qualified Control.Monad.State.Strict  as SState
+#if MIN_VERSION_mtl(2,2,1)
 import           Control.Monad.Trans.Either
+#endif
 import qualified Control.Monad.Writer.Lazy   as LWriter
 import qualified Control.Monad.Writer.Strict as SWriter
 import           Data.Typeable
@@ -41,6 +43,8 @@ instance (Enter b arg ret) => Enter (a -> b) arg (a -> ret) where
 
 -- ** 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
 
 instance C.Category (:~>) where
@@ -50,8 +54,9 @@ instance C.Category (:~>) where
 instance Enter (m a) (m :~> n) (n a) where
     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 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 (Nat n) = Nat $ hoist n
 
+-- | Like @mmorph@'s `embed`.
 embedNat :: (MMonad t, Monad n) => (m :~> t n) -> (t m :~> t n)
 embedNat (Nat n) = Nat $ embed n
 
+-- | Like @mmorph@'s `squash`.
 squashNat :: (Monad m, MMonad t) => t (t m) :~> t m
 squashNat = Nat squash
 
+-- | Like @mmorph@'s `generalize`.
 generalizeNat :: Applicative m => Identity :~> m
 generalizeNat = Nat (pure . runIdentity)

servant-server/test/Servant/Server/Internal/EnterSpec.hs

@@ -9,7 +9,6 @@ import           Control.Monad.Trans.Either
 import           Data.Proxy
 import           Servant.API
 import           Servant.Server
-import           Servant.Server.Internal.Enter
 
 import           Test.Hspec                    (Spec, describe, it)
 import           Test.Hspec.Wai                (get, matchStatus, post,