content: 
  {-# LANGUAGE   TemplateHaskell
               , OverloadedStrings
               , RecordWildCards
               , LambdaCase
               , ScopedTypeVariables
               , FlexibleInstances
               , TypeSynonymInstances
               , GeneralizedNewtypeDeriving #-}
  
  module HueJSON where
  
  import Data.Aeson
  import Data.Monoid
  import Data.Char
  import Data.Word
  import Data.Time
  import Data.Attoparsec.Text
  import Data.Hashable
  import Data.Coerce
  import qualified Data.Text as T
  import qualified Data.HashMap.Strict as HM
  import qualified Data.HashSet as HS
  import Control.Lens
  
  import Util
  
  -- Records, lenses and JSON instances for communication with a Hue bridge
  
  -- TODO: Add representations for sensor data
  
  data Light = Light { _lgtState             :: !LightState
                     , _lgtType              :: !ZLL_LightType
                     , _lgtName              :: !String
                     , _lgtModelID           :: !LightModel
                     , _lgtManufacturerName  :: !String
                     , _lgtLuminaireUniqueID :: !(Maybe String)
                     , _lgtUniqueID          :: !String
                     , _lgtSWVersion         :: !String
                     } deriving Show
  
  instance FromJSON Light where
      parseJSON (Object o) = Light <$> o .:  "state"
                                   <*> o .:  "type"
                                   <*> o .:  "name"
                                   <*> o .:  "modelid"
                                   <*> o .:  "manufacturername"
                                   <*> o .:? "luminaireuniqueid"
                                   <*> o .:  "uniqueid"
                                   <*> o .:  "swversion"
      parseJSON _ = fail "Expected object"
  
  -- TODO: Convert the various string arguments to proper ADTs
  data LightState = LightState { _lsOn         :: !Bool
                               , _lsBrightness :: !(Maybe Word8)
                               , _lsHue        :: !(Maybe Word16)
                               , _lsSaturation :: !(Maybe Word8)
                               , _lsEffect     :: !(Maybe String)
                               , _lsXY         :: !(Maybe [Float])
                               , _lsColorTemp  :: !(Maybe Word16)
                               , _lsAlert      :: !String
                               , _lsColorMode  :: !(Maybe ColorMode)
                               , _lsReachable  :: !Bool
                               } deriving Show
  
  instance FromJSON LightState where
      parseJSON (Object o) = LightState <$> o .:  "on"
                                        <*> o .:? "bri"
                                        <*> o .:? "hue"
                                        <*> o .:? "sat"
                                        <*> o .:? "effect"
                                        <*> o .:? "xy"
                                        <*> o .:? "ct"
                                        <*> o .:  "alert"
                                        <*> o .:? "colormode"
                                        <*> o .:  "reachable"
      parseJSON _ = fail "Expected object"
  
  data ColorMode = CMXY | CMCT | CMHS
                   deriving (Eq, Show, Enum)
  
  instance FromJSON ColorMode where
      parseJSON (String s) = case T.unpack s of
                                 "xy" -> return CMXY
                                 "ct" -> return CMCT
                                 "hs" -> return CMHS
                                 str  -> fail $ "Invalid color mode: " <> str
      parseJSON _ = fail "Expected string"
  
  -- Light type
  --
  -- http://www.developers.meethue.com/documentation/supported-lights
  -- http://cache.nxp.com/documents/user_manual/JN-UG-3091.pdf
  data ZLL_LightType = LT_OnOffLight
                     | LT_OnOffPlugInUnit
                     | LT_DimmableLight
                     | LT_DimmablePlugInUnit
                     | LT_ColorLight
                     | LT_ExtendedColorLight
                     | LT_ColorTemperatureLight
                       deriving Enum
  
  instance FromJSON ZLL_LightType where
      parseJSON (String s) =
          case map toLower . T.unpack $ s of
              "on/off light"            -> return LT_OnOffLight
              "on/off plug-in unit"     -> return LT_OnOffPlugInUnit
              "dimmable light"          -> return LT_DimmableLight
              "dimmable plug-in unit"   -> return LT_DimmablePlugInUnit
              "color light"             -> return LT_ColorLight
              "extended color light"    -> return LT_ExtendedColorLight
              "color temperature light" -> return LT_ColorTemperatureLight
              str                       -> fail $ "Unknown / invalid ZLL light type: " <> str
      parseJSON _ = fail "Expected string"
  
  instance Show ZLL_LightType where
      show LT_OnOffLight            = "On/Off Light"
      show LT_OnOffPlugInUnit       = "On/Off Plug-in Unit"
      show LT_DimmableLight         = "Dimmable Light"
      show LT_DimmablePlugInUnit    = "Dimmable Plug-in Unit"
      show LT_ColorLight            = "Color Light"
      show LT_ExtendedColorLight    = "Extended Color Light"
      show LT_ColorTemperatureLight = "Color Temperature Light"
  
  isColorLT :: ZLL_LightType -> Bool
  isColorLT = \case LT_ColorLight         -> True
                    LT_ExtendedColorLight -> True
                    _                     -> False
  
  isCTOnlyLight :: ZLL_LightType -> Bool
  isCTOnlyLight = \case LT_ColorTemperatureLight -> True
                        _                        -> False
  
  isCTLight :: ZLL_LightType -> Bool
  isCTLight = \case LT_ColorTemperatureLight -> True
                    LT_ExtendedColorLight    -> True
                    _                        -> False
  
  isDimmableLT :: ZLL_LightType -> Bool
  isDimmableLT = \case LT_ColorLight            -> True
                       LT_ExtendedColorLight    -> True
                       LT_ColorTemperatureLight -> True
                       LT_DimmableLight         -> True
                       LT_DimmablePlugInUnit    -> True
                       _                        -> False
  
  -- Light model
  --
  -- http://www.developers.meethue.com/documentation/supported-lights
  -- https://github.com/mhop/fhem-mirror/blob/master/fhem/FHEM/31_HUEDevice.pm
  
  data LightModel = LM_HueBulbA19
                  | LM_HueBulbA19V2
                  | LM_HueBulbA19V3
                  | LM_HueSpotBR30
                  | LM_HueSpotGU10
                  | LM_HueBR30
                  | LM_HueCandle
                  | LM_HueLightStrip
                  | LM_HueLivingColorsIris
                  | LM_HueLivingColorsBloom
                  | LM_LivingColorsGen3Iris
                  | LM_LivingColorsGen3BloomAura
                  | LM_LivingColorsAura
                  | LM_HueA19Lux
                  | LM_HueA19White
                  | LM_HueA19WhiteV2
                  | LM_ColorLightModule
                  | LM_ColorTemperatureModule
                  | LM_HueA19WhiteAmbience
                  | LM_HueGU10WhiteAmbience
                  | LM_HueCandleWhiteAmbience
                  | LM_HueGo
                  | LM_HueLightStripPlus
                  | LM_HueWhiteAmbienceFlexStrip
                  | LM_LivingWhitesPlug
                  | LM_LightifyFlex
                  | LM_LightifyClassicA60RGBW
                  | LM_LightifyClassicA60TW
                  | LM_LightifyClassicB40TW
                  | LM_LightifyPAR16
                  | LM_LightifyPlug
                  | LM_InnrGU10Spot
                  | LM_InnrBulbRB162
                  | LM_InnrBulbRB172W
                  | LM_InnrFlexLightFL110
                  | LM_Unknown !String
  
  instance FromJSON LightModel where
      parseJSON (String s) =
          case T.unpack s of
              "LCT001"                    -> return LM_HueBulbA19
              "LCT007"                    -> return LM_HueBulbA19V2
              "LCT010"                    -> return LM_HueBulbA19V3
              "LCT014"                    -> return LM_HueBulbA19V3
              "LCT002"                    -> return LM_HueSpotBR30
              "LCT003"                    -> return LM_HueSpotGU10
              "LCT011"                    -> return LM_HueBR30 -- What's the diff. to the 'Spot'?
              "LCT012"                    -> return LM_HueCandle
              "LST001"                    -> return LM_HueLightStrip
              "LLC010"                    -> return LM_HueLivingColorsIris
              "LLC011"                    -> return LM_HueLivingColorsBloom
              "LLC012"                    -> return LM_HueLivingColorsBloom
              "LLC006"                    -> return LM_LivingColorsGen3Iris
              "LLC007"                    -> return LM_LivingColorsGen3BloomAura
              "LLC014"                    -> return LM_LivingColorsAura
              "LWB004"                    -> return LM_HueA19Lux
              "LWB006"                    -> return LM_HueA19White
              "LWB007"                    -> return LM_HueA19White
              "LWB010"                    -> return LM_HueA19WhiteV2 -- 10 & 14 assumed to be Gen2
              "LWB014"                    -> return LM_HueA19WhiteV2
              "LLM001"                    -> return LM_ColorLightModule
              "LLM010"                    -> return LM_ColorTemperatureModule
              "LLM011"                    -> return LM_ColorTemperatureModule
              "LLM012"                    -> return LM_ColorTemperatureModule
              "LTW001"                    -> return LM_HueA19WhiteAmbience
              "LTW004"                    -> return LM_HueA19WhiteAmbience
              "LTW013"                    -> return LM_HueGU10WhiteAmbience
              "LTW014"                    -> return LM_HueGU10WhiteAmbience
              "LTW012"                    -> return LM_HueCandleWhiteAmbience
              "LLC020"                    -> return LM_HueGo
              "LST002"                    -> return LM_HueLightStripPlus
              "LTP001"                    -> return LM_HueWhiteAmbienceFlexStrip
              "LWL001"                    -> return LM_LivingWhitesPlug
              "Flex RGBW"                 -> return LM_LightifyFlex
              "Classic A60 RGBW"          -> return LM_LightifyClassicA60RGBW -- Model ID Unverified
              "Classic A60 TW"            -> return LM_LightifyClassicA60TW -- Model ID Unverified
              "Classic B40 TW - LIGHTIFY" -> return LM_LightifyClassicB40TW
              "PAR16 50 TW"               -> return LM_LightifyPAR16 -- Model ID Unverified
              "Plug 01"                   -> return LM_LightifyPlug -- Also 'Plug - LIGHTIFY'?
              "RS 125"                    -> return LM_InnrGU10Spot  -- Tentative support for Innr
              "RB 162"                    -> return LM_InnrBulbRB162 -- ..
              "RB 172 W"                  -> return LM_InnrBulbRB172W
              "FL 110"                    -> return LM_InnrFlexLightFL110
              str                         -> return $ LM_Unknown str
      parseJSON _ = fail "Expected string"
  
  instance Show LightModel where
      show LM_HueBulbA19                = "Hue Bulb A19"
      show LM_HueBulbA19V2              = "Hue Bulb A19 V2"
      show LM_HueBulbA19V3              = "Hue Bulb A19 V3"
      show LM_HueSpotBR30               = "Hue Spot BR30"
      show LM_HueSpotGU10               = "Hue Spot GU10"
      show LM_HueBR30                   = "Hue BR30"
      show LM_HueCandle                 = "Hue Color Candle"
      show LM_HueLightStrip             = "Hue LightStrip"
      show LM_HueLivingColorsIris       = "Hue Living Colors Iris"
      show LM_HueLivingColorsBloom      = "Hue Living Colors Bl."
      show LM_LivingColorsGen3Iris      = "Living Colors G3 Iris"
      show LM_LivingColorsGen3BloomAura = "Living Colors G3 B/A"
      show LM_LivingColorsAura          = "Living Colors Aura"
      show LM_HueA19Lux                 = "Hue A19 Lux"
      show LM_HueA19White               = "Hue A19 White"
      show LM_HueA19WhiteV2             = "Hue A19 White V2"
      show LM_ColorLightModule          = "Color Light Module"
      show LM_ColorTemperatureModule    = "Color Temp. Module"
      show LM_HueA19WhiteAmbience       = "Hue A19 White Amb."
      show LM_HueGU10WhiteAmbience      = "Hue GU10 White Amb."
      show LM_HueCandleWhiteAmbience    = "Hue White Amb. Candle"
      show LM_HueGo                     = "Hue Go"
      show LM_HueLightStripPlus         = "Hue LightStrip Plus"
      show LM_HueWhiteAmbienceFlexStrip = "Hue W. Amb. FlexStrip"
      show LM_LivingWhitesPlug          = "LivingWhites Plug"
      show LM_LightifyFlex              = "LIGHTIFY Flex"
      show LM_LightifyClassicA60RGBW    = "LIGHTIFY Cl. A60 RGBW"
      show LM_LightifyClassicA60TW      = "LIGHTIFY Cl. A60 TW"
      show LM_LightifyClassicB40TW      = "LIGHTIFY Cl. B40 TW"
      show LM_LightifyPAR16             = "LIGHTIFY PAR16 TW"
      show LM_LightifyPlug              = "LIGHTIFY Plug"
      show LM_InnrGU10Spot              = "Innr GU10 Spot"
      show LM_InnrBulbRB162             = "Innr Bulb RB 162"
      show LM_InnrBulbRB172W            = "Innr Bulb RB 172 W"
      show LM_InnrFlexLightFL110        = "Innr FlexLight FL 110"
      show (LM_Unknown s)               = "Unknown (" <> s <> ")"
  
  -- Scenes
  --
  -- http://www.developers.meethue.com/documentation/scenes-api#41_get_all_scenes
  
  data BridgeScene = BridgeScene { _bscName        :: !String
                                 , _bscLights      :: ![LightID]
                                 , _bscActive      :: !(Maybe Bool)
                                 , _bscOwner       :: !(Maybe String)
                                 , _bscRecycle     :: !(Maybe Bool)
                                 , _bscLocked      :: !(Maybe Bool)
                                 , _bscAppData     :: !(Maybe Object)
                                 , _bscPicture     :: !(Maybe String)
                                 , _bscLastUpdated :: !(Maybe UTCTime)
                                 , _bscVersion     :: !(Maybe Int)
                                 } deriving Show
  
  -- Hue UTC strings miss the final Z, fails with the default parser
  parseHueTimeMaybe :: Maybe String -> Maybe UTCTime
  parseHueTimeMaybe Nothing = Nothing
  parseHueTimeMaybe (Just t) =
      case parseTimeM True defaultTimeLocale "%FT%T" t of
          Just d  -> Just d
          Nothing -> Nothing
  
  instance FromJSON BridgeScene where
      parseJSON (Object o) = BridgeScene <$> o .:  "name"
                                         <*> o .:  "lights"
                                         <*> o .:? "active"
                                         <*> o .:? "owner"
                                         <*> o .:? "recycle"
                                         <*> o .:? "locked"
                                         <*> o .:? "appdata"
                                         <*> o .:? "picture"
                                         <*> (parseHueTimeMaybe <$> o .:? "lastupdated")
                                         <*> o .:? "version"
      parseJSON _ = fail "Expected object"
  
  -- Bridge configuration obtained from the api/config endpoint without a whitelisted user
  
  data BridgeConfigNoWhitelist = BridgeConfigNoWhitelist
      { _bcnwSWVersion  :: !String
      , _bcnwAPIVersion :: !APIVersion
      , _bcnwName       :: !String
      , _bcnwMac        :: !String
      } deriving Show
  
  instance FromJSON BridgeConfigNoWhitelist where
      parseJSON (Object o) =
          BridgeConfigNoWhitelist <$> o .: "swversion"
                                  <*> o .: "apiversion"
                                  <*> o .: "name"
                                  <*> o .: "mac"
      parseJSON _ = fail "Expected object"
  
  -- API version string
  
  data APIVersion = APIVersion { avMajor :: !Int, avMinor :: !Int, avPatch :: !Int }
  
  instance FromJSON APIVersion where
      parseJSON (String s) =
          either (fail "Failed to parse version number")
                 return
                 (parseOnly parser s)
        where parser = APIVersion <$> (decimal <* char '.') <*> (decimal <* char '.') <*> decimal
      parseJSON _ = fail "Expected string"
  
  instance Show APIVersion where
      show APIVersion { .. } = show avMajor <> "." <> show avMinor <> "." <> show avPatch
  
  -- Actual bridge configuration obtainable by whitelisted user. We only parse a selection
  -- of potentially interesting fields
  --
  -- http://www.developers.meethue.com/documentation/configuration-api#72_get_configuration
  
  data BridgeConfig = BridgeConfig
      { _bcName             :: !String
      , _bcZigBeeChannel    :: !Int
      , _bcBridgeID         :: !String
      , _bcMac              :: !String
      , _bcIPAddress        :: !IPAddress
      , _bcNetmask          :: !String
      , _bcGateway          :: !String
      , _bcModelID          :: !String
      , _bcSWVersion        :: !String
      , _bcAPIVersion       :: !APIVersion
      , _bcSWUpdate         :: !(Maybe SWUpdate)
      , _bcLinkButton       :: !Bool
      , _bcPortalServices   :: !Bool
      , _bcPortalConnection :: !String
      , _bcPortalState      :: !(Maybe PortalState)
      , _bcFactoryNew       :: !Bool
      } deriving Show
  
  data SWUpdate = SWUpdate
      { _swuUpdateState    :: !Int
      , _swuCheckForUpdate :: !Bool
      , _swuURL            :: !String
      , _swuText           :: !String
      , _swuNotify         :: !Bool
      } deriving Show
  
  data PortalState = PortalState
      { _psSignedOn      :: !Bool
      , _psIncoming      :: !Bool
      , _psOutgoing      :: !Bool
      , _psCommunication :: !String
      } deriving Show
  
  instance FromJSON BridgeConfig where
      parseJSON (Object o) =
          BridgeConfig <$> o .:  "name"
                       <*> o .:  "zigbeechannel"
                       <*> o .:  "bridgeid"
                       <*> o .:  "mac"
                       <*> o .:  "ipaddress"
                       <*> o .:  "netmask"
                       <*> o .:  "gateway"
                       <*> o .:  "modelid"
                       <*> o .:  "swversion"
                       <*> o .:  "apiversion"
                       <*> o .:? "swupdate"
                       <*> o .:  "linkbutton"
                       <*> o .:  "portalservices"
                       <*> o .:  "portalconnection"
                       <*> o .:? "portalstate"
                       <*> o .:  "factorynew"
      parseJSON _ = fail "Expected object"
  
  instance FromJSON SWUpdate where
      parseJSON (Object o) =
          SWUpdate <$> o .: "updatestate"
                   <*> o .: "checkforupdate"
                   <*> o .: "url"
                   <*> o .: "text"
                   <*> o .: "notify"
      parseJSON _ = fail "Expected object"
  
  instance FromJSON PortalState where
      parseJSON (Object o) =
          PortalState <$> o .: "signedon"
                      <*> o .: "incoming"
                      <*> o .: "outgoing"
                      <*> o .: "communication"
      parseJSON _ = fail "Expected object"
  
  -- Some helper types for receiving lists / maps of the exported objects,
  -- newtype wrappers for some modicum of type safety
  
  newtype LightID = LightID { fromLightID :: String }
                    deriving (Eq, Ord, Show, FromJSON, ToJSON, Hashable)
  
  newtype BridgeSceneID = BridgeSceneID { fromBridgeSceneID :: String }
                          deriving (Eq, Ord, Show, FromJSON, ToJSON, Hashable)
  
  newtype GroupName = GroupName { fromGroupName :: String }
                      deriving (Eq, Ord, Show, FromJSON, ToJSON, Hashable)
  
  type Lights       = HM.HashMap LightID Light                  -- Light ID to light
  type LightGroups  = HM.HashMap GroupName (HS.HashSet LightID) -- Group names to set of light IDs
  type BridgeScenes = HM.HashMap BridgeSceneID BridgeScene      -- Scene ID to scene
  
  -- 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 Lights where
      parseJSON v = (\(a :: HM.HashMap String Light) -> coerce a) <$> parseJSON v
  
  instance FromJSON LightGroups where
      parseJSON v = (\(a :: HM.HashMap String (HS.HashSet LightID)) -> coerce a) <$> parseJSON v
  
  instance FromJSON BridgeScenes where
      parseJSON v = (\(a :: HM.HashMap String BridgeScene) -> coerce a) <$> parseJSON v
  
  -- Lenses
  
  makeLenses ''BridgeConfigNoWhitelist
  makeLenses ''BridgeConfig
  makeLenses ''SWUpdate
  makeLenses ''PortalState
  makeLenses ''Light
  makeLenses ''LightState
  makeLenses ''BridgeScene
  
  