Remove Servant.Utils.Enter
This commit is contained in:
Oleg Grenrus
parent
ae05ef5312
commit
7150f2b603
3 changed files with 0 additions and 158 deletions
|
|
@ -63,7 +63,6 @@ library
|
|||
Servant.API.Verbs
|
||||
Servant.API.WithNamedContext
|
||||
Servant.Utils.Links
|
||||
Servant.Utils.Enter
|
||||
|
||||
-- Bundled with GHC: Lower bound to not force re-installs
|
||||
-- text and mtl are bundled starting with GHC-8.4
|
||||
|
|
@ -89,7 +88,6 @@ library
|
|||
, http-api-data >= 0.3.8.1 && < 0.4
|
||||
, http-media >= 0.7.1.2 && < 0.8
|
||||
, http-types >= 0.12.1 && < 0.13
|
||||
, natural-transformation >= 0.4 && < 0.5
|
||||
, mmorph >= 1.1.2 && < 1.2
|
||||
, tagged >= 0.8.5 && < 0.9
|
||||
, singleton-bool >= 0.1.4 && < 0.2
|
||||
|
|
@ -134,7 +132,6 @@ test-suite spec
|
|||
Servant.API.ContentTypesSpec
|
||||
Servant.API.ResponseHeadersSpec
|
||||
Servant.Utils.LinksSpec
|
||||
Servant.Utils.EnterSpec
|
||||
|
||||
-- Dependencies inherited from the library. No need to specify bounds.
|
||||
build-depends:
|
||||
|
|
|
|||
|
|
@ -1,122 +0,0 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Servant.Utils.Enter {-# DEPRECATED "Use hoistServer or hoistServerWithContext from servant-server" #-} (
|
||||
module Servant.Utils.Enter,
|
||||
-- * natural-transformation re-exports
|
||||
(:~>)(..),
|
||||
) where
|
||||
|
||||
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 Control.Natural
|
||||
import Data.Tagged
|
||||
(Tagged, retag)
|
||||
import Prelude ()
|
||||
import Prelude.Compat
|
||||
import Servant.API
|
||||
|
||||
-- | Helper type family to state the 'Enter' symmetry.
|
||||
type family Entered m n api where
|
||||
Entered m n (a -> api) = a -> Entered m n api
|
||||
Entered m n (m a) = n a
|
||||
Entered m n (api1 :<|> api2) = Entered m n api1 :<|> Entered m n api2
|
||||
Entered m n (Tagged m a) = Tagged n a
|
||||
|
||||
class
|
||||
( Entered m n typ ~ ret
|
||||
, Entered n m ret ~ typ
|
||||
) => Enter typ m n ret | typ m n -> ret, ret m n -> typ, ret typ m -> n, ret typ n -> m
|
||||
where
|
||||
-- | Map the leafs of an API type.
|
||||
enter :: (m :~> n) -> typ -> ret
|
||||
|
||||
-- ** Servant combinators
|
||||
|
||||
instance
|
||||
( Enter typ1 m1 n1 ret1, Enter typ2 m2 n2 ret2
|
||||
, m1 ~ m2, n1 ~ n2
|
||||
, Entered m1 n1 (typ1 :<|> typ2) ~ (ret1 :<|> ret2)
|
||||
, Entered n1 m1 (ret1 :<|> ret2) ~ (typ1 :<|> typ2)
|
||||
) => Enter (typ1 :<|> typ2) m1 n1 (ret1 :<|> ret2)
|
||||
where
|
||||
enter e (a :<|> b) = enter e a :<|> enter e b
|
||||
|
||||
instance
|
||||
( Enter typ m n ret
|
||||
, Entered m n (a -> typ) ~ (a -> ret)
|
||||
, Entered n m (a -> ret) ~ (a -> typ)
|
||||
) => Enter (a -> typ) m n (a -> ret)
|
||||
where
|
||||
enter arg f a = enter arg (f a)
|
||||
|
||||
-- ** Leaf instances
|
||||
|
||||
instance
|
||||
( Entered m n (Tagged m a) ~ Tagged n a
|
||||
, Entered n m (Tagged n a) ~ Tagged m a
|
||||
) => Enter (Tagged m a) m n (Tagged n a)
|
||||
where
|
||||
enter _ = retag
|
||||
|
||||
instance
|
||||
( Entered m n (m a) ~ n a
|
||||
, Entered n m (n a) ~ m a
|
||||
) => Enter (m a) m n (n a)
|
||||
where
|
||||
enter (NT f) = f
|
||||
|
||||
-- | Like `lift`.
|
||||
liftNat :: (Control.Monad.Morph.MonadTrans t, Monad m) => m :~> t m
|
||||
liftNat = NT Control.Monad.Morph.lift
|
||||
|
||||
runReaderTNat :: r -> (ReaderT r m :~> m)
|
||||
runReaderTNat a = NT (`runReaderT` a)
|
||||
|
||||
evalStateTLNat :: Monad m => s -> (LState.StateT s m :~> m)
|
||||
evalStateTLNat a = NT (`LState.evalStateT` a)
|
||||
|
||||
evalStateTSNat :: Monad m => s -> (SState.StateT s m :~> m)
|
||||
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 = NT $ \x -> do
|
||||
(a, w) <- SWriter.runWriterT x
|
||||
liftIO $ logger w
|
||||
return a
|
||||
|
||||
-- | Like `logWriterTSNat`, but for lazy @WriterT@.
|
||||
logWriterTLNat :: MonadIO m => (w -> IO ()) -> (LWriter.WriterT w m :~> m)
|
||||
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 (NT n) = NT $ hoist n
|
||||
|
||||
-- | Like @mmorph@'s `embed`.
|
||||
embedNat :: (MMonad t, Monad n) => (m :~> t n) -> (t m :~> t n)
|
||||
embedNat (NT n) = NT $ embed n
|
||||
|
||||
-- | Like @mmorph@'s `squash`.
|
||||
squashNat :: (Monad m, MMonad t) => t (t m) :~> t m
|
||||
squashNat = NT squash
|
||||
|
||||
-- | Like @mmorph@'s `generalize`.
|
||||
generalizeNat :: Applicative m => Identity :~> m
|
||||
generalizeNat = NT (pure . runIdentity)
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# OPTIONS_GHC -fno-warn-deprecations #-}
|
||||
module Servant.Utils.EnterSpec where
|
||||
|
||||
import Test.Hspec (Spec)
|
||||
|
||||
import Servant.API
|
||||
import Servant.Utils.Enter
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- https://github.com/haskell-servant/servant/issues/734
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- This didn't fail if executed in GHCi; cannot have as a doctest.
|
||||
|
||||
data App a
|
||||
|
||||
f :: App :~> App
|
||||
f = NT id
|
||||
|
||||
server :: App Int :<|> (String -> App Bool)
|
||||
server = undefined
|
||||
|
||||
server' :: App Int :<|> (String -> App Bool)
|
||||
server' = enter f server
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Spec
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
spec :: Spec
|
||||
spec = return ()
|
||||
Loading…
Reference in a new issue