diff --git a/servant-server/src/Servant/Server/Internal/Enter.hs b/servant-server/src/Servant/Server/Internal/Enter.hs index 0dde0c57..a754704d 100644 --- a/servant-server/src/Servant/Server/Internal/Enter.hs +++ b/servant-server/src/Servant/Server/Internal/Enter.hs @@ -8,9 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#if !MIN_VERSION_base(4,8,0) {-# LANGUAGE OverlappingInstances #-} -#endif module Servant.Server.Internal.Enter where #if !MIN_VERSION_base(4,8,0) @@ -30,14 +28,13 @@ import qualified Control.Monad.Writer.Strict as SWriter import Data.Typeable import Servant.API -class Enter typ arg ret | typ arg -> ret, typ ret -> arg where +class Enter typ arg ret | typ ret -> arg, arg ret -> typ where enter :: arg -> typ -> ret data IsRaw -- ** Servant combinators -instance ( Enter typ1 arg1 ret1 , Enter typ2 arg2 ret2 - , arg1 ~ arg2 +instance ( Enter typ1 arg1 ret1 , Enter typ2 arg1 ret2 ) => Enter (typ1 :<|> typ2) arg1 (ret1 :<|> ret2) where enter e (a :<|> b) = enter e a :<|> enter e b @@ -54,19 +51,12 @@ instance C.Category (:~>) where id = Nat id Nat f . Nat g = Nat (f . g) -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPABLE #-} -#endif - (Raw m' ~ m, Raw n' ~ n) => Enter (m a) (m' :~> n') (n a) where - enter _ (Raw a) = Raw a -instance -#if MIN_VERSION_base(4,8,0) - {-# OVERLAPPING #-} -#endif - Enter (m a) (m :~> n) (n a) where - enter (Nat f) = f +instance Enter (m a) (m :~> n) (n a) where + enter (Nat f) = f + +instance (Raw m' ~ m, Raw n' ~ n) => Enter (m a) (m' :~> n') (n a) where + enter _ (Raw a) = Raw a -- | Like `lift`. liftNat :: (Control.Monad.Morph.MonadTrans t, Monad m) => m :~> t m diff --git a/servant-server/test/Servant/Server/Internal/EnterSpec.hs b/servant-server/test/Servant/Server/Internal/EnterSpec.hs index dfed3759..a6895163 100644 --- a/servant-server/test/Servant/Server/Internal/EnterSpec.hs +++ b/servant-server/test/Servant/Server/Internal/EnterSpec.hs @@ -24,6 +24,15 @@ spec :: Spec spec = describe "module Servant.Server.Enter" $ do enterSpec +type ReaderAPI' = "ep1" :> Get '[JSON] String :<|> "ep2" :> Get '[JSON] String +readerServera' :: Reader String String :<|> Reader String String +readerServera' = ask :<|> ask + +x :: Reader String :~> EitherT ServantErr IO +x = (generalizeNat C.. (runReaderTNat "hi")) +mainServer' :: Server ReaderAPI' +mainServer' = enter x readerServera' + type ReaderAPI = "int" :> Get '[JSON] Int :<|> "string" :> Post '[JSON] String :<|> "static" :> Raw (Reader String) Application