{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, LambdaCase, DeriveFunctor #-}
module Reactive.Banana.Automation (
Automation,
runAutomation,
observeAutomation,
liftMomentIO,
EventSource,
newEventSource,
fromEventSource,
gotEvent,
getEventFrom,
Sensed (..),
sensedEvent,
sensedBehavior,
sensed,
(=:),
sensorUnavailable,
sensedEventBehavior,
automationStepper,
automationChanges,
Timestamped(..),
Timestamp(..),
sensedNow,
sensedAt,
elapsedTimeSince,
ClockSignal(..),
clockSignal,
clockSignalAt,
clockSignalBehavior,
PowerChange(..),
actuateEvent,
actuateFutureEvent,
actuateBehavior,
actuateBehaviorMaybe,
Range(..),
belowRange,
aboveRange,
inRange,
extendRange
) where
import Reactive.Banana
import Reactive.Banana.Frameworks
import Control.Monad.Fix
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import Control.Concurrent.STM
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Time.LocalTime
newtype Automation sensors actuators a = Automation
{ forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation :: ReaderT (sensors, actuators -> IO ()) MomentIO a }
instance Semigroup (Automation sensors actuators ()) where
Automation ReaderT (sensors, actuators -> IO ()) MomentIO ()
a <> :: Automation sensors actuators ()
-> Automation sensors actuators ()
-> Automation sensors actuators ()
<> Automation ReaderT (sensors, actuators -> IO ()) MomentIO ()
b = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO ()
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT (sensors, actuators -> IO ()) MomentIO ()
b)
instance Monoid (Automation sensors actuators ()) where
mempty :: Automation sensors actuators ()
mempty = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (forall (m :: * -> *) a. Monad m => a -> m a
return ())
instance Functor (Automation sensors actuators) where
fmap :: forall a b.
(a -> b)
-> Automation sensors actuators a -> Automation sensors actuators b
fmap a -> b
f = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation
instance Applicative (Automation sensors actuators) where
pure :: forall a. a -> Automation sensors actuators a
pure = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
Automation sensors actuators (a -> b)
f <*> :: forall a b.
Automation sensors actuators (a -> b)
-> Automation sensors actuators a -> Automation sensors actuators b
<*> Automation sensors actuators a
a = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall a b. (a -> b) -> a -> b
$ forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation Automation sensors actuators (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation Automation sensors actuators a
a
instance Monad (Automation sensors actuators) where
Automation sensors actuators a
m >>= :: forall a b.
Automation sensors actuators a
-> (a -> Automation sensors actuators b)
-> Automation sensors actuators b
>>= a -> Automation sensors actuators b
g = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall a b. (a -> b) -> a -> b
$ forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation Automation sensors actuators a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Automation sensors actuators b
g
instance MonadFix (Automation sensors actuators) where
mfix :: forall a.
(a -> Automation sensors actuators a)
-> Automation sensors actuators a
mfix a -> Automation sensors actuators a
f = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Automation sensors actuators a
f)
instance MonadMoment (Automation sensors actuators) where
liftMoment :: forall a. Moment a -> Automation sensors actuators a
liftMoment = forall a sensors actuators.
MomentIO a -> Automation sensors actuators a
liftMomentIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadMoment m => Moment a -> m a
liftMoment
liftMomentIO :: MomentIO a -> Automation sensors actuators a
liftMomentIO :: forall a sensors actuators.
MomentIO a -> Automation sensors actuators a
liftMomentIO = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
setupAutomation :: Automation sensors actuators () -> IO sensors -> (actuators -> IO ()) -> IO sensors
setupAutomation :: forall sensors actuators.
Automation sensors actuators ()
-> IO sensors -> (actuators -> IO ()) -> IO sensors
setupAutomation Automation sensors actuators ()
automation IO sensors
mksensors actuators -> IO ()
actuators = do
sensors
sensors <- IO sensors
mksensors
EventNetwork
network <- MomentIO () -> IO EventNetwork
compile forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (sensors
sensors, actuators -> IO ()
actuators) forall a b. (a -> b) -> a -> b
$ forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation Automation sensors actuators ()
automation
EventNetwork -> IO ()
actuate EventNetwork
network
forall (m :: * -> *) a. Monad m => a -> m a
return sensors
sensors
runAutomation :: Automation sensors actuators () -> IO sensors -> (actuators -> IO ()) -> (sensors -> IO ()) -> IO ()
runAutomation :: forall sensors actuators.
Automation sensors actuators ()
-> IO sensors
-> (actuators -> IO ())
-> (sensors -> IO ())
-> IO ()
runAutomation Automation sensors actuators ()
automation IO sensors
mksensors actuators -> IO ()
actuators sensors -> IO ()
poller = do
sensors
sensors <- forall sensors actuators.
Automation sensors actuators ()
-> IO sensors -> (actuators -> IO ()) -> IO sensors
setupAutomation Automation sensors actuators ()
automation IO sensors
mksensors actuators -> IO ()
actuators
forall {b}. sensors -> IO b
mainloop sensors
sensors
where
mainloop :: sensors -> IO b
mainloop sensors
sensors = do
sensors -> IO ()
poller sensors
sensors
sensors -> IO b
mainloop sensors
sensors
observeAutomation :: Automation sensors actuators () -> IO sensors -> IO ((sensors -> IO ()) -> IO [actuators])
observeAutomation :: forall sensors actuators.
Automation sensors actuators ()
-> IO sensors -> IO ((sensors -> IO ()) -> IO [actuators])
observeAutomation Automation sensors actuators ()
automation IO sensors
mksensors = do
TVar [actuators]
tv <- forall a. a -> IO (TVar a)
newTVarIO []
TMVar ()
lck <- forall a. IO (TMVar a)
newEmptyTMVarIO
let addeffect :: actuators -> IO ()
addeffect actuators
e = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [actuators]
tv (actuators
eforall a. a -> [a] -> [a]
:)
sensors
sensors <- forall sensors actuators.
Automation sensors actuators ()
-> IO sensors -> (actuators -> IO ()) -> IO sensors
setupAutomation Automation sensors actuators ()
automation IO sensors
mksensors actuators -> IO ()
addeffect
let runner :: (sensors -> IO ()) -> IO [actuators]
runner sensors -> IO ()
a = do
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
lck ()
() <- sensors -> IO ()
a sensors
sensors
[actuators]
l <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
forall a. TMVar a -> STM a
takeTMVar TMVar ()
lck
forall a. TVar a -> a -> STM a
swapTVar TVar [actuators]
tv []
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [actuators]
l)
forall (m :: * -> *) a. Monad m => a -> m a
return (sensors -> IO ()) -> IO [actuators]
runner
data EventSource a v = EventSource
{ forall a v. EventSource a v -> (AddHandler a, a -> IO ())
getEventSource :: (AddHandler a, a -> IO ())
, forall a v. EventSource a v -> v
fromEventSource :: v
}
newEventSource :: v -> IO (EventSource a v)
newEventSource :: forall v a. v -> IO (EventSource a v)
newEventSource v
v = forall a v. (AddHandler a, a -> IO ()) -> v -> EventSource a v
EventSource forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO (AddHandler a, Handler a)
newAddHandler forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v
addHandler :: EventSource a v -> AddHandler a
addHandler :: forall a v. EventSource a v -> AddHandler a
addHandler = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a v. EventSource a v -> (AddHandler a, a -> IO ())
getEventSource
gotEvent :: EventSource a v -> a -> IO ()
gotEvent :: forall a v. EventSource a v -> a -> IO ()
gotEvent = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a v. EventSource a v -> (AddHandler a, a -> IO ())
getEventSource
getEventFrom :: (sensors -> EventSource a v) -> Automation sensors actuators (Event a)
getEventFrom :: forall sensors a v actuators.
(sensors -> EventSource a v)
-> Automation sensors actuators (Event a)
getEventFrom sensors -> EventSource a v
getsensor = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall a b. (a -> b) -> a -> b
$ do
EventSource a v
sensor <- sensors -> EventSource a v
getsensor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. AddHandler a -> MomentIO (Event a)
fromAddHandler forall a b. (a -> b) -> a -> b
$ forall a v. EventSource a v -> AddHandler a
addHandler EventSource a v
sensor
data Sensed a = SensorUnavailable | Sensed a
deriving (Int -> Sensed a -> ShowS
forall a. Show a => Int -> Sensed a -> ShowS
forall a. Show a => [Sensed a] -> ShowS
forall a. Show a => Sensed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sensed a] -> ShowS
$cshowList :: forall a. Show a => [Sensed a] -> ShowS
show :: Sensed a -> String
$cshow :: forall a. Show a => Sensed a -> String
showsPrec :: Int -> Sensed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Sensed a -> ShowS
Show, forall a b. a -> Sensed b -> Sensed a
forall a b. (a -> b) -> Sensed a -> Sensed b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Sensed b -> Sensed a
$c<$ :: forall a b. a -> Sensed b -> Sensed a
fmap :: forall a b. (a -> b) -> Sensed a -> Sensed b
$cfmap :: forall a b. (a -> b) -> Sensed a -> Sensed b
Functor, Sensed a -> Sensed a -> Bool
Sensed a -> Sensed a -> Ordering
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
forall {a}. Ord a => Eq (Sensed a)
forall a. Ord a => Sensed a -> Sensed a -> Bool
forall a. Ord a => Sensed a -> Sensed a -> Ordering
forall a. Ord a => Sensed a -> Sensed a -> Sensed a
min :: Sensed a -> Sensed a -> Sensed a
$cmin :: forall a. Ord a => Sensed a -> Sensed a -> Sensed a
max :: Sensed a -> Sensed a -> Sensed a
$cmax :: forall a. Ord a => Sensed a -> Sensed a -> Sensed a
>= :: Sensed a -> Sensed a -> Bool
$c>= :: forall a. Ord a => Sensed a -> Sensed a -> Bool
> :: Sensed a -> Sensed a -> Bool
$c> :: forall a. Ord a => Sensed a -> Sensed a -> Bool
<= :: Sensed a -> Sensed a -> Bool
$c<= :: forall a. Ord a => Sensed a -> Sensed a -> Bool
< :: Sensed a -> Sensed a -> Bool
$c< :: forall a. Ord a => Sensed a -> Sensed a -> Bool
compare :: Sensed a -> Sensed a -> Ordering
$ccompare :: forall a. Ord a => Sensed a -> Sensed a -> Ordering
Ord, Sensed a -> Sensed a -> Bool
forall a. Eq a => Sensed a -> Sensed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sensed a -> Sensed a -> Bool
$c/= :: forall a. Eq a => Sensed a -> Sensed a -> Bool
== :: Sensed a -> Sensed a -> Bool
$c== :: forall a. Eq a => Sensed a -> Sensed a -> Bool
Eq)
sensedEvent :: (sensors -> EventSource (Sensed a) v) -> Automation sensors actuators (Event a)
sensedEvent :: forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event a)
sensedEvent sensors -> EventSource (Sensed a) v
getsensor = do
Event (Sensed a)
e <- forall sensors a v actuators.
(sensors -> EventSource a v)
-> Automation sensors actuators (Event a)
getEventFrom sensors -> EventSource (Sensed a) v
getsensor
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Event (Maybe a) -> Event a
filterJust forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event (Sensed a)
e forall a b. (a -> b) -> a -> b
$ \case
Sensed a
SensorUnavailable -> forall a. Maybe a
Nothing
Sensed a
a -> forall a. a -> Maybe a
Just a
a
sensedBehavior :: (sensors -> EventSource (Sensed a) v) -> Automation sensors actuators (Behavior (Sensed a))
sensedBehavior :: forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Behavior (Sensed a))
sensedBehavior sensors -> EventSource (Sensed a) v
getsensor = forall a sensors actuators.
Event (Sensed a)
-> Automation sensors actuators (Behavior (Sensed a))
sensedEventBehavior forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sensors a v actuators.
(sensors -> EventSource a v)
-> Automation sensors actuators (Event a)
getEventFrom sensors -> EventSource (Sensed a) v
getsensor
sensedEventBehavior :: Event (Sensed a) -> Automation sensors actuators (Behavior (Sensed a))
sensedEventBehavior :: forall a sensors actuators.
Event (Sensed a)
-> Automation sensors actuators (Behavior (Sensed a))
sensedEventBehavior = forall a sensors actuators.
a -> Event a -> Automation sensors actuators (Behavior a)
automationStepper forall a. Sensed a
SensorUnavailable
automationStepper :: a -> Event a -> Automation sensors actuators (Behavior a)
automationStepper :: forall a sensors actuators.
a -> Event a -> Automation sensors actuators (Behavior a)
automationStepper a
a Event a
e = forall a sensors actuators.
MomentIO a -> Automation sensors actuators a
liftMomentIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
stepper a
a Event a
e
automationChanges :: Behavior a -> Automation sensors actuators (Event (Future a))
automationChanges :: forall a sensors actuators.
Behavior a -> Automation sensors actuators (Event (Future a))
automationChanges = forall a sensors actuators.
MomentIO a -> Automation sensors actuators a
liftMomentIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Behavior a -> MomentIO (Event (Future a))
changes
sensed :: EventSource (Sensed a) v -> a -> IO ()
sensed :: forall a v. EventSource (Sensed a) v -> a -> IO ()
sensed EventSource (Sensed a) v
s = forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (Sensed a) v
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Sensed a
Sensed
(=:) :: EventSource (Sensed a) v -> a -> IO ()
=: :: forall a v. EventSource (Sensed a) v -> a -> IO ()
(=:) = forall a v. EventSource (Sensed a) v -> a -> IO ()
sensed
sensorUnavailable :: EventSource (Sensed a) v -> IO ()
sensorUnavailable :: forall a v. EventSource (Sensed a) v -> IO ()
sensorUnavailable EventSource (Sensed a) v
s = forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (Sensed a) v
s forall a. Sensed a
SensorUnavailable
data Timestamped t a = Timestamped
{ forall t a. Timestamped t a -> t
timestamp :: t
, forall t a. Timestamped t a -> a
value :: a
}
instance (Show t, Show a) => Show (Timestamped t a) where
show :: Timestamped t a -> String
show (Timestamped t
t a
a) = forall a. Show a => a -> String
show t
t forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a
instance Functor (Timestamped t) where
fmap :: forall a b. (a -> b) -> Timestamped t a -> Timestamped t b
fmap a -> b
f (Timestamped t
t a
a) = forall t a. t -> a -> Timestamped t a
Timestamped t
t (a -> b
f a
a)
class Timestamp t where
getCurrentTimestamp :: IO t
instance Timestamp POSIXTime where
getCurrentTimestamp :: IO POSIXTime
getCurrentTimestamp = IO POSIXTime
getPOSIXTime
instance Timestamp UTCTime where
getCurrentTimestamp :: IO UTCTime
getCurrentTimestamp = IO UTCTime
getCurrentTime
instance Timestamp ZonedTime where
getCurrentTimestamp :: IO ZonedTime
getCurrentTimestamp = IO ZonedTime
getZonedTime
instance Timestamp LocalTime where
getCurrentTimestamp :: IO LocalTime
getCurrentTimestamp = ZonedTime -> LocalTime
zonedTimeToLocalTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ZonedTime
getZonedTime
instance Timestamp TimeOfDay where
getCurrentTimestamp :: IO TimeOfDay
getCurrentTimestamp = LocalTime -> TimeOfDay
localTimeOfDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Timestamp t => IO t
getCurrentTimestamp
sensedNow :: Timestamp t => EventSource (Sensed (Timestamped t a)) v -> a -> IO ()
sensedNow :: forall t a v.
Timestamp t =>
EventSource (Sensed (Timestamped t a)) v -> a -> IO ()
sensedNow EventSource (Sensed (Timestamped t a)) v
es a
a = do
t
now <- forall t. Timestamp t => IO t
getCurrentTimestamp
forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (Sensed (Timestamped t a)) v
es (forall a. a -> Sensed a
Sensed (forall t a. t -> a -> Timestamped t a
Timestamped t
now a
a))
sensedAt :: Timestamp t => t -> EventSource (Sensed (Timestamped t a)) v -> a -> IO ()
sensedAt :: forall t a v.
Timestamp t =>
t -> EventSource (Sensed (Timestamped t a)) v -> a -> IO ()
sensedAt t
ts EventSource (Sensed (Timestamped t a)) v
es a
a = forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (Sensed (Timestamped t a)) v
es (forall a. a -> Sensed a
Sensed (forall t a. t -> a -> Timestamped t a
Timestamped t
ts a
a))
elapsedTimeSince
:: (Num t, Timestamp t)
=> (a -> Bool)
-> Event (Timestamped t a)
-> Automation sensors actuators (Event t)
elapsedTimeSince :: forall t a sensors actuators.
(Num t, Timestamp t) =>
(a -> Bool)
-> Event (Timestamped t a)
-> Automation sensors actuators (Event t)
elapsedTimeSince a -> Bool
f Event (Timestamped t a)
event = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {a}. Num a => Maybe (a, Timestamped a a) -> a
reduce) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadMoment m =>
a -> Event (a -> a) -> m (Event a)
accumE forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall {t} {b}.
Num t =>
Timestamped t a -> Maybe (t, b) -> Maybe (t, Timestamped t a)
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event (Timestamped t a)
event
where
go :: Timestamped t a -> Maybe (t, b) -> Maybe (t, Timestamped t a)
go Timestamped t a
v' (Just (t
t, b
_v))
| a -> Bool
f (forall t a. Timestamped t a -> a
value Timestamped t a
v') = forall a. a -> Maybe a
Just (forall t a. Timestamped t a -> t
timestamp Timestamped t a
v', Timestamped t a
v')
| Bool
otherwise = forall a. a -> Maybe a
Just (t
t, Timestamped t a
v')
go Timestamped t a
v Maybe (t, b)
Nothing
| a -> Bool
f (forall t a. Timestamped t a -> a
value Timestamped t a
v) = forall a. a -> Maybe a
Just (t
0, Timestamped t a
v)
| Bool
otherwise = forall a. Maybe a
Nothing
reduce :: Maybe (a, Timestamped a a) -> a
reduce (Just (a
t, Timestamped a a
v)) = forall t a. Timestamped t a -> t
timestamp Timestamped a a
v forall a. Num a => a -> a -> a
- a
t
reduce Maybe (a, Timestamped a a)
Nothing = a
0
data ClockSignal a = ClockSignal a
deriving (Int -> ClockSignal a -> ShowS
forall a. Show a => Int -> ClockSignal a -> ShowS
forall a. Show a => [ClockSignal a] -> ShowS
forall a. Show a => ClockSignal a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClockSignal a] -> ShowS
$cshowList :: forall a. Show a => [ClockSignal a] -> ShowS
show :: ClockSignal a -> String
$cshow :: forall a. Show a => ClockSignal a -> String
showsPrec :: Int -> ClockSignal a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ClockSignal a -> ShowS
Show, ClockSignal a -> ClockSignal a -> Bool
forall a. Eq a => ClockSignal a -> ClockSignal a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClockSignal a -> ClockSignal a -> Bool
$c/= :: forall a. Eq a => ClockSignal a -> ClockSignal a -> Bool
== :: ClockSignal a -> ClockSignal a -> Bool
$c== :: forall a. Eq a => ClockSignal a -> ClockSignal a -> Bool
Eq, ClockSignal a -> ClockSignal a -> Bool
ClockSignal a -> ClockSignal a -> Ordering
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
forall {a}. Ord a => Eq (ClockSignal a)
forall a. Ord a => ClockSignal a -> ClockSignal a -> Bool
forall a. Ord a => ClockSignal a -> ClockSignal a -> Ordering
forall a. Ord a => ClockSignal a -> ClockSignal a -> ClockSignal a
min :: ClockSignal a -> ClockSignal a -> ClockSignal a
$cmin :: forall a. Ord a => ClockSignal a -> ClockSignal a -> ClockSignal a
max :: ClockSignal a -> ClockSignal a -> ClockSignal a
$cmax :: forall a. Ord a => ClockSignal a -> ClockSignal a -> ClockSignal a
>= :: ClockSignal a -> ClockSignal a -> Bool
$c>= :: forall a. Ord a => ClockSignal a -> ClockSignal a -> Bool
> :: ClockSignal a -> ClockSignal a -> Bool
$c> :: forall a. Ord a => ClockSignal a -> ClockSignal a -> Bool
<= :: ClockSignal a -> ClockSignal a -> Bool
$c<= :: forall a. Ord a => ClockSignal a -> ClockSignal a -> Bool
< :: ClockSignal a -> ClockSignal a -> Bool
$c< :: forall a. Ord a => ClockSignal a -> ClockSignal a -> Bool
compare :: ClockSignal a -> ClockSignal a -> Ordering
$ccompare :: forall a. Ord a => ClockSignal a -> ClockSignal a -> Ordering
Ord, forall a b. a -> ClockSignal b -> ClockSignal a
forall a b. (a -> b) -> ClockSignal a -> ClockSignal b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ClockSignal b -> ClockSignal a
$c<$ :: forall a b. a -> ClockSignal b -> ClockSignal a
fmap :: forall a b. (a -> b) -> ClockSignal a -> ClockSignal b
$cfmap :: forall a b. (a -> b) -> ClockSignal a -> ClockSignal b
Functor)
clockSignal :: Timestamp t => EventSource (ClockSignal t) v -> IO ()
clockSignal :: forall t v. Timestamp t => EventSource (ClockSignal t) v -> IO ()
clockSignal EventSource (ClockSignal t) v
es = forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (ClockSignal t) v
es forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> ClockSignal a
ClockSignal forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t. Timestamp t => IO t
getCurrentTimestamp
clockSignalAt :: Timestamp t => t -> EventSource (ClockSignal t) v -> IO ()
clockSignalAt :: forall t v.
Timestamp t =>
t -> EventSource (ClockSignal t) v -> IO ()
clockSignalAt t
t EventSource (ClockSignal t) v
es = forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (ClockSignal t) v
es (forall a. a -> ClockSignal a
ClockSignal t
t)
clockSignalBehavior
:: Timestamp t
=> (sensors -> EventSource (ClockSignal t) v)
-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
clockSignalBehavior :: forall t sensors v actuators.
Timestamp t =>
(sensors -> EventSource (ClockSignal t) v)
-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
clockSignalBehavior sensors -> EventSource (ClockSignal t) v
getsensor = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall a b. (a -> b) -> a -> b
$ do
EventSource (ClockSignal t) v
sensor <- sensors -> EventSource (ClockSignal t) v
getsensor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
Event (Maybe (ClockSignal t))
e <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. AddHandler a -> MomentIO (Event a)
fromAddHandler forall a b. (a -> b) -> a -> b
$ forall a v. EventSource a v -> AddHandler a
addHandler EventSource (ClockSignal t) v
sensor)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
stepper forall a. Maybe a
Nothing Event (Maybe (ClockSignal t))
e
data PowerChange = PowerOff | PowerOn
deriving (Int -> PowerChange -> ShowS
[PowerChange] -> ShowS
PowerChange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PowerChange] -> ShowS
$cshowList :: [PowerChange] -> ShowS
show :: PowerChange -> String
$cshow :: PowerChange -> String
showsPrec :: Int -> PowerChange -> ShowS
$cshowsPrec :: Int -> PowerChange -> ShowS
Show, PowerChange -> PowerChange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PowerChange -> PowerChange -> Bool
$c/= :: PowerChange -> PowerChange -> Bool
== :: PowerChange -> PowerChange -> Bool
$c== :: PowerChange -> PowerChange -> Bool
Eq, Eq PowerChange
PowerChange -> PowerChange -> Bool
PowerChange -> PowerChange -> Ordering
PowerChange -> PowerChange -> PowerChange
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 :: PowerChange -> PowerChange -> PowerChange
$cmin :: PowerChange -> PowerChange -> PowerChange
max :: PowerChange -> PowerChange -> PowerChange
$cmax :: PowerChange -> PowerChange -> PowerChange
>= :: PowerChange -> PowerChange -> Bool
$c>= :: PowerChange -> PowerChange -> Bool
> :: PowerChange -> PowerChange -> Bool
$c> :: PowerChange -> PowerChange -> Bool
<= :: PowerChange -> PowerChange -> Bool
$c<= :: PowerChange -> PowerChange -> Bool
< :: PowerChange -> PowerChange -> Bool
$c< :: PowerChange -> PowerChange -> Bool
compare :: PowerChange -> PowerChange -> Ordering
$ccompare :: PowerChange -> PowerChange -> Ordering
Ord)
actuateEvent :: Event a -> (a -> actuators) -> Automation sensors actuators ()
actuateEvent :: forall a actuators sensors.
Event a -> (a -> actuators) -> Automation sensors actuators ()
actuateEvent Event a
e a -> actuators
getactuator = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall a b. (a -> b) -> a -> b
$ do
actuators -> IO ()
actuators <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Event (IO ()) -> MomentIO ()
reactimate forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (actuators -> IO ()
actuators forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> actuators
getactuator) Event a
e
actuateFutureEvent :: Event (Future a) -> (a -> actuators) -> Automation sensors actuators ()
actuateFutureEvent :: forall a actuators sensors.
Event (Future a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateFutureEvent Event (Future a)
e a -> actuators
getactuator = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall a b. (a -> b) -> a -> b
$ forall a actuators sensors.
Event (Future a)
-> (a -> actuators)
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
actuateFutureEvent' Event (Future a)
e a -> actuators
getactuator
actuateFutureEvent' :: Event (Future a) -> (a -> actuators) -> ReaderT (sensors, actuators -> IO ()) MomentIO ()
actuateFutureEvent' :: forall a actuators sensors.
Event (Future a)
-> (a -> actuators)
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
actuateFutureEvent' Event (Future a)
e a -> actuators
getactuator = do
actuators -> IO ()
actuators <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Event (Future (IO ())) -> MomentIO ()
reactimate' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (actuators -> IO ()
actuators forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> actuators
getactuator) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event (Future a)
e
actuateBehavior :: Behavior a -> (a -> actuators) -> Automation sensors actuators ()
actuateBehavior :: forall a actuators sensors.
Behavior a -> (a -> actuators) -> Automation sensors actuators ()
actuateBehavior Behavior a
b a -> actuators
getactuator = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall a b. (a -> b) -> a -> b
$ do
Event (Future a)
e <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Behavior a -> MomentIO (Event (Future a))
changes Behavior a
b
forall a actuators sensors.
Event (Future a)
-> (a -> actuators)
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
actuateFutureEvent' Event (Future a)
e a -> actuators
getactuator
actuateBehaviorMaybe :: Behavior (Maybe a) -> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe :: forall a actuators sensors.
Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe a)
b a -> actuators
getactuator = forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation forall a b. (a -> b) -> a -> b
$ do
actuators -> IO ()
actuators <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
Event (Future (Maybe a))
c <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Behavior a -> MomentIO (Event (Future a))
changes Behavior (Maybe a)
b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Event (Future (IO ())) -> MomentIO ()
reactimate' forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (actuators -> IO ()
actuators forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> actuators
getactuator)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event (Future (Maybe a))
c
data Range t = Range t t
instance Eq t => Eq (Range t) where
(Range t
a1 t
b1) == :: Range t -> Range t -> Bool
== (Range t
a2 t
b2) =
t
a1 forall a. Eq a => a -> a -> Bool
== t
a2 Bool -> Bool -> Bool
&& t
b1 forall a. Eq a => a -> a -> Bool
== t
b2 Bool -> Bool -> Bool
||
t
a1 forall a. Eq a => a -> a -> Bool
== t
b2 Bool -> Bool -> Bool
&& t
b1 forall a. Eq a => a -> a -> Bool
== t
a2
instance Show t => Show (Range t) where
show :: Range t -> String
show (Range t
a t
b) = String
"Range " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show t
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show t
b
instance Ord t => Semigroup (Range t) where
Range t
a1 t
b1 <> :: Range t -> Range t -> Range t
<> Range t
a2 t
b2 =
let vals :: [t]
vals = [t
a1, t
b1, t
a2, t
b2]
in forall t. t -> t -> Range t
Range (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [t]
vals) (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [t]
vals)
belowRange :: Ord t => t -> Range t -> Bool
belowRange :: forall t. Ord t => t -> Range t -> Bool
belowRange t
p (Range t
a t
b) = t
p forall a. Ord a => a -> a -> Bool
< t
a Bool -> Bool -> Bool
&& t
p forall a. Ord a => a -> a -> Bool
< t
b
aboveRange :: Ord t => t -> Range t -> Bool
aboveRange :: forall t. Ord t => t -> Range t -> Bool
aboveRange t
p (Range t
a t
b) = t
p forall a. Ord a => a -> a -> Bool
> t
a Bool -> Bool -> Bool
&& t
p forall a. Ord a => a -> a -> Bool
> t
b
inRange :: Ord t => t -> Range t -> Bool
inRange :: forall t. Ord t => t -> Range t -> Bool
inRange t
p Range t
r = Bool -> Bool
not (forall t. Ord t => t -> Range t -> Bool
belowRange t
p Range t
r) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall t. Ord t => t -> Range t -> Bool
aboveRange t
p Range t
r)
extendRange :: Ord t => Range t -> t -> Range t
extendRange :: forall t. Ord t => Range t -> t -> Range t
extendRange r :: Range t
r@(Range t
a t
_) t
t = Range t
r forall a. Semigroup a => a -> a -> a
<> forall t. t -> t -> Range t
Range t
a t
t