This commit is contained in:
Julian K. Arni 2015-09-30 22:51:56 +02:00 committed by Brandon Martin
parent d1d87f391a
commit 745ff985b6
2 changed files with 16 additions and 17 deletions

View file

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

View file

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