{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Servant.Pipes (
PipesToSourceIO (..),
) where
import Control.Monad.IO.Class
(MonadIO (..))
import Control.Monad.Trans.Control
(liftBaseWith)
import Pipes
(ListT (..))
import Pipes.Internal
(Proxy (..), X, closed)
import Pipes.Safe
(SafeT, runSafeT)
import Servant.API.Stream
import qualified Servant.Types.SourceT as S
class PipesToSourceIO m where
pipesToSourceIO :: Proxy X () () b m () -> SourceIO b
instance PipesToSourceIO IO where
pipesToSourceIO :: Proxy X () () b IO () -> SourceIO b
pipesToSourceIO Proxy X () () b IO ()
ma = (forall b. (StepT IO b -> IO b) -> IO b) -> SourceIO b
forall (m :: * -> *) a.
(forall b. (StepT m a -> m b) -> m b) -> SourceT m a
S.SourceT ((StepT IO b -> IO b) -> StepT IO b -> IO b
forall a b. (a -> b) -> a -> b
$ Proxy X () () b IO () -> StepT IO b
forall b. Proxy X () () b IO () -> StepT IO b
go Proxy X () () b IO ()
ma) where
go :: Proxy X () () b IO () -> S.StepT IO b
go :: Proxy X () () b IO () -> StepT IO b
go (Pure ()) = StepT IO b
forall (m :: * -> *) a. StepT m a
S.Stop
go (M IO (Proxy X () () b IO ())
p) = IO (StepT IO b) -> StepT IO b
forall (m :: * -> *) a. m (StepT m a) -> StepT m a
S.Effect ((Proxy X () () b IO () -> StepT IO b)
-> IO (Proxy X () () b IO ()) -> IO (StepT IO b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Proxy X () () b IO () -> StepT IO b
forall b. Proxy X () () b IO () -> StepT IO b
go IO (Proxy X () () b IO ())
p)
go (Request X
v () -> Proxy X () () b IO ()
_) = X -> StepT IO b
forall a. X -> a
closed X
v
go (Respond b
b () -> Proxy X () () b IO ()
n) = b -> StepT IO b -> StepT IO b
forall (m :: * -> *) a. a -> StepT m a -> StepT m a
S.Yield b
b (Proxy X () () b IO () -> StepT IO b
forall b. Proxy X () () b IO () -> StepT IO b
go (() -> Proxy X () () b IO ()
n ()))
instance m ~ IO => PipesToSourceIO (SafeT m) where
pipesToSourceIO :: Proxy X () () b (SafeT m) () -> SourceIO b
pipesToSourceIO Proxy X () () b (SafeT m) ()
ma =
(forall b. (StepT IO b -> IO b) -> IO b) -> SourceIO b
forall (m :: * -> *) a.
(forall b. (StepT m a -> m b) -> m b) -> SourceT m a
S.SourceT ((forall b. (StepT IO b -> IO b) -> IO b) -> SourceIO b)
-> (forall b. (StepT IO b -> IO b) -> IO b) -> SourceIO b
forall a b. (a -> b) -> a -> b
$ \StepT IO b -> IO b
k ->
SafeT IO b -> IO b
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT IO b -> IO b) -> SafeT IO b -> IO b
forall a b. (a -> b) -> a -> b
$ (RunInBase (SafeT IO) IO -> IO b) -> SafeT IO b
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase (SafeT IO) IO -> IO b) -> SafeT IO b)
-> (RunInBase (SafeT IO) IO -> IO b) -> SafeT IO b
forall a b. (a -> b) -> a -> b
$ \RunInBase (SafeT IO) IO
runSafe ->
StepT IO b -> IO b
k ((forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) () -> StepT IO b
forall b.
(forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) () -> StepT IO b
go forall x. SafeT m x -> m x
RunInBase (SafeT IO) IO
runSafe Proxy X () () b (SafeT m) ()
ma)
where
go :: (forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) ()
-> S.StepT IO b
go :: (forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) () -> StepT IO b
go forall x. SafeT m x -> m x
_ (Pure ()) = StepT IO b
forall (m :: * -> *) a. StepT m a
S.Stop
go forall x. SafeT m x -> m x
runSafe (M SafeT m (Proxy X () () b (SafeT m) ())
p) = m (StepT m b) -> StepT m b
forall (m :: * -> *) a. m (StepT m a) -> StepT m a
S.Effect (m (StepT m b) -> StepT m b) -> m (StepT m b) -> StepT m b
forall a b. (a -> b) -> a -> b
$ SafeT m (StepT IO b) -> m (StepT IO b)
forall x. SafeT m x -> m x
runSafe (SafeT m (StepT IO b) -> m (StepT IO b))
-> SafeT m (StepT IO b) -> m (StepT IO b)
forall a b. (a -> b) -> a -> b
$ (Proxy X () () b (SafeT m) () -> StepT IO b)
-> SafeT m (Proxy X () () b (SafeT m) ()) -> SafeT m (StepT IO b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) () -> StepT IO b
forall b.
(forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) () -> StepT IO b
go forall x. SafeT m x -> m x
runSafe) SafeT m (Proxy X () () b (SafeT m) ())
p
go forall x. SafeT m x -> m x
_ (Request X
v () -> Proxy X () () b (SafeT m) ()
_) = X -> StepT IO b
forall a. X -> a
closed X
v
go forall x. SafeT m x -> m x
runSafe (Respond b
b () -> Proxy X () () b (SafeT m) ()
n) = b -> StepT IO b -> StepT IO b
forall (m :: * -> *) a. a -> StepT m a -> StepT m a
S.Yield b
b ((forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) () -> StepT IO b
forall b.
(forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) () -> StepT IO b
go forall x. SafeT m x -> m x
runSafe (() -> Proxy X () () b (SafeT m) ()
n ()))
instance (PipesToSourceIO m, a' ~ X, a ~ (), b' ~ (), r ~ ())
=> ToSourceIO b (Proxy a' a b' b m r)
where
toSourceIO :: Proxy a' a b' b m r -> SourceIO b
toSourceIO = Proxy a' a b' b m r -> SourceIO b
forall (m :: * -> *) b.
PipesToSourceIO m =>
Proxy X () () b m () -> SourceIO b
pipesToSourceIO
instance PipesToSourceIO m => ToSourceIO a (ListT m a) where
toSourceIO :: ListT m a -> SourceIO a
toSourceIO = Proxy X () () a m () -> SourceIO a
forall (m :: * -> *) b.
PipesToSourceIO m =>
Proxy X () () b m () -> SourceIO b
pipesToSourceIO (Proxy X () () a m () -> SourceIO a)
-> (ListT m a -> Proxy X () () a m ()) -> ListT m a -> SourceIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m a -> Proxy X () () a m ()
forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate
instance (MonadIO m, a' ~ X, a ~ (), b' ~ (), r ~ ())
=> FromSourceIO b (Proxy a' a b' b m r)
where
fromSourceIO :: SourceIO b -> Proxy a' a b' b m r
fromSourceIO SourceIO b
src = m (Proxy X () () b m ()) -> Proxy X () () b m ()
forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M (m (Proxy X () () b m ()) -> Proxy X () () b m ())
-> m (Proxy X () () b m ()) -> Proxy X () () b m ()
forall a b. (a -> b) -> a -> b
$ IO (Proxy X () () b m ()) -> m (Proxy X () () b m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Proxy X () () b m ()) -> m (Proxy X () () b m ()))
-> IO (Proxy X () () b m ()) -> m (Proxy X () () b m ())
forall a b. (a -> b) -> a -> b
$ SourceIO b
-> (StepT IO b -> IO (Proxy X () () b m ()))
-> IO (Proxy X () () b m ())
forall (m :: * -> *) a.
SourceT m a -> forall b. (StepT m a -> m b) -> m b
S.unSourceT SourceIO b
src (Proxy X () () b m () -> IO (Proxy X () () b m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Proxy X () () b m () -> IO (Proxy X () () b m ()))
-> (StepT IO b -> Proxy X () () b m ())
-> StepT IO b
-> IO (Proxy X () () b m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StepT IO b -> Proxy X () () b m ()
go) where
go :: S.StepT IO b -> Proxy X () () b m ()
go :: StepT IO b -> Proxy X () () b m ()
go StepT IO b
S.Stop = () -> Proxy X () () b m ()
forall a' a b' b (m :: * -> *) r. r -> Proxy a' a b' b m r
Pure ()
go (S.Error String
err) = m (Proxy X () () b m ()) -> Proxy X () () b m ()
forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M (IO (Proxy X () () b m ()) -> m (Proxy X () () b m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Proxy X () () b m ())
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err))
go (S.Skip StepT IO b
s) = StepT IO b -> Proxy X () () b m ()
go StepT IO b
s
go (S.Effect IO (StepT IO b)
ms) = m (Proxy X () () b m ()) -> Proxy X () () b m ()
forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M (IO (Proxy X () () b m ()) -> m (Proxy X () () b m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((StepT IO b -> Proxy X () () b m ())
-> IO (StepT IO b) -> IO (Proxy X () () b m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StepT IO b -> Proxy X () () b m ()
go IO (StepT IO b)
ms))
go (S.Yield b
x StepT IO b
s) = b -> (() -> Proxy X () () b m ()) -> Proxy X () () b m ()
forall a' a b' b (m :: * -> *) r.
b -> (b' -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
Respond b
x (Proxy X () () b m () -> () -> Proxy X () () b m ()
forall a b. a -> b -> a
const (StepT IO b -> Proxy X () () b m ()
go StepT IO b
s))
{-# SPECIALIZE INLINE fromSourceIO :: SourceIO x -> Proxy X () () x IO () #-}
instance MonadIO m => FromSourceIO a (ListT m a) where
fromSourceIO :: SourceIO a -> ListT m a
fromSourceIO = Producer a m () -> ListT m a
forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (Producer a m () -> ListT m a)
-> (SourceIO a -> Producer a m ()) -> SourceIO a -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceIO a -> Producer a m ()
forall chunk a. FromSourceIO chunk a => SourceIO chunk -> a
fromSourceIO