Merge pull request #635 from phadej/natural-transformation-0.4

Use natural-transformation-0.4

Author: jkarni

doc/tutorial/Server.lhs

@@ -1044,17 +1044,17 @@ If we have a function that gets us from an `m a` to an `n a`, for any `a`, what
 do we have?
 
 ``` haskell ignore
-newtype m :~> n = Nat { unNat :: forall a. m a -> n a}
+newtype m :~> n = NT { ($$) :: forall a. m a -> n a}
 ```
 
 For example:
 
 ``` haskell
-listToMaybeNat :: [] :~> Maybe
-listToMaybeNat = Nat listToMaybe  -- from Data.Maybe
+listToMaybeNT :: [] :~> Maybe
+listToMaybeNT = NT listToMaybe  -- from Data.Maybe
 ```
 
-(`Nat` comes from "natural transformation", in case you're wondering.)
+(`NT` comes from "natural transformation", in case you're wondering.)
 
 So if you want to write handlers using another monad/type than `Handler`, say the `Reader String` monad, the first thing you have to
 prepare is a function:
@@ -1066,14 +1066,14 @@ readerToHandler :: Reader String :~> Handler
 Let's start with `readerToHandler'`. We obviously have to run the `Reader`
 computation by supplying it with a `String`, like `"hi"`. We get an `a` out
 from that and can then just `return` it into `ExceptT`. We can then just wrap
-that function with the `Nat` constructor to make it have the fancier type.
+that function with the `NT` constructor to make it have the fancier type.
 
 ``` haskell
 readerToHandler' :: forall a. Reader String a -> Handler a
 readerToHandler' r = return (runReader r "hi")
 
 readerToHandler :: Reader String :~> Handler
-readerToHandler = Nat readerToHandler'
+readerToHandler = NT readerToHandler'
 ```
 
 We can write some simple webservice with the handlers running in `Reader String`.

servant/CHANGELOG.md

@@ -1,3 +1,8 @@
+0.10
+------
+
+* Use `NT` from `natural-transformation` for `Enter`
+
 0.9.1
 ------
 

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,17 +8,20 @@
 {-# 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
 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