{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}

module Sketch.FRP.Copilot.Types where

import Language.Copilot hiding ((=:))
import Control.Monad.Writer
import Control.Monad.State.Strict
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Type.Bool
import GHC.TypeLits

-- | A value that changes over time.
--
-- This is implemented as a `Stream` in the Copilot DSL.
-- Copilot provides many operations on streams, for example
-- `Language.Copilot.&&` to combine two streams of Bools.
-- 
-- For documentation on using the Copilot DSL, see
-- <https://copilot-language.github.io/>
type Behavior t = Stream t

-- | A Behavior with an additional phantom type `p`.
--
-- The Compilot DSL only lets a Stream contain basic C types,
-- a limitation that `Behavior` also has. When more type safely
-- is needed, this can be used.
data TypedBehavior p t = TypedBehavior (Behavior t)

-- | A discrete event, that occurs at particular points in time.
data Event p v = Event v (Stream Bool)

-- | A sketch, implemented using Copilot.
--
-- It's best to think of the `Sketch` as a description of the state of the
-- board at any point in time.
--
-- Under the hood, the `Sketch` is run in a loop. On each iteration, it first
-- reads inputs and then updates outputs as needed.
--
-- While it is a monad, a Sketch's outputs are not updated in any
-- particular order, because Copilot does not guarantee any order.
--
-- This is a generalized Sketch that can operate on any type of context.
newtype GenSketch ctx t = GenSketch (WriterT [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)] (State UniqueIds) t)
	deriving 
		( Applicative (GenSketch ctx)
Applicative (GenSketch ctx) =>
(forall a b.
 GenSketch ctx a -> (a -> GenSketch ctx b) -> GenSketch ctx b)
-> (forall a b.
    GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b)
-> (forall a. a -> GenSketch ctx a)
-> Monad (GenSketch ctx)
forall ctx. Applicative (GenSketch ctx)
forall a. a -> GenSketch ctx a
forall ctx a. a -> GenSketch ctx a
forall a b. GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b
forall a b.
GenSketch ctx a -> (a -> GenSketch ctx b) -> GenSketch ctx b
forall ctx a b.
GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b
forall ctx a b.
GenSketch ctx a -> (a -> GenSketch ctx b) -> GenSketch ctx 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
$c>>= :: forall ctx a b.
GenSketch ctx a -> (a -> GenSketch ctx b) -> GenSketch ctx b
>>= :: forall a b.
GenSketch ctx a -> (a -> GenSketch ctx b) -> GenSketch ctx b
$c>> :: forall ctx a b.
GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b
>> :: forall a b. GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b
$creturn :: forall ctx a. a -> GenSketch ctx a
return :: forall a. a -> GenSketch ctx a
Monad
		, Functor (GenSketch ctx)
Functor (GenSketch ctx) =>
(forall a. a -> GenSketch ctx a)
-> (forall a b.
    GenSketch ctx (a -> b) -> GenSketch ctx a -> GenSketch ctx b)
-> (forall a b c.
    (a -> b -> c)
    -> GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx c)
-> (forall a b.
    GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b)
-> (forall a b.
    GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx a)
-> Applicative (GenSketch ctx)
forall ctx. Functor (GenSketch ctx)
forall a. a -> GenSketch ctx a
forall ctx a. a -> GenSketch ctx a
forall a b. GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx a
forall a b. GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b
forall a b.
GenSketch ctx (a -> b) -> GenSketch ctx a -> GenSketch ctx b
forall ctx a b.
GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx a
forall ctx a b.
GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b
forall ctx a b.
GenSketch ctx (a -> b) -> GenSketch ctx a -> GenSketch ctx b
forall a b c.
(a -> b -> c)
-> GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx c
forall ctx a b c.
(a -> b -> c)
-> GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx 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
$cpure :: forall ctx a. a -> GenSketch ctx a
pure :: forall a. a -> GenSketch ctx a
$c<*> :: forall ctx a b.
GenSketch ctx (a -> b) -> GenSketch ctx a -> GenSketch ctx b
<*> :: forall a b.
GenSketch ctx (a -> b) -> GenSketch ctx a -> GenSketch ctx b
$cliftA2 :: forall ctx a b c.
(a -> b -> c)
-> GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx c
liftA2 :: forall a b c.
(a -> b -> c)
-> GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx c
$c*> :: forall ctx a b.
GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b
*> :: forall a b. GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx b
$c<* :: forall ctx a b.
GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx a
<* :: forall a b. GenSketch ctx a -> GenSketch ctx b -> GenSketch ctx a
Applicative
		, (forall a b. (a -> b) -> GenSketch ctx a -> GenSketch ctx b)
-> (forall a b. a -> GenSketch ctx b -> GenSketch ctx a)
-> Functor (GenSketch ctx)
forall a b. a -> GenSketch ctx b -> GenSketch ctx a
forall a b. (a -> b) -> GenSketch ctx a -> GenSketch ctx b
forall ctx a b. a -> GenSketch ctx b -> GenSketch ctx a
forall ctx a b. (a -> b) -> GenSketch ctx a -> GenSketch ctx b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ctx a b. (a -> b) -> GenSketch ctx a -> GenSketch ctx b
fmap :: forall a b. (a -> b) -> GenSketch ctx a -> GenSketch ctx b
$c<$ :: forall ctx a b. a -> GenSketch ctx b -> GenSketch ctx a
<$ :: forall a b. a -> GenSketch ctx b -> GenSketch ctx a
Functor
		, MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
		, MonadState UniqueIds
		)

instance Monoid (GenSketch ctx ()) where
	mempty :: GenSketch ctx ()
mempty = WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  ()
-> GenSketch ctx ()
forall ctx t.
WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  t
-> GenSketch ctx t
GenSketch (()
-> WriterT
     [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
     (State UniqueIds)
     ()
forall a.
a
-> WriterT
     [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
     (State UniqueIds)
     a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

instance Semigroup (GenSketch ctx t) where
	(GenSketch WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  t
a) <> :: GenSketch ctx t -> GenSketch ctx t -> GenSketch ctx t
<> (GenSketch WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  t
b) = WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  t
-> GenSketch ctx t
forall ctx t.
WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  t
-> GenSketch ctx t
GenSketch (WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  t
a WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  t
-> WriterT
     [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
     (State UniqueIds)
     t
-> WriterT
     [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
     (State UniqueIds)
     t
forall a b.
WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  a
-> WriterT
     [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
     (State UniqueIds)
     b
-> WriterT
     [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
     (State UniqueIds)
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterT
  [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)]
  (State UniqueIds)
  t
b)

class Ord ctx => Context ctx

-- | Things that can have a `Behavior` or `Event` output to them.
class Output ctx o t where
	(=:) :: o -> t -> GenSketch ctx ()
	-- ^ Connect a `Behavior` or `Event` to an `Output`
	-- 
	-- > led =: blinking
	-- 
	-- When a `Behavior` is used, its current value is written on each
	-- iteration of the `Sketch`. 
	-- 
	-- For example, this constantly turns on the LED, even though it will
	-- already be on after the first iteration, because `true`
	-- is a `Behavior` (that is always True).
	-- 
	-- > led =: true
	-- 
	-- To avoid unncessary work being done, you can use an `Event`
	-- instead. Then the write only happens at the points in time
	-- when the `Event` occurs. To turn a `Behavior` into an `Event`,
	-- use `@:`
	-- 
	-- So to make the LED only be turned on in the first iteration,
	-- and allow it to remain on thereafter without doing extra work:
	-- 
	-- > led =: true @: firstIteration

-- Same fixity as =<<
infixr 1 =:

instance Output ctx o (Event () (Stream v)) => Output ctx o (Behavior v) where
	=: :: o -> Behavior v -> GenSketch ctx ()
(=:) o
o Behavior v
b = o
o o -> Event () (Behavior v) -> GenSketch ctx ()
forall ctx o t. Output ctx o t => o -> t -> GenSketch ctx ()
=: Event () (Behavior v)
te
	  where
	  	te :: Event () (Stream v)
		te :: Event () (Behavior v)
te = Behavior v -> Stream Bool -> Event () (Behavior v)
forall {k} (p :: k) v. v -> Stream Bool -> Event p v
Event Behavior v
b Stream Bool
true

instance Output ctx o (Event p (Stream v)) => Output ctx o (TypedBehavior p v) where
	=: :: o -> TypedBehavior p v -> GenSketch ctx ()
(=:) o
o (TypedBehavior Stream v
b) = o
o o -> Event p (Stream v) -> GenSketch ctx ()
forall ctx o t. Output ctx o t => o -> t -> GenSketch ctx ()
=: Event p (Stream v)
te
	  where
		te :: Event p (Stream v)
		te :: Event p (Stream v)
te = Stream v -> Stream Bool -> Event p (Stream v)
forall {k} (p :: k) v. v -> Stream Bool -> Event p v
Event Stream v
b Stream Bool
true

class Input ctx o t where
	-- | The list is input to use when simulating the Sketch.
	input' :: o -> [t] -> GenSketch ctx (Behavior t)

-- | The framework of a sketch.
--
-- This is a generalized Framework that can operate on any type of
-- context.
data GenFramework ctx = Framework
	{ forall ctx. GenFramework ctx -> [CChunk]
defines :: [CChunk]
	-- ^ Things that come before the C code generated by Copilot.
	, forall ctx. GenFramework ctx -> [CChunk]
setups :: [CChunk]
	-- ^ Things to do at setup, not including configuring pins.
	, forall ctx. GenFramework ctx -> [CChunk]
earlySetups :: [CChunk]
	-- ^ Things to do at setup, before the setups.
	, forall ctx. GenFramework ctx -> Map ctx (Set PinMode)
pinmodes :: M.Map ctx (S.Set PinMode)
	-- ^ How pins are used.
	, forall ctx. GenFramework ctx -> [CChunk]
loops :: [CChunk]
	-- ^ Things to run in `loop`.
	}

instance Context ctx => Semigroup (GenFramework ctx) where
	GenFramework ctx
a <> :: GenFramework ctx -> GenFramework ctx -> GenFramework ctx
<> GenFramework ctx
b = Framework
		{ defines :: [CChunk]
defines = GenFramework ctx -> [CChunk]
forall ctx. GenFramework ctx -> [CChunk]
defines GenFramework ctx
a [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> GenFramework ctx -> [CChunk]
forall ctx. GenFramework ctx -> [CChunk]
defines GenFramework ctx
b
		, setups :: [CChunk]
setups = GenFramework ctx -> [CChunk]
forall ctx. GenFramework ctx -> [CChunk]
setups GenFramework ctx
a [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> GenFramework ctx -> [CChunk]
forall ctx. GenFramework ctx -> [CChunk]
setups GenFramework ctx
b
		, earlySetups :: [CChunk]
earlySetups = GenFramework ctx -> [CChunk]
forall ctx. GenFramework ctx -> [CChunk]
earlySetups GenFramework ctx
a [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> GenFramework ctx -> [CChunk]
forall ctx. GenFramework ctx -> [CChunk]
earlySetups GenFramework ctx
b
		, pinmodes :: Map ctx (Set PinMode)
pinmodes = (Set PinMode -> Set PinMode -> Set PinMode)
-> Map ctx (Set PinMode)
-> Map ctx (Set PinMode)
-> Map ctx (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 ctx -> Map ctx (Set PinMode)
forall ctx. GenFramework ctx -> Map ctx (Set PinMode)
pinmodes GenFramework ctx
a) (GenFramework ctx -> Map ctx (Set PinMode)
forall ctx. GenFramework ctx -> Map ctx (Set PinMode)
pinmodes GenFramework ctx
b)
		, loops :: [CChunk]
loops = GenFramework ctx -> [CChunk]
forall ctx. GenFramework ctx -> [CChunk]
loops GenFramework ctx
a  [CChunk] -> [CChunk] -> [CChunk]
forall a. Semigroup a => a -> a -> a
<> GenFramework ctx -> [CChunk]
forall ctx. GenFramework ctx -> [CChunk]
loops GenFramework ctx
b
		}

instance Context ctx => Monoid (GenFramework ctx) where
	mempty :: GenFramework ctx
mempty = [CChunk]
-> [CChunk]
-> [CChunk]
-> Map ctx (Set PinMode)
-> [CChunk]
-> GenFramework ctx
forall ctx.
[CChunk]
-> [CChunk]
-> [CChunk]
-> Map ctx (Set PinMode)
-> [CChunk]
-> GenFramework ctx
Framework [CChunk]
forall a. Monoid a => a
mempty [CChunk]
forall a. Monoid a => a
mempty [CChunk]
forall a. Monoid a => a
mempty Map ctx (Set PinMode)
forall a. Monoid a => a
mempty [CChunk]
forall a. Monoid a => a
mempty

newtype UniqueIds = UniqueIds (M.Map String Integer)

newtype UniqueId = UniqueId Integer

data TriggerLimit
	= TriggerLimit (Behavior Bool)
	| NoTriggerLimit

instance Monoid TriggerLimit where
	mempty :: TriggerLimit
mempty = TriggerLimit
NoTriggerLimit

instance Semigroup TriggerLimit where
	TriggerLimit Stream Bool
a <> :: TriggerLimit -> TriggerLimit -> TriggerLimit
<> TriggerLimit Stream Bool
b =
		Stream Bool -> TriggerLimit
TriggerLimit (Stream Bool
a Stream Bool -> Stream Bool -> Stream Bool
Language.Copilot.&& Stream Bool
b)
	TriggerLimit
a <> TriggerLimit
NoTriggerLimit = TriggerLimit
a
	TriggerLimit
NoTriggerLimit <> TriggerLimit
b = TriggerLimit
b

data PinMode = InputMode | InputPullupMode | OutputMode
	deriving (Int -> PinMode -> ShowS
[PinMode] -> ShowS
PinMode -> String
(Int -> PinMode -> ShowS)
-> (PinMode -> String) -> ([PinMode] -> ShowS) -> Show PinMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PinMode -> ShowS
showsPrec :: Int -> PinMode -> ShowS
$cshow :: PinMode -> String
show :: PinMode -> String
$cshowList :: [PinMode] -> ShowS
showList :: [PinMode] -> ShowS
Show, PinMode -> PinMode -> Bool
(PinMode -> PinMode -> Bool)
-> (PinMode -> PinMode -> Bool) -> Eq PinMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PinMode -> PinMode -> Bool
== :: PinMode -> PinMode -> Bool
$c/= :: PinMode -> PinMode -> Bool
/= :: 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
$ccompare :: PinMode -> PinMode -> Ordering
compare :: PinMode -> PinMode -> Ordering
$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
>= :: PinMode -> PinMode -> Bool
$cmax :: PinMode -> PinMode -> PinMode
max :: PinMode -> PinMode -> PinMode
$cmin :: PinMode -> PinMode -> PinMode
min :: PinMode -> PinMode -> PinMode
Ord)

-- | A line of C code.
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
$c== :: CLine -> CLine -> Bool
== :: CLine -> CLine -> Bool
$c/= :: CLine -> CLine -> Bool
/= :: CLine -> CLine -> Bool
Eq, Int -> CLine -> ShowS
[CLine] -> ShowS
CLine -> String
(Int -> CLine -> ShowS)
-> (CLine -> String) -> ([CLine] -> ShowS) -> Show CLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CLine -> ShowS
showsPrec :: Int -> CLine -> ShowS
$cshow :: CLine -> String
show :: CLine -> String
$cshowList :: [CLine] -> ShowS
showList :: [CLine] -> ShowS
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
$ccompare :: CLine -> CLine -> Ordering
compare :: CLine -> CLine -> Ordering
$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
>= :: CLine -> CLine -> Bool
$cmax :: CLine -> CLine -> CLine
max :: CLine -> CLine -> CLine
$cmin :: CLine -> CLine -> CLine
min :: CLine -> CLine -> CLine
Ord)

-- | A chunk of C code. Identical chunks get deduplicated.
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
$c== :: CChunk -> CChunk -> Bool
== :: CChunk -> CChunk -> Bool
$c/= :: CChunk -> CChunk -> Bool
/= :: CChunk -> CChunk -> Bool
Eq, Int -> CChunk -> ShowS
[CChunk] -> ShowS
CChunk -> String
(Int -> CChunk -> ShowS)
-> (CChunk -> String) -> ([CChunk] -> ShowS) -> Show CChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CChunk -> ShowS
showsPrec :: Int -> CChunk -> ShowS
$cshow :: CChunk -> String
show :: CChunk -> String
$cshowList :: [CChunk] -> ShowS
showList :: [CChunk] -> ShowS
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
$ccompare :: CChunk -> CChunk -> Ordering
compare :: CChunk -> CChunk -> Ordering
$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
>= :: CChunk -> CChunk -> Bool
$cmax :: CChunk -> CChunk -> CChunk
max :: CChunk -> CChunk -> CChunk
$cmin :: CChunk -> CChunk -> CChunk
min :: CChunk -> CChunk -> CChunk
Ord, 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
$c<> :: CChunk -> CChunk -> CChunk
<> :: CChunk -> CChunk -> CChunk
$csconcat :: NonEmpty CChunk -> CChunk
sconcat :: NonEmpty CChunk -> CChunk
$cstimes :: forall b. Integral b => b -> CChunk -> CChunk
stimes :: forall b. Integral b => b -> 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
$cmempty :: CChunk
mempty :: CChunk
$cmappend :: CChunk -> CChunk -> CChunk
mappend :: CChunk -> CChunk -> CChunk
$cmconcat :: [CChunk] -> CChunk
mconcat :: [CChunk] -> CChunk
Monoid)

-- | This type family is open, so it can be extended when adding other data
-- types to the IsBehavior class.
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
	-- | Generate an Event, from some type of behavior,
	-- that only occurs when the `Behavior` Bool is True.
	(@:) :: behavior -> Behavior Bool -> BehaviorToEvent behavior

instance IsBehavior (Behavior v) where
	Behavior v
b @: :: Behavior v -> Stream Bool -> BehaviorToEvent (Behavior v)
@: Stream Bool
c = Behavior v -> Stream Bool -> Event () (Behavior v)
forall {k} (p :: k) v. v -> Stream Bool -> Event p v
Event Behavior v
b Stream Bool
c

instance IsBehavior (TypedBehavior p v) where
	@: :: TypedBehavior p v
-> Stream Bool -> BehaviorToEvent (TypedBehavior p v)
(@:) (TypedBehavior Behavior v
b) Stream Bool
c = Behavior v -> Stream Bool -> Event p (Behavior v)
forall {k} (p :: k) v. v -> Stream Bool -> Event p v
Event Behavior v
b Stream Bool
c

data PinCapabilities
	= DigitalIO
	| AnalogInput
	| PWM
	deriving (Int -> PinCapabilities -> ShowS
[PinCapabilities] -> ShowS
PinCapabilities -> String
(Int -> PinCapabilities -> ShowS)
-> (PinCapabilities -> String)
-> ([PinCapabilities] -> ShowS)
-> Show PinCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PinCapabilities -> ShowS
showsPrec :: Int -> PinCapabilities -> ShowS
$cshow :: PinCapabilities -> String
show :: PinCapabilities -> String
$cshowList :: [PinCapabilities] -> ShowS
showList :: [PinCapabilities] -> ShowS
Show, PinCapabilities -> PinCapabilities -> Bool
(PinCapabilities -> PinCapabilities -> Bool)
-> (PinCapabilities -> PinCapabilities -> Bool)
-> Eq PinCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PinCapabilities -> PinCapabilities -> Bool
== :: PinCapabilities -> PinCapabilities -> Bool
$c/= :: PinCapabilities -> PinCapabilities -> Bool
/= :: 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
$ccompare :: PinCapabilities -> PinCapabilities -> Ordering
compare :: PinCapabilities -> PinCapabilities -> Ordering
$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
>= :: PinCapabilities -> PinCapabilities -> Bool
$cmax :: PinCapabilities -> PinCapabilities -> PinCapabilities
max :: PinCapabilities -> PinCapabilities -> PinCapabilities
$cmin :: PinCapabilities -> PinCapabilities -> PinCapabilities
min :: PinCapabilities -> PinCapabilities -> 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