{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Copilot.FRPSketch.Internals where
import Language.Copilot
import Control.Monad.Writer
import Control.Monad.State.Strict
import Data.Functor.Identity
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Type.Bool
import GHC.TypeLits
type Behavior t = Stream t
data TypedBehavior p t = TypedBehavior (Behavior t)
data Event p v = Event v (Stream Bool)
newtype GenSketch pinid t = Sketch (WriterT [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)] (State UniqueIds) t)
deriving
( Applicative (GenSketch pinid)
a -> GenSketch pinid a
Applicative (GenSketch pinid)
-> (forall a b.
GenSketch pinid a -> (a -> GenSketch pinid b) -> GenSketch pinid b)
-> (forall a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b)
-> (forall a. a -> GenSketch pinid a)
-> Monad (GenSketch pinid)
GenSketch pinid a -> (a -> GenSketch pinid b) -> GenSketch pinid b
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
forall pinid. Applicative (GenSketch pinid)
forall a. a -> GenSketch pinid a
forall pinid a. a -> GenSketch pinid a
forall a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
forall a b.
GenSketch pinid a -> (a -> GenSketch pinid b) -> GenSketch pinid b
forall pinid a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
forall pinid a b.
GenSketch pinid a -> (a -> GenSketch pinid b) -> GenSketch pinid b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> GenSketch pinid a
$creturn :: forall pinid a. a -> GenSketch pinid a
>> :: GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
$c>> :: forall pinid a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
>>= :: GenSketch pinid a -> (a -> GenSketch pinid b) -> GenSketch pinid b
$c>>= :: forall pinid a b.
GenSketch pinid a -> (a -> GenSketch pinid b) -> GenSketch pinid b
$cp1Monad :: forall pinid. Applicative (GenSketch pinid)
Monad
, Functor (GenSketch pinid)
a -> GenSketch pinid a
Functor (GenSketch pinid)
-> (forall a. a -> GenSketch pinid a)
-> (forall a b.
GenSketch pinid (a -> b) -> GenSketch pinid a -> GenSketch pinid b)
-> (forall a b c.
(a -> b -> c)
-> GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid c)
-> (forall a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b)
-> (forall a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid a)
-> Applicative (GenSketch pinid)
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid a
GenSketch pinid (a -> b) -> GenSketch pinid a -> GenSketch pinid b
(a -> b -> c)
-> GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid c
forall pinid. Functor (GenSketch pinid)
forall a. a -> GenSketch pinid a
forall pinid a. a -> GenSketch pinid a
forall a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid a
forall a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
forall a b.
GenSketch pinid (a -> b) -> GenSketch pinid a -> GenSketch pinid b
forall pinid a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid a
forall pinid a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
forall pinid a b.
GenSketch pinid (a -> b) -> GenSketch pinid a -> GenSketch pinid b
forall a b c.
(a -> b -> c)
-> GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid c
forall pinid a b c.
(a -> b -> c)
-> GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid a
$c<* :: forall pinid a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid a
*> :: GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
$c*> :: forall pinid a b.
GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid b
liftA2 :: (a -> b -> c)
-> GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid c
$cliftA2 :: forall pinid a b c.
(a -> b -> c)
-> GenSketch pinid a -> GenSketch pinid b -> GenSketch pinid c
<*> :: GenSketch pinid (a -> b) -> GenSketch pinid a -> GenSketch pinid b
$c<*> :: forall pinid a b.
GenSketch pinid (a -> b) -> GenSketch pinid a -> GenSketch pinid b
pure :: a -> GenSketch pinid a
$cpure :: forall pinid a. a -> GenSketch pinid a
$cp1Applicative :: forall pinid. Functor (GenSketch pinid)
Applicative
, a -> GenSketch pinid b -> GenSketch pinid a
(a -> b) -> GenSketch pinid a -> GenSketch pinid b
(forall a b. (a -> b) -> GenSketch pinid a -> GenSketch pinid b)
-> (forall a b. a -> GenSketch pinid b -> GenSketch pinid a)
-> Functor (GenSketch pinid)
forall a b. a -> GenSketch pinid b -> GenSketch pinid a
forall a b. (a -> b) -> GenSketch pinid a -> GenSketch pinid b
forall pinid a b. a -> GenSketch pinid b -> GenSketch pinid a
forall pinid a b.
(a -> b) -> GenSketch pinid a -> GenSketch pinid b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GenSketch pinid b -> GenSketch pinid a
$c<$ :: forall pinid a b. a -> GenSketch pinid b -> GenSketch pinid a
fmap :: (a -> b) -> GenSketch pinid a -> GenSketch pinid b
$cfmap :: forall pinid a b.
(a -> b) -> GenSketch pinid a -> GenSketch pinid b
Functor
, MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
, MonadState UniqueIds
)
instance Monoid (GenSketch pinid ()) where
mempty :: GenSketch pinid ()
mempty = WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
()
-> GenSketch pinid ()
forall pinid t.
WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
-> GenSketch pinid t
Sketch (()
-> WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
instance Semigroup (GenSketch pinid t) where
(Sketch WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
a) <> :: GenSketch pinid t -> GenSketch pinid t -> GenSketch pinid t
<> (Sketch WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
b) = WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
-> GenSketch pinid t
forall pinid t.
WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
-> GenSketch pinid t
Sketch (WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
a WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
-> WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
-> WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
b)
newtype UniqueIds = UniqueIds (M.Map String Integer)
newtype UniqueId = UniqueId Integer
data TriggerLimit
= TriggerLimit (Behavior Bool)
| NoTriggerLimit
getTriggerLimit :: TriggerLimit -> Behavior Bool
getTriggerLimit :: TriggerLimit -> Behavior Bool
getTriggerLimit (TriggerLimit Behavior Bool
b) = Behavior Bool
b
getTriggerLimit TriggerLimit
NoTriggerLimit = Behavior Bool
true
addTriggerLimit :: TriggerLimit -> Behavior Bool -> Behavior Bool
addTriggerLimit :: TriggerLimit -> Behavior Bool -> Behavior Bool
addTriggerLimit TriggerLimit
tl Behavior Bool
c = TriggerLimit -> Behavior Bool
getTriggerLimit (TriggerLimit
tl TriggerLimit -> TriggerLimit -> TriggerLimit
forall a. Semigroup a => a -> a -> a
<> Behavior Bool -> TriggerLimit
TriggerLimit Behavior Bool
c)
instance Monoid TriggerLimit where
mempty :: TriggerLimit
mempty = TriggerLimit
NoTriggerLimit
instance Semigroup TriggerLimit where
TriggerLimit Behavior Bool
a <> :: TriggerLimit -> TriggerLimit -> TriggerLimit
<> TriggerLimit Behavior Bool
b =
Behavior Bool -> TriggerLimit
TriggerLimit (Behavior Bool
a Behavior Bool -> Behavior Bool -> Behavior Bool
Language.Copilot.&& Behavior Bool
b)
TriggerLimit
a <> TriggerLimit
NoTriggerLimit = TriggerLimit
a
TriggerLimit
NoTriggerLimit <> TriggerLimit
b = TriggerLimit
b
evalSketch :: Ord pinid => GenSketch pinid a -> (Maybe Spec, GenFramework pinid)
evalSketch :: GenSketch pinid a -> (Maybe Spec, GenFramework pinid)
evalSketch (Sketch WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
a
s) = (Maybe Spec
spec, GenFramework pinid
f)
where
([TriggerLimit -> Spec]
is, [TriggerLimit -> GenFramework pinid]
fs) = [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> ([TriggerLimit -> Spec], [TriggerLimit -> GenFramework pinid])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> ([TriggerLimit -> Spec], [TriggerLimit -> GenFramework pinid]))
-> [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> ([TriggerLimit -> Spec], [TriggerLimit -> GenFramework pinid])
forall a b. (a -> b) -> a -> b
$
Identity
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
forall a. Identity a -> a
runIdentity (Identity
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)])
-> Identity
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
forall a b. (a -> b) -> a -> b
$ StateT
UniqueIds
Identity
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> UniqueIds
-> Identity
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
a
-> StateT
UniqueIds
Identity
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
a
s) (Map String Integer -> UniqueIds
UniqueIds Map String Integer
forall a. Monoid a => a
mempty)
f :: GenFramework pinid
f = [GenFramework pinid] -> GenFramework pinid
forall a. Monoid a => [a] -> a
mconcat (((TriggerLimit -> GenFramework pinid) -> GenFramework pinid)
-> [TriggerLimit -> GenFramework pinid] -> [GenFramework pinid]
forall a b. (a -> b) -> [a] -> [b]
map (\TriggerLimit -> GenFramework pinid
f' -> TriggerLimit -> GenFramework pinid
f' TriggerLimit
NoTriggerLimit) [TriggerLimit -> GenFramework pinid]
fs)
spec :: Maybe Spec
spec :: Maybe Spec
spec = if [TriggerLimit -> Spec] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TriggerLimit -> Spec]
is
then Maybe Spec
forall a. Maybe a
Nothing
else Spec -> Maybe Spec
forall a. a -> Maybe a
Just (Spec -> Maybe Spec) -> Spec -> Maybe Spec
forall a b. (a -> b) -> a -> b
$ [Spec] -> Spec
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Spec] -> Spec) -> [Spec] -> Spec
forall a b. (a -> b) -> a -> b
$ ((TriggerLimit -> Spec) -> Spec)
-> [TriggerLimit -> Spec] -> [Spec]
forall a b. (a -> b) -> [a] -> [b]
map (\TriggerLimit -> Spec
i -> TriggerLimit -> Spec
i TriggerLimit
NoTriggerLimit) [TriggerLimit -> Spec]
is
whenB :: Ord pinid => Behavior Bool -> GenSketch pinid t -> GenSketch pinid t
whenB :: Behavior Bool -> GenSketch pinid t -> GenSketch pinid t
whenB Behavior Bool
c (Sketch WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
s) = do
UniqueIds
ids <- GenSketch pinid UniqueIds
forall s (m :: * -> *). MonadState s m => m s
get
let ((t
r, [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
w), UniqueIds
ids') = Identity
((t, [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]),
UniqueIds)
-> ((t,
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]),
UniqueIds)
forall a. Identity a -> a
runIdentity (Identity
((t, [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]),
UniqueIds)
-> ((t,
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]),
UniqueIds))
-> Identity
((t, [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]),
UniqueIds)
-> ((t,
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]),
UniqueIds)
forall a b. (a -> b) -> a -> b
$ StateT
UniqueIds
Identity
(t, [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)])
-> UniqueIds
-> Identity
((t, [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]),
UniqueIds)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
-> StateT
UniqueIds
Identity
(t, [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
(State UniqueIds)
t
s) UniqueIds
ids
UniqueIds -> GenSketch pinid ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put UniqueIds
ids'
let ([TriggerLimit -> Spec]
is, [TriggerLimit -> GenFramework pinid]
fs) = [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> ([TriggerLimit -> Spec], [TriggerLimit -> GenFramework pinid])
forall a b. [(a, b)] -> ([a], [b])
unzip [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
w
let spec :: TriggerLimit -> Spec
spec = (TriggerLimit -> Spec) -> TriggerLimit -> Spec
forall a. (TriggerLimit -> a) -> TriggerLimit -> a
combinetl ((TriggerLimit -> Spec) -> TriggerLimit -> Spec)
-> (TriggerLimit -> Spec) -> TriggerLimit -> Spec
forall a b. (a -> b) -> a -> b
$ \TriggerLimit
c' -> [Spec] -> Spec
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (((TriggerLimit -> Spec) -> Spec)
-> [TriggerLimit -> Spec] -> [Spec]
forall a b. (a -> b) -> [a] -> [b]
map (\TriggerLimit -> Spec
i -> TriggerLimit -> Spec
i TriggerLimit
c') [TriggerLimit -> Spec]
is)
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> GenSketch pinid ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(TriggerLimit -> Spec
spec, TriggerLimit -> GenFramework pinid
forall a. Monoid a => a
mempty)]
[TriggerLimit -> GenFramework pinid]
-> ((TriggerLimit -> GenFramework pinid) -> GenSketch pinid ())
-> GenSketch pinid ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TriggerLimit -> GenFramework pinid]
fs (((TriggerLimit -> GenFramework pinid) -> GenSketch pinid ())
-> GenSketch pinid ())
-> ((TriggerLimit -> GenFramework pinid) -> GenSketch pinid ())
-> GenSketch pinid ()
forall a b. (a -> b) -> a -> b
$ \TriggerLimit -> GenFramework pinid
f -> [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> GenSketch pinid ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(Spec -> TriggerLimit -> Spec
forall a b. a -> b -> a
const (() -> Spec
forall (m :: * -> *) a. Monad m => a -> m a
return ()), (TriggerLimit -> GenFramework pinid)
-> TriggerLimit -> GenFramework pinid
forall a. (TriggerLimit -> a) -> TriggerLimit -> a
combinetl TriggerLimit -> GenFramework pinid
f)]
t -> GenSketch pinid t
forall (m :: * -> *) a. Monad m => a -> m a
return t
r
where
combinetl :: (TriggerLimit -> a) -> TriggerLimit -> a
combinetl :: (TriggerLimit -> a) -> TriggerLimit -> a
combinetl TriggerLimit -> a
g TriggerLimit
tl = TriggerLimit -> a
g (Behavior Bool -> TriggerLimit
TriggerLimit Behavior Bool
c TriggerLimit -> TriggerLimit -> TriggerLimit
forall a. Semigroup a => a -> a -> a
<> TriggerLimit
tl)
getUniqueId :: String -> GenSketch pinid UniqueId
getUniqueId :: String -> GenSketch pinid UniqueId
getUniqueId String
s = do
UniqueIds Map String Integer
m <- GenSketch pinid UniqueIds
forall s (m :: * -> *). MonadState s m => m s
get
let u :: Integer
u = Integer -> (Integer -> Integer) -> Maybe Integer -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
1 Integer -> Integer
forall a. Enum a => a -> a
succ (String -> Map String Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
s Map String Integer
m)
UniqueIds -> GenSketch pinid ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UniqueIds -> GenSketch pinid ())
-> UniqueIds -> GenSketch pinid ()
forall a b. (a -> b) -> a -> b
$ Map String Integer -> UniqueIds
UniqueIds (Map String Integer -> UniqueIds)
-> Map String Integer -> UniqueIds
forall a b. (a -> b) -> a -> b
$ String -> Integer -> Map String Integer -> Map String Integer
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
s Integer
u Map String Integer
m
UniqueId -> GenSketch pinid UniqueId
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> UniqueId
UniqueId Integer
u)
uniqueName :: String -> UniqueId -> String
uniqueName :: String -> UniqueId -> String
uniqueName String
s (UniqueId Integer
i)
| Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== Integer
1 = String
s
| Bool
otherwise = String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
i
uniqueName' :: String -> UniqueId -> String
uniqueName' :: String -> UniqueId -> String
uniqueName' String
s (UniqueId Integer
i) = String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
i
data GenFramework pinid = Framework
{ GenFramework pinid -> [CChunk]
defines :: [CChunk]
, GenFramework pinid -> [CChunk]
setups :: [CChunk]
, GenFramework pinid -> [CChunk]
earlySetups :: [CChunk]
, GenFramework pinid -> Map pinid (Set PinMode)
pinmodes :: M.Map pinid (S.Set PinMode)
, GenFramework pinid -> [CChunk]
loops :: [CChunk]
}
instance Ord pinid => Semigroup (GenFramework pinid) where
GenFramework pinid
a <> :: GenFramework pinid -> GenFramework pinid -> GenFramework pinid
<> GenFramework pinid
b = Framework :: forall pinid.
[CChunk]
-> [CChunk]
-> [CChunk]
-> Map pinid (Set PinMode)
-> [CChunk]
-> GenFramework pinid
Framework
{ defines :: [CChunk]
defines = GenFramework pinid -> [CChunk]
forall pinid. GenFramework pinid -> [CChunk]
defines GenFramework pinid
a [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> GenFramework pinid -> [CChunk]
forall pinid. GenFramework pinid -> [CChunk]
defines GenFramework pinid
b
, setups :: [CChunk]
setups = GenFramework pinid -> [CChunk]
forall pinid. GenFramework pinid -> [CChunk]
setups GenFramework pinid
a [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> GenFramework pinid -> [CChunk]
forall pinid. GenFramework pinid -> [CChunk]
setups GenFramework pinid
b
, earlySetups :: [CChunk]
earlySetups = GenFramework pinid -> [CChunk]
forall pinid. GenFramework pinid -> [CChunk]
earlySetups GenFramework pinid
a [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> GenFramework pinid -> [CChunk]
forall pinid. GenFramework pinid -> [CChunk]
earlySetups GenFramework pinid
b
, pinmodes :: Map pinid (Set PinMode)
pinmodes = (Set PinMode -> Set PinMode -> Set PinMode)
-> Map pinid (Set PinMode)
-> Map pinid (Set PinMode)
-> Map pinid (Set PinMode)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Set PinMode -> Set PinMode -> Set PinMode
forall a. Ord a => Set a -> Set a -> Set a
S.union (GenFramework pinid -> Map pinid (Set PinMode)
forall pinid. GenFramework pinid -> Map pinid (Set PinMode)
pinmodes GenFramework pinid
a) (GenFramework pinid -> Map pinid (Set PinMode)
forall pinid. GenFramework pinid -> Map pinid (Set PinMode)
pinmodes GenFramework pinid
b)
, loops :: [CChunk]
loops = GenFramework pinid -> [CChunk]
forall pinid. GenFramework pinid -> [CChunk]
loops GenFramework pinid
a [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> GenFramework pinid -> [CChunk]
forall pinid. GenFramework pinid -> [CChunk]
loops GenFramework pinid
b
}
instance Ord pinid => Monoid (GenFramework pinid) where
mempty :: GenFramework pinid
mempty = [CChunk]
-> [CChunk]
-> [CChunk]
-> Map pinid (Set PinMode)
-> [CChunk]
-> GenFramework pinid
forall pinid.
[CChunk]
-> [CChunk]
-> [CChunk]
-> Map pinid (Set PinMode)
-> [CChunk]
-> GenFramework pinid
Framework [CChunk]
forall a. Monoid a => a
mempty [CChunk]
forall a. Monoid a => a
mempty [CChunk]
forall a. Monoid a => a
mempty Map pinid (Set PinMode)
forall a. Monoid a => a
mempty [CChunk]
forall a. Monoid a => a
mempty
newtype CLine = CLine { CLine -> String
fromCLine :: String }
deriving (CLine -> CLine -> Bool
(CLine -> CLine -> Bool) -> (CLine -> CLine -> Bool) -> Eq CLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CLine -> CLine -> Bool
$c/= :: CLine -> CLine -> Bool
== :: CLine -> CLine -> Bool
$c== :: CLine -> CLine -> Bool
Eq, Int -> CLine -> String -> String
[CLine] -> String -> String
CLine -> String
(Int -> CLine -> String -> String)
-> (CLine -> String) -> ([CLine] -> String -> String) -> Show CLine
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CLine] -> String -> String
$cshowList :: [CLine] -> String -> String
show :: CLine -> String
$cshow :: CLine -> String
showsPrec :: Int -> CLine -> String -> String
$cshowsPrec :: Int -> CLine -> String -> String
Show, Eq CLine
Eq CLine
-> (CLine -> CLine -> Ordering)
-> (CLine -> CLine -> Bool)
-> (CLine -> CLine -> Bool)
-> (CLine -> CLine -> Bool)
-> (CLine -> CLine -> Bool)
-> (CLine -> CLine -> CLine)
-> (CLine -> CLine -> CLine)
-> Ord CLine
CLine -> CLine -> Bool
CLine -> CLine -> Ordering
CLine -> CLine -> CLine
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CLine -> CLine -> CLine
$cmin :: CLine -> CLine -> CLine
max :: CLine -> CLine -> CLine
$cmax :: CLine -> CLine -> CLine
>= :: CLine -> CLine -> Bool
$c>= :: CLine -> CLine -> Bool
> :: CLine -> CLine -> Bool
$c> :: CLine -> CLine -> Bool
<= :: CLine -> CLine -> Bool
$c<= :: CLine -> CLine -> Bool
< :: CLine -> CLine -> Bool
$c< :: CLine -> CLine -> Bool
compare :: CLine -> CLine -> Ordering
$ccompare :: CLine -> CLine -> Ordering
$cp1Ord :: Eq CLine
Ord)
newtype CChunk = CChunk [CLine]
deriving (CChunk -> CChunk -> Bool
(CChunk -> CChunk -> Bool)
-> (CChunk -> CChunk -> Bool) -> Eq CChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CChunk -> CChunk -> Bool
$c/= :: CChunk -> CChunk -> Bool
== :: CChunk -> CChunk -> Bool
$c== :: CChunk -> CChunk -> Bool
Eq, Int -> CChunk -> String -> String
[CChunk] -> String -> String
CChunk -> String
(Int -> CChunk -> String -> String)
-> (CChunk -> String)
-> ([CChunk] -> String -> String)
-> Show CChunk
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CChunk] -> String -> String
$cshowList :: [CChunk] -> String -> String
show :: CChunk -> String
$cshow :: CChunk -> String
showsPrec :: Int -> CChunk -> String -> String
$cshowsPrec :: Int -> CChunk -> String -> String
Show, Eq CChunk
Eq CChunk
-> (CChunk -> CChunk -> Ordering)
-> (CChunk -> CChunk -> Bool)
-> (CChunk -> CChunk -> Bool)
-> (CChunk -> CChunk -> Bool)
-> (CChunk -> CChunk -> Bool)
-> (CChunk -> CChunk -> CChunk)
-> (CChunk -> CChunk -> CChunk)
-> Ord CChunk
CChunk -> CChunk -> Bool
CChunk -> CChunk -> Ordering
CChunk -> CChunk -> CChunk
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CChunk -> CChunk -> CChunk
$cmin :: CChunk -> CChunk -> CChunk
max :: CChunk -> CChunk -> CChunk
$cmax :: CChunk -> CChunk -> CChunk
>= :: CChunk -> CChunk -> Bool
$c>= :: CChunk -> CChunk -> Bool
> :: CChunk -> CChunk -> Bool
$c> :: CChunk -> CChunk -> Bool
<= :: CChunk -> CChunk -> Bool
$c<= :: CChunk -> CChunk -> Bool
< :: CChunk -> CChunk -> Bool
$c< :: CChunk -> CChunk -> Bool
compare :: CChunk -> CChunk -> Ordering
$ccompare :: CChunk -> CChunk -> Ordering
$cp1Ord :: Eq CChunk
Ord, b -> CChunk -> CChunk
NonEmpty CChunk -> CChunk
CChunk -> CChunk -> CChunk
(CChunk -> CChunk -> CChunk)
-> (NonEmpty CChunk -> CChunk)
-> (forall b. Integral b => b -> CChunk -> CChunk)
-> Semigroup CChunk
forall b. Integral b => b -> CChunk -> CChunk
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> CChunk -> CChunk
$cstimes :: forall b. Integral b => b -> CChunk -> CChunk
sconcat :: NonEmpty CChunk -> CChunk
$csconcat :: NonEmpty CChunk -> CChunk
<> :: CChunk -> CChunk -> CChunk
$c<> :: CChunk -> CChunk -> CChunk
Semigroup, Semigroup CChunk
CChunk
Semigroup CChunk
-> CChunk
-> (CChunk -> CChunk -> CChunk)
-> ([CChunk] -> CChunk)
-> Monoid CChunk
[CChunk] -> CChunk
CChunk -> CChunk -> CChunk
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CChunk] -> CChunk
$cmconcat :: [CChunk] -> CChunk
mappend :: CChunk -> CChunk -> CChunk
$cmappend :: CChunk -> CChunk -> CChunk
mempty :: CChunk
$cmempty :: CChunk
$cp1Monoid :: Semigroup CChunk
Monoid)
mkCChunk :: [CLine] -> [CChunk]
mkCChunk :: [CLine] -> [CChunk]
mkCChunk [CLine]
l = [[CLine] -> CChunk
CChunk [CLine]
l]
defineTriggerAlias
:: String
-> GenFramework pinid
-> GenSketch pinid (GenFramework pinid, String)
defineTriggerAlias :: String
-> GenFramework pinid
-> GenSketch pinid (GenFramework pinid, String)
defineTriggerAlias = String
-> String
-> GenFramework pinid
-> GenSketch pinid (GenFramework pinid, String)
forall pinid.
String
-> String
-> GenFramework pinid
-> GenSketch pinid (GenFramework pinid, String)
defineTriggerAlias' String
""
defineTriggerAlias'
:: String
-> String
-> GenFramework pinid
-> GenSketch pinid (GenFramework pinid, String)
defineTriggerAlias' :: String
-> String
-> GenFramework pinid
-> GenSketch pinid (GenFramework pinid, String)
defineTriggerAlias' String
suffix String
cfuncname GenFramework pinid
f = do
let basetname :: String
basetname = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
suffix
then String
cfuncname
else String
cfuncname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix
UniqueId
u <- String -> GenSketch pinid UniqueId
forall pinid. String -> GenSketch pinid UniqueId
getUniqueId String
basetname
let triggername :: String
triggername = String -> UniqueId -> String
uniqueName String
basetname UniqueId
u
let define :: [CChunk]
define = if String
cfuncname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
Prelude./= String
triggername
then [CLine] -> [CChunk]
mkCChunk [ String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
"#define " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
triggername String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cfuncname ]
else [CChunk]
forall a. Monoid a => a
mempty
(GenFramework pinid, String)
-> GenSketch pinid (GenFramework pinid, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenFramework pinid
f { defines :: [CChunk]
defines = [CChunk]
define [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> GenFramework pinid -> [CChunk]
forall pinid. GenFramework pinid -> [CChunk]
defines GenFramework pinid
f }, String
triggername)
data MkInputSource pinid t = InputSource
{ MkInputSource pinid t -> [CChunk]
defineVar :: [CChunk]
, MkInputSource pinid t -> [CChunk]
setupInput :: [CChunk]
, MkInputSource pinid t -> Map pinid PinMode
inputPinmode :: M.Map pinid PinMode
, MkInputSource pinid t -> [CChunk]
readInput :: [CChunk]
, MkInputSource pinid t -> Stream t
inputStream :: Stream t
}
mkInput :: MkInputSource pinid t -> GenSketch pinid (Behavior t)
mkInput :: MkInputSource pinid t -> GenSketch pinid (Behavior t)
mkInput MkInputSource pinid t
i = do
UniqueId
u <- String -> GenSketch pinid UniqueId
forall pinid. String -> GenSketch pinid UniqueId
getUniqueId String
"input"
[(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]
-> GenSketch pinid ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(UniqueId -> TriggerLimit -> Spec
mkspec UniqueId
u, UniqueId -> TriggerLimit -> GenFramework pinid
f UniqueId
u)]
Behavior t -> GenSketch pinid (Behavior t)
forall (m :: * -> *) a. Monad m => a -> m a
return (MkInputSource pinid t -> Behavior t
forall pinid t. MkInputSource pinid t -> Stream t
inputStream MkInputSource pinid t
i)
where
f :: UniqueId -> TriggerLimit -> GenFramework pinid
f UniqueId
u TriggerLimit
ratelimited = Framework :: forall pinid.
[CChunk]
-> [CChunk]
-> [CChunk]
-> Map pinid (Set PinMode)
-> [CChunk]
-> GenFramework pinid
Framework
{ defines :: [CChunk]
defines = MkInputSource pinid t -> [CChunk]
forall pinid t. MkInputSource pinid t -> [CChunk]
defineVar MkInputSource pinid t
i [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> UniqueId -> TriggerLimit -> [CChunk]
mkdefine UniqueId
u TriggerLimit
ratelimited
, setups :: [CChunk]
setups = MkInputSource pinid t -> [CChunk]
forall pinid t. MkInputSource pinid t -> [CChunk]
setupInput MkInputSource pinid t
i
, earlySetups :: [CChunk]
earlySetups = [CChunk]
forall a. Monoid a => a
mempty
, pinmodes :: Map pinid (Set PinMode)
pinmodes = (PinMode -> Set PinMode)
-> Map pinid PinMode -> Map pinid (Set PinMode)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map PinMode -> Set PinMode
forall a. a -> Set a
S.singleton (MkInputSource pinid t -> Map pinid PinMode
forall pinid t. MkInputSource pinid t -> Map pinid PinMode
inputPinmode MkInputSource pinid t
i)
, loops :: [CChunk]
loops = UniqueId -> TriggerLimit -> [CChunk] -> [CChunk]
mkloops UniqueId
u TriggerLimit
ratelimited (MkInputSource pinid t -> [CChunk]
forall pinid t. MkInputSource pinid t -> [CChunk]
readInput MkInputSource pinid t
i)
}
varname :: UniqueId -> String
varname = String -> UniqueId -> String
uniqueName String
"update_input"
triggername :: UniqueId -> String
triggername = String -> UniqueId -> String
uniqueName String
"input"
mkdefine :: UniqueId -> TriggerLimit -> [CChunk]
mkdefine UniqueId
_ TriggerLimit
NoTriggerLimit = []
mkdefine UniqueId
u (TriggerLimit Behavior Bool
_) = [CLine] -> [CChunk]
mkCChunk ([CLine] -> [CChunk]) -> [CLine] -> [CChunk]
forall a b. (a -> b) -> a -> b
$ (String -> CLine) -> [String] -> [CLine]
forall a b. (a -> b) -> [a] -> [b]
map String -> CLine
CLine
[ String
"bool " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UniqueId -> String
varname UniqueId
u String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" = true;"
, String
"void " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UniqueId -> String
triggername UniqueId
u String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" (bool v) {"
, String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UniqueId -> String
varname UniqueId
u String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" = v;"
, String
"}"
]
mkloops :: UniqueId -> TriggerLimit -> [CChunk] -> [CChunk]
mkloops UniqueId
_ TriggerLimit
NoTriggerLimit [CChunk]
reader = [CChunk]
reader
mkloops UniqueId
u (TriggerLimit Behavior Bool
_) [CChunk]
reader = [CLine] -> [CChunk]
mkCChunk ([CLine] -> [CChunk]) -> [CLine] -> [CChunk]
forall a b. (a -> b) -> a -> b
$ [[CLine]] -> [CLine]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
"if (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UniqueId -> String
varname UniqueId
u String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
") {" ]
, (CLine -> CLine) -> [CLine] -> [CLine]
forall a b. (a -> b) -> [a] -> [b]
map (\(CLine String
l) -> String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
l ) [CLine]
readerlines
, [ String -> CLine
CLine String
"}" ]
]
where
readerlines :: [CLine]
readerlines = (CChunk -> [CLine]) -> [CChunk] -> [CLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(CChunk [CLine]
l) -> [CLine]
l) [CChunk]
reader
mkspec :: UniqueId -> TriggerLimit -> Spec
mkspec UniqueId
_ TriggerLimit
NoTriggerLimit = () -> Spec
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mkspec UniqueId
u (TriggerLimit Behavior Bool
c) = String -> Behavior Bool -> [Arg] -> Spec
trigger (UniqueId -> String
triggername UniqueId
u) Behavior Bool
true [Behavior Bool -> Arg
forall a. Typed a => Stream a -> Arg
arg Behavior Bool
c]
data PinCapabilities
= DigitalIO
| AnalogInput
| PWM
deriving (Int -> PinCapabilities -> String -> String
[PinCapabilities] -> String -> String
PinCapabilities -> String
(Int -> PinCapabilities -> String -> String)
-> (PinCapabilities -> String)
-> ([PinCapabilities] -> String -> String)
-> Show PinCapabilities
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PinCapabilities] -> String -> String
$cshowList :: [PinCapabilities] -> String -> String
show :: PinCapabilities -> String
$cshow :: PinCapabilities -> String
showsPrec :: Int -> PinCapabilities -> String -> String
$cshowsPrec :: Int -> PinCapabilities -> String -> String
Show, PinCapabilities -> PinCapabilities -> Bool
(PinCapabilities -> PinCapabilities -> Bool)
-> (PinCapabilities -> PinCapabilities -> Bool)
-> Eq PinCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PinCapabilities -> PinCapabilities -> Bool
$c/= :: PinCapabilities -> PinCapabilities -> Bool
== :: PinCapabilities -> PinCapabilities -> Bool
$c== :: PinCapabilities -> PinCapabilities -> Bool
Eq, Eq PinCapabilities
Eq PinCapabilities
-> (PinCapabilities -> PinCapabilities -> Ordering)
-> (PinCapabilities -> PinCapabilities -> Bool)
-> (PinCapabilities -> PinCapabilities -> Bool)
-> (PinCapabilities -> PinCapabilities -> Bool)
-> (PinCapabilities -> PinCapabilities -> Bool)
-> (PinCapabilities -> PinCapabilities -> PinCapabilities)
-> (PinCapabilities -> PinCapabilities -> PinCapabilities)
-> Ord PinCapabilities
PinCapabilities -> PinCapabilities -> Bool
PinCapabilities -> PinCapabilities -> Ordering
PinCapabilities -> PinCapabilities -> PinCapabilities
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PinCapabilities -> PinCapabilities -> PinCapabilities
$cmin :: PinCapabilities -> PinCapabilities -> PinCapabilities
max :: PinCapabilities -> PinCapabilities -> PinCapabilities
$cmax :: PinCapabilities -> PinCapabilities -> PinCapabilities
>= :: PinCapabilities -> PinCapabilities -> Bool
$c>= :: PinCapabilities -> PinCapabilities -> Bool
> :: PinCapabilities -> PinCapabilities -> Bool
$c> :: PinCapabilities -> PinCapabilities -> Bool
<= :: PinCapabilities -> PinCapabilities -> Bool
$c<= :: PinCapabilities -> PinCapabilities -> Bool
< :: PinCapabilities -> PinCapabilities -> Bool
$c< :: PinCapabilities -> PinCapabilities -> Bool
compare :: PinCapabilities -> PinCapabilities -> Ordering
$ccompare :: PinCapabilities -> PinCapabilities -> Ordering
$cp1Ord :: Eq PinCapabilities
Ord)
type family IsDigitalIOPin t where
IsDigitalIOPin t =
'True ~ If (HasPinCapability 'DigitalIO t)
('True)
(TypeError ('Text "This Pin does not support digital IO"))
type family IsAnalogInputPin t where
IsAnalogInputPin t =
'True ~ If (HasPinCapability 'AnalogInput t)
('True)
(TypeError ('Text "This Pin does not support analog input"))
type family IsPWMPin t where
IsPWMPin t =
'True ~ If (HasPinCapability 'PWM t)
('True)
(TypeError ('Text "This Pin does not support PWM"))
type family HasPinCapability (c :: t) (list :: [t]) :: Bool where
HasPinCapability c '[] = 'False
HasPinCapability c (x ': xs) = SameCapability c x || HasPinCapability c xs
type family SameCapability a b :: Bool where
SameCapability 'DigitalIO 'DigitalIO = 'True
SameCapability 'AnalogInput 'AnalogInput = 'True
SameCapability 'PWM 'PWM = 'True
SameCapability _ _ = 'False
data PinMode = InputMode | InputPullupMode | OutputMode
deriving (Int -> PinMode -> String -> String
[PinMode] -> String -> String
PinMode -> String
(Int -> PinMode -> String -> String)
-> (PinMode -> String)
-> ([PinMode] -> String -> String)
-> Show PinMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PinMode] -> String -> String
$cshowList :: [PinMode] -> String -> String
show :: PinMode -> String
$cshow :: PinMode -> String
showsPrec :: Int -> PinMode -> String -> String
$cshowsPrec :: Int -> PinMode -> String -> String
Show, PinMode -> PinMode -> Bool
(PinMode -> PinMode -> Bool)
-> (PinMode -> PinMode -> Bool) -> Eq PinMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PinMode -> PinMode -> Bool
$c/= :: PinMode -> PinMode -> Bool
== :: PinMode -> PinMode -> Bool
$c== :: PinMode -> PinMode -> Bool
Eq, Eq PinMode
Eq PinMode
-> (PinMode -> PinMode -> Ordering)
-> (PinMode -> PinMode -> Bool)
-> (PinMode -> PinMode -> Bool)
-> (PinMode -> PinMode -> Bool)
-> (PinMode -> PinMode -> Bool)
-> (PinMode -> PinMode -> PinMode)
-> (PinMode -> PinMode -> PinMode)
-> Ord PinMode
PinMode -> PinMode -> Bool
PinMode -> PinMode -> Ordering
PinMode -> PinMode -> PinMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PinMode -> PinMode -> PinMode
$cmin :: PinMode -> PinMode -> PinMode
max :: PinMode -> PinMode -> PinMode
$cmax :: PinMode -> PinMode -> PinMode
>= :: PinMode -> PinMode -> Bool
$c>= :: PinMode -> PinMode -> Bool
> :: PinMode -> PinMode -> Bool
$c> :: PinMode -> PinMode -> Bool
<= :: PinMode -> PinMode -> Bool
$c<= :: PinMode -> PinMode -> Bool
< :: PinMode -> PinMode -> Bool
$c< :: PinMode -> PinMode -> Bool
compare :: PinMode -> PinMode -> Ordering
$ccompare :: PinMode -> PinMode -> Ordering
$cp1Ord :: Eq PinMode
Ord)
class Output o t where
(=:) :: o -> t -> GenSketch pinid ()
infixr 1 =:
instance Output o (Event () (Stream v)) => Output o (Behavior v) where
=: :: o -> Behavior v -> GenSketch pinid ()
(=:) o
o Behavior v
b = o
o o -> Event () (Behavior v) -> GenSketch pinid ()
forall o t pinid. Output o t => o -> t -> GenSketch pinid ()
=: Event () (Behavior v)
te
where
te :: Event () (Stream v)
te :: Event () (Behavior v)
te = Behavior v -> Behavior Bool -> Event () (Behavior v)
forall k (p :: k) v. v -> Behavior Bool -> Event p v
Event Behavior v
b Behavior Bool
true
instance Output o (Event p (Stream v)) => Output o (TypedBehavior p v) where
=: :: o -> TypedBehavior p v -> GenSketch pinid ()
(=:) o
o (TypedBehavior Stream v
b) = o
o o -> Event p (Stream v) -> GenSketch pinid ()
forall o t pinid. Output o t => o -> t -> GenSketch pinid ()
=: Event p (Stream v)
te
where
te :: Event p (Stream v)
te :: Event p (Stream v)
te = Stream v -> Behavior Bool -> Event p (Stream v)
forall k (p :: k) v. v -> Behavior Bool -> Event p v
Event Stream v
b Behavior Bool
true
type family BehaviorToEvent a
type instance BehaviorToEvent (Behavior v) = Event () (Stream v)
type instance BehaviorToEvent (TypedBehavior p v) = Event p (Stream v)
class IsBehavior behavior where
(@:) :: behavior -> Behavior Bool -> BehaviorToEvent behavior
instance IsBehavior (Behavior v) where
Behavior v
b @: :: Behavior v -> Behavior Bool -> BehaviorToEvent (Behavior v)
@: Behavior Bool
c = Behavior v -> Behavior Bool -> Event () (Behavior v)
forall k (p :: k) v. v -> Behavior Bool -> Event p v
Event Behavior v
b Behavior Bool
c
instance IsBehavior (TypedBehavior p v) where
@: :: TypedBehavior p v
-> Behavior Bool -> BehaviorToEvent (TypedBehavior p v)
(@:) (TypedBehavior Behavior v
b) Behavior Bool
c = Behavior v -> Behavior Bool -> Event p (Behavior v)
forall k (p :: k) v. v -> Behavior Bool -> Event p v
Event Behavior v
b Behavior Bool
c
class Input o t where
input' :: o -> [t] -> GenSketch pinid (Behavior t)
input :: Input o t => o -> GenSketch pinid (Behavior t)
input :: o -> GenSketch pinid (Behavior t)
input o
o = o -> [t] -> GenSketch pinid (Behavior t)
forall o t pinid.
Input o t =>
o -> [t] -> GenSketch pinid (Behavior t)
input' o
o []