{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Servant.Conduit (
ConduitToSourceIO (..),
) where
import Control.Monad.IO.Class
(MonadIO (..))
import Control.Monad.IO.Unlift
(MonadUnliftIO (..))
import Control.Monad.Trans.Resource
(ResourceT, runResourceT)
import Data.Conduit.Internal
(ConduitT (..), Pipe (..))
import Servant.API.Stream
import qualified Servant.Types.SourceT as S
class ConduitToSourceIO m where
conduitToSourceIO :: ConduitT i o m () -> SourceIO o
instance ConduitToSourceIO IO where
conduitToSourceIO :: forall i o. ConduitT i o IO () -> SourceIO o
conduitToSourceIO (ConduitT forall b. (() -> Pipe i i o () IO b) -> Pipe i i o () IO b
con) = (forall b. (StepT IO o -> IO b) -> IO b) -> SourceT IO o
forall (m :: * -> *) a.
(forall b. (StepT m a -> m b) -> m b) -> SourceT m a
S.SourceT ((StepT IO o -> IO b) -> StepT IO o -> IO b
forall a b. (a -> b) -> a -> b
$ Pipe i i o () IO () -> StepT IO o
forall {m :: * -> *} {l} {i} {a}.
Functor m =>
Pipe l i a () m () -> StepT m a
go ((() -> Pipe i i o () IO ()) -> Pipe i i o () IO ()
forall b. (() -> Pipe i i o () IO b) -> Pipe i i o () IO b
con () -> Pipe i i o () IO ()
forall l i o u (m :: * -> *) r. r -> Pipe l i o u m r
Done)) where
go :: Pipe l i a () m () -> StepT m a
go Pipe l i a () m ()
p0 = case Pipe l i a () m ()
p0 of
Done () -> StepT m a
forall (m :: * -> *) a. StepT m a
S.Stop
HaveOutput Pipe l i a () m ()
p a
o -> a -> StepT m a -> StepT m a
forall (m :: * -> *) a. a -> StepT m a -> StepT m a
S.Yield a
o (Pipe l i a () m () -> StepT m a
go Pipe l i a () m ()
p)
NeedInput i -> Pipe l i a () m ()
_ip () -> Pipe l i a () m ()
up -> StepT m a -> StepT m a
forall (m :: * -> *) a. StepT m a -> StepT m a
S.Skip (Pipe l i a () m () -> StepT m a
go (() -> Pipe l i a () m ()
up ()))
PipeM m (Pipe l i a () m ())
m -> m (StepT m a) -> StepT m a
forall (m :: * -> *) a. m (StepT m a) -> StepT m a
S.Effect (m (StepT m a) -> StepT m a) -> m (StepT m a) -> StepT m a
forall a b. (a -> b) -> a -> b
$ (Pipe l i a () m () -> StepT m a)
-> m (Pipe l i a () m ()) -> m (StepT m a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pipe l i a () m () -> StepT m a
go m (Pipe l i a () m ())
m
Leftover Pipe l i a () m ()
p l
_l -> StepT m a -> StepT m a
forall (m :: * -> *) a. StepT m a -> StepT m a
S.Skip (Pipe l i a () m () -> StepT m a
go Pipe l i a () m ()
p)
instance m ~ IO => ConduitToSourceIO (ResourceT m) where
conduitToSourceIO :: forall i o. ConduitT i o (ResourceT m) () -> SourceIO o
conduitToSourceIO (ConduitT forall b.
(() -> Pipe i i o () (ResourceT m) b)
-> Pipe i i o () (ResourceT m) b
con) =
(forall b. (StepT IO o -> IO b) -> IO b) -> SourceT IO o
forall (m :: * -> *) a.
(forall b. (StepT m a -> m b) -> m b) -> SourceT m a
S.SourceT ((forall b. (StepT IO o -> IO b) -> IO b) -> SourceT IO o)
-> (forall b. (StepT IO o -> IO b) -> IO b) -> SourceT IO o
forall a b. (a -> b) -> a -> b
$ \StepT IO o -> IO b
k ->
ResourceT IO b -> IO b
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO b -> IO b) -> ResourceT IO b -> IO b
forall a b. (a -> b) -> a -> b
$ ((forall a. ResourceT IO a -> IO a) -> IO b) -> ResourceT IO b
forall b.
((forall a. ResourceT IO a -> IO a) -> IO b) -> ResourceT IO b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ResourceT IO a -> IO a) -> IO b) -> ResourceT IO b)
-> ((forall a. ResourceT IO a -> IO a) -> IO b) -> ResourceT IO b
forall a b. (a -> b) -> a -> b
$ \forall a. ResourceT IO a -> IO a
runRes ->
StepT IO o -> IO b
k ((forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
forall i o.
(forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
go ResourceT m x -> m x
ResourceT IO x -> IO x
forall x. ResourceT m x -> m x
forall a. ResourceT IO a -> IO a
runRes ((() -> Pipe i i o () (ResourceT m) ())
-> Pipe i i o () (ResourceT m) ()
forall b.
(() -> Pipe i i o () (ResourceT m) b)
-> Pipe i i o () (ResourceT m) b
con () -> Pipe i i o () (ResourceT m) ()
forall l i o u (m :: * -> *) r. r -> Pipe l i o u m r
Done))
where
go :: (forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) ()
-> S.StepT IO o
go :: forall i o.
(forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
go forall x. ResourceT m x -> m x
_ (Done ()) = StepT IO o
forall (m :: * -> *) a. StepT m a
S.Stop
go forall x. ResourceT m x -> m x
runRes (HaveOutput Pipe i i o () (ResourceT m) ()
p o
o) = o -> StepT IO o -> StepT IO o
forall (m :: * -> *) a. a -> StepT m a -> StepT m a
S.Yield o
o ((forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
forall i o.
(forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
go ResourceT m x -> m x
forall x. ResourceT m x -> m x
runRes Pipe i i o () (ResourceT m) ()
p)
go forall x. ResourceT m x -> m x
runRes (NeedInput i -> Pipe i i o () (ResourceT m) ()
_ip () -> Pipe i i o () (ResourceT m) ()
up) = StepT IO o -> StepT IO o
forall (m :: * -> *) a. StepT m a -> StepT m a
S.Skip ((forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
forall i o.
(forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
go ResourceT m x -> m x
forall x. ResourceT m x -> m x
runRes (() -> Pipe i i o () (ResourceT m) ()
up ()))
go forall x. ResourceT m x -> m x
runRes (PipeM ResourceT m (Pipe i i o () (ResourceT m) ())
m) = IO (StepT IO o) -> StepT IO o
forall (m :: * -> *) a. m (StepT m a) -> StepT m a
S.Effect (IO (StepT IO o) -> StepT IO o) -> IO (StepT IO o) -> StepT IO o
forall a b. (a -> b) -> a -> b
$ ResourceT m (StepT IO o) -> m (StepT IO o)
forall x. ResourceT m x -> m x
runRes (ResourceT m (StepT IO o) -> m (StepT IO o))
-> ResourceT m (StepT IO o) -> m (StepT IO o)
forall a b. (a -> b) -> a -> b
$ (Pipe i i o () (ResourceT m) () -> StepT IO o)
-> ResourceT m (Pipe i i o () (ResourceT m) ())
-> ResourceT m (StepT IO o)
forall a b. (a -> b) -> ResourceT m a -> ResourceT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
forall i o.
(forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
go ResourceT m x -> m x
forall x. ResourceT m x -> m x
runRes) ResourceT m (Pipe i i o () (ResourceT m) ())
m
go forall x. ResourceT m x -> m x
runRes (Leftover Pipe i i o () (ResourceT m) ()
p i
_l) = StepT IO o -> StepT IO o
forall (m :: * -> *) a. StepT m a -> StepT m a
S.Skip ((forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
forall i o.
(forall x. ResourceT m x -> m x)
-> Pipe i i o () (ResourceT m) () -> StepT IO o
go ResourceT m x -> m x
forall x. ResourceT m x -> m x
runRes Pipe i i o () (ResourceT m) ()
p)
instance (ConduitToSourceIO m, r ~ ())
=> ToSourceIO o (ConduitT i o m r)
where
toSourceIO :: ConduitT i o m r -> SourceIO o
toSourceIO = ConduitT i o m r -> SourceIO o
ConduitT i o m () -> SourceIO o
forall i o. ConduitT i o m () -> SourceIO o
forall (m :: * -> *) i o.
ConduitToSourceIO m =>
ConduitT i o m () -> SourceIO o
conduitToSourceIO
instance (MonadIO m, r ~ ()) => FromSourceIO o (ConduitT i o m r) where
fromSourceIO :: SourceIO o -> IO (ConduitT i o m r)
fromSourceIO SourceIO o
src = ConduitT i o m r -> IO (ConduitT i o m r)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitT i o m r -> IO (ConduitT i o m r))
-> ConduitT i o m r -> IO (ConduitT i o m r)
forall a b. (a -> b) -> a -> b
$
(forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b)
-> ConduitT i o m r
forall i o (m :: * -> *) r.
(forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b)
-> ConduitT i o m r
ConduitT ((forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b)
-> ConduitT i o m r)
-> (forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b)
-> ConduitT i o m r
forall a b. (a -> b) -> a -> b
$ \r -> Pipe i i o () m b
con ->
m (Pipe i i o () m b) -> Pipe i i o () m b
forall l i o u (m :: * -> *) r.
m (Pipe l i o u m r) -> Pipe l i o u m r
PipeM (m (Pipe i i o () m b) -> Pipe i i o () m b)
-> m (Pipe i i o () m b) -> Pipe i i o () m b
forall a b. (a -> b) -> a -> b
$ IO (Pipe i i o () m b) -> m (Pipe i i o () m b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pipe i i o () m b) -> m (Pipe i i o () m b))
-> IO (Pipe i i o () m b) -> m (Pipe i i o () m b)
forall a b. (a -> b) -> a -> b
$ SourceIO o -> forall b. (StepT IO o -> IO b) -> IO b
forall (m :: * -> *) a.
SourceT m a -> forall b. (StepT m a -> m b) -> m b
S.unSourceT SourceIO o
src ((StepT IO o -> IO (Pipe i i o () m b)) -> IO (Pipe i i o () m b))
-> (StepT IO o -> IO (Pipe i i o () m b)) -> IO (Pipe i i o () m b)
forall a b. (a -> b) -> a -> b
$ \StepT IO o
step ->
(() -> Pipe i i o () m b) -> StepT IO o -> IO (Pipe i i o () m b)
forall b.
MonadIO m =>
(() -> Pipe i i o () m b) -> StepT IO o -> IO (Pipe i i o () m b)
loop r -> Pipe i i o () m b
() -> Pipe i i o () m b
con StepT IO o
step
where
loop :: MonadIO m => (() -> Pipe i i o () m b) -> S.StepT IO o -> IO (Pipe i i o () m b)
loop :: forall b.
MonadIO m =>
(() -> Pipe i i o () m b) -> StepT IO o -> IO (Pipe i i o () m b)
loop () -> Pipe i i o () m b
con StepT IO o
S.Stop = Pipe i i o () m b -> IO (Pipe i i o () m b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Pipe i i o () m b
con ())
loop () -> Pipe i i o () m b
_con (S.Error String
err) = String -> IO (Pipe i i o () m b)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
loop () -> Pipe i i o () m b
con (S.Skip StepT IO o
s) = (() -> Pipe i i o () m b) -> StepT IO o -> IO (Pipe i i o () m b)
forall b.
MonadIO m =>
(() -> Pipe i i o () m b) -> StepT IO o -> IO (Pipe i i o () m b)
loop () -> Pipe i i o () m b
con StepT IO o
s
loop () -> Pipe i i o () m b
con (S.Effect IO (StepT IO o)
ms) = IO (StepT IO o)
ms IO (StepT IO o)
-> (StepT IO o -> IO (Pipe i i o () m b)) -> IO (Pipe i i o () m b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (() -> Pipe i i o () m b) -> StepT IO o -> IO (Pipe i i o () m b)
forall b.
MonadIO m =>
(() -> Pipe i i o () m b) -> StepT IO o -> IO (Pipe i i o () m b)
loop () -> Pipe i i o () m b
con
loop () -> Pipe i i o () m b
con (S.Yield o
x StepT IO o
s) = Pipe i i o () m b -> IO (Pipe i i o () m b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pipe i i o () m b -> o -> Pipe i i o () m b
forall l i o u (m :: * -> *) r.
Pipe l i o u m r -> o -> Pipe l i o u m r
HaveOutput (m (Pipe i i o () m b) -> Pipe i i o () m b
forall l i o u (m :: * -> *) r.
m (Pipe l i o u m r) -> Pipe l i o u m r
PipeM (IO (Pipe i i o () m b) -> m (Pipe i i o () m b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pipe i i o () m b) -> m (Pipe i i o () m b))
-> IO (Pipe i i o () m b) -> m (Pipe i i o () m b)
forall a b. (a -> b) -> a -> b
$ (() -> Pipe i i o () m b) -> StepT IO o -> IO (Pipe i i o () m b)
forall b.
MonadIO m =>
(() -> Pipe i i o () m b) -> StepT IO o -> IO (Pipe i i o () m b)
loop () -> Pipe i i o () m b
con StepT IO o
s)) o
x)
{-# SPECIALIZE INLINE fromSourceIO :: SourceIO o -> IO (ConduitT i o IO ()) #-}