{-| This module provides efficient and streaming left map-with-accumulator that
    you can combine using 'Applicative' style.

    Import this module qualified to avoid clashing with the Prelude:

>>> import qualified Control.Scanl as SL

    Use 'scan' to apply a 'Scan' to a list (or other 'Traversable' structures)
    from left to right, and 'scanr' to do so from right to left.

    Note that the `Scan` type does not supersede the `Fold` type nor does the
    `Fold` type supersede the `Scan` type.  Each type has a unique advantage.

    For example, `Scan`s can be chained end-to-end:

    > (>>>) :: Scan a b -> Scan b c -> Scan a c

    In other words, `Scan` is an instance of the `Category` typeclass.

    `Fold`s cannot be chained end-to-end

    Vice versa, `Fold`s can produce a result even when fed no input:

    > extract :: Fold a b -> b

    In other words, `Fold` is an instance of the `Comonad` typeclass.

    A `Scan` cannot produce any output until provided with at least one
    input.
-}

{-# LANGUAGE CPP                       #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE TupleSections             #-}

module Control.Scanl (
    -- * Scan Types
      Scan(..)
    , ScanM(..)

    -- * Scanning
    , scan
    , scanM
    , scanr

    , prescan
    , postscan

    -- * Utilities
    -- $utilities
    , purely
    , purely_
    , impurely
    , impurely_
    , generalize
    , simplify
    , hoists
    , arrM
    , premap
    , premapM
    ) where

import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Foldl (Fold(..))
import Control.Foldl.Internal (Pair(..))
import Control.Monad ((<=<))
import Control.Monad.Trans.Class
import qualified Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict
import Data.Functor.Identity
import Data.Monoid hiding ((<>))
import Data.Profunctor
import Data.Traversable
import Data.Tuple (swap)
import Prelude hiding ((.), id, scanr)

#if MIN_VERSION_base(4, 7, 0)
import Data.Coerce
#endif

asLazy :: StateT s m a -> Lazy.StateT s m a
asLazy :: forall s (m :: * -> *) a. StateT s m a -> StateT s m a
asLazy = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT

--import qualified Control.Foldl as L

{-| Efficient representation of a left map-with-accumulator that preserves the
    scan's step function and initial accumulator.

    This allows the 'Applicative' instance to assemble derived scans that
    traverse the container only once

    A \''Scan' a b\' processes elements of type __a__ replacing each with a
    value of type __b__.
-}
data Scan a b
  -- | @Scan @ @ step @ @ initial @
  = forall x. Scan (a -> State x b) x

instance Functor (Scan a) where
    fmap :: forall a b. (a -> b) -> Scan a a -> Scan a b
fmap a -> b
f (Scan a -> State x a
step x
begin) = forall a b x. (a -> State x b) -> x -> Scan a b
Scan (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> State x a
step) x
begin
    {-# INLINE fmap #-}

instance Applicative (Scan a) where
    pure :: forall a. a -> Scan a a
pure a
b    = forall a b x. (a -> State x b) -> x -> Scan a b
Scan (\a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b) ()
    {-# INLINE pure #-}

    (Scan a -> State x (a -> b)
stepL x
beginL) <*> :: forall a b. Scan a (a -> b) -> Scan a a -> Scan a b
<*> (Scan a -> State x a
stepR x
beginR) =
        let step :: a -> Pair x x -> (b, Pair x x)
step a
a (Pair x
xL x
xR) = (a -> b
bL a
bR, (forall a b. a -> b -> Pair a b
Pair x
xL' x
xR'))
              where (a -> b
bL, x
xL') = forall s a. State s a -> s -> (a, s)
runState (a -> State x (a -> b)
stepL a
a) x
xL
                    (a
bR, x
xR') = forall s a. State s a -> s -> (a, s)
runState (a -> State x a
stepR a
a) x
xR
            begin :: Pair x x
begin = forall a b. a -> b -> Pair a b
Pair x
beginL x
beginR
        in  forall a b x. (a -> State x b) -> x -> Scan a b
Scan (forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Pair x x -> (b, Pair x x)
step) Pair x x
begin
    {-# INLINE (<*>) #-}

instance Profunctor Scan where
    lmap :: forall a b c. (a -> b) -> Scan b c -> Scan a c
lmap = forall a b c. (a -> b) -> Scan b c -> Scan a c
premap
    rmap :: forall b c a. (b -> c) -> Scan a b -> Scan a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Category Scan where
    id :: forall a. Scan a a
id = forall a b x. (a -> State x b) -> x -> Scan a b
Scan forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    {-# INLINE id #-}
    (Scan b -> State x c
s2 x
b2) . :: forall b c a. Scan b c -> Scan a b -> Scan a c
. (Scan a -> State x b
s1 x
b1) = forall a b x. (a -> State x b) -> x -> Scan a b
Scan (forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Pair x x -> (c, Pair x x)
step) (forall a b. a -> b -> Pair a b
Pair x
b1 x
b2)
        where step :: a -> Pair x x -> (c, Pair x x)
step a
a (Pair x
xL x
xR) = (c
c, forall a b. a -> b -> Pair a b
Pair x
xL' x
xR')
                where (b
b, x
xL') = forall s a. State s a -> s -> (a, s)
runState (a -> State x b
s1 a
a) x
xL
                      (c
c, x
xR') = forall s a. State s a -> s -> (a, s)
runState (b -> State x c
s2 b
b) x
xR
    {-# INLINE (.) #-}

instance Arrow Scan where
    arr :: forall b c. (b -> c) -> Scan b c
arr b -> c
f = forall a b x. (a -> State x b) -> x -> Scan a b
Scan (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> c
f) ()
    {-# INLINE arr #-}
    first :: forall b c d. Scan b c -> Scan (b, d) (c, d)
first  (Scan b -> State x c
step x
begin) = forall a b x. (a -> State x b) -> x -> Scan a b
Scan
      (\(b
a,d
b) -> forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \x
x -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (,d
b) forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> (a, s)
runState (b -> State x c
step b
a) x
x)
      x
begin
    {-# INLINE first #-}
    second :: forall b c d. Scan b c -> Scan (d, b) (d, c)
second (Scan b -> State x c
step x
begin) = forall a b x. (a -> State x b) -> x -> Scan a b
Scan
      (\(d
b,b
a) -> forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \x
x  -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (d
b,) forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> (a, s)
runState (b -> State x c
step b
a) x
x)
      x
begin
    {-# INLINE second #-}

instance Semigroup b => Semigroup (Scan a b) where
    <> :: Scan a b -> Scan a b -> Scan a b
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE (<>) #-}

instance Monoid b => Monoid (Scan a b) where
    mempty :: Scan a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}

    mappend :: Scan a b -> Scan a b -> Scan a b
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend
    {-# INLINE mappend #-}

instance Num b => Num (Scan a b) where
    fromInteger :: Integer -> Scan a b
fromInteger = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => Integer -> a
fromInteger
    {-# INLINE fromInteger #-}

    negate :: Scan a b -> Scan a b
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate
    {-# INLINE negate #-}

    abs :: Scan a b -> Scan a b
abs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
abs
    {-# INLINE abs #-}

    signum :: Scan a b -> Scan a b
signum = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
signum
    {-# INLINE signum #-}

    + :: Scan a b -> Scan a b -> Scan a b
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+)
    {-# INLINE (+) #-}

    * :: Scan a b -> Scan a b -> Scan a b
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(*)
    {-# INLINE (*) #-}

    (-) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
    {-# INLINE (-) #-}

instance Fractional b => Fractional (Scan a b) where
    fromRational :: Rational -> Scan a b
fromRational = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Fractional a => Rational -> a
fromRational
    {-# INLINE fromRational #-}

    recip :: Scan a b -> Scan a b
recip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Fractional a => a -> a
recip
    {-# INLINE recip #-}

    / :: Scan a b -> Scan a b -> Scan a b
(/) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Fractional a => a -> a -> a
(/)
    {-# INLINE (/) #-}

instance Floating b => Floating (Scan a b) where
    pi :: Scan a b
pi = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Floating a => a
pi
    {-# INLINE pi #-}

    exp :: Scan a b -> Scan a b
exp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
exp
    {-# INLINE exp #-}

    sqrt :: Scan a b -> Scan a b
sqrt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sqrt
    {-# INLINE sqrt #-}

    log :: Scan a b -> Scan a b
log = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
log
    {-# INLINE log #-}

    sin :: Scan a b -> Scan a b
sin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sin
    {-# INLINE sin #-}

    tan :: Scan a b -> Scan a b
tan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tan
    {-# INLINE tan #-}

    cos :: Scan a b -> Scan a b
cos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cos
    {-# INLINE cos #-}

    asin :: Scan a b -> Scan a b
asin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asin
    {-# INLINE asin #-}

    atan :: Scan a b -> Scan a b
atan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atan
    {-# INLINE atan #-}

    acos :: Scan a b -> Scan a b
acos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acos
    {-# INLINE acos #-}

    sinh :: Scan a b -> Scan a b
sinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sinh
    {-# INLINE sinh #-}

    tanh :: Scan a b -> Scan a b
tanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tanh
    {-# INLINE tanh #-}

    cosh :: Scan a b -> Scan a b
cosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cosh
    {-# INLINE cosh #-}

    asinh :: Scan a b -> Scan a b
asinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asinh
    {-# INLINE asinh #-}

    atanh :: Scan a b -> Scan a b
atanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atanh
    {-# INLINE atanh #-}

    acosh :: Scan a b -> Scan a b
acosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acosh
    {-# INLINE acosh #-}

    ** :: Scan a b -> Scan a b -> Scan a b
(**) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
(**)
    {-# INLINE (**) #-}

    logBase :: Scan a b -> Scan a b -> Scan a b
logBase = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
logBase
    {-# INLINE logBase #-}

{-| Like 'Scan', but monadic.

    A \''ScanM' m a b\' processes elements of type __a__ and
    results in a monadic value of type __m b__.
-}
data ScanM m a b =
  -- | @ScanM @ @ step @ @ initial @ @ extract@
  forall x . ScanM (a -> StateT x m b) (m x)

instance Functor m => Functor (ScanM m a) where
    fmap :: forall a b. (a -> b) -> ScanM m a a -> ScanM m a b
fmap a -> b
f (ScanM a -> StateT x m a
step m x
begin) = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> StateT x m a
step) m x
begin
    {-# INLINE fmap #-}

instance Applicative m => Applicative (ScanM m a) where
    pure :: forall a. a -> ScanM m a a
pure a
b    = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (\a
_ -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \() -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
b, ())) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    {-# INLINE pure #-}

    (ScanM a -> StateT x m (a -> b)
stepL m x
beginL) <*> :: forall a b. ScanM m a (a -> b) -> ScanM m a a -> ScanM m a b
<*> (ScanM a -> StateT x m a
stepR m x
beginR) =
        let step :: a -> Pair x x -> m (b, Pair x x)
step a
a (Pair x
xL x
xR) =
              (\(a -> b
bL, x
xL') (a
bR, x
xR') -> (a -> b
bL a
bR, (forall a b. a -> b -> Pair a b
Pair x
xL' x
xR')))
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT x m (a -> b)
stepL a
a) x
xL
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT x m a
stepR a
a) x
xR
            begin :: m (Pair x x)
begin = forall a b. a -> b -> Pair a b
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
beginL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m x
beginR
        in  forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Pair x x -> m (b, Pair x x)
step) m (Pair x x)
begin
    {-# INLINE (<*>) #-}

instance Functor m => Profunctor (ScanM m) where
    rmap :: forall b c a. (b -> c) -> ScanM m a b -> ScanM m a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    lmap :: forall a b c. (a -> b) -> ScanM m b c -> ScanM m a c
lmap a -> b
f (ScanM b -> StateT x m c
step m x
begin) = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (b -> StateT x m c
step forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f) m x
begin

instance Monad m => Category (ScanM m) where
    id :: forall a. ScanM m a a
id = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    {-# INLINE id #-}
    (ScanM b -> StateT x m c
s2 m x
b2) . :: forall b c a. ScanM m b c -> ScanM m a b -> ScanM m a c
. (ScanM a -> StateT x m b
s1 m x
b1) = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Pair x x -> m (c, Pair x x)
step) (forall a b. a -> b -> Pair a b
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
b1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m x
b2)
        where step :: a -> Pair x x -> m (c, Pair x x)
step a
a (Pair x
xL x
xR) = do
                (b
b, x
xL') <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT x m b
s1 a
a) x
xL
                (c
c, x
xR') <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (b -> StateT x m c
s2 b
b) x
xR
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (c
c, forall a b. a -> b -> Pair a b
Pair x
xL' x
xR')
    {-# INLINE (.) #-}

instance Monad m => Arrow (ScanM m) where
    arr :: forall b c. (b -> c) -> ScanM m b c
arr b -> c
f = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> c
f) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    {-# INLINE arr #-}
    first :: forall b c d. ScanM m b c -> ScanM m (b, d) (c, d)
first  (ScanM b -> StateT x m c
step m x
begin) = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM
      (\(b
a,d
b) -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \x
x -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (,d
b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (b -> StateT x m c
step b
a) x
x)
      m x
begin
    {-# INLINE first #-}
    second :: forall b c d. ScanM m b c -> ScanM m (d, b) (d, c)
second (ScanM b -> StateT x m c
step m x
begin) = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM
      (\(d
b,b
a) -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \x
x  -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (d
b,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (b -> StateT x m c
step b
a) x
x)
      m x
begin
    {-# INLINE second #-}

instance (Monad m, Semigroup b) => Semigroup (ScanM m a b) where
    <> :: ScanM m a b -> ScanM m a b -> ScanM m a b
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE (<>) #-}

instance (Monad m, Monoid b) => Monoid (ScanM m a b) where
    mempty :: ScanM m a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}

    mappend :: ScanM m a b -> ScanM m a b -> ScanM m a b
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend
    {-# INLINE mappend #-}

instance (Monad m, Num b) => Num (ScanM m a b) where
    fromInteger :: Integer -> ScanM m a b
fromInteger = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => Integer -> a
fromInteger
    {-# INLINE fromInteger #-}

    negate :: ScanM m a b -> ScanM m a b
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate
    {-# INLINE negate #-}

    abs :: ScanM m a b -> ScanM m a b
abs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
abs
    {-# INLINE abs #-}

    signum :: ScanM m a b -> ScanM m a b
signum = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
signum
    {-# INLINE signum #-}

    + :: ScanM m a b -> ScanM m a b -> ScanM m a b
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+)
    {-# INLINE (+) #-}

    * :: ScanM m a b -> ScanM m a b -> ScanM m a b
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(*)
    {-# INLINE (*) #-}

    (-) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
    {-# INLINE (-) #-}

instance (Monad m, Fractional b) => Fractional (ScanM m a b) where
    fromRational :: Rational -> ScanM m a b
fromRational = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Fractional a => Rational -> a
fromRational
    {-# INLINE fromRational #-}

    recip :: ScanM m a b -> ScanM m a b
recip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Fractional a => a -> a
recip
    {-# INLINE recip #-}

    / :: ScanM m a b -> ScanM m a b -> ScanM m a b
(/) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Fractional a => a -> a -> a
(/)
    {-# INLINE (/) #-}

instance (Monad m, Floating b) => Floating (ScanM m a b) where
    pi :: ScanM m a b
pi = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Floating a => a
pi
    {-# INLINE pi #-}

    exp :: ScanM m a b -> ScanM m a b
exp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
exp
    {-# INLINE exp #-}

    sqrt :: ScanM m a b -> ScanM m a b
sqrt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sqrt
    {-# INLINE sqrt #-}

    log :: ScanM m a b -> ScanM m a b
log = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
log
    {-# INLINE log #-}

    sin :: ScanM m a b -> ScanM m a b
sin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sin
    {-# INLINE sin #-}

    tan :: ScanM m a b -> ScanM m a b
tan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tan
    {-# INLINE tan #-}

    cos :: ScanM m a b -> ScanM m a b
cos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cos
    {-# INLINE cos #-}

    asin :: ScanM m a b -> ScanM m a b
asin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asin
    {-# INLINE asin #-}

    atan :: ScanM m a b -> ScanM m a b
atan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atan
    {-# INLINE atan #-}

    acos :: ScanM m a b -> ScanM m a b
acos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acos
    {-# INLINE acos #-}

    sinh :: ScanM m a b -> ScanM m a b
sinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sinh
    {-# INLINE sinh #-}

    tanh :: ScanM m a b -> ScanM m a b
tanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tanh
    {-# INLINE tanh #-}

    cosh :: ScanM m a b -> ScanM m a b
cosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cosh
    {-# INLINE cosh #-}

    asinh :: ScanM m a b -> ScanM m a b
asinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asinh
    {-# INLINE asinh #-}

    atanh :: ScanM m a b -> ScanM m a b
atanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atanh
    {-# INLINE atanh #-}

    acosh :: ScanM m a b -> ScanM m a b
acosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acosh
    {-# INLINE acosh #-}

    ** :: ScanM m a b -> ScanM m a b -> ScanM m a b
(**) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
(**)
    {-# INLINE (**) #-}

    logBase :: ScanM m a b -> ScanM m a b -> ScanM m a b
logBase = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
logBase
    {-# INLINE logBase #-}

-- | Apply a strict left 'Scan' to a 'Traversable' container
scan :: Traversable t => Scan a b -> t a -> t b
-- To make it possible to consume the generated structure lazily, we must
-- 'traverse' with lazy 'StateT'.
scan :: forall (t :: * -> *) a b. Traversable t => Scan a b -> t a -> t b
scan (Scan a -> State x b
step x
begin) t a
as = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> (a, s)
Lazy.runState (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s (m :: * -> *) a. StateT s m a -> StateT s m a
asLazy forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> State x b
step) t a
as) x
begin
{-# INLINE scan #-}

-- | Like 'scan' but start scanning from the right
scanr :: Traversable t => Scan a b -> t a -> t b
scanr :: forall (t :: * -> *) a b. Traversable t => Scan a b -> t a -> t b
scanr (Scan a -> State x b
step x
begin) t a
as =
  forall a b. (a, b) -> a
fst (forall s a. ReverseState s a -> s -> (a, s)
runReverseState (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall s a. State s a -> s -> (a, s)
runState forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> State x b
step) t a
as) x
begin)
{-# INLINE scanr #-}

-- | Like 'scan' but monadic
scanM :: (Traversable t, Monad m) => ScanM m a b -> t a -> m (t b)
-- To make it possible to consume the generated structure lazily, we must
-- 'traverse' with lazy 'StateT'.
scanM :: forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
ScanM m a b -> t a -> m (t b)
scanM (ScanM a -> StateT x m b
step m x
begin) t a
as = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s (m :: * -> *) a. StateT s m a -> StateT s m a
asLazy forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> StateT x m b
step) t a
as) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m x
begin
{-# INLINE scanM #-}

{-| Convert a `Fold` into a prescan

    \"Prescan\" means that the last element of the scan is not included
-}
prescan :: Fold a b -> Scan a b
prescan :: forall a b. Fold a b -> Scan a b
prescan (Fold x -> a -> x
step x
begin x -> b
done) = forall a b x. (a -> State x b) -> x -> Scan a b
Scan (forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> x -> (b, x)
step') x
begin
  where
    step' :: a -> x -> (b, x)
step' a
a x
x = (b
b, x
x')
      where
        x' :: x
x' = x -> a -> x
step x
x a
a
        b :: b
b  = x -> b
done x
x
{-# INLINE prescan #-}

{-| Convert a `Fold` into a postscan

    \"Postscan\" means that the first element of the scan is not included
-}
postscan :: Fold a b -> Scan a b
postscan :: forall a b. Fold a b -> Scan a b
postscan (Fold x -> a -> x
step x
begin x -> b
done) = forall a b x. (a -> State x b) -> x -> Scan a b
Scan (forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> x -> (b, x)
step') x
begin
  where
    step' :: a -> x -> (b, x)
step' a
a x
x = (b
b, x
x')
      where
        x' :: x
x' = x -> a -> x
step x
x a
a
        b :: b
b  = x -> b
done x
x'
{-# INLINE postscan #-}

arrM :: Monad m => (b -> m c) -> ScanM m b c
arrM :: forall (m :: * -> *) b c. Monad m => (b -> m c) -> ScanM m b c
arrM b -> m c
f = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> m c
f) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE arrM #-}

{- $utilities
-}

-- | Upgrade a scan to accept the 'Scan' type
purely :: (forall x . (a -> State x b) -> x -> r) -> Scan a b -> r
purely :: forall a b r.
(forall x. (a -> State x b) -> x -> r) -> Scan a b -> r
purely forall x. (a -> State x b) -> x -> r
f (Scan a -> State x b
step x
begin) = forall x. (a -> State x b) -> x -> r
f a -> State x b
step x
begin
{-# INLINABLE purely #-}

-- | Upgrade a more traditional scan to accept the `Scan` type
purely_ :: (forall x . (x -> a -> (x, b)) -> x -> r) -> Scan a b -> r
purely_ :: forall a b r.
(forall x. (x -> a -> (x, b)) -> x -> r) -> Scan a b -> r
purely_ forall x. (x -> a -> (x, b)) -> x -> r
f (Scan a -> State x b
step x
begin) = forall x. (x -> a -> (x, b)) -> x -> r
f (\x
s a
a -> forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> (a, s)
runState (a -> State x b
step a
a) x
s) x
begin
{-# INLINABLE purely_ #-}

-- | Upgrade a monadic scan to accept the 'ScanM' type
impurely
    :: (forall x . (a -> StateT x m b) -> m x -> r)
    -> ScanM m a b
    -> r
impurely :: forall a (m :: * -> *) b r.
(forall x. (a -> StateT x m b) -> m x -> r) -> ScanM m a b -> r
impurely forall x. (a -> StateT x m b) -> m x -> r
f (ScanM a -> StateT x m b
step m x
begin) = forall x. (a -> StateT x m b) -> m x -> r
f a -> StateT x m b
step m x
begin
{-# INLINABLE impurely #-}

-- | Upgrade a more traditional monadic scan to accept the `ScanM` type
impurely_
    :: Monad m
    => (forall x . (x -> a -> m (x, b)) -> m x -> r)
    -> ScanM m a b
    -> r
impurely_ :: forall (m :: * -> *) a b r.
Monad m =>
(forall x. (x -> a -> m (x, b)) -> m x -> r) -> ScanM m a b -> r
impurely_ forall x. (x -> a -> m (x, b)) -> m x -> r
f (ScanM a -> StateT x m b
step m x
begin) = forall x. (x -> a -> m (x, b)) -> m x -> r
f (\x
s a
a -> forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT x m b
step a
a) x
s) m x
begin

{-| Generalize a `Scan` to a `ScanM`

> generalize (pure r) = pure r
>
> generalize (f <*> x) = generalize f <*> generalize x
-}
generalize :: Monad m => Scan a b -> ScanM m a b
generalize :: forall (m :: * -> *) a b. Monad m => Scan a b -> ScanM m a b
generalize (Scan a -> State x b
step x
begin) = forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> ScanM m a b -> ScanM n a b
hoists
  (\(Identity x
c) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure x
c)
  (forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM a -> State x b
step (forall a. a -> Identity a
Identity x
begin))
{-# INLINABLE generalize #-}

{-| Simplify a pure `ScanM` to a `Scan`

> simplify (pure r) = pure r
>
> simplify (f <*> x) = simplify f <*> simplify x
-}
simplify :: ScanM Identity a b -> Scan a b
simplify :: forall a b. ScanM Identity a b -> Scan a b
simplify (ScanM a -> StateT x Identity b
step (Identity x
begin)) = forall a b x. (a -> State x b) -> x -> Scan a b
Scan a -> StateT x Identity b
step x
begin
{-# INLINABLE simplify #-}

{- | Shift a 'ScanM' from one monad to another with a morphism such as 'lift' or 'liftIO';
     the effect is the same as 'Control.Monad.Morph.hoist'.
-}
hoists :: (forall x . m x -> n x) -> ScanM m a b -> ScanM n a b
hoists :: forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> ScanM m a b -> ScanM n a b
hoists forall x. m x -> n x
phi (ScanM a -> StateT x m b
step m x
begin ) = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM
  (\a
a -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ forall x. m x -> n x
phi forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT x m b
step a
a))
  (forall x. m x -> n x
phi m x
begin)
{-# INLINABLE hoists #-}

{-| @(premap f scaner)@ returns a new 'Scan' where f is applied at each step

> scan (premap f scaner) list = scan scaner (map f list)

> premap id = id
>
> premap (f . g) = premap g . premap f

> premap k (pure r) = pure r
>
> premap k (f <*> x) = premap k f <*> premap k x
-}
premap :: (a -> b) -> Scan b r -> Scan a r
premap :: forall a b c. (a -> b) -> Scan b c -> Scan a c
premap a -> b
f (Scan b -> State x r
step x
begin) = forall a b x. (a -> State x b) -> x -> Scan a b
Scan (b -> State x r
step forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f) x
begin
{-# INLINABLE premap #-}

{-| @(premapM f scaner)@ returns a new 'ScanM' where f is applied to each input
    element

> premapM return = id
>
> premapM (f <=< g) = premap g . premap f

> premapM k (pure r) = pure r
>
> premapM k (f <*> x) = premapM k f <*> premapM k x
-}
premapM :: Monad m => (a -> m b) -> ScanM m b r -> ScanM m a r
premapM :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> ScanM m b r -> ScanM m a r
premapM a -> m b
f (ScanM b -> StateT x m r
step m x
begin) = forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (b -> StateT x m r
step forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m b
f) m x
begin
{-# INLINABLE premapM #-}


-- Internal helpers (not exported)
newtype ReverseState s a = ReverseState
  { forall s a. ReverseState s a -> s -> (a, s)
runReverseState :: s -> (a, s)
  }

instance Functor (ReverseState s) where
  fmap :: forall a b. (a -> b) -> ReverseState s a -> ReverseState s b
fmap a -> b
f (ReverseState s -> (a, s)
m) =
    forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState forall a b. (a -> b) -> a -> b
$ \s
s ->
      let (a
v, s
s') = s -> (a, s)
m s
s
      in (a -> b
f a
v, s
s')
  {-# INLINE fmap #-}

instance Applicative (ReverseState s) where
  pure :: forall a. a -> ReverseState s a
pure = forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (,)
  {-# INLINE pure #-}

  ReverseState s (a -> b)
mf <*> :: forall a b.
ReverseState s (a -> b) -> ReverseState s a -> ReverseState s b
<*> ReverseState s a
mx =
    forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState forall a b. (a -> b) -> a -> b
$ \s
s ->
      let (a -> b
f, s
s2) = forall s a. ReverseState s a -> s -> (a, s)
runReverseState ReverseState s (a -> b)
mf s
s1
          (a
x, s
s1) = forall s a. ReverseState s a -> s -> (a, s)
runReverseState ReverseState s a
mx s
s
      in (a -> b
f a
x, s
s2)
  {-# INLINE (<*>) #-}

#if MIN_VERSION_base(4, 10, 0)
  -- 'liftA2' was moved to the 'Applicative' class in base 4.10.0.0
  liftA2 :: forall a b c.
(a -> b -> c)
-> ReverseState s a -> ReverseState s b -> ReverseState s c
liftA2 a -> b -> c
f ReverseState s a
mx ReverseState s b
my =
    forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState forall a b. (a -> b) -> a -> b
$ \s
s ->
      let (a
x, s
s2) = forall s a. ReverseState s a -> s -> (a, s)
runReverseState ReverseState s a
mx s
s1
          (b
y, s
s1) = forall s a. ReverseState s a -> s -> (a, s)
runReverseState ReverseState s b
my s
s
      in (a -> b -> c
f a
x b
y, s
s2)
  {-# INLINE liftA2 #-}
#endif


#if MIN_VERSION_base(4, 7, 0)
-- | This is same as normal function composition, except slightly more efficient. The same trick is used in base <http://hackage.haskell.org/package/base-4.11.1.0/docs/src/Data.Functor.Utils.html#%23.> and lens <http://hackage.haskell.org/package/lens-4.17/docs/Control-Lens-Internal-Coerce.html#v:-35-..>
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
#. :: forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_ = coerce :: forall a b. Coercible a b => a -> b
coerce
#else
(#.) :: (b -> c) -> (a -> b) -> (a -> c)
(#.) = (.)
#endif

infixr 9 #.
{-# INLINE (#.) #-}