{-| 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 :: StateT s m a -> StateT s m a
asLazy = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s)) -> StateT s m a -> StateT s m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. StateT s m a -> s -> m (a, s)
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 :: (a -> b) -> Scan a a -> Scan a b
fmap a -> b
f (Scan a -> State x a
step x
begin) = (a -> State x b) -> x -> Scan a b
forall a b x. (a -> State x b) -> x -> Scan a b
Scan ((a -> b) -> State x a -> State x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (State x a -> State x b) -> (a -> State x a) -> a -> State x b
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 :: a -> Scan a a
pure a
b    = (a -> State () a) -> () -> Scan a a
forall a b x. (a -> State x b) -> x -> Scan a b
Scan (\a
_ -> a -> State () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b) ()
    {-# INLINE pure #-}

    (Scan a -> State x (a -> b)
stepL x
beginL) <*> :: 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, (x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair x
xL' x
xR'))
              where (a -> b
bL, x
xL') = State x (a -> b) -> x -> (a -> b, x)
forall s a. State s a -> s -> (a, s)
runState (a -> State x (a -> b)
stepL a
a) x
xL
                    (a
bR, x
xR') = State x a -> x -> (a, x)
forall s a. State s a -> s -> (a, s)
runState (a -> State x a
stepR a
a) x
xR
            begin :: Pair x x
begin = x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair x
beginL x
beginR
        in  (a -> State (Pair x x) b) -> Pair x x -> Scan a b
forall a b x. (a -> State x b) -> x -> Scan a b
Scan ((Pair x x -> (b, Pair x x)) -> State (Pair x x) b
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Pair x x -> (b, Pair x x)) -> State (Pair x x) b)
-> (a -> Pair x x -> (b, Pair x x)) -> a -> State (Pair x x) b
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 :: (a -> b) -> Scan b c -> Scan a c
lmap = (a -> b) -> Scan b c -> Scan a c
forall a b c. (a -> b) -> Scan b c -> Scan a c
premap
    rmap :: (b -> c) -> Scan a b -> Scan a c
rmap = (b -> c) -> Scan a b -> Scan a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Category Scan where
    id :: Scan a a
id = (a -> State () a) -> () -> Scan a a
forall a b x. (a -> State x b) -> x -> Scan a b
Scan a -> State () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    {-# INLINE id #-}
    (Scan b -> State x c
s2 x
b2) . :: Scan b c -> Scan a b -> Scan a c
. (Scan a -> State x b
s1 x
b1) = (a -> State (Pair x x) c) -> Pair x x -> Scan a c
forall a b x. (a -> State x b) -> x -> Scan a b
Scan ((Pair x x -> (c, Pair x x)) -> State (Pair x x) c
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Pair x x -> (c, Pair x x)) -> State (Pair x x) c)
-> (a -> Pair x x -> (c, Pair x x)) -> a -> State (Pair x x) c
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) (x -> x -> Pair x x
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, x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair x
xL' x
xR')
                where (b
b, x
xL') = State x b -> x -> (b, x)
forall s a. State s a -> s -> (a, s)
runState (a -> State x b
s1 a
a) x
xL
                      (c
c, x
xR') = State x c -> x -> (c, x)
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 :: (b -> c) -> Scan b c
arr b -> c
f = (b -> State () c) -> () -> Scan b c
forall a b x. (a -> State x b) -> x -> Scan a b
Scan (c -> State () c
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> State () c) -> (b -> c) -> b -> State () c
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 :: Scan b c -> Scan (b, d) (c, d)
first  (Scan b -> State x c
step x
begin) = ((b, d) -> State x (c, d)) -> x -> Scan (b, d) (c, d)
forall a b x. (a -> State x b) -> x -> Scan a b
Scan
      (\(b
a,d
b) -> (x -> ((c, d), x)) -> State x (c, d)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((x -> ((c, d), x)) -> State x (c, d))
-> (x -> ((c, d), x)) -> State x (c, d)
forall a b. (a -> b) -> a -> b
$ \x
x -> (c -> (c, d)) -> (c, x) -> ((c, d), x)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (,d
b) ((c, x) -> ((c, d), x)) -> (c, x) -> ((c, d), x)
forall a b. (a -> b) -> a -> b
$ State x c -> x -> (c, x)
forall s a. State s a -> s -> (a, s)
runState (b -> State x c
step b
a) x
x)
      x
begin
    {-# INLINE first #-}
    second :: Scan b c -> Scan (d, b) (d, c)
second (Scan b -> State x c
step x
begin) = ((d, b) -> State x (d, c)) -> x -> Scan (d, b) (d, c)
forall a b x. (a -> State x b) -> x -> Scan a b
Scan
      (\(d
b,b
a) -> (x -> ((d, c), x)) -> State x (d, c)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((x -> ((d, c), x)) -> State x (d, c))
-> (x -> ((d, c), x)) -> State x (d, c)
forall a b. (a -> b) -> a -> b
$ \x
x  -> (c -> (d, c)) -> (c, x) -> ((d, c), x)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (d
b,) ((c, x) -> ((d, c), x)) -> (c, x) -> ((d, c), x)
forall a b. (a -> b) -> a -> b
$ State x c -> x -> (c, x)
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
(<>) = (b -> b -> b) -> 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 b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE (<>) #-}

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

    mappend :: Scan a b -> Scan a b -> Scan a b
mappend = (b -> b -> b) -> 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 b -> b -> b
forall a. Monoid a => a -> a -> a
mappend
    {-# INLINE mappend #-}

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

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

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

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

    + :: Scan a b -> Scan a b -> Scan a b
(+) = (b -> b -> b) -> 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 b -> b -> b
forall a. Num a => a -> a -> a
(+)
    {-# INLINE (+) #-}

    * :: Scan a b -> Scan a b -> Scan a b
(*) = (b -> b -> b) -> 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 b -> b -> b
forall a. Num a => a -> a -> a
(*)
    {-# INLINE (*) #-}

    (-) = (b -> b -> b) -> 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 (-)
    {-# INLINE (-) #-}

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

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

    / :: Scan a b -> Scan a b -> Scan a b
(/) = (b -> b -> b) -> 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 b -> b -> b
forall a. Fractional a => a -> a -> a
(/)
    {-# INLINE (/) #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    ** :: Scan a b -> Scan a b -> Scan a b
(**) = (b -> b -> b) -> 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 b -> b -> b
forall a. Floating a => a -> a -> a
(**)
    {-# INLINE (**) #-}

    logBase :: Scan a b -> Scan a b -> Scan a b
logBase = (b -> b -> b) -> 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 b -> b -> b
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 :: (a -> b) -> ScanM m a a -> ScanM m a b
fmap a -> b
f (ScanM a -> StateT x m a
step m x
begin) = (a -> StateT x m b) -> m x -> ScanM m a b
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM ((a -> b) -> StateT x m a -> StateT x m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (StateT x m a -> StateT x m b)
-> (a -> StateT x m a) -> a -> StateT x m b
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 :: a -> ScanM m a a
pure a
b    = (a -> StateT () m a) -> m () -> ScanM m a a
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (\a
_ -> (() -> m (a, ())) -> StateT () m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((() -> m (a, ())) -> StateT () m a)
-> (() -> m (a, ())) -> StateT () m a
forall a b. (a -> b) -> a -> b
$ \() -> (a, ()) -> m (a, ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
b, ())) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    {-# INLINE pure #-}

    (ScanM a -> StateT x m (a -> b)
stepL m x
beginL) <*> :: 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, (x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair x
xL' x
xR')))
              ((a -> b, x) -> (a, x) -> (b, Pair x x))
-> m (a -> b, x) -> m ((a, x) -> (b, Pair x x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT x m (a -> b) -> x -> m (a -> b, x)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT x m (a -> b)
stepL a
a) x
xL
              m ((a, x) -> (b, Pair x x)) -> m (a, x) -> m (b, Pair x x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT x m a -> x -> m (a, x)
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 = x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair (x -> x -> Pair x x) -> m x -> m (x -> Pair x x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
beginL m (x -> Pair x x) -> m x -> m (Pair x x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m x
beginR
        in  (a -> StateT (Pair x x) m b) -> m (Pair x x) -> ScanM m a b
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM ((Pair x x -> m (b, Pair x x)) -> StateT (Pair x x) m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Pair x x -> m (b, Pair x x)) -> StateT (Pair x x) m b)
-> (a -> Pair x x -> m (b, Pair x x)) -> a -> StateT (Pair x x) m b
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 :: (b -> c) -> ScanM m a b -> ScanM m a c
rmap = (b -> c) -> ScanM m a b -> ScanM m a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    lmap :: (a -> b) -> ScanM m b c -> ScanM m a c
lmap a -> b
f (ScanM b -> StateT x m c
step m x
begin) = (a -> StateT x m c) -> m x -> ScanM m a c
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (b -> StateT x m c
step (b -> StateT x m c) -> (a -> b) -> a -> StateT x m c
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 :: ScanM m a a
id = (a -> StateT () m a) -> m () -> ScanM m a a
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM a -> StateT () m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    {-# INLINE id #-}
    (ScanM b -> StateT x m c
s2 m x
b2) . :: ScanM m b c -> ScanM m a b -> ScanM m a c
. (ScanM a -> StateT x m b
s1 m x
b1) = (a -> StateT (Pair x x) m c) -> m (Pair x x) -> ScanM m a c
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM ((Pair x x -> m (c, Pair x x)) -> StateT (Pair x x) m c
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Pair x x -> m (c, Pair x x)) -> StateT (Pair x x) m c)
-> (a -> Pair x x -> m (c, Pair x x)) -> a -> StateT (Pair x x) m c
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) (x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair (x -> x -> Pair x x) -> m x -> m (x -> Pair x x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
b1 m (x -> Pair x x) -> m x -> m (Pair x x)
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') <- StateT x m b -> x -> m (b, x)
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') <- StateT x m c -> x -> m (c, x)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (b -> StateT x m c
s2 b
b) x
xR
                (c, Pair x x) -> m (c, Pair x x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c
c, x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair x
xL' x
xR')
    {-# INLINE (.) #-}

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

    mappend :: ScanM m a b -> ScanM m a b -> ScanM m a b
mappend = (b -> b -> b) -> 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 b -> b -> b
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 = b -> ScanM m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> ScanM m a b) -> (Integer -> b) -> Integer -> ScanM m a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> b
forall a. Num a => Integer -> a
fromInteger
    {-# INLINE fromInteger #-}

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

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

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

    + :: ScanM m a b -> ScanM m a b -> ScanM m a b
(+) = (b -> b -> b) -> 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 b -> b -> b
forall a. Num a => a -> a -> a
(+)
    {-# INLINE (+) #-}

    * :: ScanM m a b -> ScanM m a b -> ScanM m a b
(*) = (b -> b -> b) -> 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 b -> b -> b
forall a. Num a => a -> a -> a
(*)
    {-# INLINE (*) #-}

    (-) = (b -> b -> b) -> 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 (-)
    {-# INLINE (-) #-}

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

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

    / :: ScanM m a b -> ScanM m a b -> ScanM m a b
(/) = (b -> b -> b) -> 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 b -> b -> b
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 = b -> ScanM m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Floating a => a
pi
    {-# INLINE pi #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    ** :: ScanM m a b -> ScanM m a b -> ScanM m a b
(**) = (b -> b -> b) -> 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 b -> b -> b
forall a. Floating a => a -> a -> a
(**)
    {-# INLINE (**) #-}

    logBase :: ScanM m a b -> ScanM m a b -> ScanM m a b
logBase = (b -> b -> b) -> 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 b -> b -> b
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 :: Scan a b -> t a -> t b
scan (Scan a -> State x b
step x
begin) t a
as = (t b, x) -> t b
forall a b. (a, b) -> a
fst ((t b, x) -> t b) -> (t b, x) -> t b
forall a b. (a -> b) -> a -> b
$ State x (t b) -> x -> (t b, x)
forall s a. State s a -> s -> (a, s)
Lazy.runState ((a -> StateT x Identity b) -> t a -> State x (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (State x b -> StateT x Identity b
forall s (m :: * -> *) a. StateT s m a -> StateT s m a
asLazy (State x b -> StateT x Identity b)
-> (a -> State x b) -> a -> StateT x Identity b
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 :: Scan a b -> t a -> t b
scanr (Scan a -> State x b
step x
begin) t a
as =
  (t b, x) -> t b
forall a b. (a, b) -> a
fst (ReverseState x (t b) -> x -> (t b, x)
forall s a. ReverseState s a -> s -> (a, s)
runReverseState ((a -> ReverseState x b) -> t a -> ReverseState x (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((x -> (b, x)) -> ReverseState x b
forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState ((x -> (b, x)) -> ReverseState x b)
-> (a -> x -> (b, x)) -> a -> ReverseState x b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. State x b -> x -> (b, x)
forall s a. State s a -> s -> (a, s)
runState (State x b -> x -> (b, x)) -> (a -> State x b) -> a -> x -> (b, x)
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 :: ScanM m a b -> t a -> m (t b)
scanM (ScanM a -> StateT x m b
step m x
begin) t a
as = ((t b, x) -> t b) -> m (t b, x) -> m (t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t b, x) -> t b
forall a b. (a, b) -> a
fst (m (t b, x) -> m (t b)) -> m (t b, x) -> m (t b)
forall a b. (a -> b) -> a -> b
$ StateT x m (t b) -> x -> m (t b, x)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT ((a -> StateT x m b) -> t a -> StateT x m (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (StateT x m b -> StateT x m b
forall s (m :: * -> *) a. StateT s m a -> StateT s m a
asLazy (StateT x m b -> StateT x m b)
-> (a -> StateT x m b) -> a -> StateT x m b
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) (x -> m (t b, x)) -> m x -> m (t b, x)
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 :: Fold a b -> Scan a b
prescan (Fold x -> a -> x
step x
begin x -> b
done) = (a -> State x b) -> x -> Scan a b
forall a b x. (a -> State x b) -> x -> Scan a b
Scan ((x -> (b, x)) -> State x b
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((x -> (b, x)) -> State x b)
-> (a -> x -> (b, x)) -> a -> State x b
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 :: Fold a b -> Scan a b
postscan (Fold x -> a -> x
step x
begin x -> b
done) = (a -> State x b) -> x -> Scan a b
forall a b x. (a -> State x b) -> x -> Scan a b
Scan ((x -> (b, x)) -> State x b
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((x -> (b, x)) -> State x b)
-> (a -> x -> (b, x)) -> a -> State x b
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 :: (b -> m c) -> ScanM m b c
arrM b -> m c
f = (b -> StateT () m c) -> m () -> ScanM m b c
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (m c -> StateT () m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m c -> StateT () m c) -> (b -> m c) -> b -> StateT () m c
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) (() -> m ()
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 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) = (a -> State x b) -> x -> r
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 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) = (x -> a -> (x, b)) -> x -> r
forall x. (x -> a -> (x, b)) -> x -> r
f (\x
s a
a -> (b, x) -> (x, b)
forall a b. (a, b) -> (b, a)
swap ((b, x) -> (x, b)) -> (b, x) -> (x, b)
forall a b. (a -> b) -> a -> b
$ State x b -> x -> (b, x)
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 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) = (a -> StateT x m b) -> m x -> r
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 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) = (x -> a -> m (x, b)) -> m x -> r
forall x. (x -> a -> m (x, b)) -> m x -> r
f (\x
s a
a -> (b, x) -> (x, b)
forall a b. (a, b) -> (b, a)
swap ((b, x) -> (x, b)) -> m (b, x) -> m (x, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT x m b -> x -> m (b, x)
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 :: Scan a b -> ScanM m a b
generalize (Scan a -> State x b
step x
begin) = (forall x. Identity x -> m x) -> ScanM Identity a b -> ScanM m a b
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> ScanM m a b -> ScanM n a b
hoists
  (\(Identity c) -> x -> m x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
c)
  ((a -> State x b) -> Identity x -> ScanM Identity a b
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM a -> State x b
step (x -> Identity x
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 :: ScanM Identity a b -> Scan a b
simplify (ScanM a -> StateT x Identity b
step (Identity x
begin)) = (a -> StateT x Identity b) -> x -> Scan a b
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 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 ) = (a -> StateT x n b) -> n x -> ScanM n a b
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM
  (\a
a -> (x -> n (b, x)) -> StateT x n b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((x -> n (b, x)) -> StateT x n b)
-> (x -> n (b, x)) -> StateT x n b
forall a b. (a -> b) -> a -> b
$ m (b, x) -> n (b, x)
forall x. m x -> n x
phi (m (b, x) -> n (b, x)) -> (x -> m (b, x)) -> x -> n (b, x)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. StateT x m b -> x -> m (b, x)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT x m b
step a
a))
  (m x -> n x
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 :: (a -> b) -> Scan b r -> Scan a r
premap a -> b
f (Scan b -> State x r
step x
begin) = (a -> State x r) -> x -> Scan a r
forall a b x. (a -> State x b) -> x -> Scan a b
Scan (b -> State x r
step (b -> State x r) -> (a -> b) -> a -> State x r
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 :: (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) = (a -> StateT x m r) -> m x -> ScanM m a r
forall (m :: * -> *) a b x.
(a -> StateT x m b) -> m x -> ScanM m a b
ScanM (b -> StateT x m r
step (b -> StateT x m r) -> (a -> StateT x m b) -> a -> StateT x m r
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m b -> StateT x m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> StateT x m b) -> (a -> m b) -> a -> StateT x m b
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
  { ReverseState s a -> s -> (a, s)
runReverseState :: s -> (a, s)
  }

instance Functor (ReverseState s) where
  fmap :: (a -> b) -> ReverseState s a -> ReverseState s b
fmap a -> b
f (ReverseState s -> (a, s)
m) =
    (s -> (b, s)) -> ReverseState s b
forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState ((s -> (b, s)) -> ReverseState s b)
-> (s -> (b, s)) -> ReverseState s b
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 :: a -> ReverseState s a
pure = (s -> (a, s)) -> ReverseState s a
forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState ((s -> (a, s)) -> ReverseState s a)
-> (a -> s -> (a, s)) -> a -> ReverseState s a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (,)
  {-# INLINE pure #-}

  ReverseState s (a -> b)
mf <*> :: ReverseState s (a -> b) -> ReverseState s a -> ReverseState s b
<*> ReverseState s a
mx =
    (s -> (b, s)) -> ReverseState s b
forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState ((s -> (b, s)) -> ReverseState s b)
-> (s -> (b, s)) -> ReverseState s b
forall a b. (a -> b) -> a -> b
$ \s
s ->
      let (a -> b
f, s
s2) = ReverseState s (a -> b) -> s -> (a -> b, s)
forall s a. ReverseState s a -> s -> (a, s)
runReverseState ReverseState s (a -> b)
mf s
s1
          (a
x, s
s1) = ReverseState s a -> s -> (a, s)
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 :: (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 =
    (s -> (c, s)) -> ReverseState s c
forall s a. (s -> (a, s)) -> ReverseState s a
ReverseState ((s -> (c, s)) -> ReverseState s c)
-> (s -> (c, s)) -> ReverseState s c
forall a b. (a -> b) -> a -> b
$ \s
s ->
      let (a
x, s
s2) = ReverseState s a -> s -> (a, s)
forall s a. ReverseState s a -> s -> (a, s)
runReverseState ReverseState s a
mx s
s1
          (b
y, s
s1) = ReverseState s b -> s -> (b, s)
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)
#. :: (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_ = (a -> b) -> a -> c
coerce
#else
(#.) :: (b -> c) -> (a -> b) -> (a -> c)
(#.) = (.)
#endif

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