module Reactive.Banana.Automation.Examples where
import Reactive.Banana
import Reactive.Banana.Automation
import Data.Time.Clock.POSIX
import Data.Time.LocalTime
import Data.Time.Calendar
data Sensors = Sensors
{ Sensors -> EventSource (Sensed Double) ()
fridgeTemperature :: EventSource (Sensed Double) ()
, Sensors -> EventSource (Sensed (Timestamped POSIXTime Bool)) ()
motionSensor :: EventSource (Sensed (Timestamped POSIXTime Bool)) ()
, Sensors -> EventSource (ClockSignal LocalTime) ()
clock :: EventSource (ClockSignal LocalTime) ()
, Sensors -> EventSource (Sensed ()) ()
rainGaugeTipSensor :: EventSource (Sensed ()) ()
}
data Actuators
= FridgePower PowerChange
| LightSwitch PowerChange
| SprinklerSwitch PowerChange
| LCDDisplay String
deriving (Int -> Actuators -> ShowS
[Actuators] -> ShowS
Actuators -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Actuators] -> ShowS
$cshowList :: [Actuators] -> ShowS
show :: Actuators -> String
$cshow :: Actuators -> String
showsPrec :: Int -> Actuators -> ShowS
$cshowsPrec :: Int -> Actuators -> ShowS
Show)
mkSensors :: IO Sensors
mkSensors :: IO Sensors
mkSensors = EventSource (Sensed Double) ()
-> EventSource (Sensed (Timestamped POSIXTime Bool)) ()
-> EventSource (ClockSignal LocalTime) ()
-> EventSource (Sensed ()) ()
-> Sensors
Sensors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v a. v -> IO (EventSource a v)
newEventSource ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall v a. v -> IO (EventSource a v)
newEventSource ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall v a. v -> IO (EventSource a v)
newEventSource ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall v a. v -> IO (EventSource a v)
newEventSource ()
fridge :: Automation Sensors Actuators ()
fridge :: Automation Sensors Actuators ()
fridge = do
Behavior (Sensed Double)
btemperature <- forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Behavior (Sensed a))
sensedBehavior Sensors -> EventSource (Sensed Double) ()
fridgeTemperature
let bpowerchange :: Behavior (Maybe PowerChange)
bpowerchange = Sensed Double -> Maybe PowerChange
calcpowerchange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior (Sensed Double)
btemperature
forall a actuators sensors.
Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe PowerChange)
bpowerchange PowerChange -> Actuators
FridgePower
where
calcpowerchange :: Sensed Double -> Maybe PowerChange
calcpowerchange (Sensed Double
temp)
| Double
temp forall t. Ord t => t -> Range t -> Bool
`belowRange` Range Double
allowedtemp = forall a. a -> Maybe a
Just PowerChange
PowerOff
| Double
temp forall t. Ord t => t -> Range t -> Bool
`aboveRange` Range Double
allowedtemp = forall a. a -> Maybe a
Just PowerChange
PowerOn
| Bool
otherwise = forall a. Maybe a
Nothing
calcpowerchange Sensed Double
SensorUnavailable = forall a. Maybe a
Nothing
allowedtemp :: Range Double
allowedtemp = forall t. t -> t -> Range t
Range Double
1 Double
4
motionActivatedLight :: Automation Sensors Actuators ()
motionActivatedLight :: Automation Sensors Actuators ()
motionActivatedLight = do
Event POSIXTime
timesincemotion <- forall t a sensors actuators.
(Num t, Timestamp t) =>
(a -> Bool)
-> Event (Timestamped t a)
-> Automation sensors actuators (Event t)
elapsedTimeSince (forall a. Eq a => a -> a -> Bool
== Bool
True)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event a)
sensedEvent Sensors -> EventSource (Sensed (Timestamped POSIXTime Bool)) ()
motionSensor
Behavior (Maybe PowerChange)
lightchange <- forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
stepper forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall {a}. (Num a, Ord a) => a -> Maybe PowerChange
calcchange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event POSIXTime
timesincemotion
forall a actuators sensors.
Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe PowerChange)
lightchange PowerChange -> Actuators
LightSwitch
where
calcchange :: a -> Maybe PowerChange
calcchange a
t
| a
t forall a. Eq a => a -> a -> Bool
== a
0 = forall a. a -> Maybe a
Just PowerChange
PowerOn
| a
t forall a. Ord a => a -> a -> Bool
> a
300 = forall a. a -> Maybe a
Just PowerChange
PowerOff
| Bool
otherwise = forall a. Maybe a
Nothing
nightLight :: Automation Sensors Actuators ()
nightLight :: Automation Sensors Actuators ()
nightLight = do
Behavior (Maybe (ClockSignal LocalTime))
bclock <- forall t sensors v actuators.
Timestamp t =>
(sensors -> EventSource (ClockSignal t) v)
-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
clockSignalBehavior Sensors -> EventSource (ClockSignal LocalTime) ()
clock
let bhour :: Behavior (Maybe (ClockSignal Int))
bhour = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (TimeOfDay -> Int
todHour forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> TimeOfDay
localTimeOfDay) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior (Maybe (ClockSignal LocalTime))
bclock
let lightchange :: Behavior (Maybe PowerChange)
lightchange = forall {a}.
(Ord a, Num a) =>
Maybe (ClockSignal a) -> Maybe PowerChange
calcchange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior (Maybe (ClockSignal Int))
bhour
forall a actuators sensors.
Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe PowerChange)
lightchange PowerChange -> Actuators
LightSwitch
where
calcchange :: Maybe (ClockSignal a) -> Maybe PowerChange
calcchange (Just (ClockSignal a
t))
| a
t forall a. Ord a => a -> a -> Bool
> a
18 = forall a. a -> Maybe a
Just PowerChange
PowerOn
| a
t forall a. Ord a => a -> a -> Bool
< a
6 = forall a. a -> Maybe a
Just PowerChange
PowerOn
| Bool
otherwise = forall a. a -> Maybe a
Just PowerChange
PowerOff
calcchange Maybe (ClockSignal a)
Nothing = forall a. Maybe a
Nothing
showBehaviorLCDDisplay :: (a -> String) -> Automation Sensors Actuators (Behavior a) -> Automation Sensors Actuators ()
showBehaviorLCDDisplay :: forall a.
(a -> String)
-> Automation Sensors Actuators (Behavior a)
-> Automation Sensors Actuators ()
showBehaviorLCDDisplay a -> String
fmt Automation Sensors Actuators (Behavior a)
mkb = do
Behavior a
b <- Automation Sensors Actuators (Behavior a)
mkb
forall a actuators sensors.
Behavior a -> (a -> actuators) -> Automation sensors actuators ()
actuateBehavior Behavior a
b (String -> Actuators
LCDDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
fmt)
totalRainfall :: Automation Sensors Actuators (Behavior Integer)
totalRainfall :: Automation Sensors Actuators (Behavior Integer)
totalRainfall = do
Event ()
tipevents <- forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event a)
sensedEvent Sensors -> EventSource (Sensed ()) ()
rainGaugeTipSensor
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event (a -> a) -> m (Behavior a)
accumB Integer
0 forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. Enum a => a -> a
succ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event ()
tipevents
totalRainfallSince :: TimeOfDay -> Automation Sensors Actuators (Behavior (Timestamped (ClockSignal LocalTime) Integer))
totalRainfallSince :: TimeOfDay
-> Automation
Sensors
Actuators
(Behavior (Timestamped (ClockSignal LocalTime) Integer))
totalRainfallSince TimeOfDay
tod = do
Event (ClockSignal LocalTime)
clockevents <- forall sensors a v actuators.
(sensors -> EventSource a v)
-> Automation sensors actuators (Event a)
getEventFrom Sensors -> EventSource (ClockSignal LocalTime) ()
clock
Behavior (Maybe (ClockSignal LocalTime))
bclock <- forall t sensors v actuators.
Timestamp t =>
(sensors -> EventSource (ClockSignal t) v)
-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
clockSignalBehavior Sensors -> EventSource (ClockSignal LocalTime) ()
clock
Event ()
tipevents <- forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event a)
sensedEvent Sensors -> EventSource (Sensed ()) ()
rainGaugeTipSensor
let tiptimes :: Event (Maybe (ClockSignal LocalTime))
tiptimes = Behavior (Maybe (ClockSignal LocalTime))
bclock forall b a. Behavior b -> Event a -> Event b
<@ Event ()
tipevents
let combined :: Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
combined = forall a. (a -> a -> a) -> Event a -> Event a -> Event a
unionWith (\(Integer -> Integer
f1, Maybe (ClockSignal LocalTime)
t1) (Integer -> Integer
f2, Maybe (ClockSignal LocalTime)
t2) -> (Integer -> Integer
f1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
f2, forall a. Ord a => a -> a -> a
max Maybe (ClockSignal LocalTime)
t1 Maybe (ClockSignal LocalTime)
t2))
((\Maybe (ClockSignal LocalTime)
e -> (forall a. a -> a
id, Maybe (ClockSignal LocalTime)
e)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just Event (ClockSignal LocalTime)
clockevents)
((\Maybe (ClockSignal LocalTime)
e -> (forall a. Enum a => a -> a
succ, Maybe (ClockSignal LocalTime)
e)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event (Maybe (ClockSignal LocalTime))
tiptimes)
let epoch :: LocalTime
epoch = Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
1 Int
1 Int
1) TimeOfDay
midnight
let initial :: (Timestamped (ClockSignal LocalTime) Integer, Maybe a)
initial = (forall t a. t -> a -> Timestamped t a
Timestamped (forall a. a -> ClockSignal a
ClockSignal LocalTime
epoch) Integer
0, forall a. Maybe a
Nothing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a.
MonadMoment m =>
a -> Event (a -> a) -> m (Behavior a)
accumB forall {a}. (Timestamped (ClockSignal LocalTime) Integer, Maybe a)
initial forall a b. (a -> b) -> a -> b
$ forall {a}.
Num a =>
(a -> a, Maybe (ClockSignal LocalTime))
-> (Timestamped (ClockSignal LocalTime) a, Maybe Day)
-> (Timestamped (ClockSignal LocalTime) a, Maybe Day)
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
combined)
where
go :: (a -> a, Maybe (ClockSignal LocalTime))
-> (Timestamped (ClockSignal LocalTime) a, Maybe Day)
-> (Timestamped (ClockSignal LocalTime) a, Maybe Day)
go (a -> a
f, Just (ClockSignal LocalTime
t)) (Timestamped ClockSignal LocalTime
_ a
n, Just Day
lastzero) =
let nextzero :: Day
nextzero = forall a. Enum a => a -> a
succ Day
lastzero
in if LocalTime
t forall a. Ord a => a -> a -> Bool
> Day -> TimeOfDay -> LocalTime
LocalTime Day
nextzero TimeOfDay
tod
then (forall t a. t -> a -> Timestamped t a
Timestamped (forall a. a -> ClockSignal a
ClockSignal LocalTime
t) a
0, forall a. a -> Maybe a
Just Day
nextzero)
else (forall t a. t -> a -> Timestamped t a
Timestamped (forall a. a -> ClockSignal a
ClockSignal LocalTime
t) (a -> a
f a
n), forall a. a -> Maybe a
Just Day
lastzero)
go (a -> a
f, Just (ClockSignal LocalTime
t)) ((Timestamped ClockSignal LocalTime
_ a
n), Maybe Day
Nothing) =
(forall t a. t -> a -> Timestamped t a
Timestamped (forall a. a -> ClockSignal a
ClockSignal LocalTime
t) (a -> a
f a
n), forall a. a -> Maybe a
Just (LocalTime -> Day
localDay LocalTime
t))
go (a -> a
_, Maybe (ClockSignal LocalTime)
Nothing) (Timestamped (ClockSignal LocalTime) a, Maybe Day)
v = (Timestamped (ClockSignal LocalTime) a, Maybe Day)
v
sprinklersStartingAt :: TimeOfDay -> Automation Sensors Actuators ()
TimeOfDay
starttod = do
Behavior (Timestamped (ClockSignal LocalTime) Integer)
brainfall <- TimeOfDay
-> Automation
Sensors
Actuators
(Behavior (Timestamped (ClockSignal LocalTime) Integer))
totalRainfallSince TimeOfDay
starttod
let b :: Behavior (Maybe PowerChange)
b = forall {a}.
(Ord a, Num a) =>
Timestamped (ClockSignal LocalTime) a -> Maybe PowerChange
calcchange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior (Timestamped (ClockSignal LocalTime) Integer)
brainfall
forall a actuators sensors.
Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe PowerChange)
b PowerChange -> Actuators
SprinklerSwitch
where
stoptod :: TimeOfDay
stoptod = TimeOfDay
starttod { todHour :: Int
todHour = (TimeOfDay -> Int
todHour TimeOfDay
starttod forall a. Num a => a -> a -> a
+ Int
1) forall a. Integral a => a -> a -> a
`mod` Int
24 }
calcchange :: Timestamped (ClockSignal LocalTime) a -> Maybe PowerChange
calcchange (Timestamped (ClockSignal LocalTime
t) a
rain)
| a
rain forall a. Ord a => a -> a -> Bool
>= a
3 = forall a. a -> Maybe a
Just PowerChange
PowerOff
| LocalTime -> TimeOfDay
localTimeOfDay LocalTime
t forall a. Ord a => a -> a -> Bool
>= TimeOfDay
starttod Bool -> Bool -> Bool
&& LocalTime -> TimeOfDay
localTimeOfDay LocalTime
t forall a. Ord a => a -> a -> Bool
< TimeOfDay
stoptod = forall a. a -> Maybe a
Just PowerChange
PowerOn
| Bool
otherwise = forall a. a -> Maybe a
Just PowerChange
PowerOff
thisHouse :: Automation Sensors Actuators ()
thisHouse :: Automation Sensors Actuators ()
thisHouse = forall a. Monoid a => [a] -> a
mconcat
[ Automation Sensors Actuators ()
fridge
, Automation Sensors Actuators ()
nightLight
, Automation Sensors Actuators ()
motionActivatedLight
, TimeOfDay -> Automation Sensors Actuators ()
sprinklersStartingAt TimeOfDay
midnight
]