content: 
  {-# LANGUAGE   LambdaCase
               , TemplateHaskell
               , RecordWildCards
               , OverloadedStrings
               , ScopedTypeVariables
               , FlexibleInstances
               , TypeSynonymInstances
               , GeneralizedNewtypeDeriving
               , DeriveGeneric #-}
  
  module PersistConfig ( configFilePath
                       , PersistConfig(..)
                       , UserData(..)
                       , defaultUserData
                       , pcBridgeIP
                       , pcBridgeUserID
                       , pcUserData
                       , pcScenes
                       , pcSchedules
                       , sHour
                       , sMinute
                       , sScene
                       , sDays
                       , sAction
                       , sTrigStatus
                       , Scene
                       , SceneName
                       , SceneAction(..)
                       , Schedule(..)
                       , ScheduleTriggerStatus(..)
                       , ScheduleName
                       , udVisibleGroupNames
                       , defaultPersistConfig
                       , loadConfig
                       , storeConfig
                       ) where
  
  import Control.Monad
  import Control.Lens hiding ((.=))
  import Control.Monad.IO.Class
  import qualified Data.Yaml as Y
  import Data.Aeson
  import qualified Data.HashMap.Strict as HM
  import qualified Data.HashSet as HS
  import Data.Monoid
  import Data.Coerce
  import GHC.Generics
  
  import Util
  import Trace
  import HueJSON
  
  -- Configuration and user data which we persist in a file
  
  configFilePath :: FilePath
  configFilePath = "./config.yaml" -- TODO: Maybe use ~/.hue-dashboard for this?
  
  -- A scene is a list of light IDs and a map of light state names to values
  type Scene     = [(LightID, (HM.HashMap String Value))]
  type SceneName = String
  type SceneMap  = HM.HashMap SceneName Scene
  
  data ScheduleTriggerStatus = STJustCreated      -- Just added, determine what to do
                             | STAlreadyTriggered -- Don't trigger today
                             | STPending          -- Trigger at earliest convenience after due time
                               deriving (Eq, Show)
  
   -- TODO: Add action that does the 15s blinking alert
  data SceneAction = SAActivate | SAActivateSlow | SATurnOff | SABlink
                     deriving (Eq, Show, Generic)
  
  instance FromJSON SceneAction
  instance ToJSON SceneAction
  
  -- Schedules
  data Schedule = Schedule { _sHour       :: !Int
                           , _sMinute     :: !Int
                           , _sScene      :: !SceneName
                           , _sDays       :: ![Bool]
                           , _sAction     :: !SceneAction
                             -- We don't serialize or compare this, only for the
                             -- scheduleWatcher thread to keep track of status
                           , _sTrigStatus :: !ScheduleTriggerStatus
                           } deriving Show
  type ScheduleName = String
  type ScheduleMap  = HM.HashMap ScheduleName Schedule
  
  makeLenses ''Schedule
  
  defaultSchedule :: Schedule
  defaultSchedule = Schedule 16 30 "SceneName" (replicate 7 True) SAActivate STJustCreated
  
  instance FromJSON Schedule where
      parseJSON (Object o) =
          Schedule <$> o .:? "_sHour"   .!= _sHour   defaultSchedule
                   <*> o .:? "_sMinute" .!= _sMinute defaultSchedule
                   <*> o .:? "_sScene"  .!= _sScene  defaultSchedule
                   <*> o .:? "_sDays"   .!= _sDays   defaultSchedule
                   <*> o .:? "_sAction" .!= _sAction defaultSchedule
                   <*> pure STJustCreated
      parseJSON _ = mzero
  
  instance ToJSON Schedule where
     toJSON Schedule { .. } =
        object [ "_sHour"   .= _sHour
               , "_sMinute" .= _sMinute
               , "_sScene"  .= _sScene
               , "_sDays"   .= _sDays
               , "_sAction" .= _sAction
               ]
  
  -- Ignore sTrigStatus, just a runtime artifact. Don't write
  -- configuration to disk again because it changed
  instance Eq Schedule where
      (==) a b = a ^. sHour   == b ^. sHour   &&
                 a ^. sMinute == b ^. sMinute &&
                 a ^. sScene  == b ^. sScene  &&
                 a ^. sDays   == b ^. sDays   &&
                 a ^. sAction == b ^. sAction
  
  -- User data
  
  data UserData = UserData
      { _udVisibleGroupNames :: !(HS.HashSet GroupName) -- Groups which are not hidden / collapsed
      } deriving (Show, Eq)
  
  makeLenses ''UserData
  
  type UserDataMap = HM.HashMap CookieUserID UserData
  
  defaultUserData :: UserData
  defaultUserData = UserData HS.empty
  
  instance FromJSON UserData where
      parseJSON (Object o) =
          UserData <$> o .:? "_udVisibleGroupNames" .!= _udVisibleGroupNames defaultUserData
      parseJSON _ = mzero
  
  instance ToJSON UserData where
     toJSON UserData { .. }  =
        object [ "_udVisibleGroupNames" .= _udVisibleGroupNames
               ]
  
  -- The newtype wrappers for the various string types give us problems with missing JSON
  -- instances, just use coerce to safely reuse the ones we already got for plain String
  instance FromJSON (HM.HashMap CookieUserID UserData) where
      parseJSON v = (\(a :: HM.HashMap String UserData) -> coerce a) <$> parseJSON v
  instance ToJSON (HM.HashMap CookieUserID UserData) where
      toJSON v = toJSON (coerce v :: HM.HashMap String UserData)
  
  -- TODO: Over time orphan data such as visibility information for non-existing groups
  --       and user data for already discarded cookies can build up in here, bloating the
  --       configuration file. Consider keeping timestamps on things, purging them
  
  data PersistConfig = PersistConfig
      { _pcBridgeIP     :: !IPAddress    -- IP address of the bridge
      , _pcBridgeUserID :: !BridgeUserID -- Hue bridge user ID for
      , _pcUserData     :: !UserDataMap  -- User ID cookie to user data
      , _pcScenes       :: !SceneMap     -- Scene name to scene settings
      , _pcSchedules    :: !ScheduleMap  -- Schedule name to schedule parameters
      } deriving (Show, Eq)
  
  makeLenses ''PersistConfig
  
  defaultPersistConfig :: PersistConfig
  defaultPersistConfig = PersistConfig (IPAddress "") (BridgeUserID "") HM.empty HM.empty HM.empty
  
  instance FromJSON PersistConfig where
      parseJSON (Object o) =
        PersistConfig <$> o .:? "_pcBridgeIP"  .!= _pcBridgeIP     defaultPersistConfig
                      <*> o .:? "_pcUserID"    .!= _pcBridgeUserID defaultPersistConfig
                      <*> o .:? "_pcUserData"  .!= _pcUserData     defaultPersistConfig
                      <*> o .:? "_pcScenes"    .!= _pcScenes       defaultPersistConfig
                      <*> o .:? "_pcSchedules" .!= _pcSchedules    defaultPersistConfig
      parseJSON _ = mzero
  
  instance ToJSON PersistConfig where
     toJSON PersistConfig { .. }  =
         object [ "_pcBridgeIP"  .= _pcBridgeIP
                , "_pcUserID"    .= _pcBridgeUserID
                , "_pcUserData"  .= _pcUserData
                , "_pcScenes"    .= _pcScenes
                , "_pcSchedules" .= _pcSchedules
                ]
  
  -- Load / store / create persistent configuration
  
  loadConfig :: MonadIO m => FilePath -> m (Maybe PersistConfig)
  loadConfig fn = do
      -- Try to load persistent configuration into the state
      traceS TLInfo $ "Loading persistent configuration from'" <> fn <> "'"
      (liftIO $ Y.decodeFileEither fn) >>= \case
          Left e    -> do traceS TLError $
                           "Can't load configuration: " <> (Y.prettyPrintParseException e)
                          traceS TLInfo "Proceeding without prior configuration data"
                          return Nothing
          Right cfg -> do traceS TLInfo $ "Configuration (truncated): " <> (take 2048 $ show cfg)
                          return $ Just cfg
  
  storeConfig :: MonadIO m => FilePath -> PersistConfig -> m ()
  storeConfig fn cfg =
      liftIO $ Y.encodeFile fn cfg
  
  