From 7150f2b60318660aafe04e935623db51c21caeae Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 24 Jun 2018 22:25:51 +0300 Subject: [PATCH] Remove Servant.Utils.Enter --- servant/servant.cabal | 3 - servant/src/Servant/Utils/Enter.hs | 122 ------------------------ servant/test/Servant/Utils/EnterSpec.hs | 33 ------- 3 files changed, 158 deletions(-) delete mode 100644 servant/src/Servant/Utils/Enter.hs delete mode 100644 servant/test/Servant/Utils/EnterSpec.hs diff --git a/servant/servant.cabal b/servant/servant.cabal index 6cf94bdb..f18fad5a 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -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: diff --git a/servant/src/Servant/Utils/Enter.hs b/servant/src/Servant/Utils/Enter.hs deleted file mode 100644 index 80c073c3..00000000 --- a/servant/src/Servant/Utils/Enter.hs +++ /dev/null @@ -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) diff --git a/servant/test/Servant/Utils/EnterSpec.hs b/servant/test/Servant/Utils/EnterSpec.hs deleted file mode 100644 index 324bac01..00000000 --- a/servant/test/Servant/Utils/EnterSpec.hs +++ /dev/null @@ -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 ()