boom

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
+instance ( Enter typ1 arg1 ret1 , Enter typ2 arg1 ret2
-         , arg1 ~ arg2
          ) => Enter (typ1 :<|> typ2) arg1 (ret1 :<|> ret2) where
     enter e (a :<|> b) = enter e a :<|> enter e b
 
@@ -54,20 +51,13 @@ 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
+instance Enter (m a) (m :~> n) (n a)  where
-#if MIN_VERSION_base(4,8,0)
-    {-# OVERLAPPING #-}
-#endif
-    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
 liftNat = Nat Control.Monad.Morph.lift

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