{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Sketch.FRP.Copilot where
import Sketch.FRP.Copilot.Types
import Language.Copilot hiding (ifThenElse)
import qualified Language.Copilot
import Control.Monad.Writer
import Control.Monad.State.Strict
import Data.Functor.Identity
blinking :: Behavior Bool
blinking :: Behavior Bool
blinking = forall a. Integral a => Period a -> Phase a -> Behavior Bool
clk (forall a. Integral a => a -> Period a
period (Integer
2 :: Integer)) (forall a. Integral a => a -> Phase a
phase (Integer
1 :: Integer))
firstIteration :: Behavior Bool
firstIteration :: Behavior Bool
firstIteration = [Bool
True]forall a. Typed a => [a] -> Stream a -> Stream a
++Behavior Bool
false
frequency :: Integer -> Behavior Bool
frequency :: Integer -> Behavior Bool
frequency Integer
n = forall a. Integral a => Period a -> Phase a -> Behavior Bool
clk (forall a. Integral a => a -> Period a
period Integer
n) (forall a. Integral a => a -> Phase a
phase Integer
1)
scheduleB
:: (Typed t, Eq t, Context ctx)
=> Behavior t
-> [(t, GenSketch ctx ())]
-> GenSketch ctx ()
scheduleB :: forall t ctx.
(Typed t, Eq t, Context ctx) =>
Behavior t -> [(t, GenSketch ctx ())] -> GenSketch ctx ()
scheduleB Behavior t
b = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {ctx} {t}.
Context ctx =>
(t, GenSketch ctx t) -> GenSketch ctx t
go
where
go :: (t, GenSketch ctx t) -> GenSketch ctx t
go (t
v, GenSketch ctx t
s) = forall ctx t.
Context ctx =>
Behavior Bool -> GenSketch ctx t -> GenSketch ctx t
whenB (Behavior t
b forall a. (Eq a, Typed a) => Stream a -> Stream a -> Behavior Bool
== forall a. Typed a => a -> Stream a
constant t
v) GenSketch ctx t
s
liftB
:: (Behavior a -> Behavior r)
-> TypedBehavior t a
-> Behavior r
liftB :: forall a r t.
(Behavior a -> Behavior r) -> TypedBehavior t a -> Behavior r
liftB Behavior a -> Behavior r
f (TypedBehavior Behavior a
b) = Behavior a -> Behavior r
f Behavior a
b
liftB2
:: (Behavior a -> Behavior b -> Behavior r)
-> TypedBehavior t a
-> TypedBehavior t b
-> Behavior r
liftB2 :: forall a b r t.
(Behavior a -> Behavior b -> Behavior r)
-> TypedBehavior t a -> TypedBehavior t b -> Behavior r
liftB2 Behavior a -> Behavior b -> Behavior r
f (TypedBehavior Behavior a
a) (TypedBehavior Behavior b
b) = Behavior a -> Behavior b -> Behavior r
f Behavior a
a Behavior b
b
whenB :: Context ctx => Behavior Bool -> GenSketch ctx t -> GenSketch ctx t
whenB :: forall ctx t.
Context ctx =>
Behavior Bool -> GenSketch ctx t -> GenSketch ctx t
whenB Behavior Bool
c (GenSketch WriterT
[(TriggerLimit -> WriterT [SpecItem] Identity (),
TriggerLimit -> GenFramework ctx)]
(State UniqueIds)
t
s) = do
UniqueIds
ids <- forall s (m :: * -> *). MonadState s m => m s
get
let ((t
r, [(TriggerLimit -> WriterT [SpecItem] Identity (),
TriggerLimit -> GenFramework ctx)]
w), UniqueIds
ids') = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT
[(TriggerLimit -> WriterT [SpecItem] Identity (),
TriggerLimit -> GenFramework ctx)]
(State UniqueIds)
t
s) UniqueIds
ids
forall s (m :: * -> *). MonadState s m => s -> m ()
put UniqueIds
ids'
let ([TriggerLimit -> WriterT [SpecItem] Identity ()]
is, [TriggerLimit -> GenFramework ctx]
fs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(TriggerLimit -> WriterT [SpecItem] Identity (),
TriggerLimit -> GenFramework ctx)]
w
let spec :: TriggerLimit -> WriterT [SpecItem] Identity ()
spec = forall a. (TriggerLimit -> a) -> TriggerLimit -> a
combinetl forall a b. (a -> b) -> a -> b
$ \TriggerLimit
c' -> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (forall a b. (a -> b) -> [a] -> [b]
map (\TriggerLimit -> WriterT [SpecItem] Identity ()
i -> TriggerLimit -> WriterT [SpecItem] Identity ()
i TriggerLimit
c') [TriggerLimit -> WriterT [SpecItem] Identity ()]
is)
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(TriggerLimit -> WriterT [SpecItem] Identity ()
spec, forall a. Monoid a => a
mempty)]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TriggerLimit -> GenFramework ctx]
fs forall a b. (a -> b) -> a -> b
$ \TriggerLimit -> GenFramework ctx
f -> forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(\TriggerLimit
_tl -> (forall (m :: * -> *) a. Monad m => a -> m a
return ()), forall a. (TriggerLimit -> a) -> TriggerLimit -> a
combinetl TriggerLimit -> GenFramework ctx
f)]
forall (m :: * -> *) a. Monad m => a -> m a
return t
r
where
combinetl :: (TriggerLimit -> a) -> TriggerLimit -> a
combinetl :: forall a. (TriggerLimit -> a) -> TriggerLimit -> a
combinetl TriggerLimit -> a
g TriggerLimit
tl = TriggerLimit -> a
g (Behavior Bool -> TriggerLimit
TriggerLimit Behavior Bool
c forall a. Semigroup a => a -> a -> a
<> TriggerLimit
tl)
class IfThenElse t a where
ifThenElse :: Behavior Bool -> t a -> t a -> t a
instance Typed a => IfThenElse Stream a where
ifThenElse :: Behavior Bool -> Stream a -> Stream a -> Stream a
ifThenElse = forall a.
Typed a =>
Behavior Bool -> Stream a -> Stream a -> Stream a
Language.Copilot.ifThenElse
instance Typed a => IfThenElse (TypedBehavior p) a where
ifThenElse :: Behavior Bool
-> TypedBehavior p a -> TypedBehavior p a -> TypedBehavior p a
ifThenElse Behavior Bool
c (TypedBehavior Behavior a
a) (TypedBehavior Behavior a
b) =
forall {k} (p :: k) t. Behavior t -> TypedBehavior p t
TypedBehavior (forall (t :: * -> *) a.
IfThenElse t a =>
Behavior Bool -> t a -> t a -> t a
ifThenElse Behavior Bool
c Behavior a
a Behavior a
b)
instance Context ctx => IfThenElse (GenSketch ctx) () where
ifThenElse :: Behavior Bool
-> GenSketch ctx () -> GenSketch ctx () -> GenSketch ctx ()
ifThenElse Behavior Bool
c GenSketch ctx ()
a GenSketch ctx ()
b = do
forall ctx t.
Context ctx =>
Behavior Bool -> GenSketch ctx t -> GenSketch ctx t
whenB Behavior Bool
c GenSketch ctx ()
a
forall ctx t.
Context ctx =>
Behavior Bool -> GenSketch ctx t -> GenSketch ctx t
whenB (Behavior Bool -> Behavior Bool
not Behavior Bool
c) GenSketch ctx ()
b
instance (Context ctx, Typed a) => IfThenElse (GenSketch ctx) (Behavior a) where
ifThenElse :: Behavior Bool
-> GenSketch ctx (Behavior a)
-> GenSketch ctx (Behavior a)
-> GenSketch ctx (Behavior a)
ifThenElse Behavior Bool
c GenSketch ctx (Behavior a)
a GenSketch ctx (Behavior a)
b = do
Behavior a
ra <- forall ctx t.
Context ctx =>
Behavior Bool -> GenSketch ctx t -> GenSketch ctx t
whenB Behavior Bool
c GenSketch ctx (Behavior a)
a
Behavior a
rb <- forall ctx t.
Context ctx =>
Behavior Bool -> GenSketch ctx t -> GenSketch ctx t
whenB (Behavior Bool -> Behavior Bool
not Behavior Bool
c) GenSketch ctx (Behavior a)
b
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
Typed a =>
Behavior Bool -> Stream a -> Stream a -> Stream a
Language.Copilot.ifThenElse Behavior Bool
c Behavior a
ra Behavior a
rb
input :: Input ctx o t => o -> GenSketch ctx (Behavior t)
input :: forall ctx o t. Input ctx o t => o -> GenSketch ctx (Behavior t)
input o
o = forall ctx o t.
Input ctx o t =>
o -> [t] -> GenSketch ctx (Behavior t)
input' o
o []
data MilliSeconds = MilliSeconds (Stream Word32)
data MicroSeconds = MicroSeconds (Stream Word32)
data Delay = Delay
delay :: Delay
delay :: Delay
delay = Delay
Delay