@@ -8,9 +8,13 @@
88{-# LANGUAGE TypeFamilies #-}
99{-# LANGUAGE TypeOperators #-}
1010{-# LANGUAGE UndecidableInstances #-}
11−module Servant.Utils.Enter where
11+module Servant.Utils.Enter (
12+ module Servant.Utils.Enter,
13+ -- * natural-transformation re-exports
14+ (:~>)(..),
15+ ) where
1216
13−import qualified Control.Category as C
17+import Control.Natural
1418import Control.Monad.Identity
1519import Control.Monad.Morph
1620import Control.Monad.Reader
@@ -18,7 +22,6 @@ import qualified Control.Monad.State.Lazy as LState
1822import qualified Control.Monad.State.Strict as SState
1923import qualified Control.Monad.Writer.Lazy as LWriter
2024import qualified Control.Monad.Writer.Strict as SWriter
21−import Data.Typeable
2225import Prelude ()
2326import Prelude.Compat
2427
@@ -38,57 +41,49 @@ instance (Enter b arg ret) => Enter (a -> b) arg (a -> ret) where
3841
3942-- ** Useful instances
4043
41−-- | A natural transformation from @m@ to @n@. Used to `enter` particular
42−-- datatypes.
43−newtype m :~> n = Nat { unNat :: forall a. m a -> n a} deriving Typeable
44−
45−instance C.Category (:~>) where
46− id = Nat id
47− Nat f . Nat g = Nat (f . g)
48−
4944instance Enter (m a) (m :~> n) (n a) where
50− enter (Nat f) = f
45+ enter (NT f) = f
5146
5247-- | Like `lift`.
5348liftNat :: (Control.Monad.Morph.MonadTrans t, Monad m) => m :~> t m
54−liftNat = Nat Control.Monad.Morph.lift
49+liftNat = NT Control.Monad.Morph.lift
5550
5651runReaderTNat :: r -> (ReaderT r m :~> m)
57−runReaderTNat a = Nat (`runReaderT` a)
52+runReaderTNat a = NT (`runReaderT` a)
5853
5954evalStateTLNat :: Monad m => s -> (LState.StateT s m :~> m)
60−evalStateTLNat a = Nat (`LState.evalStateT` a)
55+evalStateTLNat a = NT (`LState.evalStateT` a)
6156
6257evalStateTSNat :: Monad m => s -> (SState.StateT s m :~> m)
63−evalStateTSNat a = Nat (`SState.evalStateT` a)
58+evalStateTSNat a = NT (`SState.evalStateT` a)
6459
6560-- | Log the contents of `SWriter.WriterT` with the function provided as the
6661-- first argument, and return the value of the @WriterT@ computation
6762logWriterTSNat :: MonadIO m => (w -> IO ()) -> (SWriter.WriterT w m :~> m)
68−logWriterTSNat logger = Nat $ \x -> do
63+logWriterTSNat logger = NT $ \x -> do
6964 (a, w) <- SWriter.runWriterT x
7065 liftIO $ logger w
7166 return a
7267
7368-- | Like `logWriterTSNat`, but for strict @WriterT@.
7469logWriterTLNat :: MonadIO m => (w -> IO ()) -> (LWriter.WriterT w m :~> m)
75−logWriterTLNat logger = Nat $ \x -> do
70+logWriterTLNat logger = NT $ \x -> do
7671 (a, w) <- LWriter.runWriterT x
7772 liftIO $ logger w
7873 return a
7974
8075-- | Like @mmorph@'s `hoist`.
8176hoistNat :: (MFunctor t, Monad m) => (m :~> n) -> (t m :~> t n)
82−hoistNat (Nat n) = Nat $ hoist n
77+hoistNat (NT n) = NT $ hoist n
8378
8479-- | Like @mmorph@'s `embed`.
8580embedNat :: (MMonad t, Monad n) => (m :~> t n) -> (t m :~> t n)
86−embedNat (Nat n) = Nat $ embed n
81+embedNat (NT n) = NT $ embed n
8782
8883-- | Like @mmorph@'s `squash`.
8984squashNat :: (Monad m, MMonad t) => t (t m) :~> t m
90−squashNat = Nat squash
85+squashNat = NT squash
9186
9287-- | Like @mmorph@'s `generalize`.
9388generalizeNat :: Applicative m => Identity :~> m
94−generalizeNat = Nat (pure . runIdentity)
89+generalizeNat = NT (pure . runIdentity)