{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Copilot.FRPSketch where
import Copilot.FRPSketch.Internals
import Language.Copilot hiding (ifThenElse)
import qualified Language.Copilot
import Data.Maybe
blinking :: Behavior Bool
blinking :: Behavior Bool
blinking = Period Integer -> Phase Integer -> Behavior Bool
forall a. Integral a => Period a -> Phase a -> Behavior Bool
clk (Integer -> Period Integer
forall a. Integral a => a -> Period a
period (Integer
2 :: Integer)) (Integer -> Phase Integer
forall a. Integral a => a -> Phase a
phase (Integer
1 :: Integer))
firstIteration :: Behavior Bool
firstIteration :: Behavior Bool
firstIteration = [Bool
True][Bool] -> Behavior Bool -> Behavior Bool
forall a. Typed a => [a] -> Stream a -> Stream a
++Behavior Bool
false
frequency :: Integer -> Behavior Bool
frequency :: Integer -> Behavior Bool
frequency Integer
n = Period Integer -> Phase Integer -> Behavior Bool
forall a. Integral a => Period a -> Phase a -> Behavior Bool
clk (Integer -> Period Integer
forall a. Integral a => a -> Period a
period Integer
n) (Integer -> Phase Integer
forall a. Integral a => a -> Phase a
phase Integer
1)
data MilliSeconds = MilliSeconds (Stream Word32)
data MicroSeconds = MicroSeconds (Stream Word32)
delay :: Delay
delay :: Delay
delay = Delay
Delay
data Delay = Delay
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 = Behavior Bool -> Stream a -> Stream a -> Stream a
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) =
Behavior a -> TypedBehavior p a
forall k (p :: k) t. Behavior t -> TypedBehavior p t
TypedBehavior (Behavior Bool -> Behavior a -> Behavior a -> Behavior a
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 Ord pinid => IfThenElse (GenSketch pinid) () where
ifThenElse :: Behavior Bool
-> GenSketch pinid () -> GenSketch pinid () -> GenSketch pinid ()
ifThenElse Behavior Bool
c GenSketch pinid ()
a GenSketch pinid ()
b = do
Behavior Bool -> GenSketch pinid () -> GenSketch pinid ()
forall pinid t.
Ord pinid =>
Behavior Bool -> GenSketch pinid t -> GenSketch pinid t
whenB Behavior Bool
c GenSketch pinid ()
a
Behavior Bool -> GenSketch pinid () -> GenSketch pinid ()
forall pinid t.
Ord pinid =>
Behavior Bool -> GenSketch pinid t -> GenSketch pinid t
whenB (Behavior Bool -> Behavior Bool
not Behavior Bool
c) GenSketch pinid ()
b
instance (Ord pinid, Typed a) => IfThenElse (GenSketch pinid) (Behavior a) where
ifThenElse :: Behavior Bool
-> GenSketch pinid (Behavior a)
-> GenSketch pinid (Behavior a)
-> GenSketch pinid (Behavior a)
ifThenElse Behavior Bool
c GenSketch pinid (Behavior a)
a GenSketch pinid (Behavior a)
b = do
Behavior a
ra <- Behavior Bool
-> GenSketch pinid (Behavior a) -> GenSketch pinid (Behavior a)
forall pinid t.
Ord pinid =>
Behavior Bool -> GenSketch pinid t -> GenSketch pinid t
whenB Behavior Bool
c GenSketch pinid (Behavior a)
a
Behavior a
rb <- Behavior Bool
-> GenSketch pinid (Behavior a) -> GenSketch pinid (Behavior a)
forall pinid t.
Ord pinid =>
Behavior Bool -> GenSketch pinid t -> GenSketch pinid t
whenB (Behavior Bool -> Behavior Bool
not Behavior Bool
c) GenSketch pinid (Behavior a)
b
Behavior a -> GenSketch pinid (Behavior a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Behavior a -> GenSketch pinid (Behavior a))
-> Behavior a -> GenSketch pinid (Behavior a)
forall a b. (a -> b) -> a -> b
$ Behavior Bool -> Behavior a -> Behavior a -> Behavior a
forall a.
Typed a =>
Behavior Bool -> Stream a -> Stream a -> Stream a
Language.Copilot.ifThenElse Behavior Bool
c Behavior a
ra Behavior a
rb
scheduleB
:: (Typed t, Eq t, Ord pinid)
=> Behavior t
-> [(t, GenSketch pinid ())]
-> GenSketch pinid ()
scheduleB :: Behavior t -> [(t, GenSketch pinid ())] -> GenSketch pinid ()
scheduleB Behavior t
b = [GenSketch pinid ()] -> GenSketch pinid ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([GenSketch pinid ()] -> GenSketch pinid ())
-> ([(t, GenSketch pinid ())] -> [GenSketch pinid ()])
-> [(t, GenSketch pinid ())]
-> GenSketch pinid ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((t, GenSketch pinid ()) -> GenSketch pinid ())
-> [(t, GenSketch pinid ())] -> [GenSketch pinid ()]
forall a b. (a -> b) -> [a] -> [b]
map (t, GenSketch pinid ()) -> GenSketch pinid ()
forall pinid t.
Ord pinid =>
(t, GenSketch pinid t) -> GenSketch pinid t
go
where
go :: (t, GenSketch pinid t) -> GenSketch pinid t
go (t
v, GenSketch pinid t
s) = Behavior Bool -> GenSketch pinid t -> GenSketch pinid t
forall pinid t.
Ord pinid =>
Behavior Bool -> GenSketch pinid t -> GenSketch pinid t
whenB (Behavior t
b Behavior t -> Behavior t -> Behavior Bool
forall a. (Eq a, Typed a) => Stream a -> Stream a -> Behavior Bool
== t -> Behavior t
forall a. Typed a => a -> Stream a
constant t
v) GenSketch pinid t
s
sketchSpec :: Ord pinid => GenSketch pinid a -> Spec
sketchSpec :: GenSketch pinid a -> Spec
sketchSpec = Spec -> Maybe Spec -> Spec
forall a. a -> Maybe a -> a
fromMaybe (() -> Spec
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Maybe Spec -> Spec)
-> (GenSketch pinid a -> Maybe Spec) -> GenSketch pinid a -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Spec, GenFramework pinid) -> Maybe Spec
forall a b. (a, b) -> a
fst ((Maybe Spec, GenFramework pinid) -> Maybe Spec)
-> (GenSketch pinid a -> (Maybe Spec, GenFramework pinid))
-> GenSketch pinid a
-> Maybe Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenSketch pinid a -> (Maybe Spec, GenFramework pinid)
forall pinid a.
Ord pinid =>
GenSketch pinid a -> (Maybe Spec, GenFramework pinid)
evalSketch
liftB
:: (Behavior a -> Behavior r)
-> TypedBehavior t a
-> Behavior r
liftB :: (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 :: (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