{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module LiveCoding.Cell.Resample where
import Control.Arrow
import Data.Maybe
import GHC.TypeNats
import Data.Vector.Sized
import LiveCoding.Cell
import LiveCoding.Cell.Monad
resample :: (Monad m, KnownNat n) => Cell m a b -> Cell m (Vector n a) (Vector n b)
resample cell = arr toList >>> resampleList cell >>> arr (fromList >>> fromJust)
resampleList :: Monad m => Cell m a b -> Cell m [a] [b]
resampleList cell = hoistCellKleisli morph cell
where
morph _ s [] = return ([], s)
morph singleStep s (a : as) = do
(!b , s' ) <- singleStep s a
(!bs, s'') <- morph singleStep s' as
return (b : bs, s'')
resampleMaybe :: Monad m => Cell m a b -> Cell m (Maybe a) (Maybe b)
resampleMaybe cell = arr maybeToList >>> resampleList cell >>> arr listToMaybe