{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}

{- |
Run a cell at a fixed integer multiple speed.
The general approach is to take an existing cell (the "inner" cell)
and produce a new cell (the "outer" cell) that will accept several copies of the input.
The inner cell is stepped for each input.
-}
module LiveCoding.Cell.Resample where

-- base
import Control.Arrow
import Data.Maybe
import GHC.TypeNats

-- vector-sized
import Data.Vector.Sized (Vector, fromList, toList)

-- essence-of-live-coding
import LiveCoding.Cell
import LiveCoding.Cell.Monad

-- | Execute the inner cell for n steps per outer step.
resample :: (Monad m, KnownNat n) => Cell m a b -> Cell m (Vector n a) (Vector n b)
resample :: forall (m :: * -> *) (n :: Nat) a b.
(Monad m, KnownNat n) =>
Cell m a b -> Cell m (Vector n a) (Vector n b)
resample Cell m a b
cell = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall (n :: Nat) a. Vector n a -> [a]
toList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: * -> *) a b. Monad m => Cell m a b -> Cell m [a] [b]
resampleList Cell m a b
cell forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (n :: Nat) a. KnownNat n => [a] -> Maybe (Vector n a)
fromList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. HasCallStack => Maybe a -> a
fromJust)

-- | Execute the cell for as many steps as the input list is long.
resampleList :: Monad m => Cell m a b -> Cell m [a] [b]
resampleList :: forall (m :: * -> *) a b. Monad m => Cell m a b -> Cell m [a] [b]
resampleList = forall (m1 :: * -> *) (m2 :: * -> *) a1 b1 a2 b2.
(Monad m1, Monad m2) =>
(forall s. (s -> a1 -> m1 (b1, s)) -> s -> a2 -> m2 (b2, s))
-> Cell m1 a1 b1 -> Cell m2 a2 b2
hoistCellKleisli forall {m :: * -> *} {t} {t} {a}.
Monad m =>
(t -> t -> m (a, t)) -> t -> [t] -> m ([a], t)
morph
  where
    morph :: (t -> t -> m (a, t)) -> t -> [t] -> m ([a], t)
morph t -> t -> m (a, t)
_ t
s [] = forall (m :: * -> *) a. Monad m => a -> m a
return ([], t
s)
    morph t -> t -> m (a, t)
singleStep t
s (t
a : [t]
as) = do
      (!a
b, t
s') <- t -> t -> m (a, t)
singleStep t
s t
a
      (![a]
bs, t
s'') <- (t -> t -> m (a, t)) -> t -> [t] -> m ([a], t)
morph t -> t -> m (a, t)
singleStep t
s' [t]
as
      forall (m :: * -> *) a. Monad m => a -> m a
return (a
b forall a. a -> [a] -> [a]
: [a]
bs, t
s'')

resampleMaybe :: Monad m => Cell m a b -> Cell m (Maybe a) (Maybe b)
resampleMaybe :: forall (m :: * -> *) a b.
Monad m =>
Cell m a b -> Cell m (Maybe a) (Maybe b)
resampleMaybe Cell m a b
cell = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. Maybe a -> [a]
maybeToList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: * -> *) a b. Monad m => Cell m a b -> Cell m [a] [b]
resampleList Cell m a b
cell forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. [a] -> Maybe a
listToMaybe

{- | Create as many cells as the input list is long and execute them in parallel
 (in the sense that each one has a separate state). At each tick the list with
 the different states grows or shrinks depending on the size of the input list.

 Similar to Yampa's [parC](https://hackage.haskell.org/package/Yampa-0.13.3/docs/FRP-Yampa-Switches.html#v:parC).
-}
resampleListPar :: Monad m => Cell m a b -> Cell m [a] [b]
resampleListPar :: forall (m :: * -> *) a b. Monad m => Cell m a b -> Cell m [a] [b]
resampleListPar (Cell s
initial s -> a -> m (b, s)
step) = Cell {[s] -> [a] -> m ([b], [s])
forall a. [a]
cellStep :: [s] -> [a] -> m ([b], [s])
cellState :: [s]
cellStep :: [s] -> [a] -> m ([b], [s])
cellState :: forall a. [a]
..}
  where
    cellState :: [a]
cellState = []
    cellStep :: [s] -> [a] -> m ([b], [s])
cellStep [s]
s [a]
xs = forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry s -> a -> m (b, s)
step) (forall a b. [a] -> [b] -> [(a, b)]
zip [s]
s' [a]
xs)
      where
        s' :: [s]
s' = [s]
s forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [s]
s) s
initial
resampleListPar (ArrM a -> m b
f) = forall (m :: * -> *) a b. (a -> m b) -> Cell m a b
ArrM (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m b
f)