content: 
  {-# LANGUAGE OverloadedStrings, RecordWildCards, RankNTypes, LambdaCase #-}
  
  module WebUITileBuildingScenes ( addScenesTile
                                 , addSceneTile
                                 , addImportedScenesTile
                                 ) where
  
  import Text.Printf
  import qualified Data.Text as T
  import Data.Monoid
  import Data.List
  import Data.Aeson
  import Data.Hashable
  import qualified Data.Vector as V
  import qualified Data.Function (on)
  import qualified Data.HashMap.Strict as HM
  import qualified Data.HashSet as HS
  import Control.Concurrent.STM
  import Control.Lens hiding ((#), set, (<.>), element)
  import Control.Monad
  import Control.Monad.Reader
  import qualified Graphics.UI.Threepenny as UI
  import Graphics.UI.Threepenny.Core
  import qualified Text.Blaze.Html5 as H
  import qualified Text.Blaze.Html5.Attributes as A
  
  import Util
  import Trace
  import HueJSON
  import LightColor
  import AppDefs
  import PersistConfig
  import WebUIHelpers
  import WebUIREST
  
  -- Code for building the scene tiles
  
  -- We give this CSS class to all scene tile elements we want
  -- to hide / show as part of the 'Scenes' group
  sceneTilesClass :: String
  sceneTilesClass = "scene-tiles-hide-show"
  
  -- Capture the relevant state of the passed light IDs and create a named scene from it
  createScene :: TVar Lights -> TVar PersistConfig -> SceneName -> [LightID] -> IO ()
  createScene tvLights tvPC sceneName inclLights = atomically $ do
    lights <- readTVar tvLights
    pc     <- readTVar tvPC
    writeTVar tvPC $ pc & pcScenes . at sceneName ?~ -- Overwrite or create scene
      ( flip map inclLights $ \lgtID ->
        ( lgtID
        , case HM.lookup lgtID lights of
            Nothing   -> HM.empty -- Light with that LightID doesn't exist
            Just lgt ->
              -- For lights that are off we only have to store the off state
              if not $ lgt ^. lgtState . lsOn then HM.fromList [("on", Bool False)] else
                -- On, store all relevant light state
                let lsToNA = Array . V.fromList . map (Number . realToFrac)
                    bri    = lgt ^. lgtState . lsBrightness
                    effect = lgt ^. lgtState . lsEffect
                    cm     = lgt ^. lgtState . lsColorMode
                    xy     = lgt ^. lgtState . lsXY
                    ct     = lgt ^. lgtState . lsColorTemp
                    hue    = lgt ^. lgtState . lsHue
                    sat    = lgt ^. lgtState . lsSaturation
                in  HM.empty
                      &                 at "on"     ?~ Bool True
                      & maybe id (\v -> at "bri"    ?~ (Number $ fromIntegral v)) bri
                      & maybe id (\v -> at "effect" ?~ (String $ T.pack v)      ) effect
                      -- Check the color mode and store the active value
                      & case cm of
                            Just CMXY ->
                                maybe id (\v -> at "xy"  ?~ (lsToNA v)) xy
                            Just CMHS ->
                                (\hm -> hm
                                    & maybe id (\v -> at "hue" ?~ (Number $ fromIntegral v)) hue
                                    & maybe id (\v -> at "sat" ?~ (Number $ fromIntegral v)) sat
                                )
                            Just CMCT ->
                                maybe id (\v -> at "ct"  ?~ (Number $ fromIntegral v)) ct
                            _         -> id
        )
      )
  
  -- TODO: Scene creation and deletion currently requires a page reload
  
  sceneCreatorID, sceneCreatorNameID :: String
  sceneCreatorLightCheckboxID        :: LightID -> String
  sceneCreatorID                    = "scene-creator-dialog-container"
  sceneCreatorNameID                = "scene-creator-dialog-name"
  sceneCreatorLightCheckboxID lgtID = "scene-creator-dialog-check-light-" <> fromLightID lgtID
  
  -- Build the head tile for toggling visibility and creation of scenes. Return if the
  -- 'Scenes' group is visible and subsequent elements should be added hidden or not
  addScenesTile :: CookieUserID -> Window -> PageBuilder Bool
  addScenesTile userID window = do
    AppEnv { .. } <- ask
    let sceneCreatorBtnID       = "scene-creator-dialog-btn"  :: String
        scenesTileHideShowBtnID = "scenes-tile-hide-show-btn" :: String
        scenesTileGroupName     = GroupName "<ScenesTileGroup>"
        queryGroupShown         =
          queryUserData _aePC userID (udVisibleGroupNames . to (HS.member scenesTileGroupName))
    grpShown <- liftIO (atomically queryGroupShown)
    -- Sorted light names with corresponding IDs for the scene creation dialog
    lightNameIDSorted <-
      return . map (\(lgtID, lgt) -> (lgt ^. lgtName, lgtID)) .
        sortBy (compare `Data.Function.on` (^. _2 . lgtName)) . HM.toList =<<
          (liftIO . atomically $ readTVar _aeLights)
    -- Scene count
    numScenes <- length . _pcScenes <$> (liftIO . atomically $ readTVar _aePC)
    -- Tile
    addPageTile $
      H.div H.! A.class_ "tile" $ do
        -- Caption and scene icon
        H.div H.! A.class_ "light-caption light-caption-group-header small"
              H.! A.style "cursor: default;"
              $ "Scenes"
        H.img H.! A.class_ "img-rounded"
              H.! A.src "static/svg/tap.svg"
              H.! A.style "cursor: default;"
        -- Scene creation dialog
        H.div H.! A.class_ "color-picker-curtain"
              H.! A.style "display: none;"
              H.! A.id (H.toValue sceneCreatorID)
              H.! A.onclick
                -- Close after a click, but only on the curtain itself, not the dialog
                ( H.toValue $
                    "if (event.target.id=='" <> sceneCreatorID <> "') { $(this).fadeOut(150); }"
                )
              $ do
          H.div H.! A.class_ "scene-creator-frame" $ do
            H.div H.! A.class_ "light-checkbox-container small" $
              -- TODO: More light selection options: all, none, all on, by group, etc.
              forM_ lightNameIDSorted $ \(lgtNm, lgtID) -> do -- Light checkboxes
                H.input H.! A.type_ "checkbox"
                        H.! A.id (H.toValue $ sceneCreatorLightCheckboxID lgtID)
                H.toHtml $ " " <> lgtNm
                H.br
            H.div H.! A.class_ "scene-create-form input-group" $ do -- Name & 'Create' button
              H.input H.! A.type_ "text"
                      H.! A.class_ "form-control input-sm"
                      H.! A.maxlength "30"
                      H.! A.placeholder "Name Required"
                      H.! A.id (H.toValue sceneCreatorNameID)
              H.span H.! A.class_ "input-group-btn" $
                H.button H.! A.class_ "btn btn-sm btn-info"
                         H.! A.id (H.toValue sceneCreatorBtnID)
                         $ "Create / Update"
            H.h6 $
              H.small $
                H.toHtml $
                  ( "Scenes capture the state of one or more lights, " <>
                    "including them being turned off. " <>
                    "Select the lights to be saved and provide a name."
                    :: String
                  )
        -- Scene count
        H.h6 $
          H.small $
            H.toHtml $ case numScenes of
                         0 -> "No Scenes"
                         1 -> "1 Scene"
                         _ -> show numScenes <> " Scenes"
        -- Group show / hide widget and 'New' button
        H.div H.! A.class_ "btn-group btn-group-sm" $ do
          H.button H.! A.type_ "button"
                   H.! A.class_ "btn btn-scene plus-btn"
                   H.! A.onclick
                     ( H.toValue $
                         "$('#" <> sceneCreatorID <> "').fadeIn(150)"
                     ) $
                     H.span H.! A.class_ "glyphicon glyphicon-plus" $ return ()
          H.button H.! A.type_ "button"
                   H.! A.class_ "btn btn-info show-hide-btn"
                   H.! A.id (H.toValue scenesTileHideShowBtnID)
                   $ H.toHtml (if grpShown then grpShownCaption else grpHiddenCaption)
    addPageUIAction $ do
        -- Create a new scene
        onElementIDClick sceneCreatorBtnID $ do
            -- Collect scene name and included lights
            sceneNameElement <- getElementByIdSafe window sceneCreatorNameID
            sceneName        <- T.unpack . T.strip . T.pack <$> -- Trim, autocorrect adds spaces
                                    get value sceneNameElement
            inclLights       <- fmap concat . forM lightNameIDSorted $ \(_, lgtID) -> do
                let checkboxID = sceneCreatorLightCheckboxID lgtID
                checkboxElement <- getElementByIdSafe window checkboxID
                checkboxCheck   <- get UI.checked checkboxElement
                return $ if checkboxCheck then [lgtID] else []
            -- Don't bother creating scenes without name or lights
            -- TODO: Show an error message to indicate what the problem is
            unless (null sceneName || null inclLights) $ do
                liftIO $ createScene _aeLights _aePC sceneName inclLights
                traceS TLInfo $ printf "Created new scene '%s' with %i lights"
                                       sceneName (length inclLights)
                reloadPage
        -- Show / hide scenes
        onElementIDClick scenesTileHideShowBtnID $ do
            -- Start a transaction, flip the shown state of the group by adding /
            -- removing it from the visible list and return a list of UI actions to
            -- update the UI with the changes
            btn <- getElementByIdSafe window scenesTileHideShowBtnID
            uiActions <- liftIO . atomically $ do
                pc <- readTVar _aePC
                let grpShownNow = pc
                                ^. pcUserData
                                 . at userID
                                 . non defaultUserData
                                 . udVisibleGroupNames
                                 . to (HS.member scenesTileGroupName)
                writeTVar _aePC
                    $  pc
                       -- Careful not to use 'non' here, would otherwise remove the
                       -- entire user when removing the last HS entry, confusing...
                    &  pcUserData . at userID . _Just . udVisibleGroupNames
                    %~ ( if   grpShownNow
                         then HS.delete scenesTileGroupName
                         else HS.insert scenesTileGroupName
                       )
                return $
                    ( if   grpShownNow
                      then [ void $ element btn & set UI.text grpHiddenCaption ]
                      else [ void $ element btn & set UI.text grpShownCaption  ]
                    ) <>
                    -- Hide or show all members of the scene group. We do this by
                    -- identifying them by a special CSS class instead of just setting
                    -- them from names in our scene database. This ensures we don't try
                    -- to set a non-existing element in case another users has created
                    -- a scene not yet present in our DOM as a tile
                    [ runFunction . ffi $ "$('." <> sceneTilesClass <> "')." <>
                          if   grpShownNow
                          then "hide()"
                          else "fadeIn()"
                    ]
            sequence_ uiActions
    return grpShown
  
  -- Add a tile for an individual scene
  addSceneTile :: SceneName -> Scene -> Bool -> PageBuilder ()
  addSceneTile sceneName scene shown = do
    AppEnv { .. } <- ask
    let -- We use the hash of the scene name, just in case the user
        -- used characters not valid for element IDs
        sceneNameHash      = show $ hash sceneName
        editDeleteDivID    = "scene-" <> sceneNameHash <> "-edit-delete-div"
        deleteConfirmDivID = "scene-" <> sceneNameHash <> "-confirm-div"
        deleteConfirmBtnID = "scene-" <> sceneNameHash <> "-confirm-btn"
        circleContainerID  = "scene-" <> sceneNameHash <> "-circle-container"
        styleCircleNoExist = "background: white; border-color: lightgrey;" :: String
    -- Get relevant bridge information, assume it won't change over the lifetime of the connection
    bridgeIP     <- liftIO . atomically $ (^. pcBridgeIP    ) <$> readTVar _aePC
    bridgeUserID <- liftIO . atomically $ (^. pcBridgeUserID) <$> readTVar _aePC
    -- Query groups for the scene group information
    groups       <- liftIO . atomically . readTVar $ _aeLightGroups
    -- Tile
    addPageTile $
      H.div H.! A.class_ (H.toValue $ "tile " <> sceneTilesClass)
            H.! A.style  ( H.toValue $ ( if   shown
                                         then "display: block;"
                                         else "display: none;"
                                         :: String
                                       )
                         )
            $ do
        -- Caption (TODO: Clicking the caption should make the lights in the scene blink)
        H.div H.! A.class_ "light-caption small"
              H.! A.style "cursor: default;"
              $ H.toHtml sceneName
        -- Scene light preview (TODO: Maybe use actual light icons instead of circles?)
        H.div H.! A.class_ "circle-container"
              H.! A.id (H.toValue circleContainerID) $ do
          forM_ (take 9 $ scene) $ \(_, lgSt) ->
            -- Build mock LightState from scene light. This is basically the body
            -- we pass to the set light state API, doesn't contain a color mode
            let lsBase = LightState True
                                    Nothing
                                    Nothing
                                    Nothing
                                    ((\(String t) -> T.unpack t) <$> HM.lookup "effect" lgSt)
                                    Nothing
                                    Nothing
                                    "none"
                                    Nothing
                                    True
                col :: String
                col | HM.lookup "on" lgSt == Just (Bool False) = "black"
                    | Just (Array vXY)         <- HM.lookup "xy" lgSt,
                      [Number xXY, Number yXY] <- V.toList vXY =
                        htmlColorFromLightState $
                          lsBase & lsXY .~ (Just [realToFrac xXY, realToFrac yXY])
                    | Just (Number hue)        <- HM.lookup "hue" lgSt,
                      Just (Number sat)        <- HM.lookup "sat" lgSt =
                        htmlColorFromLightState $
                          lsBase & lsHue        .~ (Just $ round hue)
                                 & lsSaturation .~ (Just $ round sat)
                    | Just (Number ct)         <- HM.lookup "ct" lgSt =
                        htmlColorFromLightState $
                          lsBase & lsColorTemp .~ (Just $ round ct)
                    | otherwise = "white;"
            in  H.div H.! A.class_ "circle"
                      H.! A.style (H.toValue $ "background: " <> col <> ";")
                      $ return ()
          forM_ [0..8 - length scene] $ \_ -> -- Fill remainder with grey circles
            H.div H.! A.class_ "circle"
                  H.! A.style (H.toValue styleCircleNoExist)
                  $ return ()
        -- List all group names affected by the scene, truncate with ellipsis if needed
        --
        -- TODO: If all lights in the scene have been removed this fails to output even
        --       an empty line and causes slightly wrong layout. Maybe show an error
        H.h6 $
          H.small $
            H.toHtml $
              let groupsTouched =
                      flip concatMap (HM.toList groups) $ \(grpName, grpLights) ->
                        if   or $ map (\(lgtID, _) -> HS.member lgtID grpLights) scene
                        then [grpName]
                        else []
                  groupStr      = concat . intersperse ", " . sort $ map fromGroupName groupsTouched
              in  trucateEllipsis 19 groupStr
        -- Edit and delete button (TODO: Add 'turn off' button)
        let editOnClick =
              -- Disable all light check boxes in the dialog
              "var checkboxes = document.getElementsByClassName('light-checkbox-container')[0]" <>
                  ".getElementsByTagName('input');" <>
              "for (var i=0; i<checkboxes.length; i++) { checkboxes[i].checked = false; }" <>
              -- Re-enable lights included in scene (TODO: This fails if a light has been removed)
              ( flip concatMap scene $ \(lgtID, _) ->
                  "getElementById('" <> sceneCreatorLightCheckboxID lgtID <> "').checked = true;"
              ) <>
              -- Set scene name
              "getElementById('" <> sceneCreatorNameID <> "').value = '" <> sceneName <> "';" <>
              -- Show dialog
              "$('#" <> sceneCreatorID <> "').fadeIn(150);"
        addEditAndDeleteButton editDeleteDivID
                               editOnClick
                               deleteConfirmDivID
                               deleteConfirmBtnID
    addPageUIAction $ do
        -- Activate
        --
        -- TODO: Maybe add a rate limiter for this? Spamming the activate button for a scene
        --       with lots of lights can really overwhelm the bridge
        --
        onElementIDClick circleContainerID $ lightsSetScene bridgeIP bridgeUserID scene
        -- Delete
        onElementIDClick deleteConfirmBtnID $ do
            liftIO . atomically $ do
                pc <- readTVar _aePC
                writeTVar _aePC $ pc & pcScenes . iat sceneName #~ Nothing
            reloadPage
  
  addImportedScenesTile :: Bool -> PageBuilder ()
  addImportedScenesTile shown = do
    AppEnv { .. } <- ask
    -- Get relevant bridge information, assume it won't change over the lifetime of the connection
    bridgeIP     <- liftIO . atomically $ (^. pcBridgeIP    ) <$> readTVar _aePC
    bridgeUserID <- liftIO . atomically $ (^. pcBridgeUserID) <$> readTVar _aePC
    let sceneBttnID sceneID = -- TODO: Move this logic to where the scenes are fetched
          -- DOM ID from scene ID
          "bridge-scene-activate-bttn-" <> fromBridgeSceneID sceneID
        nameKeyedScenes =
            -- Use the scene name as the key instead of the scene ID
            map (\(sceneID, scene) -> (scene ^. bscName, (sceneID, scene)))
                $ HM.toList _aeBridgeScenes
        nubScenes =
            -- Build 'name -> (sceneID, scene)' hashmap, resolve name
            -- collisions with the last update date
            flip HM.fromListWith nameKeyedScenes $ \sceneA sceneB ->
                case (compare `Data.Function.on` (^. _2 . bscLastUpdated)) sceneA sceneB of
                    EQ -> sceneA
                    LT -> sceneB
                    GT -> sceneA
        recentScenes =
            -- List of scenes sorted by last update date
            reverse . sortBy (compare `Data.Function.on` (^. _2 . bscLastUpdated)) .
                map snd $ HM.toList nubScenes
        fixNames =
            -- Scene names are truncated and decorated when stored on the bridge,
            -- salvage what we can and extract the cleanest UI label for them
            recentScenes & traversed . _2 . bscName %~ \sceneName ->
                (\nm -> if length nm == 16 then nm <> "…" else nm) . take 16 .
                    concat . intersperse " " . reverse $ case reverse $ words sceneName of
                        xs@("0":"on":_)  -> drop 2 xs
                        xs@("on":_)      -> drop 1 xs
                        xs@("0":"off":_) -> drop 2 xs
                        xs@("off":_)     -> drop 1 xs
                        xs               -> xs
        topScenes = take 7 fixNames
    -- Build scenes tile
    addPageTile $
      H.div H.! A.class_ (H.toValue $ "tile " <> sceneTilesClass)
            H.! A.style  ( H.toValue $ ( if   shown
                                         then "display: block;"
                                         else "display: none;"
                                         :: String
                                       )
                         )
            $ do
        H.div H.! A.class_ "light-caption small" $ do
          void $ "Imported"
          H.br
          void $ "Scenes"
        H.div H.! A.class_ "btn-group-vertical btn-group-xs scene-btn-group" $
          forM_ topScenes $ \(sceneID, scene) ->
            H.button H.! A.class_ "btn btn-scene"
                     H.! A.id (H.toValue $ sceneBttnID sceneID) $
                       H.small $ (H.toHtml $ scene ^. bscName)
    -- Register click handlers for activating the scenes
    addPageUIAction $
        forM_ topScenes $ \(sceneID, _) ->
            onElementIDClick (sceneBttnID sceneID) $
                recallScene bridgeIP
                            bridgeUserID
                            sceneID
  
  