content: 
  {-# LANGUAGE OverloadedStrings, RecordWildCards, RankNTypes, LambdaCase #-}
  
  module WebUITileBuildingSchedules ( addSchedulesTile
                                    , addScheduleTile
                                    ) where
  
  import Text.Printf
  import Text.Read (readMaybe)
  import qualified Data.Text as T
  import Data.Monoid
  import Data.Maybe
  import Data.Hashable
  import Data.Time.Clock.POSIX (getPOSIXTime)
  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 AppDefs
  import PersistConfig
  import WebUIHelpers
  
  -- Code for building the schedule tiles
  
  -- TODO: This module has a fair bit in common with WebUITileBuildingScenes, refactor
  
  -- We give this CSS class to all schedule tile elements we want
  -- to hide / show as part of the 'Schedules' group
  scheduleTilesClass :: String
  scheduleTilesClass = "schedule-tiles-hide-show"
  
  -- Overwrite or create schedule
  createSchedule :: TVar PersistConfig
                 -> ScheduleName
                 -> SceneName
                 -> Int
                 -> Int
                 -> [Bool]
                 -> SceneAction
                 -> IO ()
  createSchedule tvPC scheduleName _sScene _sHour _sMinute _sDays _sAction =
      atomically $ modifyTVar' tvPC (pcSchedules . at scheduleName ?~
          Schedule { _sTrigStatus = STJustCreated, .. })
  
  -- Weekday names
  days :: [String]
  days = ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"]
  
  -- TODO: Schedule creation and deletion currently requires a page reload
  
  scheduleCreatorID, scheduleCreatorNameID, scheduleCreatorHourID, scheduleCreatorMinuteID,
      scheduleCreatorActionID, scheduleCreatorSceneID, actionActivate, actionActivateSlow,
      actionTurnOff, actionBlink
      :: String
  scheduleCreatorDayID :: String -> String
  scheduleCreatorID        = "schedule-creator-dialog-container"
  scheduleCreatorNameID    = "schedule-creator-dialog-name"
  scheduleCreatorHourID    = "schedule-creator-dialog-hour"
  scheduleCreatorMinuteID  = "schedule-creator-dialog-minute"
  scheduleCreatorActionID  = "schedule-creator-dialog-action"
  scheduleCreatorSceneID   = "schedule-creator-dialog-scene"
  scheduleCreatorDayID day = "schedule-creator-dialog-day" <> day
  actionActivate           = "activate"
  actionActivateSlow       = "activate slow"
  actionTurnOff            = "turn-off"
  actionBlink              = "blink"
  
  -- Build the head tile for toggling visibility and creation of schedules. Return if the
  -- 'Schedules' group is visible and subsequent elements should be added hidden or not
  addSchedulesTile :: [SceneName] -> CookieUserID -> Window -> PageBuilder Bool
  addSchedulesTile sceneNames userID window = do
    AppEnv { .. } <- ask
    let scheduleCreatorBtnID       = "schedule-creator-dialog-btn"  :: String
        schedulesTileHideShowBtnID = "schedules-tile-hide-show-btn" :: String
        schedulesTileGroupName     = GroupName "<SchedulesTileGroup>"
        queryGroupShown            =
          queryUserData _aePC userID (udVisibleGroupNames . to (HS.member schedulesTileGroupName))
    grpShown <- liftIO (atomically queryGroupShown)
    -- Client and server epoch time in ms, compute difference and complain if it differs too much
    -- TODO: Round trip, maybe just send the server time and move this logic client side?
    clientTime <- liftIO $ runUI window (callFunction $ ffi "(new Date()).getTime()" :: UI Double)
    serverTime <- (1000 *) . realToFrac <$> liftIO getPOSIXTime :: PageBuilder Double
    let timeDiff          = abs $ clientTime - serverTime
        timeDiffThreshold = 120 * 1000 -- 2min
    when (timeDiff > timeDiffThreshold) $
        traceS TLWarn $ printf "Time difference between client and server is %i seconds"
                        (round $ timeDiff / 1000 :: Int)
    -- 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;"
              $ "Schedules"
        H.img H.! A.class_ "img-rounded"
              H.! A.src "static/svg/clock.svg"
              H.! A.style "cursor: default;"
        -- Schedule creation dialog
        H.div H.! A.class_ "color-picker-curtain"
              H.! A.style "display: none;"
              H.! A.id (H.toValue scheduleCreatorID)
              H.! A.onclick
                -- Close after a click, but only on the curtain itself, not the dialog
                ( H.toValue $
                    "if (event.target.id == '" <> scheduleCreatorID <> "') { $(this).fadeOut(150); }"
                )
              $ do
          H.div H.! A.class_ "scene-creator-frame" $ do
            H.div H.! A.class_ "small" $ do
              void $ "at "
              H.select H.! A.id (H.toValue scheduleCreatorHourID) $
                forM_ ([0..23] :: [Int]) $ \h ->
                  if  h == 16 -- Default
                  then H.option H.! A.value "16" H.! A.selected "selected" $ "16"
                  else H.option H.! A.value (H.toValue . show $ h) $ H.toHtml (show h)
              void $ " hour "
              H.select H.! A.id (H.toValue scheduleCreatorMinuteID) $
                forM_ ([0..59] :: [Int]) $ \m ->
                  if  m == 30 -- Default
                  then H.option H.! A.value "30" H.! A.selected "selected" $ "30"
                  else H.option H.! A.value (H.toValue . show $ m) $ H.toHtml (show m)
              void $ " minutes"
              H.br >> H.br
              void $ "do "
              H.select H.! A.id (H.toValue scheduleCreatorActionID) $ do
                H.option H.! A.value (H.toValue actionActivate    ) $ "activate"
                H.option H.! A.value (H.toValue actionActivateSlow) $ "activate slowly"
                H.option H.! A.value (H.toValue actionTurnOff     ) $ "turn lights off in"
                H.option H.! A.value (H.toValue actionBlink       ) $ "blink lights in"
              H.br >> H.br
              void $ "scene "
              H.select H.! A.id (H.toValue scheduleCreatorSceneID) $
                -- TODO: Maybe also add light names here to allow schedules for single
                --       lights without being forced to create a scene?
                forM_ sceneNames $ \s ->
                  H.option H.! A.value (H.toValue s) $ H.toHtml s
              void $ " on"
              H.br >> H.br
              H.div H.! A.class_ "schedule-day-container" $
                forM_ days $ \day ->
                  H.div H.! A.class_ "day" $ do
                    H.input H.! A.type_ "checkbox"
                            H.! A.id (H.toValue $ scheduleCreatorDayID day)
                            H.! A.checked "checked"
                    H.br
                    H.toHtml day
            H.br
            -- TODO: Do schedules actually need to have names? It often feels redundant
            --       to come up with one, what a schedule does is often very clear from
            --       the actual parameters displayed
            H.div H.! A.class_ "input-group" $ do
              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 scheduleCreatorNameID)
              H.span H.! A.class_ "input-group-btn" $
                H.button H.! A.class_ "btn btn-sm btn-info"
                         H.! A.id (H.toValue scheduleCreatorBtnID)
                         $ "Create / Update"
            -- TODO: Consider adding a 'Turn off X minutes later' section to cover this
            --       common use case without having to create two schedules
            H.h6 $
              H.small $
                H.toHtml $
                    ( "Schedules allow to program reoccurring changes to the state of lights"
                      :: String
                    )
        -- Server / client time status
        H.h6 $
            if   timeDiff > timeDiffThreshold
            then H.small H.! A.style "color: red;" $ do
                   H.span H.! A.class_ "glyphicon glyphicon-remove" $ return ()
                   H.toHtml (" Server Time Differs" :: String)
            else H.small H.! A.style "color: green;" $ do
                   H.span H.! A.class_ "glyphicon glyphicon-ok" $ return ()
                   H.toHtml (" Server Time Matches" :: String)
        -- 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 $
                         "$('#" <> scheduleCreatorID <>"').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 schedulesTileHideShowBtnID)
                   $ H.toHtml (if grpShown then grpShownCaption else grpHiddenCaption)
        -- TODO: Consider adding global toggle to suspend all schedules
    addPageUIAction $ do
        -- Create a new scene
        onElementIDClick scheduleCreatorBtnID $ do
            -- Schedule name
            scheduleName <- -- Trim, autocorrect adds spaces
                            T.unpack . T.strip . T.pack <$>
                                (get value =<< getElementByIdSafe window scheduleCreatorNameID)
            -- Scene name
            sceneName    <- get value =<< getElementByIdSafe window scheduleCreatorSceneID
            -- Hour
            hour         <- fromMaybe 16 . readMaybe <$>
                                (get value =<< getElementByIdSafe window scheduleCreatorHourID)
            -- Minute
            minute       <- fromMaybe 30 . readMaybe <$>
                                (get value =<< getElementByIdSafe window scheduleCreatorMinuteID)
            -- Active days
            daysActive   <- forM days $ \day ->
                get UI.checked =<< getElementByIdSafe window (scheduleCreatorDayID day)
            -- Action
            actionStr    <- get value =<< getElementByIdSafe window scheduleCreatorActionID
            let action | actionStr == actionActivate     = SAActivate
                       | actionStr == actionActivateSlow = SAActivateSlow
                       | actionStr == actionTurnOff      = SATurnOff
                       | actionStr == actionBlink        = SABlink
                       | otherwise                       = SAActivate
            -- Don't bother creating schedules without name
            -- TODO: Show an error message to indicate what the problem is
            -- TODO: Deal with the situation where we have no scenes at all
            unless (null scheduleName) $ do
                liftIO $ createSchedule _aePC
                                        scheduleName
                                        sceneName
                                        hour
                                        minute
                                        daysActive
                                        action
                traceS TLInfo $ printf
                    "Created new schedule '%s' triggering at %i:%i action '%s' scene '%s' on %s"
                    scheduleName
                    hour
                    minute
                    (show action)
                    sceneName
                    ( concatMap (\(i, active) -> if   active
                                                 then days !! i
                                                 else ""
                                ) $ zip [0..] daysActive
                    )
                reloadPage
        -- Show / hide schedules
        onElementIDClick schedulesTileHideShowBtnID $ 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 schedulesTileHideShowBtnID
            uiActions <- liftIO . atomically $ do
                pc <- readTVar _aePC
                let grpShownNow = pc
                                ^. pcUserData
                                 . at userID
                                 . non defaultUserData
                                 . udVisibleGroupNames
                                 . to (HS.member schedulesTileGroupName)
                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 schedulesTileGroupName
                         else HS.insert schedulesTileGroupName
                       )
                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 schedule group. We do this by
                    -- identifying them by a special CSS class instead of just setting
                    -- them from names in our schedule database. This ensures we don't try
                    -- to set a non-existing element in case another users has created
                    -- a schedule not yet present in our DOM as a tile
                    [ runFunction . ffi $ "$('." <> scheduleTilesClass <> "')." <>
                          if   grpShownNow
                          then "hide()"
                          else "fadeIn()"
                    ]
            sequence_ uiActions
    return grpShown
  
  -- Add a tile for an individual schedule
  addScheduleTile :: ScheduleName -> Schedule -> Bool -> PageBuilder ()
  addScheduleTile scheduleName Schedule { .. } shown = do
    AppEnv { .. } <- ask
    scenes <- _pcScenes <$> (liftIO . atomically . readTVar $ _aePC)
    let -- We use the hash of the scene name, just in case the user
        -- used characters not valid for element IDs
        scheduleNameHash   = show $ hash scheduleName
        editDeleteDivID    = "schedule-" <> scheduleNameHash <> "-edit-delete-div"
        deleteConfirmDivID = "schedule-" <> scheduleNameHash <> "-confirm-div"
        deleteConfirmBtnID = "schedule-" <> scheduleNameHash <> "-confirm-btn"
        minute             = show _sMinute
        minutePretty       = if length minute == 1 then "0" <> minute else minute
        sceneMissing       = not $ HM.member _sScene scenes
        opacity            = if or _sDays then enabledOpacity else disabledOpacity
    -- Tile
    addPageTile $
      H.div H.! A.class_ (H.toValue $ "tile " <> scheduleTilesClass)
            H.! A.style ( H.toValue $ "opacity: " <> show opacity <> ";" <>
                            if shown then "display: block;" else "display: none;"
                        )
            $ do
        -- Caption
        H.div H.! A.class_ "light-caption small"
              H.! A.style "cursor: default;"
              $ H.toHtml scheduleName
        -- Schedule information
        H.div H.! A.class_ "schedule-time-display" $ do
          H.span H.! A.class_ "glyphicon glyphicon-time" -- TODO: Use SVG clock to show actual time
                 H.! A.style "vertical-align: middle;"
                 $ return ()
          H.span H.! A.style "vertical-align: middle;" $
            H.toHtml $ " " <> show _sHour <> ":" <> minutePretty
        H.div $
          forM_ (zip days _sDays) $ \(dayName, dayEnabled) ->
            H.span H.! A.class_ (if dayEnabled then "day-enabled" else "day-disabled") $
              H.toHtml $ take 2 dayName <> " "
        H.span H.! A.class_ "glyphicon glyphicon-chevron-down schedule-chevron-down" $ return ()
        H.div H.! A.class_ "schedule-action" $
          case _sAction of
            SAActivate     -> "Activate"
            SAActivateSlow -> "Activate Slowly"
            SATurnOff      -> "Turn Off"
            SABlink        -> "Blink"
        H.div H.! A.class_ "light-caption small no-padding-margin"
              H.! A.style "cursor: default;"
              $ do
          H.toHtml _sScene
          when sceneMissing $ do
            H.toHtml (" " :: String)
            H.span H.! A.class_ "glyphicon glyphicon-alert"
                   H.! A.style "color: red;"
                   $ return ()
        -- Edit and delete button
        let editOnClick =
              -- Minutes and hours
              "getElementById('" <> scheduleCreatorMinuteID <> "').value = '" <>
                show _sMinute <> "';" <>
              "getElementById('" <> scheduleCreatorHourID <> "').value = '" <>
                show _sHour <> "';" <>
              -- Action
              "getElementById('" <> scheduleCreatorActionID <> "').value = '" <>
                ( case _sAction of
                    SAActivate     -> actionActivate
                    SAActivateSlow -> actionActivateSlow
                    SATurnOff      -> actionTurnOff
                    SABlink        -> actionBlink
                ) <> "';" <>
              -- Scene, only if present
              ( if   sceneMissing
                then ""
                else "getElementById('" <> scheduleCreatorSceneID <> "').value = '" <>
                       _sScene <> "';"
              ) <>
              -- Days
              ( flip concatMap (zip days _sDays) $ \(dayName, dayEnabled) ->
                  "getElementById('" <> scheduleCreatorDayID dayName <> "').checked = '" <>
                    (if dayEnabled then "checked" else "") <> "';"
              ) <>
              -- Name
              "getElementById('" <> scheduleCreatorNameID <> "').value = '" <>
                scheduleName <> "';" <>
              -- Show dialog
              "$('#" <> scheduleCreatorID  <> "').fadeIn(150);"
        addEditAndDeleteButton editDeleteDivID
                               editOnClick
                               deleteConfirmDivID
                               deleteConfirmBtnID
    addPageUIAction $
        -- Delete
        onElementIDClick deleteConfirmBtnID $ do
            liftIO . atomically $ do
                pc <- readTVar _aePC
                writeTVar _aePC $ pc & pcSchedules . iat scheduleName #~ Nothing
            reloadPage
  
  