{- | 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 Cell m a b cell = (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 Cell m a b cell 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