eeva/servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Remove Servant.Utils.Enter

Browse Source
This commit is contained in:
Oleg Grenrus 2018-06-24 22:25:51 +03:00
parent ae05ef5312
commit 7150f2b603
3 changed files with 0 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
servant/servant.cabal
View File

@ -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:

122
servant/src/Servant/Utils/Enter.hs
View File

@ -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)

33
servant/test/Servant/Utils/EnterSpec.hs
View File

@ -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 ()