    {-|

    Element-agnostic grouping utilities for @pipes@

    See "Pipes.Group.Tutorial" for an extended tutorial

    Some type signatures below refer to the aliases below, which are not used in
    this library, but are included to simplify the documentation.

    @
    type Groups         a m x = 'FreeT' ('Producer' a m) m x
    type Splitter       a m x = 'Producer' a m x -> Groups a m x
    type Transformation a m x = Groups a m x -> Groups a m x
    type Joiner         a m x = Groups a m x -> 'Producer' a m x
    @
    -}

    {-# LANGUAGE RankNTypes #-}

    module Pipes.Group (
        -- * Lenses
        groups,
        groupsBy,
        groupsBy',
        chunksOf,

        -- * Transformations
        takes,
        takes',
        drops,
        maps,
        individually,

        -- * Joiners
        concats,
        intercalates,

        -- * Folds
        -- $folds
        folds,
        foldsM,

        -- * Re-exports
        -- $reexports
        module Control.Monad.Trans.Class,
        module Control.Monad.Trans.Free,
        module Pipes
        ) where

    import Control.Monad.Trans.Class (lift)
    import Control.Monad.Trans.Free (FreeF(Pure, Free), FreeT(FreeT, runFreeT))
    import qualified Control.Monad.Trans.Free as F
    import Data.Functor.Constant (Constant(Constant, getConstant))
    import Data.Functor.Identity (Identity(Identity, runIdentity))
    import Pipes (Producer, yield, next)
    import Pipes.Parse (span, splitAt)
    import qualified Pipes as P

    import Prelude hiding (span, splitAt)

    type Lens a' a b' b = forall f . Functor f => (b' -> f b) -> (a' -> f a)
    type Setter a' a b' b = (b' -> Identity b) -> (a' -> Identity a)

    (^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
    a ^. lens = getConstant (lens Constant a)

    {-| 'groupsBy' splits a 'Producer' into a 'FreeT' of 'Producer's grouped using
        the given equality predicate

    @
          groupsBy p  :: Monad m => Lens' ('Producer' a m x) (Groups a m x)
    view (groupsBy p) :: Monad m => Splitter a m x
    set  (groupsBy p) :: Monad m => Groups a m x -> 'Producer' a m x -> 'Producer' a m x
    over (groupsBy p) :: Monad m => Transformation a m x -> 'Producer' a m x -> 'Producer' a m x
    @

    >>> import Lens.Family (view)
    >>> import Pipes (yield, each)
    >>> import Pipes.Prelude (toList)
    >>> (toList . intercalates (yield '|') . view (groupsBy (==))) (each "12233345")
    "1|22|333|4|5"
    -}
    groupsBy
        :: Monad m
        => (a' -> a' -> Bool)
        -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x)
    groupsBy equals k p0 = fmap concats (k (_groupsBy p0))
      where
    --  _groupsBy :: Monad m => Producer a m r -> FreeT (Producer a m) m r
        _groupsBy p = FreeT $ do
            x <- next p
            return $ case x of
                Left   r      -> Pure r
                Right (a, p') -> Free $
                    fmap _groupsBy (yield a >> (p' ^. span (equals a)))
    {-# INLINABLE groupsBy #-}

    {-| `groupsBy'` splits a 'Producer' into a 'FreeT' of 'Producer's grouped using
        the given equality predicate

        This differs from `groupsBy` by comparing successive elements for equality
        instead of comparing each element to the first member of the group

    >>> import Lens.Family (view)
    >>> import Pipes (yield, each)
    >>> import Pipes.Prelude (toList)
    >>> let cmp c1 c2 = succ c1 == c2
    >>> (toList . intercalates (yield '|') . view (groupsBy' cmp)) (each "12233345")
    "12|23|3|345"
    >>> (toList . intercalates (yield '|') . view (groupsBy  cmp)) (each "12233345")
    "122|3|3|34|5"

    @
          groupsBy' p  :: Monad m => Lens' ('Producer' a m x) (Groups a m x)
    view (groupsBy' p) :: Monad m => Splitter a m x
    set  (groupsBy' p) :: Monad m => Groups a m x -> 'Producer' a m x -> 'Producer' a m x
    over (groupsBy' p) :: Monad m => Transformation a m x -> 'Producer' a m x -> 'Producer' a m x
    @
    -}
    groupsBy'
        :: Monad m
        => (a' -> a' -> Bool) -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x)
    groupsBy' equals k p0 = fmap concats (k (_groupsBy p0))
      where
    --  _groupsBy :: Monad m => Producer a m r -> FreeT (Producer a m) m r
        _groupsBy p = FreeT $ do
            x <- next p
            return $ case x of
                Left   r      -> Pure r
                Right (a, p') -> Free (fmap _groupsBy (loop0 (yield a >> p')))

    --  loop0
    --      :: Monad m
    --      => Producer a m r
    --      -> Producer a m (Producer a m r)
        loop0 p1 = do
            x <- lift (next p1)
            case x of
                Left   r      -> return (return r)
                Right (a2, p2) -> do
                    yield a2
                    let loop1 a p = do
                            y <- lift (next p)
                            case y of
                                Left   r      -> return (return r)
                                Right (a', p') ->
                                    if equals a a'
                                    then do
                                        yield a'
                                        loop1 a' p'
                                    else return (yield a' >> p')
                    loop1 a2 p2
    {-# INLINABLE groupsBy' #-}

    {-| Like 'groupsBy', where the equality predicate is ('==')

    @
         groups :: Monad m => Lens' ('Producer' a m x) (Groups a m x)
    view groups :: Monad m => Splitter a m x
    set  groups :: Monad m => Groups a m x -> 'Producer' a m x -> 'Producer' a m x
    over groups :: Monad m => Transformation a m x -> 'Producer' a m x -> 'Producer' a m x
    @

    >>> import Lens.Family (view)
    >>> import Pipes (yield, each)
    >>> import Pipes.Prelude (toList)
    >>> (toList . intercalates (yield '|') . view groups) (each "12233345")
    "1|22|333|4|5"
    -}
    groups :: (Monad m, Eq a') => Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x)
    groups = groupsBy (==)
    {-# INLINABLE groups #-}

    {-| 'chunksOf' is an splits a 'Producer' into a 'FreeT' of 'Producer's of fixed
        length

    @
          chunksOf n  :: Monad m => Lens' ('Producer' a m x) (Groups a m x)
    view (chunksOf n) :: Monad m => Splitter a m x
    set  (chunksOf n) :: Monad m => Groups a m x -> 'Producer' a m x -> 'Producer' a m x
    over (chunksOf n) :: Monad m => Transformation a m x -> 'Producer' a m x -> 'Producer' a m x
    @

    >>> import Lens.Family (view)
    >>> import Pipes (yield, each)
    >>> import Pipes.Prelude (toList)
    >>> (toList . intercalates (yield '|') . view (chunksOf 3)) (each "12233345")
    "122|333|45"
    -}
    chunksOf
        :: Monad m => Int -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x)
    chunksOf n0 k p0 = fmap concats (k (_chunksOf p0))
      where
    --  _chunksOf :: Monad m => Producer a m x -> FreeT (Producer a m) m x
        _chunksOf p = FreeT $ do
            x <- next p
            return $ case x of
                Left   r      -> Pure r
                Right (a, p') -> Free $ fmap _chunksOf ((yield a >> p')^.splitAt n0)
    {-# INLINABLE chunksOf #-}

    -- | Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer'
    --
    -- @
    -- concats :: Monad m => Joiner a m x
    -- @
    concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x
    concats = go
      where
        go f = do
            x <- lift (runFreeT f)
            case x of
                Pure r -> return r
                Free p -> do
                    f' <- p
                    go f'
    {-# INLINABLE concats #-}

    {-| Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' by
        intercalating a 'Producer' in between them

    @
    intercalates :: Monad m => 'Producer' a m () -> Joiner a m x
    @
    -}
    intercalates
        :: Monad m => Producer a m () -> FreeT (Producer a m) m x -> Producer a m x
    intercalates sep = go0
      where
        go0 f = do
            x <- lift (runFreeT f)
            case x of
                Pure r -> return r
                Free p -> do
                    f' <- p
                    go1 f'
        go1 f = do
            x <- lift (runFreeT f)
            case x of
                Pure r -> return r
                Free p -> do
                    sep
                    f' <- p
                    go1 f'
    {-# INLINABLE intercalates #-}

    {-| @(takes n)@ only keeps the first @n@ functor layers of a 'FreeT'

    @
    takes :: Monad m => Int -> Groups a m () -> Groups a m ()
    @

    >>> import Lens.Family (view)
    >>> import Pipes (yield, each)
    >>> import Pipes.Prelude (toList)
    >>> (toList . intercalates (yield '|') . takes 3 . view groups) (each "12233345")
    "1|22|333"
    -}
    takes :: (Functor f, Monad m) => Int -> FreeT f m () -> FreeT f m ()
    takes = go
      where
        go n f =
            if (n > 0)
            then FreeT $ do
                x <- runFreeT f
                case x of
                    Pure () -> return (Pure ())
                    Free w  -> return (Free (fmap (go $! n - 1) w))
            else return ()
    {-# INLINABLE takes #-}

    {-| @(takes' n)@ only keeps the first @n@ 'Producer's of a 'FreeT'

        'takes'' differs from 'takes' by draining unused 'Producer's in order
        to preserve the return value.  This makes it a suitable argument for 'maps'.

    @
    takes' :: Monad m => Int -> Transformation a m x
    @
    -}
    takes' :: Monad m => Int -> FreeT (Producer a m) m x -> FreeT (Producer a m) m x
    takes' = go0
      where
        go0 n f = FreeT $
            if (n > 0)
            then do
                x <- runFreeT f
                return $ case x of
                    Pure r -> Pure r
                    Free p -> Free $ fmap (go0 $! n - 1) p
            else go1 f
        go1 f = do
            x <- runFreeT f
            case x of
                Pure r -> return (Pure r)
                Free p -> do
                    f' <- P.runEffect (P.for p P.discard)
                    go1 f'
    {-# INLINABLE takes' #-}

    {-| @(drops n)@ peels off the first @n@ 'Producer' layers of a 'FreeT'

    @
    drops :: Monad m => Int -> Transformation a m x
    @

    >>> import Lens.Family (view)
    >>> import Pipes (yield, each)
    >>> import Pipes.Prelude (toList)
    >>> (toList . intercalates (yield '|') . drops 3 . view groups) (each "12233345")
    "4|5"

        __Use carefully__: the peeling off is not free.   This runs the first @n@
        layers, just discarding everything they produce.
    -}
    drops :: Monad m => Int -> FreeT (Producer a m) m x -> FreeT (Producer a m) m x
    drops = go
      where
        go n ft
            | n <= 0 = ft
            | otherwise = FreeT $ do
                ff <- runFreeT ft
                case ff of
                    Pure _ -> return ff
                    Free f -> do
                        ft' <- P.runEffect $ P.for f P.discard
                        runFreeT $ go (n-1) ft'
    {-# INLINABLE drops #-}

    {-| Transform each individual functor layer of a 'FreeT'

        You can think of this as:

    > maps
    >     :: (forall r . Producer a m r -> Producer b m r)
    >     -> FreeT (Producer a m) m x -> FreeT (Producer b m) m x

        This is just a synonym for 'F.transFreeT'
    -}
    maps
        :: (Monad m, Functor g)
        => (forall r . f r -> g r) -> FreeT f m x -> FreeT g m x
    maps = F.transFreeT
    {-# INLINABLE maps #-}

    {-| Lens to transform each individual functor layer of a 'FreeT'. (@over
        'individually'@) is equivalent to 'maps', but with a less general type.

    @
    type Group a m x = 'Producer' a m (Groups a m x)

    set  individually :: Monad m => Group a m x -> Transformation a m x
    over individually :: Monad m => (Group a m x -> Group a m x) -> Transformation a m x
    @
    -}
    individually
        :: (Monad m, Functor g)
        => Setter (FreeT f m x) (FreeT g m x) (f (FreeT f m x)) (g (FreeT f m x))
    individually nat f0 = Identity (go f0)
      where
        nat' = runIdentity . nat
        go f = FreeT $ do
            x <- runFreeT f
            return $ case x of
                Pure r -> Pure r
                Free w -> Free (fmap go (nat' w))
    {-# INLINABLE individually #-}

    {- $folds
        These folds are designed to be compatible with the @foldl@ library.  See
        the 'Control.Foldl.purely' and 'Control.Foldl.impurely' functions from that
        library for more details.

        For example, to count the number of 'Producer' layers in a 'FreeT', you can
        write:

    > import Control.Applicative (pure)
    > import qualified Control.Foldl as L
    > import Pipes.Group
    > import qualified Pipes.Prelude as P
    >
    > count :: Monad m => FreeT (Producer a m) m () -> m Int
    > count = P.sum . L.purely folds (pure 1)
    -}
    {-| Fold each 'Producer' of a 'FreeT'

    @
    'Control.Foldl.purely' folds :: Monad m => 'Control.Foldl.Fold' a b -> Groups a m r -> 'Producer' b m r
    @
    -}
    folds
        :: Monad m
        => (x -> a -> x)
        -- ^ Step function
        -> x
        -- ^ Initial accumulator
        -> (x -> b)
        -- ^ Extraction function
        -> FreeT (Producer a m) m r
        -- ^
        -> Producer b m r
    folds step begin done = go
      where
        go f = do
            x <- lift (runFreeT f)
            case x of
                Pure r -> return r
                Free p -> do
                    (f', b) <- lift (fold p begin)
                    yield b
                    go f'

        fold p x = do
            y <- next p
            case y of
                Left   f      -> return (f, done x)
                Right (a, p') -> fold p' $! step x a
    {-# INLINABLE folds #-}

    {-| Fold each 'Producer' of a 'FreeT', monadically

    @
    'Control.Foldl.impurely' foldsM :: Monad m => 'Control.Foldl.FoldM' a b -> Groups a m r -> 'Producer' b m r
    @
    -}
    foldsM
        :: Monad m
        => (x -> a -> m x)
        -- ^ Step function
        -> m x
        -- ^ Initial accumulator
        -> (x -> m b)
        -- ^ Extraction function
        -> FreeT (Producer a m) m r
        -- ^
        -> Producer b m r
    foldsM step begin done = go
      where
        go f = do
            y <- lift (runFreeT f)
            case y of
                Pure r -> return r
                Free p -> do
                    (f', b) <- lift $ do
                        x <- begin
                        foldM p x
                    yield b
                    go f'

        foldM p x = do
            y <- next p
            case y of
                Left   f      -> do
                    b <- done x
                    return (f, b)
                Right (a, p') -> do
                    x' <- step x a
                    foldM p' $! x'
    {-# INLINABLE foldsM #-}
    {- $reexports
        "Control.Monad.Trans.Class" re-exports 'lift'.

        "Control.Monad.Trans.Free" re-exports 'FreeF' and 'FreeT'

        "Pipes" re-exports 'Producer', 'yield', and 'next'.
    -}