{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, LambdaCase, DeriveFunctor #-}

-- | Home (etc) automation using reactive-banana.
--
-- Functional Reactive Programming is a natural fit for home automation,
-- which involves sensor values that vary over time and are used to control
-- actuators.
--
-- This library provides a framework and some useful types for
-- using the reactive-banana FRP library for home automation.
-- 
-- Its main abstraction is the `Automation` which describes how to process
-- `Event`s from `Sensor`s and how to drive actuators such as lights,
-- and relays in response.
--
-- See "Reactive.Banana.Automation.Examples" for several examples
-- of using this library.
module Reactive.Banana.Automation (
	-- * Framework
	Automation,
	runAutomation,
	observeAutomation,
	liftMomentIO,
	-- * Events
	EventSource,
	newEventSource,
	fromEventSource,
	gotEvent,
	getEventFrom,
	-- * Sensors
	Sensed (..),
	sensedEvent,
	sensedBehavior,
	sensed,
	(=:),
	sensorUnavailable,
	sensedEventBehavior,
	-- * Combinators
	automationStepper,
	automationChanges,
	-- * Time
	Timestamped(..),
	Timestamp(..),
	sensedNow,
	sensedAt,
	elapsedTimeSince,
	ClockSignal(..),
	clockSignal,
	clockSignalAt,
	clockSignalBehavior,
	-- * Actuators
	PowerChange(..),
	actuateEvent,
	actuateFutureEvent,
	actuateBehavior,
	actuateBehaviorMaybe,
	-- * Ranges
	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

-- | An Automation receives `Event`s from some sensors and decides what
-- to do, controlling the actuators. It is implemented as a reactive-banana
-- event network description.
--
-- For example, let's make an automation for a fridge, which has a
-- temperature sensor and a relay controlling its power, and should
-- run as needed to keep the temperature in a safe range, while
-- minimizing compressor starts.
--
-- > data Sensors = Sensors { fridgeTemperature :: EventSource (Sensed Double) () }
-- > data Actuators = FridgePower PowerChange deriving (Show)
-- > 
-- > fridge :: Automation Sensors Actuators ()
-- > fridge = do
-- >	btemperature <- sensedBehavior fridgeTemperature
-- >	let bpowerchange = calcpowerchange <$> btemperature
-- >	actuateBehavior bpowerchange FridgePower
-- >   where
-- >	calcpowerchange (Sensed temp)
-- >		| temp `belowRange` allowedtemp = Just PowerOff
-- >		| temp `aboveRange` allowedtemp = Just PowerOn
-- >		| otherwise = Nothing
-- >	calcpowerchange SensorUnavailable = Nothing
-- >	allowedtemp = Range 1 4
-- 
-- Automation is a wrapper around reactive-banana's `MomentIO`,
-- but without the `MonadIO` instance, so this monad
-- is limited to using its sensors and actuators for IO. That allows
-- it to be fully tested using `observeAutomation`.
newtype Automation sensors actuators a = Automation
	{ 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 = ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO ()
a ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
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 = ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (() -> ReaderT (sensors, actuators -> IO ()) MomentIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

instance Functor (Automation sensors actuators) where
	fmap :: (a -> b)
-> Automation sensors actuators a -> Automation sensors actuators b
fmap a -> b
f = ReaderT (sensors, actuators -> IO ()) MomentIO b
-> Automation sensors actuators b
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO b
 -> Automation sensors actuators b)
-> (Automation sensors actuators a
    -> ReaderT (sensors, actuators -> IO ()) MomentIO b)
-> Automation sensors actuators a
-> Automation sensors actuators b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b)
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
-> ReaderT (sensors, actuators -> IO ()) MomentIO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ReaderT (sensors, actuators -> IO ()) MomentIO a
 -> ReaderT (sensors, actuators -> IO ()) MomentIO b)
-> (Automation sensors actuators a
    -> ReaderT (sensors, actuators -> IO ()) MomentIO a)
-> Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation

instance Applicative (Automation sensors actuators) where
	pure :: a -> Automation sensors actuators a
pure = ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO a
 -> Automation sensors actuators a)
-> (a -> ReaderT (sensors, actuators -> IO ()) MomentIO a)
-> a
-> Automation sensors actuators a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT (sensors, actuators -> IO ()) MomentIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
	Automation sensors actuators (a -> b)
f <*> :: Automation sensors actuators (a -> b)
-> Automation sensors actuators a -> Automation sensors actuators b
<*> Automation sensors actuators a
a = ReaderT (sensors, actuators -> IO ()) MomentIO b
-> Automation sensors actuators b
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO b
 -> Automation sensors actuators b)
-> ReaderT (sensors, actuators -> IO ()) MomentIO b
-> Automation sensors actuators b
forall a b. (a -> b) -> a -> b
$ Automation sensors actuators (a -> b)
-> ReaderT (sensors, actuators -> IO ()) MomentIO (a -> b)
forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation Automation sensors actuators (a -> b)
f ReaderT (sensors, actuators -> IO ()) MomentIO (a -> b)
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
-> ReaderT (sensors, actuators -> IO ()) MomentIO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
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 >>= :: Automation sensors actuators a
-> (a -> Automation sensors actuators b)
-> Automation sensors actuators b
>>= a -> Automation sensors actuators b
g = ReaderT (sensors, actuators -> IO ()) MomentIO b
-> Automation sensors actuators b
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO b
 -> Automation sensors actuators b)
-> ReaderT (sensors, actuators -> IO ()) MomentIO b
-> Automation sensors actuators b
forall a b. (a -> b) -> a -> b
$ Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation Automation sensors actuators a
m ReaderT (sensors, actuators -> IO ()) MomentIO a
-> (a -> ReaderT (sensors, actuators -> IO ()) MomentIO b)
-> ReaderT (sensors, actuators -> IO ()) MomentIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Automation sensors actuators b
-> ReaderT (sensors, actuators -> IO ()) MomentIO b
forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation (Automation sensors actuators b
 -> ReaderT (sensors, actuators -> IO ()) MomentIO b)
-> (a -> Automation sensors actuators b)
-> a
-> ReaderT (sensors, actuators -> IO ()) MomentIO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Automation sensors actuators b
g

instance MonadFix (Automation sensors actuators) where
	mfix :: (a -> Automation sensors actuators a)
-> Automation sensors actuators a
mfix a -> Automation sensors actuators a
f = ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO a
 -> Automation sensors actuators a)
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
forall a b. (a -> b) -> a -> b
$ (a -> ReaderT (sensors, actuators -> IO ()) MomentIO a)
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation (Automation sensors actuators a
 -> ReaderT (sensors, actuators -> IO ()) MomentIO a)
-> (a -> Automation sensors actuators a)
-> a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Automation sensors actuators a
f)

-- | All of "Reactive.Banana.Combinators" can be used with this monad.
instance MonadMoment (Automation sensors actuators) where
	liftMoment :: Moment a -> Automation sensors actuators a
liftMoment = MomentIO a -> Automation sensors actuators a
forall a sensors actuators.
MomentIO a -> Automation sensors actuators a
liftMomentIO (MomentIO a -> Automation sensors actuators a)
-> (Moment a -> MomentIO a)
-> Moment a
-> Automation sensors actuators a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Moment a -> MomentIO a
forall (m :: * -> *) a. MonadMoment m => Moment a -> m a
liftMoment

-- | Allows "Reactive.Banana.Framework" to be used with this monad.
liftMomentIO :: MomentIO a -> Automation sensors actuators a
liftMomentIO :: MomentIO a -> Automation sensors actuators a
liftMomentIO = ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO a
 -> Automation sensors actuators a)
-> (MomentIO a -> ReaderT (sensors, actuators -> IO ()) MomentIO a)
-> MomentIO a
-> Automation sensors actuators a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MomentIO a -> ReaderT (sensors, actuators -> IO ()) MomentIO a
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 :: 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 (MomentIO () -> IO EventNetwork) -> MomentIO () -> IO EventNetwork
forall a b. (a -> b) -> a -> b
$ (ReaderT (sensors, actuators -> IO ()) MomentIO ()
 -> (sensors, actuators -> IO ()) -> MomentIO ())
-> (sensors, actuators -> IO ())
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> MomentIO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> (sensors, actuators -> IO ()) -> MomentIO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (sensors
sensors, actuators -> IO ()
actuators) (ReaderT (sensors, actuators -> IO ()) MomentIO () -> MomentIO ())
-> ReaderT (sensors, actuators -> IO ()) MomentIO () -> MomentIO ()
forall a b. (a -> b) -> a -> b
$ Automation sensors actuators ()
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
forall sensors actuators a.
Automation sensors actuators a
-> ReaderT (sensors, actuators -> IO ()) MomentIO a
unAutomation Automation sensors actuators ()
automation
	EventNetwork -> IO ()
actuate EventNetwork
network
	sensors -> IO sensors
forall (m :: * -> *) a. Monad m => a -> m a
return sensors
sensors

-- | Runs an Automation, given a constructor for the sensors, an IO
-- action to drive the actuators, and an IO action that feeds data into
-- the sensors.
-- 
-- Continuing the above example of a fridge, here's how to run it:
-- 
-- > mkSensors :: IO Sensors
-- > mkSensors = Sensors <$> newEventSource ()
-- > 
-- > driveActuators :: Actuators -> IO ()
-- > driveActuators = print
-- >
-- > getFridgeTemperature :: IO Double
-- > getFridgeTemperature = ...
-- > 
-- > main = runAutomation fridge mkSensors driveActuators $ \sensors -> do
-- > 	getFridgeTemperature >>= sensed (fridgeTemperature sensors)
--
-- Note that this function does not return; the sensor feeding action is
-- run in a loop.
runAutomation :: Automation sensors actuators () -> IO sensors -> (actuators -> IO ()) -> (sensors -> IO ()) -> IO ()
runAutomation :: 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 <- Automation sensors actuators ()
-> IO sensors -> (actuators -> IO ()) -> IO sensors
forall sensors actuators.
Automation sensors actuators ()
-> IO sensors -> (actuators -> IO ()) -> IO sensors
setupAutomation Automation sensors actuators ()
automation IO sensors
mksensors actuators -> IO ()
actuators
	sensors -> IO ()
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

-- | Allows observing what an Automation does. Designed to be especially
-- useful for testing.
--
-- The Automation is started, and a runner action is returned.
-- The runner allows updating the sensors, and returns what the
-- Automation wants to do in response.
--
-- For example, in ghci:
--
-- > > runner <- observeAutomation fridge mkSensors
-- > > runner $ \sensors -> fridgeTemperature sensors =: 6
-- > [FridgeRelay PowerOn]
-- > > runner $ \sensors -> fridgeTemperature sensors =: 3
-- > []
-- > > runner $ \sensors -> fridgeTemperature sensors =: 0.5
-- > [FridgeRelay PowerOff]
--
-- Note that internal state is maintained between calls to the runner.
observeAutomation :: Automation sensors actuators () -> IO sensors -> IO ((sensors -> IO ()) -> IO [actuators])
observeAutomation :: Automation sensors actuators ()
-> IO sensors -> IO ((sensors -> IO ()) -> IO [actuators])
observeAutomation Automation sensors actuators ()
automation IO sensors
mksensors = do
	TVar [actuators]
tv <- [actuators] -> IO (TVar [actuators])
forall a. a -> IO (TVar a)
newTVarIO []
	TMVar ()
lck <- IO (TMVar ())
forall a. IO (TMVar a)
newEmptyTMVarIO
	let addeffect :: actuators -> IO ()
addeffect actuators
e = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar [actuators] -> ([actuators] -> [actuators]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [actuators]
tv (actuators
eactuators -> [actuators] -> [actuators]
forall a. a -> [a] -> [a]
:)
	sensors
sensors <- Automation sensors actuators ()
-> IO sensors -> (actuators -> IO ()) -> IO 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
		-- Avoid concurrent calls, since there is only one
		-- tv to collect effects.
		STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar () -> () -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
lck ()
		() <- sensors -> IO ()
a sensors
sensors
		[actuators]
l <- STM [actuators] -> IO [actuators]
forall a. STM a -> IO a
atomically (STM [actuators] -> IO [actuators])
-> STM [actuators] -> IO [actuators]
forall a b. (a -> b) -> a -> b
$ do
			TMVar () -> STM ()
forall a. TMVar a -> STM a
takeTMVar TMVar ()
lck
			TVar [actuators] -> [actuators] -> STM [actuators]
forall a. TVar a -> a -> STM a
swapTVar TVar [actuators]
tv []
		[actuators] -> IO [actuators]
forall (m :: * -> *) a. Monad m => a -> m a
return ([actuators] -> [actuators]
forall a. [a] -> [a]
reverse [actuators]
l)
	((sensors -> IO ()) -> IO [actuators])
-> IO ((sensors -> IO ()) -> IO [actuators])
forall (m :: * -> *) a. Monad m => a -> m a
return (sensors -> IO ()) -> IO [actuators]
runner

-- | A source of events.
--
-- `v` is unused by this library, but is provided in case you
-- need a way to track some extra data about an EventSource such as, for
-- example, the timestamp of the most recent event.
data EventSource a v = EventSource
	{ EventSource a v -> (AddHandler a, a -> IO ())
getEventSource :: (AddHandler a, a -> IO ())
	, EventSource a v -> v
fromEventSource :: v
	-- ^ Get extra data from an EventSource.
	}

-- | Construct a new EventSource.
newEventSource :: v -> IO (EventSource a v)
newEventSource :: v -> IO (EventSource a v)
newEventSource v
v = (AddHandler a, a -> IO ()) -> v -> EventSource a v
forall a v. (AddHandler a, a -> IO ()) -> v -> EventSource a v
EventSource ((AddHandler a, a -> IO ()) -> v -> EventSource a v)
-> IO (AddHandler a, a -> IO ()) -> IO (v -> EventSource a v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (AddHandler a, a -> IO ())
forall a. IO (AddHandler a, Handler a)
newAddHandler IO (v -> EventSource a v) -> IO v -> IO (EventSource a v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> v -> IO v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v

addHandler :: EventSource a v -> AddHandler a
addHandler :: EventSource a v -> AddHandler a
addHandler = (AddHandler a, a -> IO ()) -> AddHandler a
forall a b. (a, b) -> a
fst ((AddHandler a, a -> IO ()) -> AddHandler a)
-> (EventSource a v -> (AddHandler a, a -> IO ()))
-> EventSource a v
-> AddHandler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventSource a v -> (AddHandler a, a -> IO ())
forall a v. EventSource a v -> (AddHandler a, a -> IO ())
getEventSource

-- | Call this to trigger an event.
gotEvent :: EventSource a v -> a -> IO ()
gotEvent :: EventSource a v -> a -> IO ()
gotEvent = (AddHandler a, a -> IO ()) -> a -> IO ()
forall a b. (a, b) -> b
snd ((AddHandler a, a -> IO ()) -> a -> IO ())
-> (EventSource a v -> (AddHandler a, a -> IO ()))
-> EventSource a v
-> a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventSource a v -> (AddHandler a, a -> IO ())
forall a v. EventSource a v -> (AddHandler a, a -> IO ())
getEventSource

-- | Get an Event from an EventSource.
getEventFrom :: (sensors -> EventSource a v) -> Automation sensors actuators (Event a)
getEventFrom :: (sensors -> EventSource a v)
-> Automation sensors actuators (Event a)
getEventFrom sensors -> EventSource a v
getsensor = ReaderT (sensors, actuators -> IO ()) MomentIO (Event a)
-> Automation sensors actuators (Event a)
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO (Event a)
 -> Automation sensors actuators (Event a))
-> ReaderT (sensors, actuators -> IO ()) MomentIO (Event a)
-> Automation sensors actuators (Event a)
forall a b. (a -> b) -> a -> b
$ do
	EventSource a v
sensor <- sensors -> EventSource a v
getsensor (sensors -> EventSource a v)
-> ((sensors, actuators -> IO ()) -> sensors)
-> (sensors, actuators -> IO ())
-> EventSource a v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (sensors, actuators -> IO ()) -> sensors
forall a b. (a, b) -> a
fst ((sensors, actuators -> IO ()) -> EventSource a v)
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (sensors, actuators -> IO ())
-> ReaderT (sensors, actuators -> IO ()) MomentIO (EventSource a v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (sensors, actuators -> IO ())
  MomentIO
  (sensors, actuators -> IO ())
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
	MomentIO (Event a)
-> ReaderT (sensors, actuators -> IO ()) MomentIO (Event a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MomentIO (Event a)
 -> ReaderT (sensors, actuators -> IO ()) MomentIO (Event a))
-> MomentIO (Event a)
-> ReaderT (sensors, actuators -> IO ()) MomentIO (Event a)
forall a b. (a -> b) -> a -> b
$ AddHandler a -> MomentIO (Event a)
forall a. AddHandler a -> MomentIO (Event a)
fromAddHandler (AddHandler a -> MomentIO (Event a))
-> AddHandler a -> MomentIO (Event a)
forall a b. (a -> b) -> a -> b
$ EventSource a v -> AddHandler a
forall a v. EventSource a v -> AddHandler a
addHandler EventSource a v
sensor

-- | A value read from a sensor.
--
-- Sensors are sometimes not available, or have not provided a value
-- yet.
data Sensed a = SensorUnavailable | Sensed a
	deriving (Int -> Sensed a -> ShowS
[Sensed a] -> ShowS
Sensed a -> String
(Int -> Sensed a -> ShowS)
-> (Sensed a -> String) -> ([Sensed a] -> ShowS) -> Show (Sensed a)
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, a -> Sensed b -> Sensed a
(a -> b) -> Sensed a -> Sensed b
(forall a b. (a -> b) -> Sensed a -> Sensed b)
-> (forall a b. a -> Sensed b -> Sensed a) -> Functor Sensed
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
<$ :: a -> Sensed b -> Sensed a
$c<$ :: forall a b. a -> Sensed b -> Sensed a
fmap :: (a -> b) -> Sensed a -> Sensed b
$cfmap :: forall a b. (a -> b) -> Sensed a -> Sensed b
Functor, Eq (Sensed a)
Eq (Sensed a)
-> (Sensed a -> Sensed a -> Ordering)
-> (Sensed a -> Sensed a -> Bool)
-> (Sensed a -> Sensed a -> Bool)
-> (Sensed a -> Sensed a -> Bool)
-> (Sensed a -> Sensed a -> Bool)
-> (Sensed a -> Sensed a -> Sensed a)
-> (Sensed a -> Sensed a -> Sensed a)
-> Ord (Sensed a)
Sensed a -> Sensed a -> Bool
Sensed a -> Sensed a -> Ordering
Sensed a -> Sensed a -> Sensed a
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
$cp1Ord :: forall a. Ord a => Eq (Sensed a)
Ord, Sensed a -> Sensed a -> Bool
(Sensed a -> Sensed a -> Bool)
-> (Sensed a -> Sensed a -> Bool) -> Eq (Sensed a)
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)

-- | Create an Event from sensed values.
--
-- The Event only contains values when the sensor provided a reading,
-- not times when it was unavailable.
sensedEvent :: (sensors -> EventSource (Sensed a) v) -> Automation sensors actuators (Event a)
sensedEvent :: (sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event a)
sensedEvent sensors -> EventSource (Sensed a) v
getsensor = do
	Event (Sensed a)
e <- (sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event (Sensed a))
forall sensors a v actuators.
(sensors -> EventSource a v)
-> Automation sensors actuators (Event a)
getEventFrom sensors -> EventSource (Sensed a) v
getsensor
	Event a -> Automation sensors actuators (Event a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event a -> Automation sensors actuators (Event a))
-> Event a -> Automation sensors actuators (Event a)
forall a b. (a -> b) -> a -> b
$ Event (Maybe a) -> Event a
forall a. Event (Maybe a) -> Event a
filterJust (Event (Maybe a) -> Event a) -> Event (Maybe a) -> Event a
forall a b. (a -> b) -> a -> b
$ ((Sensed a -> Maybe a) -> Event (Sensed a) -> Event (Maybe a))
-> Event (Sensed a) -> (Sensed a -> Maybe a) -> Event (Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Sensed a -> Maybe a) -> Event (Sensed a) -> Event (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event (Sensed a)
e ((Sensed a -> Maybe a) -> Event (Maybe a))
-> (Sensed a -> Maybe a) -> Event (Maybe a)
forall a b. (a -> b) -> a -> b
$ \case
		Sensed a
SensorUnavailable -> Maybe a
forall a. Maybe a
Nothing
		Sensed a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | Create a Behavior from sensed values.
sensedBehavior :: (sensors -> EventSource (Sensed a) v) -> Automation sensors actuators (Behavior (Sensed a))
sensedBehavior :: (sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Behavior (Sensed a))
sensedBehavior sensors -> EventSource (Sensed a) v
getsensor = Event (Sensed a)
-> Automation sensors actuators (Behavior (Sensed a))
forall a sensors actuators.
Event (Sensed a)
-> Automation sensors actuators (Behavior (Sensed a))
sensedEventBehavior (Event (Sensed a)
 -> Automation sensors actuators (Behavior (Sensed a)))
-> Automation sensors actuators (Event (Sensed a))
-> Automation sensors actuators (Behavior (Sensed a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event (Sensed a))
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 :: Event (Sensed a)
-> Automation sensors actuators (Behavior (Sensed a))
sensedEventBehavior = Sensed a
-> Event (Sensed a)
-> Automation sensors actuators (Behavior (Sensed a))
forall a sensors actuators.
a -> Event a -> Automation sensors actuators (Behavior a)
automationStepper Sensed a
forall a. Sensed a
SensorUnavailable

-- | `stepper` lifted into `Automation`
automationStepper :: a -> Event a -> Automation sensors actuators (Behavior a)
automationStepper :: a -> Event a -> Automation sensors actuators (Behavior a)
automationStepper a
a Event a
e = MomentIO (Behavior a) -> Automation sensors actuators (Behavior a)
forall a sensors actuators.
MomentIO a -> Automation sensors actuators a
liftMomentIO (MomentIO (Behavior a)
 -> Automation sensors actuators (Behavior a))
-> MomentIO (Behavior a)
-> Automation sensors actuators (Behavior a)
forall a b. (a -> b) -> a -> b
$ a -> Event a -> MomentIO (Behavior a)
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
stepper a
a Event a
e

-- | `changes` lifted into `Automation`
automationChanges :: Behavior a -> Automation sensors actuators (Event (Future a))
automationChanges :: Behavior a -> Automation sensors actuators (Event (Future a))
automationChanges = MomentIO (Event (Future a))
-> Automation sensors actuators (Event (Future a))
forall a sensors actuators.
MomentIO a -> Automation sensors actuators a
liftMomentIO (MomentIO (Event (Future a))
 -> Automation sensors actuators (Event (Future a)))
-> (Behavior a -> MomentIO (Event (Future a)))
-> Behavior a
-> Automation sensors actuators (Event (Future a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior a -> MomentIO (Event (Future a))
forall a. Behavior a -> MomentIO (Event (Future a))
changes

-- | Call when a sensor has sensed a value.
--
-- > getFridgeTemperature >>= sensed (fridgeTemperature sensors)
sensed :: EventSource (Sensed a) v -> a -> IO ()
sensed :: EventSource (Sensed a) v -> a -> IO ()
sensed EventSource (Sensed a) v
s = EventSource (Sensed a) v -> Sensed a -> IO ()
forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (Sensed a) v
s (Sensed a -> IO ()) -> (a -> Sensed a) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Sensed a
forall a. a -> Sensed a
Sensed

-- | Same as `sensed`
-- 
-- > fridgeTemperature sensors =: 0
(=:) :: EventSource (Sensed a) v -> a -> IO ()
=: :: EventSource (Sensed a) v -> a -> IO ()
(=:) = EventSource (Sensed a) v -> a -> IO ()
forall a v. EventSource (Sensed a) v -> a -> IO ()
sensed

-- | Call when a sensor is unavailable.
sensorUnavailable :: EventSource (Sensed a) v -> IO ()
sensorUnavailable :: EventSource (Sensed a) v -> IO ()
sensorUnavailable EventSource (Sensed a) v
s = EventSource (Sensed a) v -> Sensed a -> IO ()
forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (Sensed a) v
s Sensed a
forall a. Sensed a
SensorUnavailable

-- | A timestamped value.
--
-- In reactive-banana, an `Event` is tagged with its time of occurrence,
-- but that internal representation of time is never exposed. It can be
-- useful to have an `Event` timestamped as occurring at a specific wall
-- clock time.
--
-- See `Reactive.Banana.Examples.motionActivatedLight` for an example
-- of using timestamped values, and how to test code that uses them.
data Timestamped t a = Timestamped
	{ Timestamped t a -> t
timestamp :: t
	, 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) = t -> String
forall a. Show a => a -> String
show t
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a

instance Functor (Timestamped t) where
	fmap :: (a -> b) -> Timestamped t a -> Timestamped t b
fmap a -> b
f (Timestamped t
t a
a) = t -> b -> Timestamped t b
forall t a. t -> a -> Timestamped t a
Timestamped t
t (a -> b
f a
a)

-- | Class of values that are timestamps.
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 (ZonedTime -> LocalTime) -> IO ZonedTime -> IO LocalTime
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 (LocalTime -> TimeOfDay) -> IO LocalTime -> IO TimeOfDay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO LocalTime
forall t. Timestamp t => IO t
getCurrentTimestamp

-- | Call when a sensor has sensed a value, which will be `Timestamped` with
-- the current time.
sensedNow :: Timestamp t => EventSource (Sensed (Timestamped t a)) v -> a -> IO ()
sensedNow :: EventSource (Sensed (Timestamped t a)) v -> a -> IO ()
sensedNow EventSource (Sensed (Timestamped t a)) v
es a
a = do
	t
now <- IO t
forall t. Timestamp t => IO t
getCurrentTimestamp
	EventSource (Sensed (Timestamped t a)) v
-> Sensed (Timestamped t a) -> IO ()
forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (Sensed (Timestamped t a)) v
es (Timestamped t a -> Sensed (Timestamped t a)
forall a. a -> Sensed a
Sensed (t -> a -> Timestamped t a
forall t a. t -> a -> Timestamped t a
Timestamped t
now a
a))

-- | Call when a sensor sensed a value with a particular timestamp.
sensedAt :: Timestamp t => t -> EventSource (Sensed (Timestamped t a)) v -> a -> IO ()
sensedAt :: t -> EventSource (Sensed (Timestamped t a)) v -> a -> IO ()
sensedAt t
ts EventSource (Sensed (Timestamped t a)) v
es a
a = EventSource (Sensed (Timestamped t a)) v
-> Sensed (Timestamped t a) -> IO ()
forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (Sensed (Timestamped t a)) v
es (Timestamped t a -> Sensed (Timestamped t a)
forall a. a -> Sensed a
Sensed (t -> a -> Timestamped t a
forall t a. t -> a -> Timestamped t a
Timestamped t
ts a
a))

-- | Given a `Timestamped` `Event` and a function, produces an `Event`
-- that contains the elapsed time since the function last matched the
-- event's value.
--
-- `Reactive.Banana.Examples.motionActivatedLight` has a good example
-- of using this.
elapsedTimeSince
	:: (Num t, Timestamp t)
	=> (a -> Bool)
	-> Event (Timestamped t a)
	-> Automation sensors actuators (Event t)
elapsedTimeSince :: (a -> Bool)
-> Event (Timestamped t a)
-> Automation sensors actuators (Event t)
elapsedTimeSince a -> Bool
f Event (Timestamped t a)
event = (Event (Maybe (t, Timestamped t a)) -> Event t)
-> Automation
     sensors actuators (Event (Maybe (t, Timestamped t a)))
-> Automation sensors actuators (Event t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (t, Timestamped t a) -> t)
-> Event (Maybe (t, Timestamped t a)) -> Event t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (t, Timestamped t a) -> t
forall p a. Num p => Maybe (p, Timestamped p a) -> p
reduce) (Automation sensors actuators (Event (Maybe (t, Timestamped t a)))
 -> Automation sensors actuators (Event t))
-> Automation
     sensors actuators (Event (Maybe (t, Timestamped t a)))
-> Automation sensors actuators (Event t)
forall a b. (a -> b) -> a -> b
$ Maybe (t, Timestamped t a)
-> Event (Maybe (t, Timestamped t a) -> Maybe (t, Timestamped t a))
-> Automation
     sensors actuators (Event (Maybe (t, Timestamped t a)))
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event (a -> a) -> m (Event a)
accumE Maybe (t, Timestamped t a)
forall a. Maybe a
Nothing (Event (Maybe (t, Timestamped t a) -> Maybe (t, Timestamped t a))
 -> Automation
      sensors actuators (Event (Maybe (t, Timestamped t a))))
-> Event (Maybe (t, Timestamped t a) -> Maybe (t, Timestamped t a))
-> Automation
     sensors actuators (Event (Maybe (t, Timestamped t a)))
forall a b. (a -> b) -> a -> b
$ Timestamped t a
-> Maybe (t, Timestamped t a) -> Maybe (t, Timestamped t a)
forall t b.
Num t =>
Timestamped t a -> Maybe (t, b) -> Maybe (t, Timestamped t a)
go (Timestamped t a
 -> Maybe (t, Timestamped t a) -> Maybe (t, Timestamped t a))
-> Event (Timestamped t a)
-> Event (Maybe (t, Timestamped t a) -> Maybe (t, Timestamped t a))
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 (Timestamped t a -> a
forall t a. Timestamped t a -> a
value Timestamped t a
v') = (t, Timestamped t a) -> Maybe (t, Timestamped t a)
forall a. a -> Maybe a
Just (Timestamped t a -> t
forall t a. Timestamped t a -> t
timestamp Timestamped t a
v', Timestamped t a
v')
		| Bool
otherwise = (t, Timestamped t a) -> Maybe (t, Timestamped t a)
forall a. a -> Maybe a
Just (t
t, Timestamped t a
v')
	go Timestamped t a
v Maybe (t, b)
Nothing
		| a -> Bool
f (Timestamped t a -> a
forall t a. Timestamped t a -> a
value Timestamped t a
v) = (t, Timestamped t a) -> Maybe (t, Timestamped t a)
forall a. a -> Maybe a
Just (t
0, Timestamped t a
v)
		| Bool
otherwise = Maybe (t, Timestamped t a)
forall a. Maybe a
Nothing
	reduce :: Maybe (p, Timestamped p a) -> p
reduce (Just (p
t, Timestamped p a
v)) = Timestamped p a -> p
forall t a. Timestamped t a -> t
timestamp Timestamped p a
v p -> p -> p
forall a. Num a => a -> a -> a
- p
t
	reduce Maybe (p, Timestamped p a)
Nothing = p
0

-- | A clock signal.
--
-- See `Reactive.Banana.Examples.nightLight` for an example
-- of using clock signals, and how to test code that uses them.
--
-- It's recommended that any `Behavior` that contains a `ClockSignal`
-- be constructed to update whenever the clock signals an update.
data ClockSignal a = ClockSignal a
	deriving (Int -> ClockSignal a -> ShowS
[ClockSignal a] -> ShowS
ClockSignal a -> String
(Int -> ClockSignal a -> ShowS)
-> (ClockSignal a -> String)
-> ([ClockSignal a] -> ShowS)
-> Show (ClockSignal a)
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
(ClockSignal a -> ClockSignal a -> Bool)
-> (ClockSignal a -> ClockSignal a -> Bool) -> Eq (ClockSignal a)
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, Eq (ClockSignal a)
Eq (ClockSignal a)
-> (ClockSignal a -> ClockSignal a -> Ordering)
-> (ClockSignal a -> ClockSignal a -> Bool)
-> (ClockSignal a -> ClockSignal a -> Bool)
-> (ClockSignal a -> ClockSignal a -> Bool)
-> (ClockSignal a -> ClockSignal a -> Bool)
-> (ClockSignal a -> ClockSignal a -> ClockSignal a)
-> (ClockSignal a -> ClockSignal a -> ClockSignal a)
-> Ord (ClockSignal a)
ClockSignal a -> ClockSignal a -> Bool
ClockSignal a -> ClockSignal a -> Ordering
ClockSignal a -> ClockSignal a -> ClockSignal a
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
$cp1Ord :: forall a. Ord a => Eq (ClockSignal a)
Ord, a -> ClockSignal b -> ClockSignal a
(a -> b) -> ClockSignal a -> ClockSignal b
(forall a b. (a -> b) -> ClockSignal a -> ClockSignal b)
-> (forall a b. a -> ClockSignal b -> ClockSignal a)
-> Functor ClockSignal
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
<$ :: a -> ClockSignal b -> ClockSignal a
$c<$ :: forall a b. a -> ClockSignal b -> ClockSignal a
fmap :: (a -> b) -> ClockSignal a -> ClockSignal b
$cfmap :: forall a b. (a -> b) -> ClockSignal a -> ClockSignal b
Functor)

-- | Call repeatedly to feed a clock signal to an `Automation`
-- that needs to know what time it is.
clockSignal :: Timestamp t => EventSource (ClockSignal t) v -> IO ()
clockSignal :: EventSource (ClockSignal t) v -> IO ()
clockSignal EventSource (ClockSignal t) v
es = EventSource (ClockSignal t) v -> ClockSignal t -> IO ()
forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (ClockSignal t) v
es (ClockSignal t -> IO ()) -> (t -> ClockSignal t) -> t -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ClockSignal t
forall a. a -> ClockSignal a
ClockSignal (t -> IO ()) -> IO t -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO t
forall t. Timestamp t => IO t
getCurrentTimestamp

-- | Call to feed a particular time to an `Automation`.
clockSignalAt :: Timestamp t => t -> EventSource (ClockSignal t) v -> IO ()
clockSignalAt :: t -> EventSource (ClockSignal t) v -> IO ()
clockSignalAt t
t EventSource (ClockSignal t) v
es = EventSource (ClockSignal t) v -> ClockSignal t -> IO ()
forall a v. EventSource a v -> a -> IO ()
gotEvent EventSource (ClockSignal t) v
es (t -> ClockSignal t
forall a. a -> ClockSignal a
ClockSignal t
t)

-- | Create a Behavior from a ClockSignal. It will initially be Nothing,
-- and then updates with each incoming clock signal.
clockSignalBehavior
	:: Timestamp t
	=> (sensors -> EventSource (ClockSignal t) v)
	-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
clockSignalBehavior :: (sensors -> EventSource (ClockSignal t) v)
-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
clockSignalBehavior sensors -> EventSource (ClockSignal t) v
getsensor = ReaderT
  (sensors, actuators -> IO ())
  MomentIO
  (Behavior (Maybe (ClockSignal t)))
-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT
   (sensors, actuators -> IO ())
   MomentIO
   (Behavior (Maybe (ClockSignal t)))
 -> Automation sensors actuators (Behavior (Maybe (ClockSignal t))))
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (Behavior (Maybe (ClockSignal t)))
-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
forall a b. (a -> b) -> a -> b
$ do
	EventSource (ClockSignal t) v
sensor <- sensors -> EventSource (ClockSignal t) v
getsensor (sensors -> EventSource (ClockSignal t) v)
-> ((sensors, actuators -> IO ()) -> sensors)
-> (sensors, actuators -> IO ())
-> EventSource (ClockSignal t) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (sensors, actuators -> IO ()) -> sensors
forall a b. (a, b) -> a
fst ((sensors, actuators -> IO ()) -> EventSource (ClockSignal t) v)
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (sensors, actuators -> IO ())
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (EventSource (ClockSignal t) v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (sensors, actuators -> IO ())
  MomentIO
  (sensors, actuators -> IO ())
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
	Event (Maybe (ClockSignal t))
e <- (ClockSignal t -> Maybe (ClockSignal t))
-> Event (ClockSignal t) -> Event (Maybe (ClockSignal t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClockSignal t -> Maybe (ClockSignal t)
forall a. a -> Maybe a
Just (Event (ClockSignal t) -> Event (Maybe (ClockSignal t)))
-> ReaderT
     (sensors, actuators -> IO ()) MomentIO (Event (ClockSignal t))
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (Event (Maybe (ClockSignal t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MomentIO (Event (ClockSignal t))
-> ReaderT
     (sensors, actuators -> IO ()) MomentIO (Event (ClockSignal t))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AddHandler (ClockSignal t) -> MomentIO (Event (ClockSignal t))
forall a. AddHandler a -> MomentIO (Event a)
fromAddHandler (AddHandler (ClockSignal t) -> MomentIO (Event (ClockSignal t)))
-> AddHandler (ClockSignal t) -> MomentIO (Event (ClockSignal t))
forall a b. (a -> b) -> a -> b
$ EventSource (ClockSignal t) v -> AddHandler (ClockSignal t)
forall a v. EventSource a v -> AddHandler a
addHandler EventSource (ClockSignal t) v
sensor)
	MomentIO (Behavior (Maybe (ClockSignal t)))
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (Behavior (Maybe (ClockSignal t)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MomentIO (Behavior (Maybe (ClockSignal t)))
 -> ReaderT
      (sensors, actuators -> IO ())
      MomentIO
      (Behavior (Maybe (ClockSignal t))))
-> MomentIO (Behavior (Maybe (ClockSignal t)))
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (Behavior (Maybe (ClockSignal t)))
forall a b. (a -> b) -> a -> b
$ Maybe (ClockSignal t)
-> Event (Maybe (ClockSignal t))
-> MomentIO (Behavior (Maybe (ClockSignal t)))
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
stepper Maybe (ClockSignal t)
forall a. Maybe a
Nothing Event (Maybe (ClockSignal t))
e

-- | For controlling relays and other things that can have
-- their power turned on and off.
data PowerChange = PowerOff | PowerOn
	deriving (Int -> PowerChange -> ShowS
[PowerChange] -> ShowS
PowerChange -> String
(Int -> PowerChange -> ShowS)
-> (PowerChange -> String)
-> ([PowerChange] -> ShowS)
-> Show PowerChange
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
(PowerChange -> PowerChange -> Bool)
-> (PowerChange -> PowerChange -> Bool) -> Eq PowerChange
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
Eq PowerChange
-> (PowerChange -> PowerChange -> Ordering)
-> (PowerChange -> PowerChange -> Bool)
-> (PowerChange -> PowerChange -> Bool)
-> (PowerChange -> PowerChange -> Bool)
-> (PowerChange -> PowerChange -> Bool)
-> (PowerChange -> PowerChange -> PowerChange)
-> (PowerChange -> PowerChange -> PowerChange)
-> Ord 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
$cp1Ord :: Eq PowerChange
Ord)

-- | Makes an Event drive an actuator.
actuateEvent :: Event a -> (a -> actuators) -> Automation sensors actuators ()
actuateEvent :: Event a -> (a -> actuators) -> Automation sensors actuators ()
actuateEvent Event a
e a -> actuators
getactuator = ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO ()
 -> Automation sensors actuators ())
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall a b. (a -> b) -> a -> b
$ do
	actuators -> IO ()
actuators <- (sensors, actuators -> IO ()) -> actuators -> IO ()
forall a b. (a, b) -> b
snd ((sensors, actuators -> IO ()) -> actuators -> IO ())
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (sensors, actuators -> IO ())
-> ReaderT
     (sensors, actuators -> IO ()) MomentIO (actuators -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (sensors, actuators -> IO ())
  MomentIO
  (sensors, actuators -> IO ())
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
	MomentIO () -> ReaderT (sensors, actuators -> IO ()) MomentIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MomentIO () -> ReaderT (sensors, actuators -> IO ()) MomentIO ())
-> MomentIO () -> ReaderT (sensors, actuators -> IO ()) MomentIO ()
forall a b. (a -> b) -> a -> b
$ Event (IO ()) -> MomentIO ()
reactimate (Event (IO ()) -> MomentIO ()) -> Event (IO ()) -> MomentIO ()
forall a b. (a -> b) -> a -> b
$ (a -> IO ()) -> Event a -> Event (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (actuators -> IO ()
actuators (actuators -> IO ()) -> (a -> actuators) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> actuators
getactuator) Event a
e

-- | Like `actuateEvent` but with a Future, as produced by
-- `automationChanges`
actuateFutureEvent :: Event (Future a) -> (a -> actuators) -> Automation sensors actuators ()
actuateFutureEvent :: Event (Future a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateFutureEvent Event (Future a)
e a -> actuators
getactuator = ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO ()
 -> Automation sensors actuators ())
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall a b. (a -> b) -> a -> b
$ Event (Future a)
-> (a -> actuators)
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
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' :: Event (Future a)
-> (a -> actuators)
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
actuateFutureEvent' Event (Future a)
e a -> actuators
getactuator = do
	actuators -> IO ()
actuators <- (sensors, actuators -> IO ()) -> actuators -> IO ()
forall a b. (a, b) -> b
snd ((sensors, actuators -> IO ()) -> actuators -> IO ())
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (sensors, actuators -> IO ())
-> ReaderT
     (sensors, actuators -> IO ()) MomentIO (actuators -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (sensors, actuators -> IO ())
  MomentIO
  (sensors, actuators -> IO ())
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
	MomentIO () -> ReaderT (sensors, actuators -> IO ()) MomentIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MomentIO () -> ReaderT (sensors, actuators -> IO ()) MomentIO ())
-> MomentIO () -> ReaderT (sensors, actuators -> IO ()) MomentIO ()
forall a b. (a -> b) -> a -> b
$ Event (Future (IO ())) -> MomentIO ()
reactimate' (Event (Future (IO ())) -> MomentIO ())
-> Event (Future (IO ())) -> MomentIO ()
forall a b. (a -> b) -> a -> b
$ (a -> IO ()) -> Future a -> Future (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (actuators -> IO ()
actuators (actuators -> IO ()) -> (a -> actuators) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> actuators
getactuator) (Future a -> Future (IO ()))
-> Event (Future a) -> Event (Future (IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event (Future a)
e

-- | Makes a Behavior drive an actuator. This will happen when the
-- Behavior's value changes, but possibly more often as well, depending on
-- how the Behavior is constructed.
actuateBehavior :: Behavior a -> (a -> actuators) -> Automation sensors actuators ()
actuateBehavior :: Behavior a -> (a -> actuators) -> Automation sensors actuators ()
actuateBehavior Behavior a
b a -> actuators
getactuator = ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO ()
 -> Automation sensors actuators ())
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall a b. (a -> b) -> a -> b
$ do
	Event (Future a)
e <- MomentIO (Event (Future a))
-> ReaderT
     (sensors, actuators -> IO ()) MomentIO (Event (Future a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MomentIO (Event (Future a))
 -> ReaderT
      (sensors, actuators -> IO ()) MomentIO (Event (Future a)))
-> MomentIO (Event (Future a))
-> ReaderT
     (sensors, actuators -> IO ()) MomentIO (Event (Future a))
forall a b. (a -> b) -> a -> b
$ Behavior a -> MomentIO (Event (Future a))
forall a. Behavior a -> MomentIO (Event (Future a))
changes Behavior a
b
	Event (Future a)
-> (a -> actuators)
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
forall a actuators sensors.
Event (Future a)
-> (a -> actuators)
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
actuateFutureEvent' Event (Future a)
e a -> actuators
getactuator

-- | Variant of `actuateBehavior` that does nothing when a behavior
-- is Nothing.
actuateBehaviorMaybe :: Behavior (Maybe a) -> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe :: Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe a)
b a -> actuators
getactuator = ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall sensors actuators a.
ReaderT (sensors, actuators -> IO ()) MomentIO a
-> Automation sensors actuators a
Automation (ReaderT (sensors, actuators -> IO ()) MomentIO ()
 -> Automation sensors actuators ())
-> ReaderT (sensors, actuators -> IO ()) MomentIO ()
-> Automation sensors actuators ()
forall a b. (a -> b) -> a -> b
$ do
	actuators -> IO ()
actuators <- (sensors, actuators -> IO ()) -> actuators -> IO ()
forall a b. (a, b) -> b
snd ((sensors, actuators -> IO ()) -> actuators -> IO ())
-> ReaderT
     (sensors, actuators -> IO ())
     MomentIO
     (sensors, actuators -> IO ())
-> ReaderT
     (sensors, actuators -> IO ()) MomentIO (actuators -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (sensors, actuators -> IO ())
  MomentIO
  (sensors, actuators -> IO ())
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
	Event (Future (Maybe a))
c <- MomentIO (Event (Future (Maybe a)))
-> ReaderT
     (sensors, actuators -> IO ()) MomentIO (Event (Future (Maybe a)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MomentIO (Event (Future (Maybe a)))
 -> ReaderT
      (sensors, actuators -> IO ()) MomentIO (Event (Future (Maybe a))))
-> MomentIO (Event (Future (Maybe a)))
-> ReaderT
     (sensors, actuators -> IO ()) MomentIO (Event (Future (Maybe a)))
forall a b. (a -> b) -> a -> b
$ Behavior (Maybe a) -> MomentIO (Event (Future (Maybe a)))
forall a. Behavior a -> MomentIO (Event (Future a))
changes Behavior (Maybe a)
b
	MomentIO () -> ReaderT (sensors, actuators -> IO ()) MomentIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MomentIO () -> ReaderT (sensors, actuators -> IO ()) MomentIO ())
-> MomentIO () -> ReaderT (sensors, actuators -> IO ()) MomentIO ()
forall a b. (a -> b) -> a -> b
$ Event (Future (IO ())) -> MomentIO ()
reactimate' (Event (Future (IO ())) -> MomentIO ())
-> Event (Future (IO ())) -> MomentIO ()
forall a b. (a -> b) -> a -> b
$
		(Maybe a -> IO ()) -> Future (Maybe a) -> Future (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IO () -> (a -> IO ()) -> Maybe a -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (actuators -> IO ()
actuators (actuators -> IO ()) -> (a -> actuators) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> actuators
getactuator)) (Future (Maybe a) -> Future (IO ()))
-> Event (Future (Maybe a)) -> Event (Future (IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event (Future (Maybe a))
c

-- | The range between two values (inclusive).
--
-- Note that the position of the two values in the Range constructor 
-- is not significant; Range 1 10 == Range 10 1
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 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
a2 Bool -> Bool -> Bool
&& t
b1 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
b2 Bool -> Bool -> Bool
||
		t
a1 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
b2 Bool -> Bool -> Bool
&& t
b1 t -> t -> Bool
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
b

-- | Combining two ranges yields a range between their respective lowest
-- and highest values.
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 t -> t -> Range t
forall t. t -> t -> Range t
Range ([t] -> t
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [t]
vals) ([t] -> t
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [t]
vals)

-- | Check if a value is below a range.
belowRange :: Ord t => t -> Range t -> Bool
belowRange :: t -> Range t -> Bool
belowRange t
p (Range t
a t
b) = t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
a Bool -> Bool -> Bool
&& t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
b

-- | Check if a value is above a range.
aboveRange :: Ord t => t -> Range t -> Bool
aboveRange :: t -> Range t -> Bool
aboveRange t
p (Range t
a t
b) = t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
a Bool -> Bool -> Bool
&& t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
b

-- | Check if a value is within a range.
inRange :: Ord t => t -> Range t -> Bool
inRange :: t -> Range t -> Bool
inRange t
p Range t
r = Bool -> Bool
not (t -> Range t -> Bool
forall t. Ord t => t -> Range t -> Bool
belowRange t
p Range t
r) Bool -> Bool -> Bool
&& Bool -> Bool
not (t -> Range t -> Bool
forall t. Ord t => t -> Range t -> Bool
aboveRange t
p Range t
r)

-- | Extends a range up/down to a value.
extendRange :: Ord t => Range t -> t -> Range t
extendRange :: Range t -> t -> Range t
extendRange r :: Range t
r@(Range t
a t
_) t
t = Range t
r Range t -> Range t -> Range t
forall a. Semigroup a => a -> a -> a
<> t -> t -> Range t
forall t. t -> t -> Range t
Range t
a t
t