git.iko.soy/servant
on master help sign in
Use natural-transformation-0.4
b1ac9dcOleg Grenrus
servant/servant.cabal+1
compare with master
unifiedsplit
@@ -58,6 +58,7 @@ library
58 , http-api-data >= 0.3 && < 0.4
58 , http-api-data >= 0.3 && < 0.4
59 , http-media >= 0.4 && < 0.7
59 , http-media >= 0.4 && < 0.7
60 , http-types >= 0.8 && < 0.10
60 , http-types >= 0.8 && < 0.10
61+ , natural-transformation >= 0.4 && < 0.5
61 , mtl >= 2.0 && < 2.3
62 , mtl >= 2.0 && < 2.3
62 , mmorph >= 1 && < 1.1
63 , mmorph >= 1 && < 1.1
63 , text >= 1 && < 1.3
64 , text >= 1 && < 1.3
servant/src/Servant/Utils/Enter.hs+17−22
@@ -8,9 +8,13 @@
8{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE TypeOperators #-}
9{-# LANGUAGE TypeOperators #-}
10{-# LANGUAGE UndecidableInstances #-}
10{-# 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
12
16
13−import qualified Control.Category as C
17+import Control.Natural
14import Control.Monad.Identity
18import Control.Monad.Identity
15import Control.Monad.Morph
19import Control.Monad.Morph
16import Control.Monad.Reader
20import Control.Monad.Reader
@@ -18,7 +22,6 @@ import qualified Control.Monad.State.Lazy as LState
18import qualified Control.Monad.State.Strict as SState
22import qualified Control.Monad.State.Strict as SState
19import qualified Control.Monad.Writer.Lazy as LWriter
23import qualified Control.Monad.Writer.Lazy as LWriter
20import qualified Control.Monad.Writer.Strict as SWriter
24import qualified Control.Monad.Writer.Strict as SWriter
21−import Data.Typeable
22import Prelude ()
25import Prelude ()
23import Prelude.Compat
26import Prelude.Compat
24
27
@@ -38,57 +41,49 @@ instance (Enter b arg ret) => Enter (a -> b) arg (a -> ret) where
38
41
39-- ** Useful instances
42-- ** Useful instances
40
43
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−
49instance Enter (m a) (m :~> n) (n a) where
44instance Enter (m a) (m :~> n) (n a) where
50− enter (Nat f) = f
45+ enter (NT f) = f
51
46
52-- | Like `lift`.
47-- | Like `lift`.
53liftNat :: (Control.Monad.Morph.MonadTrans t, Monad m) => m :~> t m
48liftNat :: (Control.Monad.Morph.MonadTrans t, Monad m) => m :~> t m
54−liftNat = Nat Control.Monad.Morph.lift
49+liftNat = NT Control.Monad.Morph.lift
55
50
56runReaderTNat :: r -> (ReaderT r m :~> m)
51runReaderTNat :: r -> (ReaderT r m :~> m)
57−runReaderTNat a = Nat (`runReaderT` a)
52+runReaderTNat a = NT (`runReaderT` a)
58
53
59evalStateTLNat :: Monad m => s -> (LState.StateT s m :~> m)
54evalStateTLNat :: Monad m => s -> (LState.StateT s m :~> m)
60−evalStateTLNat a = Nat (`LState.evalStateT` a)
55+evalStateTLNat a = NT (`LState.evalStateT` a)
61
56
62evalStateTSNat :: Monad m => s -> (SState.StateT s m :~> m)
57evalStateTSNat :: Monad m => s -> (SState.StateT s m :~> m)
63−evalStateTSNat a = Nat (`SState.evalStateT` a)
58+evalStateTSNat a = NT (`SState.evalStateT` a)
64
59
65-- | Log the contents of `SWriter.WriterT` with the function provided as the
60-- | Log the contents of `SWriter.WriterT` with the function provided as the
66-- first argument, and return the value of the @WriterT@ computation
61-- first argument, and return the value of the @WriterT@ computation
67logWriterTSNat :: MonadIO m => (w -> IO ()) -> (SWriter.WriterT w m :~> m)
62logWriterTSNat :: MonadIO m => (w -> IO ()) -> (SWriter.WriterT w m :~> m)
68−logWriterTSNat logger = Nat $ \x -> do
63+logWriterTSNat logger = NT $ \x -> do
69 (a, w) <- SWriter.runWriterT x
64 (a, w) <- SWriter.runWriterT x
70 liftIO $ logger w
65 liftIO $ logger w
71 return a
66 return a
72
67
73-- | Like `logWriterTSNat`, but for strict @WriterT@.
68-- | Like `logWriterTSNat`, but for strict @WriterT@.
74logWriterTLNat :: MonadIO m => (w -> IO ()) -> (LWriter.WriterT w m :~> m)
69logWriterTLNat :: MonadIO m => (w -> IO ()) -> (LWriter.WriterT w m :~> m)
75−logWriterTLNat logger = Nat $ \x -> do
70+logWriterTLNat logger = NT $ \x -> do
76 (a, w) <- LWriter.runWriterT x
71 (a, w) <- LWriter.runWriterT x
77 liftIO $ logger w
72 liftIO $ logger w
78 return a
73 return a
79
74
80-- | Like @mmorph@'s `hoist`.
75-- | Like @mmorph@'s `hoist`.
81hoistNat :: (MFunctor t, Monad m) => (m :~> n) -> (t m :~> t n)
76hoistNat :: (MFunctor t, Monad m) => (m :~> n) -> (t m :~> t n)
82−hoistNat (Nat n) = Nat $ hoist n
77+hoistNat (NT n) = NT $ hoist n
83
78
84-- | Like @mmorph@'s `embed`.
79-- | Like @mmorph@'s `embed`.
85embedNat :: (MMonad t, Monad n) => (m :~> t n) -> (t m :~> t n)
80embedNat :: (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
87
82
88-- | Like @mmorph@'s `squash`.
83-- | Like @mmorph@'s `squash`.
89squashNat :: (Monad m, MMonad t) => t (t m) :~> t m
84squashNat :: (Monad m, MMonad t) => t (t m) :~> t m
90−squashNat = Nat squash
85+squashNat = NT squash
91
86
92-- | Like @mmorph@'s `generalize`.
87-- | Like @mmorph@'s `generalize`.
93generalizeNat :: Applicative m => Identity :~> m
88generalizeNat :: Applicative m => Identity :~> m
94−generalizeNat = Nat (pure . runIdentity)
89+generalizeNat = NT (pure . runIdentity)
stack-ghc-7.8.4.yaml+1
@@ -15,6 +15,7 @@ extra-deps:
15- hspec-discover-2.2.3
15- hspec-discover-2.2.3
16- hspec-expectations-0.7.2
16- hspec-expectations-0.7.2
17- http-api-data-0.3
17- http-api-data-0.3
18+- natural-transformation-0.4
18- primitive-0.6.1.0
19- primitive-0.6.1.0
19- should-not-typecheck-2.1.0
20- should-not-typecheck-2.1.0
20- time-locale-compat-0.1.1.1
21- time-locale-compat-0.1.1.1
stack-ghc-8.0.1.yaml+1
@@ -8,4 +8,5 @@ packages:
8extra-deps:
8extra-deps:
9- http-api-data-0.3
9- http-api-data-0.3
10- uri-bytestring-0.2.2.0
10- uri-bytestring-0.2.2.0
11+- natural-transformation-0.4
11flags: {}
12flags: {}
stack.yaml+1
@@ -9,4 +9,5 @@ packages:
9extra-deps:
9extra-deps:
10- http-api-data-0.3
10- http-api-data-0.3
11- servant-js-0.9 # needed for tutorial
11- servant-js-0.9 # needed for tutorial
12+- natural-transformation-0.4
12resolver: lts-6.0
13resolver: lts-6.0