{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- | This module exports 'ToSourceIO' and 'FromSourceIO' for 'Proxy' and 'SafeT' instances.
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

-- | Helper class to implement @'ToSourceIO' 'Proxy'@ instance
-- for various monads.
class PipesToSourceIO m where
    pipesToSourceIO :: Proxy X () () b m () -> SourceIO b

instance PipesToSourceIO IO where
    pipesToSourceIO :: forall b. Proxy X () () b IO () -> SourceIO b
pipesToSourceIO Proxy X () () b IO ()
ma = forall (m :: * -> *) a.
(forall b. (StepT m a -> m b) -> m b) -> SourceT m a
S.SourceT (forall a b. (a -> b) -> a -> 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 :: forall b. Proxy X () () b IO () -> StepT IO b
go (Pure ())     = forall (m :: * -> *) a. StepT m a
S.Stop
        go (M IO (Proxy X () () b IO ())
p)         = forall (m :: * -> *) a. m (StepT m a) -> StepT m a
S.Effect (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b. Proxy X () () b IO () -> StepT IO b
go IO (Proxy X () () b IO ())
p)
        go (Request X
v () -> Proxy X () () b IO ()
_) = forall a. X -> a
closed X
v
        go (Respond b
b () -> Proxy X () () b IO ()
n) = forall (m :: * -> *) a. a -> StepT m a -> StepT m a
S.Yield b
b (forall b. Proxy X () () b IO () -> StepT IO b
go (() -> Proxy X () () b IO ()
n ()))

instance m ~ IO => PipesToSourceIO (SafeT m) where
    pipesToSourceIO :: forall b. Proxy X () () b (SafeT m) () -> SourceIO b
pipesToSourceIO Proxy X () () b (SafeT m) ()
ma =
        forall (m :: * -> *) a.
(forall b. (StepT m a -> m b) -> m b) -> SourceT m a
S.SourceT forall a b. (a -> b) -> a -> b
$ \StepT IO b -> IO b
k ->
        forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \RunInBase (SafeT IO) IO
runSafe ->
        StepT IO b -> IO b
k (forall b.
(forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) () -> StepT IO b
go 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 b.
(forall x. SafeT m x -> m x)
-> Proxy X () () b (SafeT m) () -> StepT IO b
go forall x. SafeT m x -> m x
_        (Pure ())    = 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)         = forall (m :: * -> *) a. m (StepT m a) -> StepT m a
S.Effect forall a b. (a -> b) -> a -> b
$ forall x. SafeT m x -> m x
runSafe forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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) ()
_) = 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) = forall (m :: * -> *) a. a -> StepT m a -> StepT m a
S.Yield b
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 = 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 = forall (m :: * -> *) b.
PipesToSourceIO m =>
Proxy X () () b m () -> SourceIO b
pipesToSourceIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
SourceT m a -> forall b. (StepT m a -> m b) -> m b
S.unSourceT SourceIO b
src (forall (m :: * -> *) a. Monad m => a -> m a
return 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        = forall a' a b' b (m :: * -> *) r. r -> Proxy a' a b' b m r
Pure ()
        go (S.Error String
err) = forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 -- drives
        go (S.Effect IO (StepT IO b)
ms) = forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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) = 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 (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 = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chunk a. FromSourceIO chunk a => SourceIO chunk -> a
fromSourceIO