    {-# LANGUAGE CPP                 #-}
    module Servant.Types.SourceT where

    import           Control.Monad.Except
                     (ExceptT (..), runExceptT, throwError)
    import           Control.Monad.Morph
                     (MFunctor (..))
    import           Control.Monad.Trans.Class
                     (MonadTrans (..))
    import qualified Data.Attoparsec.ByteString as A
    import qualified Data.ByteString            as BS
    import           Data.Functor.Classes
                     (Show1 (..), showsBinaryWith, showsPrec1, showsUnaryWith)
    import           Data.Functor.Identity
                     (Identity (..))
    import           Prelude hiding (readFile)
    import           System.IO
                     (Handle, IOMode (..), withFile)
    import qualified Test.QuickCheck            as QC

    -- $setup
    -- >>> :set -XNoOverloadedStrings
    -- >>> import Data.String (fromString)
    -- >>> import Control.Monad.Except (runExcept)
    -- >>> import Data.Foldable (toList)
    -- >>> import qualified Data.Attoparsec.ByteString.Char8 as A8

    -- | This is CPSised ListT.
    --
    -- @since 0.15
    --
    newtype SourceT m a = SourceT
        { forall (m :: Type -> Type) a.
    SourceT m a -> forall b. (StepT m a -> m b) -> m b
    unSourceT :: forall b. (StepT m a -> m b) -> m b
        }

    mapStepT :: (StepT m a -> StepT m b) -> SourceT m a -> SourceT m b
    mapStepT :: forall (m :: Type -> Type) a b.
    (StepT m a -> StepT m b) -> SourceT m a -> SourceT m b
    mapStepT StepT m a -> StepT m b
    f (SourceT forall b. (StepT m a -> m b) -> m b
    m) = (forall b. (StepT m b -> m b) -> m b) -> SourceT m b
    forall (m :: Type -> Type) a.
    (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    SourceT ((forall b. (StepT m b -> m b) -> m b) -> SourceT m b)
    -> (forall b. (StepT m b -> m b) -> m b) -> SourceT m b
    forall a b. (a -> b) -> a -> b
    $ \StepT m b -> m b
    k -> (StepT m a -> m b) -> m b
    forall b. (StepT m a -> m b) -> m b
    m (StepT m b -> m b
    k (StepT m b -> m b) -> (StepT m a -> StepT m b) -> StepT m a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StepT m a -> StepT m b
    f)
    {-# INLINE mapStepT #-}

    -- | @ListT@ with additional constructors.
    --
    -- @since 0.15
    --
    data StepT m a
        = Stop
        | Error String      -- we can this argument configurable.
        | Skip (StepT m a)  -- Note: not sure about this constructor
        | Yield a (StepT m a)
        | Effect (m (StepT m a))
      deriving (forall a b. (a -> b) -> StepT m a -> StepT m b)
    -> (forall a b. a -> StepT m b -> StepT m a) -> Functor (StepT m)
    forall a b. a -> StepT m b -> StepT m a
    forall a b. (a -> b) -> StepT m a -> StepT m b
    forall (m :: Type -> Type) a b.
    Functor m =>
    a -> StepT m b -> StepT m a
    forall (m :: Type -> Type) a b.
    Functor m =>
    (a -> b) -> StepT m a -> StepT m b
    forall (f :: Type -> Type).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall (m :: Type -> Type) a b.
    Functor m =>
    (a -> b) -> StepT m a -> StepT m b
    fmap :: forall a b. (a -> b) -> StepT m a -> StepT m b
    $c<$ :: forall (m :: Type -> Type) a b.
    Functor m =>
    a -> StepT m b -> StepT m a
    <$ :: forall a b. a -> StepT m b -> StepT m a
    Functor

    -- | Create 'SourceT' from 'Step'.
    --
    -- /Note:/ often enough you want to use 'SourceT' directly.
    fromStepT :: StepT m a -> SourceT m a
    fromStepT :: forall (m :: Type -> Type) a. StepT m a -> SourceT m a
    fromStepT StepT m a
    s = (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    forall (m :: Type -> Type) a.
    (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    SourceT ((StepT m a -> m b) -> StepT m a -> m b
    forall a b. (a -> b) -> a -> b
    $ StepT m a
    s)

    -------------------------------------------------------------------------------
    -- SourceT instances
    -------------------------------------------------------------------------------

    instance Functor m => Functor (SourceT m) where
        fmap :: forall a b. (a -> b) -> SourceT m a -> SourceT m b
    fmap a -> b
    f = (StepT m a -> StepT m b) -> SourceT m a -> SourceT m b
    forall (m :: Type -> Type) a b.
    (StepT m a -> StepT m b) -> SourceT m a -> SourceT m b
    mapStepT ((a -> b) -> StepT m a -> StepT m b
    forall a b. (a -> b) -> StepT m a -> StepT m b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f)

    -- | >>> toList (source [1::Int .. 10])
    -- [1,2,3,4,5,6,7,8,9,10]
    --
    instance Identity ~ m => Foldable (SourceT m) where
        foldr :: forall a b. (a -> b -> b) -> b -> SourceT m a -> b
    foldr a -> b -> b
    f b
    z (SourceT forall b. (StepT m a -> m b) -> m b
    m) = (a -> b -> b) -> b -> StepT m a -> b
    forall a b. (a -> b -> b) -> b -> StepT m a -> b
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> b -> b
    f b
    z (Identity (StepT m a) -> StepT m a
    forall a. Identity a -> a
    runIdentity ((StepT m a -> m (StepT m a)) -> m (StepT m a)
    forall b. (StepT m a -> m b) -> m b
    m StepT m a -> m (StepT m a)
    StepT m a -> Identity (StepT m a)
    forall a. a -> Identity a
    Identity))

    instance (Applicative m, Show1 m) => Show1 (SourceT m) where
        liftShowsPrec :: forall a.
    (Int -> a -> ShowS)
    -> ([a] -> ShowS) -> Int -> SourceT m a -> ShowS
    liftShowsPrec Int -> a -> ShowS
    sp [a] -> ShowS
    sl Int
    d (SourceT forall b. (StepT m a -> m b) -> m b
    m) = (Int -> StepT m a -> ShowS) -> String -> Int -> StepT m a -> ShowS
    forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    showsUnaryWith
            ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> StepT m a -> ShowS
    forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> StepT m a -> ShowS
    forall (f :: Type -> Type) a.
    Show1 f =>
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
    liftShowsPrec Int -> a -> ShowS
    sp [a] -> ShowS
    sl)
            String
    "fromStepT" Int
    d (m (StepT m a) -> StepT m a
    forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
    Effect ((StepT m a -> m (StepT m a)) -> m (StepT m a)
    forall b. (StepT m a -> m b) -> m b
    m StepT m a -> m (StepT m a)
    forall {m :: Type -> Type} {a}.
    Applicative m =>
    StepT m a -> m (StepT m a)
    pure'))
          where
            pure' :: StepT m a -> m (StepT m a)
    pure' (Effect m (StepT m a)
    s) = m (StepT m a)
    s
            pure' StepT m a
    s          = StepT m a -> m (StepT m a)
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure StepT m a
    s

    instance (Applicative m, Show1 m, Show a) => Show (SourceT m a) where
        showsPrec :: Int -> SourceT m a -> ShowS
    showsPrec = Int -> SourceT m a -> ShowS
    forall (f :: Type -> Type) a.
    (Show1 f, Show a) =>
    Int -> f a -> ShowS
    showsPrec1

    -- | >>> hoist (Just . runIdentity) (source [1..3]) :: SourceT Maybe Int
    -- fromStepT (Effect (Just (Yield 1 (Yield 2 (Yield 3 Stop)))))
    instance MFunctor SourceT where
        hoist :: forall (m :: Type -> Type) (n :: Type -> Type) b.
    Monad m =>
    (forall a. m a -> n a) -> SourceT m b -> SourceT n b
    hoist forall a. m a -> n a
    f (SourceT forall b. (StepT m b -> m b) -> m b
    m) = (forall b. (StepT n b -> n b) -> n b) -> SourceT n b
    forall (m :: Type -> Type) a.
    (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    SourceT ((forall b. (StepT n b -> n b) -> n b) -> SourceT n b)
    -> (forall b. (StepT n b -> n b) -> n b) -> SourceT n b
    forall a b. (a -> b) -> a -> b
    $ \StepT n b -> n b
    k -> StepT n b -> n b
    k (StepT n b -> n b) -> StepT n b -> n b
    forall a b. (a -> b) -> a -> b
    $
            n (StepT n b) -> StepT n b
    forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
    Effect (n (StepT n b) -> StepT n b) -> n (StepT n b) -> StepT n b
    forall a b. (a -> b) -> a -> b
    $ m (StepT n b) -> n (StepT n b)
    forall a. m a -> n a
    f (m (StepT n b) -> n (StepT n b)) -> m (StepT n b) -> n (StepT n b)
    forall a b. (a -> b) -> a -> b
    $ (StepT m b -> StepT n b) -> m (StepT m b) -> m (StepT n b)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((forall a. m a -> n a) -> StepT m b -> StepT n b
    forall {k} (t :: (Type -> Type) -> k -> Type) (m :: Type -> Type)
           (n :: Type -> Type) (b :: k).
    (MFunctor t, Monad m) =>
    (forall a. m a -> n a) -> t m b -> t n b
    forall (m :: Type -> Type) (n :: Type -> Type) b.
    Monad m =>
    (forall a. m a -> n a) -> StepT m b -> StepT n b
    hoist m a -> n a
    forall a. m a -> n a
    f) (m (StepT m b) -> m (StepT n b)) -> m (StepT m b) -> m (StepT n b)
    forall a b. (a -> b) -> a -> b
    $ (StepT m b -> m (StepT m b)) -> m (StepT m b)
    forall b. (StepT m b -> m b) -> m b
    m StepT m b -> m (StepT m b)
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure

    -- | >>> source "xy" <> source "z" :: SourceT Identity Char
    -- fromStepT (Effect (Identity (Yield 'x' (Yield 'y' (Yield 'z' Stop)))))
    --
    instance Functor m => Semigroup (SourceT m a) where
        SourceT forall b. (StepT m a -> m b) -> m b
    withL <> :: SourceT m a -> SourceT m a -> SourceT m a
    <> SourceT forall b. (StepT m a -> m b) -> m b
    withR = (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    forall (m :: Type -> Type) a.
    (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    SourceT ((forall b. (StepT m a -> m b) -> m b) -> SourceT m a)
    -> (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    forall a b. (a -> b) -> a -> b
    $ \StepT m a -> m b
    ret ->
            (StepT m a -> m b) -> m b
    forall b. (StepT m a -> m b) -> m b
    withL ((StepT m a -> m b) -> m b) -> (StepT m a -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \StepT m a
    l ->
            (StepT m a -> m b) -> m b
    forall b. (StepT m a -> m b) -> m b
    withR ((StepT m a -> m b) -> m b) -> (StepT m a -> m b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \StepT m a
    r ->
            StepT m a -> m b
    ret (StepT m a -> m b) -> StepT m a -> m b
    forall a b. (a -> b) -> a -> b
    $ StepT m a
    l StepT m a -> StepT m a -> StepT m a
    forall a. Semigroup a => a -> a -> a
    <> StepT m a
    r

    -- | >>> mempty :: SourceT Maybe Int
    -- fromStepT (Effect (Just Stop))
    instance Functor m => Monoid (SourceT m a) where
        mempty :: SourceT m a
    mempty = StepT m a -> SourceT m a
    forall (m :: Type -> Type) a. StepT m a -> SourceT m a
    fromStepT StepT m a
    forall a. Monoid a => a
    mempty
        mappend :: SourceT m a -> SourceT m a -> SourceT m a
    mappend = SourceT m a -> SourceT m a -> SourceT m a
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | Doesn't generate 'Error' constructors. 'SourceT' doesn't shrink.
    instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (SourceT m a) where
        arbitrary :: Gen (SourceT m a)
    arbitrary = StepT m a -> SourceT m a
    forall (m :: Type -> Type) a. StepT m a -> SourceT m a
    fromStepT (StepT m a -> SourceT m a) -> Gen (StepT m a) -> Gen (SourceT m a)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen (StepT m a)
    forall a. Arbitrary a => Gen a
    QC.arbitrary

    -- An example of above instance. Not doctested because it's volatile.
    --
    -- >>> import Test.QuickCheck as QC
    -- >>> import Test.QuickCheck.Gen as QC
    -- >>> import Test.QuickCheck.Random as QC
    -- >>> let generate (QC.MkGen g) = g (QC.mkQCGen 44) 10
    --
    -- >>> generate (arbitrary :: QC.Gen (SourceT Identity Int))
    -- fromStepT (Effect (Identity (Yield (-10) (Yield 3 (Skip (Yield 1 Stop))))))

    -------------------------------------------------------------------------------
    -- StepT instances
    -------------------------------------------------------------------------------

    instance Identity ~ m => Foldable (StepT m) where
        foldr :: forall a b. (a -> b -> b) -> b -> StepT m a -> b
    foldr a -> b -> b
    f b
    z = StepT m a -> b
    StepT Identity a -> b
    go where
            go :: StepT Identity a -> b
    go StepT Identity a
    Stop                  = b
    z
            go (Error String
    _)             = b
    z
            go (Skip StepT Identity a
    s)              = StepT Identity a -> b
    go StepT Identity a
    s
            go (Yield a
    a StepT Identity a
    s)           = a -> b -> b
    f a
    a (StepT Identity a -> b
    go StepT Identity a
    s)
            go (Effect (Identity StepT Identity a
    s)) = StepT Identity a -> b
    go StepT Identity a
    s

    instance (Applicative m, Show1 m) => Show1 (StepT m) where
        liftShowsPrec :: forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> StepT m a -> ShowS
    liftShowsPrec Int -> a -> ShowS
    sp [a] -> ShowS
    sl = Int -> StepT m a -> ShowS
    go where
            go :: Int -> StepT m a -> ShowS
    go Int
    _ StepT m a
    Stop        = String -> ShowS
    showString String
    "Stop"
            go Int
    d (Skip StepT m a
    s)    = (Int -> StepT m a -> ShowS) -> String -> Int -> StepT m a -> ShowS
    forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    showsUnaryWith
                Int -> StepT m a -> ShowS
    go
                String
    "Skip" Int
    d StepT m a
    s
            go Int
    d (Error String
    err) = (Int -> String -> ShowS) -> String -> Int -> String -> ShowS
    forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    showsUnaryWith
                Int -> String -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec
                String
    "Error" Int
    d String
    err
            go Int
    d (Effect m (StepT m a)
    ms) = (Int -> m (StepT m a) -> ShowS)
    -> String -> Int -> m (StepT m a) -> ShowS
    forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    showsUnaryWith
                ((Int -> StepT m a -> ShowS)
    -> ([StepT m a] -> ShowS) -> Int -> m (StepT m a) -> ShowS
    forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> m a -> ShowS
    forall (f :: Type -> Type) a.
    Show1 f =>
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
    liftShowsPrec Int -> StepT m a -> ShowS
    go [StepT m a] -> ShowS
    goList)
                String
    "Effect" Int
    d m (StepT m a)
    ms
            go Int
    d (Yield a
    x StepT m a
    s) = (Int -> a -> ShowS)
    -> (Int -> StepT m a -> ShowS)
    -> String
    -> Int
    -> a
    -> StepT m a
    -> ShowS
    forall a b.
    (Int -> a -> ShowS)
    -> (Int -> b -> ShowS) -> String -> Int -> a -> b -> ShowS
    showsBinaryWith
                Int -> a -> ShowS
    sp Int -> StepT m a -> ShowS
    go
                String
    "Yield" Int
    d a
    x StepT m a
    s

            goList :: [StepT m a] -> ShowS
    goList = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [StepT m a] -> ShowS
    forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [StepT m a] -> ShowS
    forall (f :: Type -> Type) a.
    Show1 f =>
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
    liftShowList Int -> a -> ShowS
    sp [a] -> ShowS
    sl

    instance (Applicative m, Show1 m, Show a) => Show (StepT m a) where
        showsPrec :: Int -> StepT m a -> ShowS
    showsPrec = Int -> StepT m a -> ShowS
    forall (f :: Type -> Type) a.
    (Show1 f, Show a) =>
    Int -> f a -> ShowS
    showsPrec1

    #if !MIN_VERSION_transformers(0,6,0)
    -- Since transformers-0.6, MonadTrans only works on Monads.
    -- StepT isn't necesssarily a monad. It doesn't have the Monad instance.
    -- See https://gitlab.haskell.org/ghc/ghc/-/issues/19922

    -- | >>> lift [1,2,3] :: StepT [] Int
    -- Effect [Yield 1 Stop,Yield 2 Stop,Yield 3 Stop]
    --
    instance MonadTrans StepT where
        lift = Effect . fmap (`Yield` Stop)
    #endif

    instance MFunctor StepT where
        hoist :: forall (m :: Type -> Type) (n :: Type -> Type) b.
    Monad m =>
    (forall a. m a -> n a) -> StepT m b -> StepT n b
    hoist forall a. m a -> n a
    f = StepT m b -> StepT n b
    go where
            go :: StepT m b -> StepT n b
    go StepT m b
    Stop        = StepT n b
    forall (m :: Type -> Type) a. StepT m a
    Stop
            go (Error String
    err) = String -> StepT n b
    forall (m :: Type -> Type) a. String -> StepT m a
    Error String
    err
            go (Skip StepT m b
    s)    = StepT n b -> StepT n b
    forall (m :: Type -> Type) a. StepT m a -> StepT m a
    Skip (StepT m b -> StepT n b
    go StepT m b
    s)
            go (Yield b
    x StepT m b
    s) = b -> StepT n b -> StepT n b
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield b
    x (StepT m b -> StepT n b
    go StepT m b
    s)
            go (Effect m (StepT m b)
    ms) = n (StepT n b) -> StepT n b
    forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
    Effect (m (StepT n b) -> n (StepT n b)
    forall a. m a -> n a
    f ((StepT m b -> StepT n b) -> m (StepT m b) -> m (StepT n b)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap StepT m b -> StepT n b
    go m (StepT m b)
    ms))

    instance Functor m => Semigroup (StepT m a) where
        StepT m a
    Stop      <> :: StepT m a -> StepT m a -> StepT m a
    <> StepT m a
    r = StepT m a
    r
        Error String
    err <> StepT m a
    _ = String -> StepT m a
    forall (m :: Type -> Type) a. String -> StepT m a
    Error String
    err
        Skip StepT m a
    s    <> StepT m a
    r = StepT m a -> StepT m a
    forall (m :: Type -> Type) a. StepT m a -> StepT m a
    Skip (StepT m a
    s StepT m a -> StepT m a -> StepT m a
    forall a. Semigroup a => a -> a -> a
    <> StepT m a
    r)
        Yield a
    x StepT m a
    s <> StepT m a
    r = a -> StepT m a -> StepT m a
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield a
    x (StepT m a
    s StepT m a -> StepT m a -> StepT m a
    forall a. Semigroup a => a -> a -> a
    <> StepT m a
    r)
        Effect m (StepT m a)
    ms <> StepT m a
    r = m (StepT m a) -> StepT m a
    forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
    Effect ((StepT m a -> StepT m a -> StepT m a
    forall a. Semigroup a => a -> a -> a
    <> StepT m a
    r) (StepT m a -> StepT m a) -> m (StepT m a) -> m (StepT m a)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> m (StepT m a)
    ms)

    -- | >>> mempty :: StepT [] Int
    -- Stop
    --
    -- >>> mempty :: StepT Identity Int
    -- Stop
    --
    instance Functor m => Monoid (StepT m a) where
        mempty :: StepT m a
    mempty = StepT m a
    forall (m :: Type -> Type) a. StepT m a
    Stop
        mappend :: StepT m a -> StepT m a -> StepT m a
    mappend = StepT m a -> StepT m a -> StepT m a
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | Doesn't generate 'Error' constructors.
    instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (StepT m a) where
        arbitrary :: Gen (StepT m a)
    arbitrary = (Int -> Gen (StepT m a)) -> Gen (StepT m a)
    forall a. (Int -> Gen a) -> Gen a
    QC.sized Int -> Gen (StepT m a)
    forall {a} {m :: Type -> Type} {a}.
    (Ord a, Num a, Applicative m, Arbitrary a) =>
    a -> Gen (StepT m a)
    arb where
            arb :: a -> Gen (StepT m a)
    arb a
    n | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    0    = StepT m a -> Gen (StepT m a)
    forall a. a -> Gen a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure StepT m a
    forall (m :: Type -> Type) a. StepT m a
    Stop
                  | Bool
    otherwise = [(Int, Gen (StepT m a))] -> Gen (StepT m a)
    forall a. [(Int, Gen a)] -> Gen a
    QC.frequency
                      [ (Int
    1, StepT m a -> Gen (StepT m a)
    forall a. a -> Gen a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure StepT m a
    forall (m :: Type -> Type) a. StepT m a
    Stop)
                      , (Int
    1, StepT m a -> StepT m a
    forall (m :: Type -> Type) a. StepT m a -> StepT m a
    Skip (StepT m a -> StepT m a) -> Gen (StepT m a) -> Gen (StepT m a)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen (StepT m a)
    arb')
                      , (Int
    1, m (StepT m a) -> StepT m a
    forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
    Effect (m (StepT m a) -> StepT m a)
    -> (StepT m a -> m (StepT m a)) -> StepT m a -> StepT m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StepT m a -> m (StepT m a)
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (StepT m a -> StepT m a) -> Gen (StepT m a) -> Gen (StepT m a)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen (StepT m a)
    arb')
                      , (Int
    8, a -> StepT m a -> StepT m a
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield (a -> StepT m a -> StepT m a)
    -> Gen a -> Gen (StepT m a -> StepT m a)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen a
    forall a. Arbitrary a => Gen a
    QC.arbitrary Gen (StepT m a -> StepT m a) -> Gen (StepT m a) -> Gen (StepT m a)
    forall a b. Gen (a -> b) -> Gen a -> Gen b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> Gen (StepT m a)
    arb')
                      ]
              where
                arb' :: Gen (StepT m a)
    arb' = a -> Gen (StepT m a)
    arb (a
    n a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1)

        shrink :: StepT m a -> [StepT m a]
    shrink StepT m a
    Stop        = []
        shrink (Error String
    _)   = [StepT m a
    forall (m :: Type -> Type) a. StepT m a
    Stop]
        shrink (Skip StepT m a
    s)    = [StepT m a
    s]
        shrink (Effect m (StepT m a)
    _)  = []
        shrink (Yield a
    x StepT m a
    s) =
            [ a -> StepT m a -> StepT m a
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield a
    x' StepT m a
    s | a
    x' <- a -> [a]
    forall a. Arbitrary a => a -> [a]
    QC.shrink a
    x ] [StepT m a] -> [StepT m a] -> [StepT m a]
    forall a. [a] -> [a] -> [a]
    ++
            [ a -> StepT m a -> StepT m a
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield a
    x StepT m a
    s' | StepT m a
    s' <- StepT m a -> [StepT m a]
    forall a. Arbitrary a => a -> [a]
    QC.shrink StepT m a
    s ]

    -------------------------------------------------------------------------------
    -- Operations
    -------------------------------------------------------------------------------

    -- | Create pure 'SourceT'.
    --
    -- >>> source "foo" :: SourceT Identity Char
    -- fromStepT (Effect (Identity (Yield 'f' (Yield 'o' (Yield 'o' Stop)))))
    --
    source :: Foldable f => f a -> SourceT m a
    source :: forall (f :: Type -> Type) a (m :: Type -> Type).
    Foldable f =>
    f a -> SourceT m a
    source = StepT m a -> SourceT m a
    forall (m :: Type -> Type) a. StepT m a -> SourceT m a
    fromStepT (StepT m a -> SourceT m a)
    -> (f a -> StepT m a) -> f a -> SourceT m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> StepT m a -> StepT m a) -> StepT m a -> f a -> StepT m a
    forall a b. (a -> b -> b) -> b -> f a -> b
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> StepT m a -> StepT m a
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield StepT m a
    forall (m :: Type -> Type) a. StepT m a
    Stop

    -- | Get the answers.
    --
    -- >>> runSourceT (source "foo" :: SourceT Identity Char)
    -- ExceptT (Identity (Right "foo"))
    --
    -- >>> runSourceT (source "foo" :: SourceT [] Char)
    -- ExceptT [Right "foo"]
    --
    runSourceT :: Monad m => SourceT m a -> ExceptT String m [a]
    runSourceT :: forall (m :: Type -> Type) a.
    Monad m =>
    SourceT m a -> ExceptT String m [a]
    runSourceT (SourceT forall b. (StepT m a -> m b) -> m b
    m) = m (Either String [a]) -> ExceptT String m [a]
    forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
    ExceptT ((StepT m a -> m (Either String [a])) -> m (Either String [a])
    forall b. (StepT m a -> m b) -> m b
    m (ExceptT String m [a] -> m (Either String [a])
    forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT String m [a] -> m (Either String [a]))
    -> (StepT m a -> ExceptT String m [a])
    -> StepT m a
    -> m (Either String [a])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StepT m a -> ExceptT String m [a]
    forall (m :: Type -> Type) a.
    Monad m =>
    StepT m a -> ExceptT String m [a]
    runStepT))

    runStepT :: Monad m => StepT m a -> ExceptT String m [a]
    runStepT :: forall (m :: Type -> Type) a.
    Monad m =>
    StepT m a -> ExceptT String m [a]
    runStepT StepT m a
    Stop        = [a] -> ExceptT String m [a]
    forall a. a -> ExceptT String m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure []
    runStepT (Error String
    err) = String -> ExceptT String m [a]
    forall a. String -> ExceptT String m a
    forall e (m :: Type -> Type) a. MonadError e m => e -> m a
    throwError String
    err
    runStepT (Skip StepT m a
    s)    = StepT m a -> ExceptT String m [a]
    forall (m :: Type -> Type) a.
    Monad m =>
    StepT m a -> ExceptT String m [a]
    runStepT StepT m a
    s
    runStepT (Yield a
    x StepT m a
    s) = ([a] -> [a]) -> ExceptT String m [a] -> ExceptT String m [a]
    forall a b. (a -> b) -> ExceptT String m a -> ExceptT String m b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) (StepT m a -> ExceptT String m [a]
    forall (m :: Type -> Type) a.
    Monad m =>
    StepT m a -> ExceptT String m [a]
    runStepT StepT m a
    s)
    runStepT (Effect m (StepT m a)
    ms) = m (StepT m a) -> ExceptT String m (StepT m a)
    forall (m :: Type -> Type) a. Monad m => m a -> ExceptT String m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift m (StepT m a)
    ms ExceptT String m (StepT m a)
    -> (StepT m a -> ExceptT String m [a]) -> ExceptT String m [a]
    forall a b.
    ExceptT String m a
    -> (a -> ExceptT String m b) -> ExceptT String m b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= StepT m a -> ExceptT String m [a]
    forall (m :: Type -> Type) a.
    Monad m =>
    StepT m a -> ExceptT String m [a]
    runStepT

    {-
    -- | >>> uncons (foldr Yield Stop "foo" :: StepT Identity Char)
    -- Identity (Just ('f',Yield 'o' (Yield 'o' Stop)))
    --
    uncons :: Monad m => StepT m a -> m (Maybe (a, StepT m a))
    uncons Stop        = pure Nothing
    uncons (Skip s)    = uncons s
    uncons (Yield x s) = pure (Just (x, s))
    uncons (Effect ms) = ms >>= uncons
    uncons (Error _) =
    -}

    -- | Filter values.
    --
    -- >>> toList $ mapMaybe (\x -> if odd x then Just x else Nothing) (source [0..10]) :: [Int]
    -- [1,3,5,7,9]
    --
    -- >>> mapMaybe (\x -> if odd x then Just x else Nothing) (source [0..2]) :: SourceT Identity Int
    -- fromStepT (Effect (Identity (Skip (Yield 1 (Skip Stop)))))
    --
    -- Illustrates why we need 'Skip'.
    mapMaybe :: Functor m => (a -> Maybe b) -> SourceT m a -> SourceT m b
    mapMaybe :: forall (m :: Type -> Type) a b.
    Functor m =>
    (a -> Maybe b) -> SourceT m a -> SourceT m b
    mapMaybe a -> Maybe b
    p (SourceT forall b. (StepT m a -> m b) -> m b
    m) = (forall b. (StepT m b -> m b) -> m b) -> SourceT m b
    forall (m :: Type -> Type) a.
    (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    SourceT ((forall b. (StepT m b -> m b) -> m b) -> SourceT m b)
    -> (forall b. (StepT m b -> m b) -> m b) -> SourceT m b
    forall a b. (a -> b) -> a -> b
    $ \StepT m b -> m b
    k -> (StepT m a -> m b) -> m b
    forall b. (StepT m a -> m b) -> m b
    m (StepT m b -> m b
    k (StepT m b -> m b) -> (StepT m a -> StepT m b) -> StepT m a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Maybe b) -> StepT m a -> StepT m b
    forall (m :: Type -> Type) a b.
    Functor m =>
    (a -> Maybe b) -> StepT m a -> StepT m b
    mapMaybeStep a -> Maybe b
    p)

    mapMaybeStep :: Functor m => (a -> Maybe b) -> StepT m a -> StepT m b
    mapMaybeStep :: forall (m :: Type -> Type) a b.
    Functor m =>
    (a -> Maybe b) -> StepT m a -> StepT m b
    mapMaybeStep a -> Maybe b
    p = StepT m a -> StepT m b
    go where
        go :: StepT m a -> StepT m b
    go StepT m a
    Stop        = StepT m b
    forall (m :: Type -> Type) a. StepT m a
    Stop
        go (Error String
    err) = String -> StepT m b
    forall (m :: Type -> Type) a. String -> StepT m a
    Error String
    err
        go (Skip StepT m a
    s)    = StepT m b -> StepT m b
    forall (m :: Type -> Type) a. StepT m a -> StepT m a
    Skip (StepT m a -> StepT m b
    go StepT m a
    s)
        go (Effect m (StepT m a)
    ms) = m (StepT m b) -> StepT m b
    forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
    Effect ((StepT m a -> StepT m b) -> m (StepT m a) -> m (StepT m b)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap StepT m a -> StepT m b
    go m (StepT m a)
    ms)
        go (Yield a
    x StepT m a
    s) = case a -> Maybe b
    p a
    x of
            Maybe b
    Nothing -> StepT m b -> StepT m b
    forall (m :: Type -> Type) a. StepT m a -> StepT m a
    Skip (StepT m a -> StepT m b
    go StepT m a
    s)
            Just b
    y  -> b -> StepT m b -> StepT m b
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield b
    y (StepT m a -> StepT m b
    go StepT m a
    s)

    -- | Run action for each value in the 'SourceT'.
    --
    -- >>> foreach fail print $ source ("abc" :: String)
    -- 'a'
    -- 'b'
    -- 'c'
    --
    foreach
        :: Monad m
        => (String -> m ())  -- ^ error handler
        -> (a -> m ())
        -> SourceT m a
        -> m ()
    foreach :: forall (m :: Type -> Type) a.
    Monad m =>
    (String -> m ()) -> (a -> m ()) -> SourceT m a -> m ()
    foreach String -> m ()
    f a -> m ()
    g SourceT m a
    src = SourceT m a -> forall b. (StepT m a -> m b) -> m b
    forall (m :: Type -> Type) a.
    SourceT m a -> forall b. (StepT m a -> m b) -> m b
    unSourceT SourceT m a
    src ((String -> m ()) -> (a -> m ()) -> StepT m a -> m ()
    forall (m :: Type -> Type) a.
    Monad m =>
    (String -> m ()) -> (a -> m ()) -> StepT m a -> m ()
    foreachStep String -> m ()
    f a -> m ()
    g)

    -- | See 'foreach'.
    foreachStep
        :: Monad m
        => (String -> m ())  -- ^ error handler
        -> (a -> m ())
        -> StepT m a
        -> m ()
    foreachStep :: forall (m :: Type -> Type) a.
    Monad m =>
    (String -> m ()) -> (a -> m ()) -> StepT m a -> m ()
    foreachStep String -> m ()
    f a -> m ()
    g = StepT m a -> m ()
    go where
        go :: StepT m a -> m ()
    go StepT m a
    Stop        = () -> m ()
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ()
        go (Skip StepT m a
    s)    = StepT m a -> m ()
    go StepT m a
    s
        go (Yield a
    x StepT m a
    s) = a -> m ()
    g a
    x m () -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> StepT m a -> m ()
    go StepT m a
    s
        go (Error String
    err) = String -> m ()
    f String
    err
        go (Effect m (StepT m a)
    ms) = m (StepT m a)
    ms m (StepT m a) -> (StepT m a -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= StepT m a -> m ()
    go

    -------------------------------------------------------------------------------
    -- Monadic
    -------------------------------------------------------------------------------

    fromAction :: Functor m => (a -> Bool) -> m a -> SourceT m a
    fromAction :: forall (m :: Type -> Type) a.
    Functor m =>
    (a -> Bool) -> m a -> SourceT m a
    fromAction a -> Bool
    stop m a
    action = (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    forall (m :: Type -> Type) a.
    (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    SourceT ((StepT m a -> m b) -> StepT m a -> m b
    forall a b. (a -> b) -> a -> b
    $ (a -> Bool) -> m a -> StepT m a
    forall (m :: Type -> Type) a.
    Functor m =>
    (a -> Bool) -> m a -> StepT m a
    fromActionStep a -> Bool
    stop m a
    action)
    {-# INLINE fromAction #-}

    fromActionStep :: Functor m => (a -> Bool) -> m a -> StepT m a
    fromActionStep :: forall (m :: Type -> Type) a.
    Functor m =>
    (a -> Bool) -> m a -> StepT m a
    fromActionStep a -> Bool
    stop m a
    action = StepT m a
    loop where
        loop :: StepT m a
    loop = m (StepT m a) -> StepT m a
    forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
    Effect (m (StepT m a) -> StepT m a) -> m (StepT m a) -> StepT m a
    forall a b. (a -> b) -> a -> b
    $ (a -> StepT m a) -> m a -> m (StepT m a)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> StepT m a
    step m a
    action
        step :: a -> StepT m a
    step a
    x
            | a -> Bool
    stop a
    x    = StepT m a
    forall (m :: Type -> Type) a. StepT m a
    Stop
            | Bool
    otherwise = a -> StepT m a -> StepT m a
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield a
    x StepT m a
    loop
    {-# INLINE fromActionStep #-}

    -------------------------------------------------------------------------------
    -- File
    -------------------------------------------------------------------------------

    -- | Read file.
    --
    -- >>> foreach fail BS.putStr (readFile "servant.cabal")
    -- cabal-version:      3.0
    -- name:               servant
    -- ...
    --
    readFile :: FilePath -> SourceT IO BS.ByteString
    readFile :: String -> SourceT IO ByteString
    readFile String
    fp =
        (forall b. (StepT IO ByteString -> IO b) -> IO b)
    -> SourceT IO ByteString
    forall (m :: Type -> Type) a.
    (forall b. (StepT m a -> m b) -> m b) -> SourceT m a
    SourceT ((forall b. (StepT IO ByteString -> IO b) -> IO b)
     -> SourceT IO ByteString)
    -> (forall b. (StepT IO ByteString -> IO b) -> IO b)
    -> SourceT IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \StepT IO ByteString -> IO b
    k ->
        String -> IOMode -> (Handle -> IO b) -> IO b
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withFile String
    fp IOMode
    ReadMode ((Handle -> IO b) -> IO b) -> (Handle -> IO b) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \Handle
    hdl ->
        StepT IO ByteString -> IO b
    k (Handle -> StepT IO ByteString
    readHandle Handle
    hdl)
      where
        readHandle :: Handle -> StepT IO BS.ByteString
        readHandle :: Handle -> StepT IO ByteString
    readHandle Handle
    hdl = (ByteString -> Bool) -> IO ByteString -> StepT IO ByteString
    forall (m :: Type -> Type) a.
    Functor m =>
    (a -> Bool) -> m a -> StepT m a
    fromActionStep ByteString -> Bool
    BS.null (Handle -> Int -> IO ByteString
    BS.hGet Handle
    hdl Int
    4096)

    -------------------------------------------------------------------------------
    -- Attoparsec
    -------------------------------------------------------------------------------

    -- | Transform using @attoparsec@ parser.
    --
    -- Note: @parser@ should not accept empty input!
    --
    -- >>> let parser = A.skipWhile A8.isSpace_w8 >> A.takeWhile1 A8.isDigit_w8
    --
    -- >>> runExcept $ runSourceT $ transformWithAtto parser (source $ [fromString "1 2 3"])
    -- Right ["1","2","3"]
    --
    -- >>> runExcept $ runSourceT $ transformWithAtto parser (source $ map fromString ["1", "2", "3"])
    -- Right ["123"]
    --
    -- >>> runExcept $ runSourceT $ transformWithAtto parser (source $ map fromString ["1", "2 3", "4"])
    -- Right ["12","34"]
    --
    -- >>> runExcept $ runSourceT $ transformWithAtto parser (source [fromString "foobar"])
    -- Left "Failed reading: takeWhile1"
    --
    transformWithAtto :: Monad m => A.Parser a -> SourceT m BS.ByteString -> SourceT m a
    transformWithAtto :: forall (m :: Type -> Type) a.
    Monad m =>
    Parser a -> SourceT m ByteString -> SourceT m a
    transformWithAtto Parser a
    parser = (StepT m ByteString -> StepT m a)
    -> SourceT m ByteString -> SourceT m a
    forall (m :: Type -> Type) a b.
    (StepT m a -> StepT m b) -> SourceT m a -> SourceT m b
    mapStepT (Parser a -> StepT m ByteString -> StepT m a
    forall a (m :: Type -> Type).
    Monad m =>
    Parser a -> StepT m ByteString -> StepT m a
    transformStepWithAtto Parser a
    parser)

    transformStepWithAtto
        :: forall a m. Monad m
        => A.Parser a -> StepT m BS.ByteString -> StepT m a
    transformStepWithAtto :: forall a (m :: Type -> Type).
    Monad m =>
    Parser a -> StepT m ByteString -> StepT m a
    transformStepWithAtto Parser a
    parser = (ByteString -> Result a) -> StepT m ByteString -> StepT m a
    go (Parser a -> ByteString -> Result a
    forall a. Parser a -> ByteString -> Result a
    A.parse Parser a
    parser) where
        p0 :: ByteString -> Result a
    p0 = Parser a -> ByteString -> Result a
    forall a. Parser a -> ByteString -> Result a
    A.parse Parser a
    parser

        go :: (BS.ByteString -> A.Result a)
           -> StepT m BS.ByteString -> StepT m a
        go :: (ByteString -> Result a) -> StepT m ByteString -> StepT m a
    go ByteString -> Result a
    _ (Error String
    err)  = String -> StepT m a
    forall (m :: Type -> Type) a. String -> StepT m a
    Error String
    err
        go ByteString -> Result a
    p (Skip StepT m ByteString
    s)     = StepT m a -> StepT m a
    forall (m :: Type -> Type) a. StepT m a -> StepT m a
    Skip ((ByteString -> Result a) -> StepT m ByteString -> StepT m a
    go ByteString -> Result a
    p StepT m ByteString
    s)
        go ByteString -> Result a
    p (Effect m (StepT m ByteString)
    ms)  = m (StepT m a) -> StepT m a
    forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
    Effect ((StepT m ByteString -> StepT m a)
    -> m (StepT m ByteString) -> m (StepT m a)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((ByteString -> Result a) -> StepT m ByteString -> StepT m a
    go ByteString -> Result a
    p) m (StepT m ByteString)
    ms)
        go ByteString -> Result a
    p StepT m ByteString
    Stop         = case ByteString -> Result a
    p ByteString
    forall a. Monoid a => a
    mempty of
            A.Fail ByteString
    _ [String]
    _ String
    err -> String -> StepT m a
    forall (m :: Type -> Type) a. String -> StepT m a
    Error String
    err
            A.Done ByteString
    _ a
    a     -> a -> StepT m a -> StepT m a
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield a
    a StepT m a
    forall (m :: Type -> Type) a. StepT m a
    Stop
            A.Partial ByteString -> Result a
    _    -> StepT m a
    forall (m :: Type -> Type) a. StepT m a
    Stop
        go ByteString -> Result a
    p (Yield ByteString
    bs0 StepT m ByteString
    s) = (ByteString -> Result a) -> ByteString -> StepT m a
    loop ByteString -> Result a
    p ByteString
    bs0 where
            loop :: (ByteString -> Result a) -> ByteString -> StepT m a
    loop ByteString -> Result a
    p' ByteString
    bs
                | ByteString -> Bool
    BS.null ByteString
    bs = StepT m a -> StepT m a
    forall (m :: Type -> Type) a. StepT m a -> StepT m a
    Skip ((ByteString -> Result a) -> StepT m ByteString -> StepT m a
    go ByteString -> Result a
    p' StepT m ByteString
    s)
                | Bool
    otherwise  = case ByteString -> Result a
    p' ByteString
    bs of
                    A.Fail ByteString
    _ [String]
    _ String
    err -> String -> StepT m a
    forall (m :: Type -> Type) a. String -> StepT m a
    Error String
    err
                    A.Done ByteString
    bs' a
    a   -> a -> StepT m a -> StepT m a
    forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
    Yield a
    a ((ByteString -> Result a) -> ByteString -> StepT m a
    loop ByteString -> Result a
    p0 ByteString
    bs')
                    A.Partial ByteString -> Result a
    p''  -> StepT m a -> StepT m a
    forall (m :: Type -> Type) a. StepT m a -> StepT m a
    Skip ((ByteString -> Result a) -> StepT m ByteString -> StepT m a
    go ByteString -> Result a
    p'' StepT m ByteString
    s)