{-# LANGUAGE Arrows #-}
{-# LANGUAGE OverloadedStrings #-}
module HomeAssistant.Controller.Children where
import HomeAssistant.Controller (HASS, callService, Target (AreaId), light, Light(..))
import AFRP (Event)
import qualified AFRP
import Control.Arrow (Arrow(..), (>>>))
import Data.Time (Day, TimeOfDay (..), localDay, LocalTime (..))
import Data.Time.Calendar.OrdinalDate (WeekOfYear, mondayStartWeek)
import Data.Functor.Contravariant (Predicate (..), (>$<))

-- Let's see building some reasonable interface for utctime
dow :: Day -> (WeekOfYear, Int)
dow = mondayStartWeek


weekday :: Predicate Day
weekday = Predicate (betweenInclusive 1 5 . snd . dow)
  where
    betweenInclusive a b c = c >= a && c <= b

time :: (Int, Int) -> Predicate TimeOfDay
time (h,m) = mconcat
  [ Predicate (equals h . todHour)
  , Predicate (equals m . todMin)
  ]
  where
    equals a b = a == b


atTime :: Predicate LocalTime -> HASS a (Event ())
atTime p = AFRP.currentTime
  >>> arr (getPredicate p)
  >>> AFRP.edge

-- I don't have any proper presence sensors in their bedroom
-- and they are notoriously bad at changing clothes in complete darkness
-- So I have set up an automation that attempts to turn on the lights sometime
-- before they leave for school and turns them off a bit later

-- Don't mconcat these predicates they have && behavior
-- if you mconcat the actual arrows, they combine the behaviors of the separate branches
-- essentially becoming || behavior
timersOff :: [Predicate LocalTime]
timersOff =
  [ day 1 <> at (08,15)
  , day 2 <> at (09,15)
  , day 3 <> at (08,15)
  , day 4 <> at (08,15)
  , day 5 <> at (08,15)
  , at (18,57) -- debug
  ]
  where
    dayOfWeek = snd . mondayStartWeek . localDay
    at (h,m) = localTimeOfDay >$< Predicate (\TimeOfDay{todHour, todMin} -> todHour == h && todMin == m)
    day n = dayOfWeek >$< Predicate (== n)

timersOn :: [Predicate LocalTime]
timersOn =
  [ day 1 <> at (07,30)
  , day 2 <> at (08,30)
  , day 3 <> at (07,30)
  , day 4 <> at (07,30)
  , day 5 <> at (07,30)
  , at (18,55) -- debug
  ]
  where
    dayOfWeek = snd . mondayStartWeek . localDay
    at (h,m) = localTimeOfDay >$< Predicate (\TimeOfDay{todHour, todMin} -> todHour == h && todMin == m)
    day n = dayOfWeek >$< Predicate (== n)

schoolLightController :: HASS a ()
schoolLightController = lightsOn <> lightsOff


lightsOn :: HASS a ()
lightsOn = foldMap atTime timersOn
  >>> AFRP.onEvent (callService (light [AreaId "lasten_makuuhuone"] On{brightnessPercentage = Just 100}))

lightsOff :: HASS a ()
lightsOff = foldMap atTime timersOff
  >>> AFRP.onEvent (callService (light [AreaId "lasten_makuuhuone"] Off))