Demo.hs

{- Controlling a hot water heater.
 -
 - This shows how additional types can be used to eg, keep track of units
 - of measurement, while using the Copilot DSL.
 -}

{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE EmptyDataDecls #-}

module Examples.WaterHeater.Demo where

import Copilot.Arduino.Uno
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as L

-- For use as phantom types in TypedBehavior
data PSI
data Celsius

maxSafePSI :: TypedBehavior PSI Float
maxSafePSI = TypedBehavior (constant 45)

maxWaterTemp :: TypedBehavior Celsius Float
maxWaterTemp = TypedBehavior (constant 35)

warmWaterTemp :: TypedBehavior Celsius Float
warmWaterTemp = TypedBehavior (constant 30)

isSafeTemp :: TypedBehavior Celsius Float -> Behavior Bool
isSafeTemp t = liftB2 (<) t maxWaterTemp

isSafePSI :: TypedBehavior PSI Float -> Behavior Bool
isSafePSI p = liftB2 (<) p maxSafePSI

-- Avoid explosions and scalding water.
isSafeToHeat :: TypedBehavior PSI Float -> NonEmpty (TypedBehavior Celsius Float) -> Behavior Bool
isSafeToHeat p cs = foldl (&&) (isSafePSI p) (L.map isSafeTemp cs)

-- Convert a raw value read from an ADC into a temperature in Celsius.
--
-- Assumes the ADC value is 0 at 0F, and 1024 at 200F.
adcToCelsius :: Behavior ADC -> TypedBehavior Celsius Float
adcToCelsius v = TypedBehavior $ v' * (constant 200 / constant 1024)
  where
	v' :: Behavior Float
	v' = unsafeCast v

-- Convert a raw value read from an ADC into a PSI.
--
-- Assumes the ADCI value is 0 at 0 PSI, and 1024 at 150 PSI.
adcToPSI :: Behavior ADC -> TypedBehavior PSI Float
adcToPSI v = TypedBehavior $ v' * (constant 150 / constant 1024)
  where
	v' :: Behavior Float
	v' = unsafeCast v

main :: IO ()
main = arduino $ do
	uppertemp <- adcToCelsius <$> input a1
	lowertemp <- adcToCelsius <$> input a2
	pressure <- adcToPSI <$> input a3
	let upperheatingelement = pin4
	let lowerheatingelement = pin5
	whenB (isSafeToHeat pressure (uppertemp :| [lowertemp])) $ do
		-- Run the upper heating element if the upper water temp is
		-- low, to provide hot water on demand. Run the lower
		-- heating element only when the upper is off.
		let runupper = liftB2 (<) uppertemp warmWaterTemp
		upperheatingelement =: runupper
		lowerheatingelement =: not runupper
	delay =: MilliSeconds 1000