content: 
  {-# LANGUAGE RecordWildCards, LambdaCase #-}
  
  module Main (main) where
  
  import Data.Monoid
  import Data.Maybe
  import qualified Data.HashMap.Strict as HM
  import Data.Aeson
  import qualified Data.ByteString.Char8 as B8
  import qualified Data.ByteString.Lazy as BS
  import Control.Lens
  import Control.Exception
  import Control.Concurrent.STM
  import qualified Codec.Picture as JP
  import Text.Read
  import Control.Concurrent.Async
  
  import Trace
  import App
  import AppDefs
  import HueREST
  import HueSetup
  import PersistConfig
  import CmdLineOptions
  import BackgroundProcessing
  
  main :: IO ()
  main = do
      -- Command line options
      flags <- parseCmdLineOpt
      -- Setup tracing
      let traceFn  = foldr (\f r -> case f of FlagTraceFile fn -> Just fn; _ -> r) Nothing flags
          mkTrcOpt = \case "n" -> TLNone; "e" -> TLError; "w" -> TLWarn; "i" -> TLInfo; _ -> TLInfo
          traceLvl = foldr (\f r -> case f of (FlagTraceLevel lvl) -> mkTrcOpt lvl; _ -> r)
                           TLInfo flags
      withTrace traceFn
              (not $ FlagTraceNoEcho       `elem` flags)
              (      FlagTraceAppend       `elem` flags)
              (not $ FlagTraceDisableColor `elem` flags)
              traceLvl
              $ do
        -- Load configuration (might not be there)
        mbCfg <- loadConfig configFilePath
        -- Bridge connection and user ID
        let cmdOptBridgeIP =
              foldr ( \f r -> case f of
                                FlagBridgeIP ip ->
                                  decode . BS.fromStrict . B8.pack $ "\"" <> ip <> "\""
                                _               -> r
              ) Nothing flags
        bridgeIP <- discoverBridgeIP $ case cmdOptBridgeIP of Just ip -> ip
                                                              Nothing -> view pcBridgeIP <$> mbCfg
        userID <- createUser bridgeIP $ view pcBridgeUserID <$> mbCfg
        -- We have everything setup, build and store configuration
        let newCfg = (fromMaybe defaultPersistConfig mbCfg)
                         & pcBridgeIP     .~ bridgeIP
                         & pcBridgeUserID .~ userID
        _aePC <- atomically . newTVar $ newCfg
        -- Write configuration data on exit
        --
        -- TODO: Couldn't get this to work reliably on any thread but the main one.
        --       Shouldn't interfere with the pcWriterThread as it should already be
        --       terminated when we run the handler. Still a risk of data corruption
        --       when being interrupted twice
        --
        -- TODO: This doesn't seem to trigger when we run with daemontools and do 'svc -d'
        --
        flip finally
          ( do currentCfg <- atomically $ readTVar _aePC
               traceS TLInfo "Exiting, persisting configuration data..."
               storeConfig configFilePath currentCfg
          ) $
          -- Launch persistent configuration writer thread
          withAsync (pcWriterThread _aePC) $ \_ ->
          -- Launch schedule watcher thread
          withAsync (scheduleWatcher _aePC) $ \_ -> do
            -- Request full bridge configuration
            traceS TLInfo $ "Trying to obtain full bridge configuration..."
            _aeBC <- bridgeRequestRetryTrace MethodGET bridgeIP noBody userID "config"
            traceS TLInfo $ "Success, full bridge configuration:\n" <> show _aeBC
            -- Request all scenes (TODO: Maybe do this on every new connection, not once per server?)
            -- http://www.developers.meethue.com/documentation/scenes-api#41_get_all_scenes
            traceS TLInfo $ "Trying to obtain list of bridge scenes..."
            _aeBridgeScenes <- bridgeRequestRetryTrace MethodGET bridgeIP noBody userID "scenes"
            traceS TLInfo $ "Success, number of scenes received: " <> show (length _aeBridgeScenes)
            -- TVars for sharing light / group state across threads
            _aeLights      <- atomically . newTVar $ HM.empty
            _aeLightGroups <- atomically . newTVar $ HM.empty
            -- TChan for propagating light updates
            _aeBroadcast <- atomically $ newBroadcastTChan
            -- Load color picker image
            _aeColorPickerImg <- JP.readPng "static/color_picker.png" >>= \case
                Right (JP.ImageRGB8 image) -> do traceS TLInfo $ "Loaded color picker image"
                                                 return image
                Right _                    -> traceAndThrow $ "Color picker image wrong format"
                Left err                   -> traceAndThrow $ "Can't load color picker image: " <> err
            -- Command line options passed on to the rest of the program
            let _aeCmdLineOpts = CmdLineOpts
                    { _cloPort          =
                          foldr (\f r -> case f of
                                   FlagPort port -> fromMaybe defPort $ readMaybe port; _ -> r)
                                defPort
                                flags
                    , _cloOnlyLocalhost = FlagLocalhost `elem` flags
                    , _cloPollInterval  =
                           foldr (\f r -> case f of
                                   FlagPollInterval interval ->
                                     fromMaybe defPollInterval $ readMaybe interval;
                                   _ -> r)
                                 defPollInterval
                                 flags
                    , _cloTraceHTTP     =  FlagTraceHTTP `elem` flags
                    }
            -- Number of currently connected users
            _aeConnectedUsers <- atomically . newTVar $ 0
            -- Launch application
            run AppEnv { .. }
  
  