@@ -1,122 +0,0 @@
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE FunctionalDependencies #-}
4−{-# LANGUAGE MultiParamTypeClasses #-}
5−{-# LANGUAGE RankNTypes #-}
6−{-# LANGUAGE ScopedTypeVariables #-}
7−{-# LANGUAGE TypeFamilies #-}
8−{-# LANGUAGE TypeOperators #-}
9−{-# LANGUAGE UndecidableInstances #-}
10−module Servant.Utils.Enter {-# DEPRECATED "Use hoistServer or hoistServerWithContext from servant-server" #-} (
11− module Servant.Utils.Enter,
12− -- * natural-transformation re-exports
16−import Control.Monad.Identity
17−import Control.Monad.Morph
18−import Control.Monad.Reader
19−import qualified Control.Monad.State.Lazy as LState
20−import qualified Control.Monad.State.Strict as SState
21−import qualified Control.Monad.Writer.Lazy as LWriter
22−import qualified Control.Monad.Writer.Strict as SWriter
23−import Control.Natural
30−-- | Helper type family to state the 'Enter' symmetry.
31−type family Entered m n api where
32− Entered m n (a -> api) = a -> Entered m n api
33− Entered m n (m a) = n a
34− Entered m n (api1 :<|> api2) = Entered m n api1 :<|> Entered m n api2
35− Entered m n (Tagged m a) = Tagged n a
38− ( Entered m n typ ~ ret
39− , Entered n m ret ~ typ
40− ) => Enter typ m n ret | typ m n -> ret, ret m n -> typ, ret typ m -> n, ret typ n -> m
42− -- | Map the leafs of an API type.
43− enter :: (m :~> n) -> typ -> ret
45−-- ** Servant combinators
48− ( Enter typ1 m1 n1 ret1, Enter typ2 m2 n2 ret2
50− , Entered m1 n1 (typ1 :<|> typ2) ~ (ret1 :<|> ret2)
51− , Entered n1 m1 (ret1 :<|> ret2) ~ (typ1 :<|> typ2)
52− ) => Enter (typ1 :<|> typ2) m1 n1 (ret1 :<|> ret2)
54− enter e (a :<|> b) = enter e a :<|> enter e b
58− , Entered m n (a -> typ) ~ (a -> ret)
59− , Entered n m (a -> ret) ~ (a -> typ)
60− ) => Enter (a -> typ) m n (a -> ret)
62− enter arg f a = enter arg (f a)
67− ( Entered m n (Tagged m a) ~ Tagged n a
68− , Entered n m (Tagged n a) ~ Tagged m a
69− ) => Enter (Tagged m a) m n (Tagged n a)
74− ( Entered m n (m a) ~ n a
75− , Entered n m (n a) ~ m a
76− ) => Enter (m a) m n (n a)
81−liftNat :: (Control.Monad.Morph.MonadTrans t, Monad m) => m :~> t m
82−liftNat = NT Control.Monad.Morph.lift
84−runReaderTNat :: r -> (ReaderT r m :~> m)
85−runReaderTNat a = NT (`runReaderT` a)
87−evalStateTLNat :: Monad m => s -> (LState.StateT s m :~> m)
88−evalStateTLNat a = NT (`LState.evalStateT` a)
90−evalStateTSNat :: Monad m => s -> (SState.StateT s m :~> m)
91−evalStateTSNat a = NT (`SState.evalStateT` a)
93−-- | Log the contents of `SWriter.WriterT` with the function provided as the
94−-- first argument, and return the value of the @WriterT@ computation
95−logWriterTSNat :: MonadIO m => (w -> IO ()) -> (SWriter.WriterT w m :~> m)
96−logWriterTSNat logger = NT $ \x -> do
97− (a, w) <- SWriter.runWriterT x
101−-- | Like `logWriterTSNat`, but for lazy @WriterT@.
102−logWriterTLNat :: MonadIO m => (w -> IO ()) -> (LWriter.WriterT w m :~> m)
103−logWriterTLNat logger = NT $ \x -> do
104− (a, w) <- LWriter.runWriterT x
108−-- | Like @mmorph@'s `hoist`.
109−hoistNat :: (MFunctor t, Monad m) => (m :~> n) -> (t m :~> t n)
110−hoistNat (NT n) = NT $ hoist n
112−-- | Like @mmorph@'s `embed`.
113−embedNat :: (MMonad t, Monad n) => (m :~> t n) -> (t m :~> t n)
114−embedNat (NT n) = NT $ embed n
116−-- | Like @mmorph@'s `squash`.
117−squashNat :: (Monad m, MMonad t) => t (t m) :~> t m
118−squashNat = NT squash
120−-- | Like @mmorph@'s `generalize`.
121−generalizeNat :: Applicative m => Identity :~> m
122−generalizeNat = NT (pure . runIdentity)