{- |
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.
-}

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module LiveCoding.Cell.Resample where

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

-- vector-sized
import Data.Vector.Sized

-- 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 :: Cell m a b -> Cell m (Vector n a) (Vector n b)
resample Cell m a b
cell = (Vector n a -> [a]) -> Cell m (Vector n a) [a]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Vector n a -> [a]
forall (n :: Nat) a. Vector n a -> [a]
toList Cell m (Vector n a) [a]
-> Cell m [a] (Vector n b) -> Cell m (Vector n a) (Vector n b)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Cell m a b -> Cell m [a] [b]
forall (m :: * -> *) a b. Monad m => Cell m a b -> Cell m [a] [b]
resampleList Cell m a b
cell Cell m [a] [b]
-> Cell m [b] (Vector n b) -> Cell m [a] (Vector n b)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([b] -> Vector n b) -> Cell m [b] (Vector n b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ([b] -> Maybe (Vector n b)
forall (n :: Nat) a. KnownNat n => [a] -> Maybe (Vector n a)
fromList ([b] -> Maybe (Vector n b))
-> (Maybe (Vector n b) -> Vector n b) -> [b] -> Vector n b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Maybe (Vector n b) -> Vector n b
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 :: Cell m a b -> Cell m [a] [b]
resampleList = (forall s. (s -> a -> m (b, s)) -> s -> [a] -> m ([b], s))
-> Cell m a b -> Cell m [a] [b]
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 s. (s -> a -> m (b, s)) -> s -> [a] -> m ([b], s)
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 [] = ([a], t) -> m ([a], t)
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
      ([a], t) -> m ([a], t)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
bs, t
s'')

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