Use natural-transformation-0.4

servant/servant.cabal

@@ -58,6 +58,7 @@ library
     , http-api-data         >= 0.3  && < 0.4
     , http-media            >= 0.4  && < 0.7
     , http-types            >= 0.8  && < 0.10
+    , natural-transformation >= 0.4 && < 0.5
     , mtl                   >= 2.0  && < 2.3
     , mmorph                >= 1    && < 1.1
     , text                  >= 1    && < 1.3

servant/src/Servant/Utils/Enter.hs

@@ -8,9 +8,13 @@
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE TypeOperators          #-}
 {-# LANGUAGE UndecidableInstances   #-}
-module Servant.Utils.Enter where
+module Servant.Utils.Enter (
+    module Servant.Utils.Enter,
+    -- * natural-transformation re-exports
+    (:~>)(..),
+    ) where
 
-import qualified Control.Category            as C
+import           Control.Natural
 import           Control.Monad.Identity
 import           Control.Monad.Morph
 import           Control.Monad.Reader
@@ -18,7 +22,6 @@ import qualified Control.Monad.State.Lazy    as LState
 import qualified Control.Monad.State.Strict  as SState
 import qualified Control.Monad.Writer.Lazy   as LWriter
 import qualified Control.Monad.Writer.Strict as SWriter
-import           Data.Typeable
 import           Prelude                     ()
 import           Prelude.Compat
 
@@ -38,57 +41,49 @@ 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
-    id = Nat id
-    Nat f . Nat g = Nat (f . g)
-
 instance Enter (m a) (m :~> n) (n a) where
-    enter (Nat f) = f
+    enter (NT f) = f
 
 -- | Like `lift`.
 liftNat :: (Control.Monad.Morph.MonadTrans t, Monad m) => m :~> t m
-liftNat = Nat Control.Monad.Morph.lift
+liftNat = NT Control.Monad.Morph.lift
 
 runReaderTNat :: r -> (ReaderT r m :~> m)
-runReaderTNat a = Nat (`runReaderT` a)
+runReaderTNat a = NT (`runReaderT` a)
 
 evalStateTLNat :: Monad m => s -> (LState.StateT s m :~> m)
-evalStateTLNat a = Nat (`LState.evalStateT` a)
+evalStateTLNat a = NT (`LState.evalStateT` a)
 
 evalStateTSNat :: Monad m => s -> (SState.StateT s m :~> m)
-evalStateTSNat a = Nat (`SState.evalStateT` a)
+evalStateTSNat a = NT (`SState.evalStateT` a)
 
 -- | Log the contents of `SWriter.WriterT` with the function provided as the
 -- first argument, and return the value of the @WriterT@ computation
 logWriterTSNat :: MonadIO m => (w -> IO ()) -> (SWriter.WriterT w m :~> m)
-logWriterTSNat logger = Nat $ \x -> do
+logWriterTSNat logger = NT $ \x -> do
     (a, w) <- SWriter.runWriterT x
     liftIO $ logger w
     return a
 
 -- | Like `logWriterTSNat`, but for strict @WriterT@.
 logWriterTLNat :: MonadIO m => (w -> IO ()) -> (LWriter.WriterT w m :~> m)
-logWriterTLNat logger = Nat $ \x -> do
+logWriterTLNat logger = NT $ \x -> do
     (a, w) <- LWriter.runWriterT x
     liftIO $ logger w
     return a
 
 -- | Like @mmorph@'s `hoist`.
 hoistNat :: (MFunctor t, Monad m) => (m :~> n) ->  (t m :~> t n)
-hoistNat (Nat n) = Nat $ hoist n
+hoistNat (NT n) = NT $ hoist n
 
 -- | Like @mmorph@'s `embed`.
 embedNat :: (MMonad t, Monad n) => (m :~> t n) -> (t m :~> t n)
-embedNat (Nat n) = Nat $ embed n
+embedNat (NT n) = NT $ embed n
 
 -- | Like @mmorph@'s `squash`.
 squashNat :: (Monad m, MMonad t) => t (t m) :~> t m
-squashNat = Nat squash
+squashNat = NT squash
 
 -- | Like @mmorph@'s `generalize`.
 generalizeNat :: Applicative m => Identity :~> m
-generalizeNat = Nat (pure . runIdentity)
+generalizeNat = NT (pure . runIdentity)

stack-ghc-7.8.4.yaml

@@ -15,6 +15,7 @@ extra-deps:
 - hspec-discover-2.2.3
 - hspec-expectations-0.7.2
 - http-api-data-0.3
+- natural-transformation-0.4
 - primitive-0.6.1.0
 - should-not-typecheck-2.1.0
 - time-locale-compat-0.1.1.1

stack-ghc-8.0.1.yaml

@@ -8,4 +8,5 @@ packages:
 extra-deps:
 - http-api-data-0.3
 - uri-bytestring-0.2.2.0
+- natural-transformation-0.4
 flags: {}

stack.yaml

@@ -9,4 +9,5 @@ packages:
 extra-deps:
 - http-api-data-0.3
 - servant-js-0.9 # needed for tutorial
+- natural-transformation-0.4
 resolver: lts-6.0