boom
This commit is contained in:
parent
d1d87f391a
commit
745ff985b6
2 changed files with 16 additions and 17 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue