{-# LANGUAGE Arrows #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module LiveCoding.Cell.Util where
import Control.Arrow
import Control.Monad (guard, join)
import Control.Monad.IO.Class
import Data.Data (Data)
import Data.Foldable (toList)
import Data.Functor (void)
import Data.Maybe
import Data.Sequence hiding (take)
import qualified Data.Sequence as Sequence
import Data.Time.Clock
import LiveCoding.Cell
import LiveCoding.Cell.Feedback
import LiveCoding.Cell.Resample (resampleMaybe)
import LiveCoding.Cell.Util.Internal
sumFrom :: Monad m => Integer -> Cell m Integer Integer
sumFrom :: forall (m :: * -> *). Monad m => Integer -> Cell m Integer Integer
sumFrom Integer
n0 = forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback Integer
n0 forall a b. (a -> b) -> a -> b
$ proc (Integer
n, Integer
acc) -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (Integer
acc, Integer
acc forall a. Num a => a -> a -> a
+ Integer
n)
count :: Monad m => Cell m a Integer
count :: forall (m :: * -> *) a. Monad m => Cell m a Integer
count = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. a -> b -> a
const Integer
1) 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. (Monad m, Num a, Data a) => Cell m a a
sumC
foldC :: (Data b, Monad m) => (a -> b -> b) -> b -> Cell m a b
foldC :: forall b (m :: * -> *) a.
(Data b, Monad m) =>
(a -> b -> b) -> b -> Cell m a b
foldC a -> b -> b
step b
cellState = Cell {b
forall {m :: * -> *}. Monad m => b -> a -> m (b, b)
cellStep :: b -> a -> m (b, b)
cellState :: b
cellStep :: forall {m :: * -> *}. Monad m => b -> a -> m (b, b)
cellState :: b
..}
where
cellStep :: b -> a -> m (b, b)
cellStep b
b a
a = let b' :: b
b' = a -> b -> b
step a
a b
b in forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, b
b')
foldC' :: (Data b, Monad m) => (a -> b -> b) -> b -> Cell m a b
foldC' :: forall b (m :: * -> *) a.
(Data b, Monad m) =>
(a -> b -> b) -> b -> Cell m a b
foldC' a -> b -> b
step b
cellState = Cell {b
forall {m :: * -> *}. Monad m => b -> a -> m (b, b)
cellStep :: forall {m :: * -> *}. Monad m => b -> a -> m (b, b)
cellState :: b
cellStep :: b -> a -> m (b, b)
cellState :: b
..}
where
cellStep :: b -> a -> m (b, b)
cellStep b
b a
a = let b' :: b
b' = a -> b -> b
step a
a b
b in forall (m :: * -> *) a. Monad m => a -> m a
return (b
b', b
b')
hold :: (Data a, Monad m) => a -> Cell m (Maybe a) a
hold :: forall a (m :: * -> *).
(Data a, Monad m) =>
a -> Cell m (Maybe a) a
hold a
a = forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback a
a forall a b. (a -> b) -> a -> b
$ proc (Maybe a
ma, a
aOld) -> do
let aNew :: a
aNew = forall a. a -> Maybe a -> a
fromMaybe a
aOld Maybe a
ma
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
aNew, a
aNew)
changes ::
(Data a, Eq a, Monad m) =>
Cell m a (Maybe a)
changes :: forall a (m :: * -> *).
(Data a, Eq a, Monad m) =>
Cell m a (Maybe a)
changes = proc a
a -> do
Maybe a
aLast <- forall s (m :: * -> *). (Data s, Monad m) => s -> Cell m s s
delay forall a. Maybe a
Nothing -< forall a. a -> Maybe a
Just a
a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
-< do
a
aLast' <- Maybe a
aLast
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ a
a forall a. Eq a => a -> a -> Bool
/= a
aLast'
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
holdJust ::
(Monad m, Data a) =>
Cell m (Maybe a) (Maybe a)
holdJust :: forall (m :: * -> *) a.
(Monad m, Data a) =>
Cell m (Maybe a) (Maybe a)
holdJust = forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {a}. (Maybe a, Maybe a) -> (Maybe a, Maybe a)
keep
where
keep :: (Maybe a, Maybe a) -> (Maybe a, Maybe a)
keep (Maybe a
Nothing, Maybe a
Nothing) = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
keep (Maybe a
_, Just a
a) = (forall a. a -> Maybe a
Just a
a, forall a. a -> Maybe a
Just a
a)
keep (Just a
a, Maybe a
Nothing) = (forall a. a -> Maybe a
Just a
a, forall a. a -> Maybe a
Just a
a)
holdFirst :: (Data a, Monad m) => Cell m a a
holdFirst :: forall a (m :: * -> *). (Data a, Monad m) => Cell m a a
holdFirst = Cell {forall a. Maybe a
forall {m :: * -> *} {a}. Monad m => Maybe a -> a -> m (a, Maybe a)
cellStep :: forall {m :: * -> *} {a}. Monad m => Maybe a -> a -> m (a, Maybe a)
cellState :: forall a. Maybe a
cellStep :: Maybe a -> a -> m (a, Maybe a)
cellState :: Maybe a
..}
where
cellState :: Maybe a
cellState = forall a. Maybe a
Nothing
cellStep :: Maybe a -> a -> m (a, Maybe a)
cellStep Maybe a
Nothing a
x = forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, forall a. a -> Maybe a
Just a
x)
cellStep (Just a
s) a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (a
s, forall a. a -> Maybe a
Just a
s)
boundedFIFO :: (Data a, Monad m) => Int -> Cell m (Maybe a) (Seq a)
boundedFIFO :: forall a (m :: * -> *).
(Data a, Monad m) =>
Int -> Cell m (Maybe a) (Seq a)
boundedFIFO Int
n = forall b (m :: * -> *) a.
(Data b, Monad m) =>
(a -> b -> b) -> b -> Cell m a b
foldC' forall {a}. Maybe a -> Seq a -> Seq a
step forall a. Seq a
empty
where
step :: Maybe a -> Seq a -> Seq a
step Maybe a
Nothing Seq a
as = Seq a
as
step (Just a
a) Seq a
as = forall a. Int -> Seq a -> Seq a
Sequence.take Int
n forall a b. (a -> b) -> a -> b
$ a
a forall a. a -> Seq a -> Seq a
<| Seq a
as
fifo :: (Monad m, Data a) => Cell m (Seq a) (Maybe a)
fifo :: forall (m :: * -> *) a.
(Monad m, Data a) =>
Cell m (Seq a) (Maybe a)
fifo = forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback forall a. Seq a
empty forall a b. (a -> b) -> a -> b
$ proc (Seq a
as, Seq a
accum) -> do
let accum' :: Seq a
accum' = Seq a
accum forall a. Seq a -> Seq a -> Seq a
>< Seq a
as
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
-< case Seq a
accum' of
Seq a
Empty -> (forall a. Maybe a
Nothing, forall a. Seq a
empty)
a
a :<| Seq a
as -> (forall a. a -> Maybe a
Just a
a, Seq a
as)
fifoList :: (Monad m, Data a) => Cell m [a] (Maybe a)
fifoList :: forall (m :: * -> *) a. (Monad m, Data a) => Cell m [a] (Maybe a)
fifoList = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. [a] -> Seq 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 (m :: * -> *) a.
(Monad m, Data a) =>
Cell m (Seq a) (Maybe a)
fifo
fifoFoldable :: (Monad m, Data a, Foldable f) => Cell m (f a) (Maybe a)
fifoFoldable :: forall (m :: * -> *) a (f :: * -> *).
(Monad m, Data a, Foldable f) =>
Cell m (f a) (Maybe a)
fifoFoldable = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall (t :: * -> *) a. Foldable t => t 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. (Monad m, Data a) => Cell m [a] (Maybe a)
fifoList
edge :: Monad m => Cell m Bool Bool
edge :: forall (m :: * -> *). Monad m => Cell m Bool Bool
edge = proc Bool
b -> do
Bool
bLast <- forall s (m :: * -> *). (Data s, Monad m) => s -> Cell m s s
delay Bool
False -< Bool
b
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Bool
b Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
bLast
printTime :: MonadIO m => String -> m ()
printTime :: forall (m :: * -> *). MonadIO m => String -> m ()
printTime String
msg = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Int -> [a] -> [a]
take Int
8 String
msg forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
printTimeC :: MonadIO m => String -> Cell m () ()
printTimeC :: forall (m :: * -> *). MonadIO m => String -> Cell m () ()
printTimeC String
msg = forall (m :: * -> *) b a. m b -> Cell m a b
constM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => String -> m ()
printTime String
msg
data BufferCommand a
=
Push a
|
Pop
maybePush :: Maybe a -> [BufferCommand a]
maybePush :: forall a. Maybe a -> [BufferCommand a]
maybePush = (forall a. a -> BufferCommand a
Push forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> [a]
maybeToList
maybePop :: Maybe a -> [BufferCommand b]
maybePop :: forall a b. Maybe a -> [BufferCommand b]
maybePop = (forall a b. a -> b -> a
const forall a. BufferCommand a
Pop forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> [a]
maybeToList
buffer :: (Monad m, Data a) => Cell m [BufferCommand a] (Maybe a)
buffer :: forall (m :: * -> *) a.
(Monad m, Data a) =>
Cell m [BufferCommand a] (Maybe a)
buffer = Cell {forall a. Seq a
forall {m :: * -> *} {a}.
Monad m =>
Seq a -> [BufferCommand a] -> m (Maybe a, Seq a)
cellStep :: forall {m :: * -> *} {a}.
Monad m =>
Seq a -> [BufferCommand a] -> m (Maybe a, Seq a)
cellState :: forall a. Seq a
cellStep :: Seq a -> [BufferCommand a] -> m (Maybe a, Seq a)
cellState :: Seq a
..}
where
cellState :: Seq a
cellState = forall a. Seq a
empty
cellStep :: Seq a -> [BufferCommand a] -> m (Maybe a, Seq a)
cellStep Seq a
as [BufferCommand a]
commands = forall (m :: * -> *) a. Monad m => a -> m a
return (forall {a}. Seq a -> Maybe a
currentHead Seq a
as, forall {a}. Seq a -> [BufferCommand a] -> Seq a
nextBuffer Seq a
as [BufferCommand a]
commands)
currentHead :: Seq a -> Maybe a
currentHead Seq a
as = case forall a. Seq a -> ViewL a
viewl Seq a
as of
ViewL a
EmptyL -> forall a. Maybe a
Nothing
a
a :< Seq a
as' -> forall a. a -> Maybe a
Just a
a
nextBuffer :: Seq a -> [BufferCommand a] -> Seq a
nextBuffer Seq a
as [] = Seq a
as
nextBuffer Seq a
as (Push a
a : [BufferCommand a]
commands) = Seq a -> [BufferCommand a] -> Seq a
nextBuffer (Seq a
as forall a. Seq a -> a -> Seq a
|> a
a) [BufferCommand a]
commands
nextBuffer Seq a
as (BufferCommand a
Pop : [BufferCommand a]
commands) = Seq a -> [BufferCommand a] -> Seq a
nextBuffer (forall a. Int -> Seq a -> Seq a
Sequence.drop Int
1 Seq a
as) [BufferCommand a]
commands
buffered ::
(Monad m, Data a) =>
Cell m (Maybe a) (Maybe b) ->
Cell m (Maybe a) (Maybe b)
buffered :: forall (m :: * -> *) a b.
(Monad m, Data a) =>
Cell m (Maybe a) (Maybe b) -> Cell m (Maybe a) (Maybe b)
buffered Cell m (Maybe a) (Maybe b)
cell = forall (m :: * -> *) s a b.
(Monad m, Data s) =>
s -> Cell m (a, s) (b, s) -> Cell m a b
feedback forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ proc (Maybe a
aMaybe, Maybe ()
ticked) -> do
Maybe a
aMaybe' <- forall (m :: * -> *) a.
(Monad m, Data a) =>
Cell m [BufferCommand a] (Maybe a)
buffer -< forall a b. Maybe a -> [BufferCommand b]
maybePop Maybe ()
ticked forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [BufferCommand a]
maybePush Maybe a
aMaybe
Maybe b
bMaybe' <- Cell m (Maybe a) (Maybe b)
cell -< Maybe a
aMaybe'
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (Maybe b
bMaybe', forall (f :: * -> *) a. Functor f => f a -> f ()
void Maybe b
bMaybe')
onChange ::
(Monad m, Data p, Eq p) =>
p ->
(p -> p -> a -> m b) ->
Cell m a (Maybe b)
onChange :: forall (m :: * -> *) p a b.
(Monad m, Data p, Eq p) =>
p -> (p -> p -> a -> m b) -> Cell m a (Maybe b)
onChange p
p p -> p -> a -> m b
action = proc a
a -> do
p
pCurrent <- forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const p
p -< ()
p
pPrevious <- forall s (m :: * -> *). (Data s, Monad m) => s -> Cell m s s
delay p
p -< p
pCurrent
forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM forall a b. (a -> b) -> a -> b
$ forall p (m :: * -> *) a b.
(Eq p, Monad m) =>
(p -> p -> a -> m b) -> (p, p, a) -> m (Maybe b)
whenDifferent p -> p -> a -> m b
action -< (p
pCurrent, p
pPrevious, a
a)
onChange' ::
(Monad m, Data p, Eq p) =>
(p -> p -> a -> m b) ->
Cell m (p, a) (Maybe b)
onChange' :: forall (m :: * -> *) p a b.
(Monad m, Data p, Eq p) =>
(p -> p -> a -> m b) -> Cell m (p, a) (Maybe b)
onChange' p -> p -> a -> m b
action = proc (p
pCurrent, a
a) -> do
Maybe p
pPrevious <- forall s (m :: * -> *). (Data s, Monad m) => s -> Cell m s s
delay forall a. Maybe a
Nothing -< forall a. a -> Maybe a
Just p
pCurrent
Maybe (Maybe b)
bMaybeMaybe <- forall (m :: * -> *) a b.
Monad m =>
Cell m a b -> Cell m (Maybe a) (Maybe b)
resampleMaybe forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM forall a b. (a -> b) -> a -> b
$ forall p (m :: * -> *) a b.
(Eq p, Monad m) =>
(p -> p -> a -> m b) -> (p, p, a) -> m (Maybe b)
whenDifferent p -> p -> a -> m b
action -< (,p
pCurrent,a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe p
pPrevious
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe b)
bMaybeMaybe