{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ExistentialQuantification #-}
{- |
Processes that use only the current and past data.
Essentially this is a data type for the 'Synthesizer.State.Signal.crochetL' function.
-}
{-
ToDo:
Causal process usually depend on the sample rate,
so we need a phantom type parameter of T for the rate.

Include ST monad for mutable arrays,
this can be useful for delay lines.
On the other hand, couldn't we also use the StorableVector.Cursor data structure
and avoid the ST monad here?
-}
module Synthesizer.Causal.Process (
   T(Cons),
   fromStateMaybe,
   fromState,
   fromSimpleModifier,
   fromInitializedModifier,

   id,
   map,
   first,
   second,
   compose,
   split,
   fanout,
   loop,

{-
   We don't re-export these identifiers
   because people could abuse them for other Arrows.

   (>>>), (***), (&&&),
   (Arrow.^<<), (Arrow.^>>), (Arrow.<<^), (Arrow.>>^),
-}

   apply,
   applyFst,
   applySnd,
   applySameType,
   applyConst,
   apply2,
   apply3,
   applyStorableChunk,

   feed,
   feedFst,
   feedSnd,
   feedGenericFst,
   feedGenericSnd,
   feedConstFst,
   feedConstSnd,

   crochetL,
   mapAccumL,
   scanL,
   scanL1,
   zipWith,
   consInit,
   chainControlled,
   replicateControlled,
   feedback,
   feedbackControlled,

   -- for testing
   applyFst',
   applySnd',
   ) where

import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Causal.Class as Class
import qualified Synthesizer.Causal.Utility as ArrowUtil

import qualified Synthesizer.Plain.Modifier as Modifier

import qualified Data.StorableVector as SV

import Foreign.Storable (Storable, )

import qualified Control.Category as Cat
import Control.Arrow
          (Arrow(..), returnA, (<<<), (>>>), (^>>), ArrowLoop(..),
           Kleisli(Kleisli), runKleisli, )
import Control.Monad.Trans.State
          (State, runState,
           StateT(StateT), runStateT, )
import Control.Monad (liftM, )
import Control.Applicative (Applicative, liftA2, pure, (<*>), )

import Data.Tuple.HT (mapSnd, )

import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive

import qualified Prelude as P
import Prelude hiding (id, map, zipWith, )



-- | Cf. StreamFusion  'Synthesizer.State.Signal.T'
data T a b =
   forall s. -- Seq s =>
      Cons !(a -> StateT s Maybe b)  -- compute next value
           !s                        -- initial state



{-# INLINE fromStateMaybe #-}
fromStateMaybe :: (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe :: forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe = (a -> StateT s Maybe b) -> s -> T a b
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons

{-# INLINE fromState #-}
fromState :: (a -> State s b) -> s -> T a b
fromState :: forall a s b. (a -> State s b) -> s -> T a b
fromState a -> State s b
f =
   (a -> StateT s Maybe b) -> s -> T a b
forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe (\a
x -> (s -> Maybe (b, s)) -> StateT s Maybe b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((b, s) -> Maybe (b, s)
forall a. a -> Maybe a
Just ((b, s) -> Maybe (b, s)) -> (s -> (b, s)) -> s -> Maybe (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s b -> s -> (b, s)
forall s a. State s a -> s -> (a, s)
runState (a -> State s b
f a
x)))

{-# INLINE fromSimpleModifier #-}
fromSimpleModifier ::
   Modifier.Simple s ctrl a b -> T (ctrl,a) b
fromSimpleModifier :: forall s ctrl a b. Simple s ctrl a b -> T (ctrl, a) b
fromSimpleModifier (Modifier.Simple s
s ctrl -> a -> State s b
f) =
   ((ctrl, a) -> State s b) -> s -> T (ctrl, a) b
forall a s b. (a -> State s b) -> s -> T a b
fromState ((ctrl -> a -> State s b) -> (ctrl, a) -> State s b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ctrl -> a -> State s b
f) s
s

{-# INLINE fromInitializedModifier #-}
fromInitializedModifier ::
   Modifier.Initialized s init ctrl a b -> init -> T (ctrl,a) b
fromInitializedModifier :: forall s init ctrl a b.
Initialized s init ctrl a b -> init -> T (ctrl, a) b
fromInitializedModifier (Modifier.Initialized init -> s
initF ctrl -> a -> State s b
f) init
initS =
   ((ctrl, a) -> State s b) -> s -> T (ctrl, a) b
forall a s b. (a -> State s b) -> s -> T a b
fromState ((ctrl -> a -> State s b) -> (ctrl, a) -> State s b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ctrl -> a -> State s b
f) (init -> s
initF init
initS)


{-
It's almost a Kleisli Arrow,
but the hidden type of the state disturbs.
-}
instance Cat.Category T where
   {-# INLINE id #-}
   {-# INLINE (.) #-}

   id :: forall a. T a a
id  = (a -> State () a) -> () -> T a a
forall a s b. (a -> State s b) -> s -> T a b
fromState a -> State () a
forall a. a -> StateT () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   . :: forall b c a. T b c -> T a b -> T a c
(.) = (T a b -> T b c -> T a c) -> T b c -> T a b -> T a c
forall a b c. (a -> b -> c) -> b -> a -> c
flip T a b -> T b c -> T a c
forall a b c. T a b -> T b c -> T a c
compose

instance Arrow T where
   {-# INLINE arr #-}
   {-# INLINE first #-}
   {-# INLINE second #-}
   {-# INLINE (***) #-}
   {-# INLINE (&&&) #-}

   arr :: forall b c. (b -> c) -> T b c
arr    = (b -> c) -> T b c
forall b c. (b -> c) -> T b c
map
   first :: forall b c d. T b c -> T (b, d) (c, d)
first  = (forall s.
 Kleisli (StateT s Maybe) b c
 -> Kleisli (StateT s Maybe) (b, d) (c, d))
-> T b c -> T (b, d) (c, d)
forall a0 a1 b0 b1.
(forall s.
 Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1)
-> T a0 a1 -> T b0 b1
liftKleisli Kleisli (StateT s Maybe) b c
-> Kleisli (StateT s Maybe) (b, d) (c, d)
forall s.
Kleisli (StateT s Maybe) b c
-> Kleisli (StateT s Maybe) (b, d) (c, d)
forall b c d.
Kleisli (StateT s Maybe) b c
-> Kleisli (StateT s Maybe) (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
   second :: forall b c d. T b c -> T (d, b) (d, c)
second = (forall s.
 Kleisli (StateT s Maybe) b c
 -> Kleisli (StateT s Maybe) (d, b) (d, c))
-> T b c -> T (d, b) (d, c)
forall a0 a1 b0 b1.
(forall s.
 Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1)
-> T a0 a1 -> T b0 b1
liftKleisli Kleisli (StateT s Maybe) b c
-> Kleisli (StateT s Maybe) (d, b) (d, c)
forall s.
Kleisli (StateT s Maybe) b c
-> Kleisli (StateT s Maybe) (d, b) (d, c)
forall b c d.
Kleisli (StateT s Maybe) b c
-> Kleisli (StateT s Maybe) (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
   *** :: forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
(***)  = T b c -> T b' c' -> T (b, b') (c, c')
forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
split
   &&& :: forall b c c'. T b c -> T b c' -> T b (c, c')
(&&&)  = T b c -> T b c' -> T b (c, c')
forall b c c'. T b c -> T b c' -> T b (c, c')
fanout

{-
I think we cannot define an ArrowApply instance,
because we must extract the initial state somehow
from the inner (T a b) which is not possible.

instance ArrowApply T where
--   app = Cons (runKleisli undefined) ()
   app = first (arr (flip Cons () . runKleisli)) >>> app
-}


instance ArrowLoop T where
   {-# INLINE loop #-}
   loop :: forall b d c. T (b, d) (c, d) -> T b c
loop = (forall s.
 Kleisli (StateT s Maybe) (b, d) (c, d)
 -> Kleisli (StateT s Maybe) b c)
-> T (b, d) (c, d) -> T b c
forall a0 a1 b0 b1.
(forall s.
 Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1)
-> T a0 a1 -> T b0 b1
liftKleisli Kleisli (StateT s Maybe) (b, d) (c, d)
-> Kleisli (StateT s Maybe) b c
forall s.
Kleisli (StateT s Maybe) (b, d) (c, d)
-> Kleisli (StateT s Maybe) b c
forall b d c.
Kleisli (StateT s Maybe) (b, d) (c, d)
-> Kleisli (StateT s Maybe) b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop


type instance Class.ProcessOf Sig.T = T

instance Class.C T where
   type SignalOf T = Sig.T
   toSignal :: forall a. T () a -> SignalOf T a
toSignal = (T () a -> () -> T a) -> () -> T () a -> T a
forall a b c. (a -> b -> c) -> b -> a -> c
flip T () a -> () -> T a
forall a b. T a b -> a -> T b
applyConst ()
   fromSignal :: forall b a. SignalOf T b -> T a b
fromSignal SignalOf T b
sig = () -> a -> ()
forall a b. a -> b -> a
const () (a -> ()) -> T () b -> T a b
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> T b -> T () b
forall (sig :: * -> *) a. Read sig a => sig a -> T () a
feed SignalOf T b
T b
sig


instance Functor (T a) where
   fmap :: forall a b. (a -> b) -> T a a -> T a b
fmap = (a -> b) -> T a a -> T a b
forall (arrow :: * -> * -> *) b c a.
Arrow arrow =>
(b -> c) -> arrow a b -> arrow a c
ArrowUtil.map

instance Applicative (T a) where
   pure :: forall a. a -> T a a
pure = a -> T a a
forall (arrow :: * -> * -> *) b a. Arrow arrow => b -> arrow a b
ArrowUtil.pure
   <*> :: forall a b. T a (a -> b) -> T a a -> T a b
(<*>) = T a (a -> b) -> T a a -> T a b
forall (arrow :: * -> * -> *) a b c.
Arrow arrow =>
arrow a (b -> c) -> arrow a b -> arrow a c
ArrowUtil.apply


instance (Additive.C b) => Additive.C (T a b) where
   zero :: T a b
zero = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. C a => a
Additive.zero
   negate :: T a b -> T a b
negate = (b -> b) -> T a b -> T a b
forall a b. (a -> b) -> T a a -> T a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. C a => a -> a
Additive.negate
   + :: T a b -> T a b -> T a b
(+) = (b -> b -> b) -> T a b -> T a b -> T a b
forall a b c. (a -> b -> c) -> T a a -> T a b -> T a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. C a => a -> a -> a
(Additive.+)
   (-) = (b -> b -> b) -> T a b -> T a b -> T a b
forall a b c. (a -> b -> c) -> T a a -> T a b -> T a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. C a => a -> a -> a
(Additive.-)

instance (Ring.C b) => Ring.C (T a b) where
   one :: T a b
one = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. C a => a
Ring.one
   * :: T a b -> T a b -> T a b
(*) = (b -> b -> b) -> T a b -> T a b -> T a b
forall a b c. (a -> b -> c) -> T a a -> T a b -> T a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. C a => a -> a -> a
(Ring.*)
   T a b
x^ :: T a b -> Integer -> T a b
^Integer
n = (b -> b) -> T a b -> T a b
forall a b. (a -> b) -> T a a -> T a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> Integer -> b
forall a. C a => a -> Integer -> a
Ring.^ Integer
n) T a b
x
   fromInteger :: Integer -> T a b
fromInteger = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> T a b) -> (Integer -> b) -> Integer -> T a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> b
forall a. C a => Integer -> a
Ring.fromInteger

instance (Field.C b) => Field.C (T a b) where
   / :: T a b -> T a b -> T a b
(/) = (b -> b -> b) -> T a b -> T a b -> T a b
forall a b c. (a -> b -> c) -> T a a -> T a b -> T a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. C a => a -> a -> a
(Field./)
   recip :: T a b -> T a b
recip = (b -> b) -> T a b -> T a b
forall a b. (a -> b) -> T a a -> T a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. C a => a -> a
Field.recip
   fromRational' :: Rational -> T a b
fromRational' = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> T a b) -> (Rational -> b) -> Rational -> T a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> b
forall a. C a => Rational -> a
Field.fromRational'


instance (P.Num b) => P.Num (T a b) where
   + :: T a b -> T a b -> T a b
(+) = (b -> b -> b) -> T a b -> T a b -> T a b
forall a b c. (a -> b -> c) -> T a a -> T a b -> T a c
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
(P.+)
   (-) = (b -> b -> b) -> T a b -> T a b -> T a b
forall a b c. (a -> b -> c) -> T a a -> T a b -> T a c
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
(P.-)
   * :: T a b -> T a b -> T a b
(*) = (b -> b -> b) -> T a b -> T a b -> T a b
forall a b c. (a -> b -> c) -> T a a -> T a b -> T a c
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
(P.*)
   negate :: T a b -> T a b
negate = (b -> b) -> T a b -> T a b
forall a b. (a -> b) -> T a a -> T a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Num a => a -> a
P.negate
   abs :: T a b -> T a b
abs = (b -> b) -> T a b -> T a b
forall a b. (a -> b) -> T a a -> T a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Num a => a -> a
P.abs
   signum :: T a b -> T a b
signum = (b -> b) -> T a b -> T a b
forall a b. (a -> b) -> T a a -> T a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall a. Num a => a -> a
P.signum
   fromInteger :: Integer -> T a b
fromInteger = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> T a b) -> (Integer -> b) -> Integer -> T a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> b
forall a. Num a => Integer -> a
P.fromInteger

instance (P.Fractional b) => P.Fractional (T a b) where
   / :: T a b -> T a b -> T a b
(/) = (b -> b -> b) -> T a b -> T a b -> T a b
forall a b c. (a -> b -> c) -> T a a -> T a b -> T a c
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
(P./)
   fromRational :: Rational -> T a b
fromRational = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> T a b) -> (Rational -> b) -> Rational -> T a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> b
forall a. Fractional a => Rational -> a
P.fromRational



{-# INLINE extendStateFstT #-}
extendStateFstT :: Monad m => StateT s m a -> StateT (t,s) m a
extendStateFstT :: forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (t, s) m a
extendStateFstT StateT s m a
st =
   ((t, s) -> m (a, (t, s))) -> StateT (t, s) m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\(t
t0,s
s0) -> ((a, s) -> (a, (t, s))) -> m (a, s) -> m (a, (t, s))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((s -> (t, s)) -> (a, s) -> (a, (t, s))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\s
s1 -> (t
t0,s
s1))) (StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
st s
s0))

{-# INLINE extendStateSndT #-}
extendStateSndT :: Monad m => StateT s m a -> StateT (s,t) m a
extendStateSndT :: forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (s, t) m a
extendStateSndT StateT s m a
st =
   ((s, t) -> m (a, (s, t))) -> StateT (s, t) m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\(s
s0,t
t0) -> ((a, s) -> (a, (s, t))) -> m (a, s) -> m (a, (s, t))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((s -> (s, t)) -> (a, s) -> (a, (s, t))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\s
s1 -> (s
s1,t
t0))) (StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
st s
s0))


{-# INLINE liftKleisli #-}
liftKleisli ::
   (forall s.
    Kleisli (StateT s Maybe) a0 a1 ->
    Kleisli (StateT s Maybe) b0 b1) ->
   T a0 a1 -> T b0 b1
liftKleisli :: forall a0 a1 b0 b1.
(forall s.
 Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1)
-> T a0 a1 -> T b0 b1
liftKleisli forall s.
Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1
op (Cons a0 -> StateT s Maybe a1
f s
s) =
   (b0 -> StateT s Maybe b1) -> s -> T b0 b1
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons (Kleisli (StateT s Maybe) b0 b1 -> b0 -> StateT s Maybe b1
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (Kleisli (StateT s Maybe) b0 b1 -> b0 -> StateT s Maybe b1)
-> Kleisli (StateT s Maybe) b0 b1 -> b0 -> StateT s Maybe b1
forall a b. (a -> b) -> a -> b
$ Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1
forall s.
Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1
op (Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1)
-> Kleisli (StateT s Maybe) a0 a1 -> Kleisli (StateT s Maybe) b0 b1
forall a b. (a -> b) -> a -> b
$ (a0 -> StateT s Maybe a1) -> Kleisli (StateT s Maybe) a0 a1
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli a0 -> StateT s Maybe a1
f) s
s

{-# INLINE liftKleisli2 #-}
liftKleisli2 ::
   (forall s.
      Kleisli (StateT s Maybe) a0 a1 ->
      Kleisli (StateT s Maybe) b0 b1 ->
      Kleisli (StateT s Maybe) c0 c1) ->
   T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 :: forall a0 a1 b0 b1 c0 c1.
(forall s.
 Kleisli (StateT s Maybe) a0 a1
 -> Kleisli (StateT s Maybe) b0 b1
 -> Kleisli (StateT s Maybe) c0 c1)
-> T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 forall s.
Kleisli (StateT s Maybe) a0 a1
-> Kleisli (StateT s Maybe) b0 b1 -> Kleisli (StateT s Maybe) c0 c1
op (Cons a0 -> StateT s Maybe a1
f s
s) (Cons b0 -> StateT s Maybe b1
g s
t) =
   (c0 -> StateT (s, s) Maybe c1) -> (s, s) -> T c0 c1
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons
      (Kleisli (StateT (s, s) Maybe) c0 c1 -> c0 -> StateT (s, s) Maybe c1
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli
         ((a0 -> StateT (s, s) Maybe a1)
-> Kleisli (StateT (s, s) Maybe) a0 a1
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (StateT s Maybe a1 -> StateT (s, s) Maybe a1
forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (s, t) m a
extendStateSndT (StateT s Maybe a1 -> StateT (s, s) Maybe a1)
-> (a0 -> StateT s Maybe a1) -> a0 -> StateT (s, s) Maybe a1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a0 -> StateT s Maybe a1
f) Kleisli (StateT (s, s) Maybe) a0 a1
-> Kleisli (StateT (s, s) Maybe) b0 b1
-> Kleisli (StateT (s, s) Maybe) c0 c1
forall s.
Kleisli (StateT s Maybe) a0 a1
-> Kleisli (StateT s Maybe) b0 b1 -> Kleisli (StateT s Maybe) c0 c1
`op`
          (b0 -> StateT (s, s) Maybe b1)
-> Kleisli (StateT (s, s) Maybe) b0 b1
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (StateT s Maybe b1 -> StateT (s, s) Maybe b1
forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (t, s) m a
extendStateFstT (StateT s Maybe b1 -> StateT (s, s) Maybe b1)
-> (b0 -> StateT s Maybe b1) -> b0 -> StateT (s, s) Maybe b1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b0 -> StateT s Maybe b1
g)))
      (s
s,s
t)


{-# INLINE id #-}
id :: T a a
id :: forall a. T a a
id = T a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA

{-# INLINE map #-}
map :: (a -> b) -> T a b
map :: forall b c. (b -> c) -> T b c
map a -> b
f = (a -> State () b) -> () -> T a b
forall a s b. (a -> State s b) -> s -> T a b
fromState (b -> State () b
forall a. a -> StateT () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> State () b) -> (a -> b) -> a -> State () b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ()

{-# INLINE compose #-}
compose :: T a b -> T b c -> T a c
compose :: forall a b c. T a b -> T b c -> T a c
compose = (forall s.
 Kleisli (StateT s Maybe) a b
 -> Kleisli (StateT s Maybe) b c -> Kleisli (StateT s Maybe) a c)
-> T a b -> T b c -> T a c
forall a0 a1 b0 b1 c0 c1.
(forall s.
 Kleisli (StateT s Maybe) a0 a1
 -> Kleisli (StateT s Maybe) b0 b1
 -> Kleisli (StateT s Maybe) c0 c1)
-> T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 Kleisli (StateT s Maybe) a b
-> Kleisli (StateT s Maybe) b c -> Kleisli (StateT s Maybe) a c
forall s.
Kleisli (StateT s Maybe) a b
-> Kleisli (StateT s Maybe) b c -> Kleisli (StateT s Maybe) a c
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>)

{-# INLINE split #-}
split :: T a b -> T c d -> T (a,c) (b,d)
split :: forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
split = (forall s.
 Kleisli (StateT s Maybe) a b
 -> Kleisli (StateT s Maybe) c d
 -> Kleisli (StateT s Maybe) (a, c) (b, d))
-> T a b -> T c d -> T (a, c) (b, d)
forall a0 a1 b0 b1 c0 c1.
(forall s.
 Kleisli (StateT s Maybe) a0 a1
 -> Kleisli (StateT s Maybe) b0 b1
 -> Kleisli (StateT s Maybe) c0 c1)
-> T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 Kleisli (StateT s Maybe) a b
-> Kleisli (StateT s Maybe) c d
-> Kleisli (StateT s Maybe) (a, c) (b, d)
forall s.
Kleisli (StateT s Maybe) a b
-> Kleisli (StateT s Maybe) c d
-> Kleisli (StateT s Maybe) (a, c) (b, d)
forall b c b' c'.
Kleisli (StateT s Maybe) b c
-> Kleisli (StateT s Maybe) b' c'
-> Kleisli (StateT s Maybe) (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***)

{-# INLINE fanout #-}
fanout :: T a b -> T a c -> T a (b,c)
fanout :: forall b c c'. T b c -> T b c' -> T b (c, c')
fanout = (forall s.
 Kleisli (StateT s Maybe) a b
 -> Kleisli (StateT s Maybe) a c
 -> Kleisli (StateT s Maybe) a (b, c))
-> T a b -> T a c -> T a (b, c)
forall a0 a1 b0 b1 c0 c1.
(forall s.
 Kleisli (StateT s Maybe) a0 a1
 -> Kleisli (StateT s Maybe) b0 b1
 -> Kleisli (StateT s Maybe) c0 c1)
-> T a0 a1 -> T b0 b1 -> T c0 c1
liftKleisli2 Kleisli (StateT s Maybe) a b
-> Kleisli (StateT s Maybe) a c
-> Kleisli (StateT s Maybe) a (b, c)
forall s.
Kleisli (StateT s Maybe) a b
-> Kleisli (StateT s Maybe) a c
-> Kleisli (StateT s Maybe) a (b, c)
forall b c c'.
Kleisli (StateT s Maybe) b c
-> Kleisli (StateT s Maybe) b c'
-> Kleisli (StateT s Maybe) b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&)


{-# INLINE runViewL #-}
runViewL :: (SigG.Read sig a) =>
   sig a ->
   (forall s. StateT s Maybe a -> s -> x) ->
   x
runViewL :: forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
sig forall s. StateT s Maybe a -> s -> x
cont =
   sig a -> (forall s. (s -> Maybe (a, s)) -> s -> x) -> x
forall (sig :: * -> *) y x.
Read sig y =>
sig y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
SigG.runViewL sig a
sig (\s -> Maybe (a, s)
f s
s -> StateT s Maybe a -> s -> x
forall s. StateT s Maybe a -> s -> x
cont ((s -> Maybe (a, s)) -> StateT s Maybe a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT s -> Maybe (a, s)
f) s
s)


{-# INLINE apply #-}
apply :: (SigG.Transform sig a, SigG.Transform sig b) =>
   T a b -> sig a -> sig b
apply :: forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
apply (Cons a -> StateT s Maybe b
f s
s) =
   (a -> s -> Maybe (b, s)) -> s -> sig a -> sig b
forall y0 y1 s.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
SigG.crochetL (StateT s Maybe b -> s -> Maybe (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT s Maybe b -> s -> Maybe (b, s))
-> (a -> StateT s Maybe b) -> a -> s -> Maybe (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT s Maybe b
f) s
s

{-# INLINE applySameType #-}
applySameType :: (SigG.Transform sig a) =>
   T a a -> sig a -> sig a
applySameType :: forall (sig :: * -> *) a.
Transform sig a =>
T a a -> sig a -> sig a
applySameType (Cons a -> StateT s Maybe a
f s
s) =
   (a -> s -> Maybe (a, s)) -> s -> sig a -> sig a
forall y0 y1 s.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
SigG.crochetL (StateT s Maybe a -> s -> Maybe (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT s Maybe a -> s -> Maybe (a, s))
-> (a -> StateT s Maybe a) -> a -> s -> Maybe (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT s Maybe a
f) s
s


{- |
I think this function does too much.
Better use 'feedFst' and (>>>).
-}
{-# INLINE applyFst #-}
applyFst, applyFst' :: (SigG.Read sig a) =>
   T (a,b) c -> sig a -> T b c
applyFst :: forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst T (a, b) c
c sig a
as =
   T (a, b) c
c T (a, b) c -> T b (a, b) -> T b c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< sig a -> T b (a, b)
forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
feedFst sig a
as

applyFst' :: forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst' (Cons (a, b) -> StateT s Maybe c
f s
s) sig a
as =
   sig a -> (forall s. StateT s Maybe a -> s -> T b c) -> T b c
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
as (\StateT s Maybe a
getNext s
r ->
   (b -> StateT (s, s) Maybe c) -> (s, s) -> T b c
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons (\b
b ->
           do a
a <- StateT s Maybe a -> StateT (s, s) Maybe a
forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (t, s) m a
extendStateFstT StateT s Maybe a
getNext
              StateT s Maybe c -> StateT (s, s) Maybe c
forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (s, t) m a
extendStateSndT ((a, b) -> StateT s Maybe c
f (a
a,b
b)))
        (s
s,s
r))

{- |
I think this function does too much.
Better use 'feedSnd' and (>>>).
-}
{-# INLINE applySnd #-}
applySnd, applySnd' :: (SigG.Read sig b) =>
   T (a,b) c -> sig b -> T a c
applySnd :: forall (sig :: * -> *) b a c.
Read sig b =>
T (a, b) c -> sig b -> T a c
applySnd T (a, b) c
c sig b
as =
   T (a, b) c
c T (a, b) c -> T a (a, b) -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< sig b -> T a (a, b)
forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
feedSnd sig b
as

applySnd' :: forall (sig :: * -> *) b a c.
Read sig b =>
T (a, b) c -> sig b -> T a c
applySnd' (Cons (a, b) -> StateT s Maybe c
f s
s) sig b
bs =
   sig b -> (forall s. StateT s Maybe b -> s -> T a c) -> T a c
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig b
bs (\StateT s Maybe b
getNext s
r ->
   (a -> StateT (s, s) Maybe c) -> (s, s) -> T a c
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons (\a
a ->
           do b
b <- StateT s Maybe b -> StateT (s, s) Maybe b
forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (t, s) m a
extendStateFstT StateT s Maybe b
getNext
              StateT s Maybe c -> StateT (s, s) Maybe c
forall (m :: * -> *) s a t.
Monad m =>
StateT s m a -> StateT (s, t) m a
extendStateSndT ((a, b) -> StateT s Maybe c
f (a
a,b
b)))
        (s
s,s
r))

{- |
applyConst c x == apply c (repeat x)
-}
{-# INLINE applyConst #-}
applyConst :: T a b -> a -> Sig.T b
applyConst :: forall a b. T a b -> a -> T b
applyConst (Cons a -> StateT s Maybe b
f s
s) a
a =
   (s -> Maybe (b, s)) -> s -> T b
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
Sig.unfoldR (StateT s Maybe b -> s -> Maybe (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT s Maybe b
f a
a)) s
s

{-
Can be easily done by converting the result of applyConst to generic signal
{-# INLINE applyConstGeneric #-}
applyConstGeneric :: SigG.LazySize -> T a b -> a -> sig b
applyConstGeneric size (Cons f s) a =
   SigG.unfoldR size (runStateT (f a)) s
-}


{-# INLINE apply2 #-}
apply2 ::
   (SigG.Read sig a, SigG.Transform sig b, SigG.Transform sig c) =>
   T (a,b) c -> sig a -> sig b -> sig c
apply2 :: forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
T (a, b) c -> sig a -> sig b -> sig c
apply2 T (a, b) c
f sig a
x sig b
y =
   T b c -> sig b -> sig c
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
apply (T (a, b) c -> sig a -> T b c
forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst T (a, b) c
f sig a
x) sig b
y

{-# INLINE apply3 #-}
apply3 ::
   (SigG.Read sig a, SigG.Read sig b, SigG.Transform sig c, SigG.Transform sig d) =>
   T (a,b,c) d -> sig a -> sig b -> sig c -> sig d
apply3 :: forall (sig :: * -> *) a b c d.
(Read sig a, Read sig b, Transform sig c, Transform sig d) =>
T (a, b, c) d -> sig a -> sig b -> sig c -> sig d
apply3 T (a, b, c) d
f sig a
x sig b
y sig c
z =
   T (b, c) d -> sig b -> sig c -> sig d
forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
T (a, b) c -> sig a -> sig b -> sig c
apply2 (T (a, (b, c)) d -> sig a -> T (b, c) d
forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst ((\(a
a,(b
b,c
c)) -> (a
a,b
b,c
c)) ((a, (b, c)) -> (a, b, c)) -> T (a, b, c) d -> T (a, (b, c)) d
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> T (a, b, c) d
f) sig a
x) sig b
y sig c
z


{-
A generalized version could be of type

Transform sig a b => Causal.T a b -> Causal.T (sig a) (sig b)

but we cannot implement that,
since crochetL does not return the final state.
-}
applyStorableChunk ::
   (Storable a, Storable b) =>
   T a b -> T (SV.Vector a) (SV.Vector b)
applyStorableChunk :: forall a b.
(Storable a, Storable b) =>
T a b -> T (Vector a) (Vector b)
applyStorableChunk (Cons a -> StateT s Maybe b
next s
start) = (Vector a -> StateT (Maybe s) Maybe (Vector b))
-> Maybe s -> T (Vector a) (Vector b)
forall a b s. (a -> StateT s Maybe b) -> s -> T a b
Cons
   (\Vector a
a -> (Maybe s -> Maybe (Vector b, Maybe s))
-> StateT (Maybe s) Maybe (Vector b)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Maybe s -> Maybe (Vector b, Maybe s))
 -> StateT (Maybe s) Maybe (Vector b))
-> (Maybe s -> Maybe (Vector b, Maybe s))
-> StateT (Maybe s) Maybe (Vector b)
forall a b. (a -> b) -> a -> b
$ \Maybe s
ms ->
      ((s -> (Vector b, Maybe s))
 -> Maybe s -> Maybe (Vector b, Maybe s))
-> Maybe s
-> (s -> (Vector b, Maybe s))
-> Maybe (Vector b, Maybe s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (s -> (Vector b, Maybe s)) -> Maybe s -> Maybe (Vector b, Maybe s)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe s
ms ((s -> (Vector b, Maybe s)) -> Maybe (Vector b, Maybe s))
-> (s -> (Vector b, Maybe s)) -> Maybe (Vector b, Maybe s)
forall a b. (a -> b) -> a -> b
$ \s
s ->
         (a -> s -> Maybe (b, s)) -> s -> Vector a -> (Vector b, Maybe s)
forall x y acc.
(Storable x, Storable y) =>
(x -> acc -> Maybe (y, acc))
-> acc -> Vector x -> (Vector y, Maybe acc)
SV.crochetLResult (StateT s Maybe b -> s -> Maybe (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT s Maybe b -> s -> Maybe (b, s))
-> (a -> StateT s Maybe b) -> a -> s -> Maybe (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT s Maybe b
next) s
s Vector a
a)
   (s -> Maybe s
forall a. a -> Maybe a
Just s
start)


{-# INLINE feed #-}
feed :: (SigG.Read sig a) =>
   sig a -> T () a
feed :: forall (sig :: * -> *) a. Read sig a => sig a -> T () a
feed sig a
proc =
   sig a -> (forall s. StateT s Maybe a -> s -> T () a) -> T () a
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
proc (\StateT s Maybe a
getNext ->
      (() -> StateT s Maybe a) -> s -> T () a
forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe (StateT s Maybe a -> () -> StateT s Maybe a
forall a b. a -> b -> a
const StateT s Maybe a
getNext))

{-# INLINE feedFst #-}
feedFst :: (SigG.Read sig a) =>
   sig a -> T b (a,b)
feedFst :: forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
feedFst sig a
proc =
   sig a
-> (forall s. StateT s Maybe a -> s -> T b (a, b)) -> T b (a, b)
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
proc (\StateT s Maybe a
getNext ->
      (b -> StateT s Maybe (a, b)) -> s -> T b (a, b)
forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe (\b
b -> (a -> (a, b)) -> StateT s Maybe a -> StateT s Maybe (a, b)
forall a b. (a -> b) -> StateT s Maybe a -> StateT s Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b -> (a, b)) -> b -> a -> (a, b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
b) StateT s Maybe a
getNext))

{-# INLINE feedSnd #-}
feedSnd :: (SigG.Read sig a) =>
   sig a -> T b (b,a)
feedSnd :: forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
feedSnd sig a
proc =
   sig a
-> (forall s. StateT s Maybe a -> s -> T b (b, a)) -> T b (b, a)
forall (sig :: * -> *) a x.
Read sig a =>
sig a -> (forall s. StateT s Maybe a -> s -> x) -> x
runViewL sig a
proc (\StateT s Maybe a
getNext ->
      (b -> StateT s Maybe (b, a)) -> s -> T b (b, a)
forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe (\b
b -> (a -> (b, a)) -> StateT s Maybe a -> StateT s Maybe (b, a)
forall a b. (a -> b) -> StateT s Maybe a -> StateT s Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) b
b) StateT s Maybe a
getNext))

{-# INLINE feedConstFst #-}
feedConstFst :: a -> T b (a,b)
feedConstFst :: forall a b. a -> T b (a, b)
feedConstFst a
a = (b -> (a, b)) -> T b (a, b)
forall b c. (b -> c) -> T b c
map (\b
b -> (a
a,b
b))

{-# INLINE feedConstSnd #-}
feedConstSnd :: a -> T b (b,a)
feedConstSnd :: forall a b. a -> T b (b, a)
feedConstSnd a
a = (b -> (b, a)) -> T b (b, a)
forall b c. (b -> c) -> T b c
map (\b
b -> (b
b,a
a))

{-# INLINE feedGenericFst #-}
feedGenericFst :: (SigG.Read sig a) =>
   sig a -> T b (a,b)
feedGenericFst :: forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
feedGenericFst =
   T a -> T b (a, b)
forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
feedFst (T a -> T b (a, b)) -> (sig a -> T a) -> sig a -> T b (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig a -> T a
forall y. Storage (sig y) => sig y -> T y
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState

{-# INLINE feedGenericSnd #-}
feedGenericSnd :: (SigG.Read sig a) =>
   sig a -> T b (b,a)
feedGenericSnd :: forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
feedGenericSnd =
   T a -> T b (b, a)
forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
feedSnd (T a -> T b (b, a)) -> (sig a -> T a) -> sig a -> T b (b, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig a -> T a
forall y. Storage (sig y) => sig y -> T y
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState



-- * list like functions

{-# INLINE crochetL #-}
crochetL :: (x -> acc -> Maybe (y, acc)) -> acc -> T x y
crochetL :: forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x y
crochetL x -> acc -> Maybe (y, acc)
f acc
s = (x -> StateT acc Maybe y) -> acc -> T x y
forall a s b. (a -> StateT s Maybe b) -> s -> T a b
fromStateMaybe ((acc -> Maybe (y, acc)) -> StateT acc Maybe y
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((acc -> Maybe (y, acc)) -> StateT acc Maybe y)
-> (x -> acc -> Maybe (y, acc)) -> x -> StateT acc Maybe y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> acc -> Maybe (y, acc)
f) acc
s

{-# INLINE mapAccumL #-}
mapAccumL :: (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL :: forall x acc y. (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL x -> acc -> (y, acc)
next = (x -> acc -> Maybe (y, acc)) -> acc -> T x y
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x y
crochetL (\x
a acc
s -> (y, acc) -> Maybe (y, acc)
forall a. a -> Maybe a
Just ((y, acc) -> Maybe (y, acc)) -> (y, acc) -> Maybe (y, acc)
forall a b. (a -> b) -> a -> b
$ x -> acc -> (y, acc)
next x
a acc
s)

{-# INLINE scanL #-}
scanL :: (acc -> x -> acc) -> acc -> T x acc
scanL :: forall acc x. (acc -> x -> acc) -> acc -> T x acc
scanL acc -> x -> acc
f = (x -> acc -> (acc, acc)) -> acc -> T x acc
forall x acc y. (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL (\x
x acc
acc -> (acc
acc, acc -> x -> acc
f acc
acc x
x))

{-# INLINE scanL1 #-}
scanL1 :: (x -> x -> x) -> T x x
scanL1 :: forall x. (x -> x -> x) -> T x x
scanL1 x -> x -> x
f =
   (x -> Maybe x -> (x, Maybe x)) -> Maybe x -> T x x
forall x acc y. (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL (\x
x Maybe x
acc -> (x
x, x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> x -> Maybe x
forall a b. (a -> b) -> a -> b
$ x -> (x -> x) -> Maybe x -> x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe x
x ((x -> x -> x) -> x -> x -> x
forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> x -> x
f x
x) Maybe x
acc)) Maybe x
forall a. Maybe a
Nothing

{-# INLINE zipWith #-}
zipWith :: (SigG.Read sig a) =>
   (a -> b -> c) -> sig a -> T b c
zipWith :: forall (sig :: * -> *) a b c.
Read sig a =>
(a -> b -> c) -> sig a -> T b c
zipWith a -> b -> c
f = T (a, b) c -> sig a -> T b c
forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
applyFst (((a, b) -> c) -> T (a, b) c
forall b c. (b -> c) -> T b c
map ((a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
f))

{- |
Prepend an element to a signal,
but keep the signal length,
i.e. drop the last element.
-}
{-# INLINE consInit #-}
consInit :: x -> T x x
consInit :: forall x. x -> T x x
consInit = (x -> x -> (x, x)) -> x -> T x x
forall x acc y. (x -> acc -> (y, acc)) -> acc -> T x y
mapAccumL (\x
x x
acc -> (x
acc, x
x))



{-# INLINE chainControlled #-}
chainControlled :: [T (c,x) x] -> T (c,x) x
chainControlled :: forall c x. [T (c, x) x] -> T (c, x) x
chainControlled = [T (c, x) x] -> T (c, x) x
forall (arrow :: * -> * -> *) c x.
Arrow arrow =>
[arrow (c, x) x] -> arrow (c, x) x
Class.chainControlled

{- |
If @T@ would be the function type @->@
then @replicateControlled 3 f@ computes
@\(c,x) -> f(c, f(c, f(c, x)))@.
-}
{-# INLINE replicateControlled #-}
replicateControlled :: Int -> T (c,x) x -> T (c,x) x
replicateControlled :: forall c x. Int -> T (c, x) x -> T (c, x) x
replicateControlled = Int -> T (c, x) x -> T (c, x) x
forall (arrow :: * -> * -> *) c x.
Arrow arrow =>
Int -> arrow (c, x) x -> arrow (c, x) x
Class.replicateControlled


{-# INLINE feedback #-}
feedback :: T (a,c) b -> T b c -> T a b
feedback :: forall a c b. T (a, c) b -> T b c -> T a b
feedback T (a, c) b
forth T b c
back =
   T (a, c) (b, c) -> T a b
forall b d c. T (b, d) (c, d) -> T b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop (T (a, c) b
forth T (a, c) b -> T b (b, c) -> T (a, c) (b, c)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>  T b b
forall a. T a a
id T b b -> T b c -> T b (b, c)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T b c
back)

{-# INLINE feedbackControlled #-}
feedbackControlled :: T ((ctrl,a),c) b -> T (ctrl,b) c -> T (ctrl,a) b
feedbackControlled :: forall ctrl a c b.
T ((ctrl, a), c) b -> T (ctrl, b) c -> T (ctrl, a) b
feedbackControlled T ((ctrl, a), c) b
forth T (ctrl, b) c
back =
   T ((ctrl, a), c) (b, c) -> T (ctrl, a) b
forall b d c. T (b, d) (c, d) -> T b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop ((((ctrl, a), c) -> ctrl) -> T ((ctrl, a), c) ctrl
forall b c. (b -> c) -> T b c
map ((ctrl, a) -> ctrl
forall a b. (a, b) -> a
fst((ctrl, a) -> ctrl)
-> (((ctrl, a), c) -> (ctrl, a)) -> ((ctrl, a), c) -> ctrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((ctrl, a), c) -> (ctrl, a)
forall a b. (a, b) -> a
fst) T ((ctrl, a), c) ctrl
-> T ((ctrl, a), c) b -> T ((ctrl, a), c) (ctrl, b)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T ((ctrl, a), c) b
forth  T ((ctrl, a), c) (ctrl, b)
-> T (ctrl, b) (b, c) -> T ((ctrl, a), c) (b, c)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>  ((ctrl, b) -> b) -> T (ctrl, b) b
forall b c. (b -> c) -> T b c
map (ctrl, b) -> b
forall a b. (a, b) -> b
snd T (ctrl, b) b -> T (ctrl, b) c -> T (ctrl, b) (b, c)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T (ctrl, b) c
back)

{-
{-# INLINE feedbackControlled #-}
feedbackControlled :: T (ctrl, (a,c)) b -> T (ctrl,b) c -> T (ctrl,a) b
feedbackControlled forth back =
   loop ((\((ctrl,a),c) -> (ctrl, (a,c)))  ^>>
         map fst &&& forth  >>>
         map snd &&& back)
-}