{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.RTView.GUI.Markup
    ( mkPageBody
    ) where

import           Cardano.Prelude
import           Prelude (String)

import qualified Data.Text as T

import qualified Graphics.UI.Threepenny as UI
import           Graphics.UI.Threepenny.Core (Element, UI, element, set, string, ( # ), ( #+ ),
                                              ( #. ))

import qualified Cardano.RTView.GUI.Charts as Chart
import           Cardano.RTView.GUI.Elements (ElementName (..), HTMLClass (..),
                                              HTMLId (..), HTMLW3Class (..),
                                              NodeStateElements, NodesStateElements,
                                              PeerInfoItem, hideIt, showCell, showIt,
                                              showRow, ( ## ), (<+>))
import           Cardano.RTView.GUI.Grid (allMetricsNames, metricLabel, mkNodesGrid)
import           Cardano.RTView.GUI.Pane (mkNodePane)
import           Cardano.BM.Data.Configuration (RemoteAddrNamed (..))

mkPageBody
  :: UI.Window
  -> [RemoteAddrNamed]
  -> UI ( Element
        , (NodesStateElements, NodesStateElements)
        )
mkPageBody :: Window
-> [RemoteAddrNamed]
-> UI (Element, (NodesStateElements, NodesStateElements))
mkPageBody Window
window [RemoteAddrNamed]
acceptors = do
  -- Create panes for each node (corresponding to acceptors).
  [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems
    <- [RemoteAddrNamed]
-> (RemoteAddrNamed
    -> UI (Text, Element, NodeStateElements, [PeerInfoItem]))
-> UI [(Text, Element, NodeStateElements, [PeerInfoItem])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RemoteAddrNamed]
acceptors ((RemoteAddrNamed
  -> UI (Text, Element, NodeStateElements, [PeerInfoItem]))
 -> UI [(Text, Element, NodeStateElements, [PeerInfoItem])])
-> (RemoteAddrNamed
    -> UI (Text, Element, NodeStateElements, [PeerInfoItem]))
-> UI [(Text, Element, NodeStateElements, [PeerInfoItem])]
forall a b. (a -> b) -> a -> b
$ \(RemoteAddrNamed Text
nameOfNode RemoteAddr
_) -> do
         (Element
pane, NodeStateElements
nodeStateElems, [PeerInfoItem]
peerInfoItems) <- Text -> UI (Element, NodeStateElements, [PeerInfoItem])
mkNodePane Text
nameOfNode
         (Text, Element, NodeStateElements, [PeerInfoItem])
-> UI (Text, Element, NodeStateElements, [PeerInfoItem])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
nameOfNode, Element
pane, NodeStateElements
nodeStateElems, [PeerInfoItem]
peerInfoItems)

  -- Create panes areas on the page.
  [UI Element]
panesAreas
    <- [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> ((Text, Element, NodeStateElements, [PeerInfoItem])
    -> UI (UI Element))
-> UI [UI Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems (((Text, Element, NodeStateElements, [PeerInfoItem])
  -> UI (UI Element))
 -> UI [UI Element])
-> ((Text, Element, NodeStateElements, [PeerInfoItem])
    -> UI (UI Element))
-> UI [UI Element]
forall a b. (a -> b) -> a -> b
$ \(Text
_, Element
pane, NodeStateElements
_, [PeerInfoItem]
_) ->
         UI Element -> UI (UI Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (UI Element -> UI (UI Element)) -> UI Element -> UI (UI Element)
forall a b. (a -> b) -> a -> b
$ UI Element
UI.div UI Element -> String -> UI Element
#. [HTMLW3Class
W3Col, HTMLW3Class
W3L6, HTMLW3Class
W3M12, HTMLW3Class
W3S12] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> [UI Element] -> UI Element
#+ [Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
pane]

  -- Register clickable selector for nodes (to be able to show only one or all of them).
  [UI Element]
nodesSelector <- [RemoteAddrNamed]
-> (RemoteAddrNamed -> UI (UI Element)) -> UI [UI Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RemoteAddrNamed]
acceptors ((RemoteAddrNamed -> UI (UI Element)) -> UI [UI Element])
-> (RemoteAddrNamed -> UI (UI Element)) -> UI [UI Element]
forall a b. (a -> b) -> a -> b
$ \(RemoteAddrNamed Text
nameOfNode RemoteAddr
_) -> do
    Element
nodeCheckbox
      <- UI Element
UI.input UI Element -> String -> UI Element
#. [HTMLW3Class
W3Check] [HTMLW3Class] -> [HTMLClass] -> String
<+> [HTMLClass
SelectNodeCheck]
                  # set UI.type_ "checkbox"
                  # set UI.checked True
                  #+ []
    Element
nodeButton <-
      UI Element
UI.div UI Element -> String -> UI Element
#. HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
SelectNodeCheckArea UI Element -> [UI Element] -> UI Element
#+
        [ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
nodeCheckbox
        , UI Element
UI.label UI Element -> [UI Element] -> UI Element
#+ [String -> UI Element
UI.string (String -> UI Element) -> String -> UI Element
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
nameOfNode]
        ]
    UI (UI ()) -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI (UI ()) -> UI ()) -> UI (UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ Event Bool -> (Bool -> UI ()) -> UI (UI ())
forall a void. Event a -> (a -> UI void) -> UI (UI ())
UI.onEvent (Element -> Event Bool
UI.checkedChange Element
nodeCheckbox) ((Bool -> UI ()) -> UI (UI ())) -> (Bool -> UI ()) -> UI (UI ())
forall a b. (a -> b) -> a -> b
$ \Bool
isChecked -> do
      Window -> String -> UI (Maybe Element)
UI.getElementById Window
window (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
ViewModeButton) UI (Maybe Element) -> (Maybe Element -> UI ()) -> UI ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Element
btn -> ReadWriteAttr Element String String -> Element -> UI String
forall x i o. ReadWriteAttr x i o -> x -> UI o
UI.get ReadWriteAttr Element String String
UI.value Element
btn UI String -> (String -> UI ()) -> UI ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          String
"paneMode" -> do
            let action :: UI Element -> UI Element
action = if Bool
isChecked then UI Element -> UI Element
showIt else UI Element -> UI Element
hideIt
            Text
-> [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> (UI Element -> UI Element)
-> UI ()
forNode Text
nameOfNode [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems UI Element -> UI Element
action
          String
_ -> do
            let action :: UI Element -> UI Element
action = if Bool
isChecked then UI Element -> UI Element
showCell else UI Element -> UI Element
hideIt
            Window -> Text -> (UI Element -> UI Element) -> UI ()
forNodeColumn Window
window Text
nameOfNode UI Element -> UI Element
action

        Maybe Element
Nothing -> () -> UI ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Window -> HTMLId -> HTMLClass -> UI ()
changeStatusOfShowAllButton Window
window HTMLId
ShowAllNodesButton HTMLClass
SelectNodeCheck
    UI Element -> UI (UI Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (UI Element -> UI (UI Element)) -> UI Element -> UI (UI Element)
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
nodeButton

  [UI Element]
showAndHideAllNodesButtons
    <- if [UI Element] -> Int
forall a. HasLength a => a -> Int
length [UI Element]
nodesSelector Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
         then do
           Element
showAllNodesButton <- HTMLId -> UI Element
showAllButton HTMLId
ShowAllNodesButton
           Element
hideAllNodesButton <- HTMLId -> UI Element
hideAllButton HTMLId
HideAllNodesButton

           UI (UI ()) -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI (UI ()) -> UI ()) -> UI (UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ Event () -> (() -> UI ()) -> UI (UI ())
forall a void. Event a -> (a -> UI void) -> UI (UI ())
UI.onEvent (Element -> Event ()
UI.click Element
showAllNodesButton) ((() -> UI ()) -> UI (UI ())) -> (() -> UI ()) -> UI (UI ())
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
             Window -> String -> UI (Maybe Element)
UI.getElementById Window
window (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
ViewModeButton) UI (Maybe Element) -> (Maybe Element -> UI ()) -> UI ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
               Just Element
btn -> ReadWriteAttr Element String String -> Element -> UI String
forall x i o. ReadWriteAttr x i o -> x -> UI o
UI.get ReadWriteAttr Element String String
UI.value Element
btn UI String -> (String -> UI ()) -> UI ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                 String
"paneMode" -> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])] -> UI ()
showAllNodes Window
window [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems
                 String
_ -> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])] -> UI ()
showAllNodesColumns Window
window [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems
               Maybe Element
Nothing -> () -> UI ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
showAllNodesButton UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3Disabled] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])
             UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
hideAllNodesButton UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3BorderBottom] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])

           UI (UI ()) -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI (UI ()) -> UI ()) -> UI (UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ Event () -> (() -> UI ()) -> UI (UI ())
forall a void. Event a -> (a -> UI void) -> UI (UI ())
UI.onEvent (Element -> Event ()
UI.click Element
hideAllNodesButton) ((() -> UI ()) -> UI (UI ())) -> (() -> UI ()) -> UI (UI ())
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
             Window -> String -> UI (Maybe Element)
UI.getElementById Window
window (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
ViewModeButton) UI (Maybe Element) -> (Maybe Element -> UI ()) -> UI ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
               Just Element
btn -> ReadWriteAttr Element String String -> Element -> UI String
forall x i o. ReadWriteAttr x i o -> x -> UI o
UI.get ReadWriteAttr Element String String
UI.value Element
btn UI String -> (String -> UI ()) -> UI ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                 String
"paneMode" -> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])] -> UI ()
hideAllNodes Window
window [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems
                 String
_ -> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])] -> UI ()
hideAllNodesColumns Window
window [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems
               Maybe Element
Nothing -> () -> UI ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
showAllNodesButton UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])
             UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
hideAllNodesButton UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3BorderBottom, HTMLW3Class
W3Disabled] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])

           [UI Element] -> UI [UI Element]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
showAllNodesButton, Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
hideAllNodesButton]
         else
           [UI Element] -> UI [UI Element]
forall (m :: * -> *) a. Monad m => a -> m a
return []

  let allSelectors :: [UI Element]
allSelectors = [UI Element]
showAndHideAllNodesButtons [UI Element] -> [UI Element] -> [UI Element]
forall a. [a] -> [a] -> [a]
++ [UI Element]
nodesSelector

  -- View mode buttons.
  Element
paneViewButton <- UI Element
UI.anchor UI Element -> String -> UI Element
#. [HTMLW3Class
W3BarItem, HTMLW3Class
W3Button] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.href String
"#" UI Element -> [UI Element] -> UI Element
#+ [String -> UI Element
UI.string String
"Pane view"]
  Element
gridViewButton <- UI Element
UI.anchor UI Element -> String -> UI Element
#. [HTMLW3Class
W3BarItem, HTMLW3Class
W3Button] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.href String
"#" UI Element -> [UI Element] -> UI Element
#+ [String -> UI Element
UI.string String
"Grid view"]
  let viewModeSelector :: [UI Element]
      viewModeSelector :: [UI Element]
viewModeSelector = [ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
paneViewButton
                         , Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
gridViewButton
                         ]

  [UI Element]
metricsSelector <- Window -> UI [UI Element]
mkMetricsSelector Window
window

  -- Make page body.
  (Element
gridNodes, NodesStateElements
gridNodesStateElems) <- Window -> [RemoteAddrNamed] -> UI (Element, NodesStateElements)
mkNodesGrid Window
window [RemoteAddrNamed]
acceptors
  Element
panes <- UI Element
UI.div UI Element -> String -> UI Element
#. HTMLW3Class -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLW3Class
W3Row UI Element -> [UI Element] -> UI Element
#+ [UI Element]
panesAreas
  Element
body
    <- Window -> UI Element
UI.getBody Window
window UI Element -> [UI Element] -> UI Element
#+
         [ [UI Element] -> [UI Element] -> [UI Element] -> UI Element
topNavigation [UI Element]
allSelectors [UI Element]
viewModeSelector [UI Element]
metricsSelector
         , Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
panes
         ]

  JSFunction () -> UI ()
UI.runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> JSFunction ()
forall a. FFI a => String -> a
UI.ffi String
Chart.prepareChartsJS

  UI (UI ()) -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI (UI ()) -> UI ()) -> UI (UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ Event () -> (() -> UI ()) -> UI (UI ())
forall a void. Event a -> (a -> UI void) -> UI (UI ())
UI.onEvent (Element -> Event ()
UI.click Element
paneViewButton) ((() -> UI ()) -> UI (UI ())) -> (() -> UI ()) -> UI (UI ())
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
    Window
-> String -> Element -> [UI Element] -> [UI Element] -> UI ()
toggleViewMode Window
window String
"paneMode" Element
panes [UI Element]
panesAreas [Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
gridNodes]
    Window -> String -> (UI Element -> UI Element) -> UI ()
forElementWithId Window
window (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
SelectMetricButton) UI Element -> UI Element
hideIt
  UI (UI ()) -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI (UI ()) -> UI ()) -> UI (UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ Event () -> (() -> UI ()) -> UI (UI ())
forall a void. Event a -> (a -> UI void) -> UI (UI ())
UI.onEvent (Element -> Event ()
UI.click Element
gridViewButton) ((() -> UI ()) -> UI (UI ())) -> (() -> UI ()) -> UI (UI ())
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
    Window
-> String -> Element -> [UI Element] -> [UI Element] -> UI ()
toggleViewMode Window
window String
"gridMode" Element
panes [Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
gridNodes] [UI Element]
panesAreas
    Window -> String -> (UI Element -> UI Element) -> UI ()
forElementWithId Window
window (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
SelectMetricButton) UI Element -> UI Element
showIt
    [RemoteAddrNamed] -> (RemoteAddrNamed -> UI ()) -> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RemoteAddrNamed]
acceptors ((RemoteAddrNamed -> UI ()) -> UI ())
-> (RemoteAddrNamed -> UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ \(RemoteAddrNamed Text
nameOfNode RemoteAddr
_) -> do
      JSFunction () -> UI ()
UI.runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> JSFunction ()
forall a. FFI a => String -> a
UI.ffi String
Chart.gridMemoryUsageChartJS  (HTMLId -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridMemoryUsageChartId  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfNode)
      JSFunction () -> UI ()
UI.runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> JSFunction ()
forall a. FFI a => String -> a
UI.ffi String
Chart.gridCPUUsageChartJS     (HTMLId -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridCPUUsageChartId     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfNode)
      JSFunction () -> UI ()
UI.runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> JSFunction ()
forall a. FFI a => String -> a
UI.ffi String
Chart.gridDiskUsageChartJS    (HTMLId -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridDiskUsageChartId    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfNode)
      JSFunction () -> UI ()
UI.runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> JSFunction ()
forall a. FFI a => String -> a
UI.ffi String
Chart.gridNetworkUsageChartJS (HTMLId -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridNetworkUsageChartId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfNode)

  [RemoteAddrNamed] -> (RemoteAddrNamed -> UI ()) -> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RemoteAddrNamed]
acceptors ((RemoteAddrNamed -> UI ()) -> UI ())
-> (RemoteAddrNamed -> UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ \(RemoteAddrNamed Text
nameOfNode RemoteAddr
_) -> do
    -- Charts for different metrics.
    JSFunction () -> UI ()
UI.runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> JSFunction ()
forall a. FFI a => String -> a
UI.ffi String
Chart.memoryUsageChartJS  (HTMLId -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
MemoryUsageChartId  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfNode)
    JSFunction () -> UI ()
UI.runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> JSFunction ()
forall a. FFI a => String -> a
UI.ffi String
Chart.cpuUsageChartJS     (HTMLId -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
CPUUsageChartId     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfNode)
    JSFunction () -> UI ()
UI.runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> JSFunction ()
forall a. FFI a => String -> a
UI.ffi String
Chart.diskUsageChartJS    (HTMLId -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
DiskUsageChartId    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfNode)
    JSFunction () -> UI ()
UI.runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> JSFunction ()
forall a. FFI a => String -> a
UI.ffi String
Chart.networkUsageChartJS (HTMLId -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
NetworkUsageChartId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameOfNode)

  NodesStateElements
nodesStateElems
    <- [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> ((Text, Element, NodeStateElements, [PeerInfoItem])
    -> UI (Text, NodeStateElements, [PeerInfoItem]))
-> UI NodesStateElements
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems (((Text, Element, NodeStateElements, [PeerInfoItem])
  -> UI (Text, NodeStateElements, [PeerInfoItem]))
 -> UI NodesStateElements)
-> ((Text, Element, NodeStateElements, [PeerInfoItem])
    -> UI (Text, NodeStateElements, [PeerInfoItem]))
-> UI NodesStateElements
forall a b. (a -> b) -> a -> b
$ \(Text
nameOfNode, Element
_, NodeStateElements
nodeStateElems, [PeerInfoItem]
peerInfoItems) ->
         (Text, NodeStateElements, [PeerInfoItem])
-> UI (Text, NodeStateElements, [PeerInfoItem])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
nameOfNode, NodeStateElements
nodeStateElems, [PeerInfoItem]
peerInfoItems)

  (Element, (NodesStateElements, NodesStateElements))
-> UI (Element, (NodesStateElements, NodesStateElements))
forall (m :: * -> *) a. Monad m => a -> m a
return (Element
body, (NodesStateElements
nodesStateElems, NodesStateElements
gridNodesStateElems))

topNavigation
  :: [UI Element]
  -> [UI Element]
  -> [UI Element]
  -> UI Element
topNavigation :: [UI Element] -> [UI Element] -> [UI Element] -> UI Element
topNavigation [UI Element]
nodesSelector [UI Element]
viewModeSelector [UI Element]
metricsSelector =
  UI Element
UI.div UI Element -> String -> UI Element
#. [HTMLW3Class
W3Bar, HTMLW3Class
W3Large] [HTMLW3Class] -> [HTMLClass] -> String
<+> [HTMLClass
TopBar] UI Element -> [UI Element] -> UI Element
#+
    [ UI Element
UI.anchor UI Element -> String -> UI Element
#. [HTMLW3Class
W3BarItem, HTMLW3Class
W3Mobile] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.href String
"https://cardano.org/" UI Element -> [UI Element] -> UI Element
#+
        [ UI Element
UI.img UI Element -> String -> UI Element
#. HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
CardanoLogo UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.src String
"/static/images/cardano-logo.svg"
        ]
    , UI Element
UI.div UI Element -> String -> UI Element
#. [HTMLW3Class
W3DropdownHover, HTMLW3Class
W3Mobile] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> [UI Element] -> UI Element
#+
        [ UI Element
UI.button UI Element -> String -> UI Element
## HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
ViewModeButton
                    #. show W3Button
                    # set UI.value "paneMode"
                    #+ [string "View mode ▾"]
        , UI Element
UI.div UI Element -> String -> UI Element
#. [HTMLW3Class
W3DropdownContent, HTMLW3Class
W3BarBlock, HTMLW3Class
W3Card4] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> [UI Element] -> UI Element
#+ [UI Element]
viewModeSelector
        ]
    , UI Element
UI.div UI Element -> String -> UI Element
#. [HTMLW3Class
W3DropdownHover, HTMLW3Class
W3Mobile] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> [UI Element] -> UI Element
#+
        [ UI Element
UI.button UI Element -> String -> UI Element
#. HTMLW3Class -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLW3Class
W3Button UI Element -> [UI Element] -> UI Element
#+ [String -> UI Element
string String
"Select node ▾"]
        , UI Element
UI.div UI Element -> String -> UI Element
#. [HTMLW3Class
W3DropdownContent, HTMLW3Class
W3BarBlock, HTMLW3Class
W3Card4] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> [UI Element] -> UI Element
#+ [UI Element]
nodesSelector
        ]
    , UI Element
UI.div UI Element -> String -> UI Element
## HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
SelectMetricButton UI Element -> String -> UI Element
#. [HTMLW3Class
W3DropdownHover, HTMLW3Class
W3Mobile] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# UI Element -> UI Element
hideIt UI Element -> [UI Element] -> UI Element
#+
        [ UI Element
UI.button UI Element -> String -> UI Element
#. HTMLW3Class -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLW3Class
W3Button UI Element -> [UI Element] -> UI Element
#+ [String -> UI Element
string String
"Select metric ▾"]
        , UI Element
UI.div UI Element -> String -> UI Element
#. [HTMLW3Class
W3DropdownContent, HTMLW3Class
W3BarBlock, HTMLW3Class
W3Card4] [HTMLW3Class] -> [HTMLClass] -> String
<+> [HTMLClass
MetricsArea] UI Element -> [UI Element] -> UI Element
#+ [UI Element]
metricsSelector
        ]
    , UI Element
UI.span UI Element -> String -> UI Element
#. [HTMLW3Class
W3Right, HTMLW3Class
W3HideMedium, HTMLW3Class
W3HideSmall] [HTMLW3Class] -> [HTMLClass] -> String
<+> [HTMLClass
ServiceName] UI Element -> [UI Element] -> UI Element
#+
        [ String -> UI Element
string String
"Cardano Node Real-time View"
        ]
    ]

forNode
  :: Text
  -> [(Text, Element, NodeStateElements, [PeerInfoItem])]
  -> (UI Element -> UI Element)
  -> UI ()
forNode :: Text
-> [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> (UI Element -> UI Element)
-> UI ()
forNode Text
nameOfNode [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems UI Element -> UI Element
action =
  [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> ((Text, Element, NodeStateElements, [PeerInfoItem]) -> UI ())
-> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems (((Text, Element, NodeStateElements, [PeerInfoItem]) -> UI ())
 -> UI ())
-> ((Text, Element, NodeStateElements, [PeerInfoItem]) -> UI ())
-> UI ()
forall a b. (a -> b) -> a -> b
$ \(Text
aName, Element
pane, NodeStateElements
_, [PeerInfoItem]
_) ->
    Bool -> UI () -> UI ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
aName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
nameOfNode) (UI () -> UI ()) -> UI () -> UI ()
forall a b. (a -> b) -> a -> b
$
      UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
pane UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# UI Element -> UI Element
action

forNodeColumn
  :: UI.Window
  -> Text
  -> (UI Element -> UI Element)
  -> UI ()
forNodeColumn :: Window -> Text -> (UI Element -> UI Element) -> UI ()
forNodeColumn Window
window Text
nameOfNode UI Element -> UI Element
action = do
  let cellsIdsForNodeColumn :: [String]
cellsIdsForNodeColumn =
        (ElementName -> String) -> [ElementName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\ElementName
elemName -> ElementName -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ElementName
elemName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nameOfNode)
            [ElementName]
allMetricsNames
  let allCells :: [String]
allCells = (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridNodeTH String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nameOfNode) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
cellsIdsForNodeColumn
  [String] -> (String -> UI ()) -> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
allCells ((String -> UI ()) -> UI ()) -> (String -> UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ \String
anId ->
    Window -> String -> (UI Element -> UI Element) -> UI ()
forElementWithId Window
window String
anId UI Element -> UI Element
action

showAllNodes, hideAllNodes
  :: UI.Window
  -> [(Text, Element, NodeStateElements, [PeerInfoItem])]
  -> UI ()
showAllNodes :: Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])] -> UI ()
showAllNodes = Bool
-> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> UI ()
changeNodesVisibility Bool
True
hideAllNodes :: Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])] -> UI ()
hideAllNodes = Bool
-> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> UI ()
changeNodesVisibility Bool
False

changeNodesVisibility
  :: Bool
  -> UI.Window
  -> [(Text, Element, NodeStateElements, [PeerInfoItem])]
  -> UI ()
changeNodesVisibility :: Bool
-> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> UI ()
changeNodesVisibility Bool
showThem Window
window [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems = do
  [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> ((Text, Element, NodeStateElements, [PeerInfoItem]) -> UI ())
-> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems (((Text, Element, NodeStateElements, [PeerInfoItem]) -> UI ())
 -> UI ())
-> ((Text, Element, NodeStateElements, [PeerInfoItem]) -> UI ())
-> UI ()
forall a b. (a -> b) -> a -> b
$ \(Text
_, Element
pane, NodeStateElements
_, [PeerInfoItem]
_) ->
    UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
pane UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# if Bool
showThem then UI Element -> UI Element
showIt else UI Element -> UI Element
hideIt
  [Element]
nodesCheckboxes <- Window -> String -> UI [Element]
UI.getElementsByClassName Window
window (HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
SelectNodeCheck)
  [Element] -> (Element -> UI ()) -> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Element]
nodesCheckboxes ((Element -> UI ()) -> UI ()) -> (Element -> UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ \Element
checkbox ->
    UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
checkbox UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element Bool Bool -> Bool -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element Bool Bool
UI.checked Bool
showThem

showAllNodesColumns, hideAllNodesColumns
  :: UI.Window
  -> [(Text, Element, NodeStateElements, [PeerInfoItem])]
  -> UI ()
showAllNodesColumns :: Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])] -> UI ()
showAllNodesColumns = Bool
-> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> UI ()
changeNodesColumnsVisibility Bool
True
hideAllNodesColumns :: Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])] -> UI ()
hideAllNodesColumns = Bool
-> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> UI ()
changeNodesColumnsVisibility Bool
False

changeNodesColumnsVisibility
  :: Bool
  -> UI.Window
  -> [(Text, Element, NodeStateElements, [PeerInfoItem])]
  -> UI ()
changeNodesColumnsVisibility :: Bool
-> Window
-> [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> UI ()
changeNodesColumnsVisibility Bool
showThem Window
window [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems = do
  [(Text, Element, NodeStateElements, [PeerInfoItem])]
-> ((Text, Element, NodeStateElements, [PeerInfoItem]) -> UI ())
-> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Element, NodeStateElements, [PeerInfoItem])]
nodePanesWithElems (((Text, Element, NodeStateElements, [PeerInfoItem]) -> UI ())
 -> UI ())
-> ((Text, Element, NodeStateElements, [PeerInfoItem]) -> UI ())
-> UI ()
forall a b. (a -> b) -> a -> b
$ \(Text
nameOfNode, Element
_, NodeStateElements
_, [PeerInfoItem]
_) ->
    Window -> Text -> (UI Element -> UI Element) -> UI ()
forNodeColumn Window
window Text
nameOfNode ((UI Element -> UI Element) -> UI ())
-> (UI Element -> UI Element) -> UI ()
forall a b. (a -> b) -> a -> b
$ if Bool
showThem then UI Element -> UI Element
showCell else UI Element -> UI Element
hideIt
  [Element]
nodesCheckboxes <- Window -> String -> UI [Element]
UI.getElementsByClassName Window
window (HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
SelectNodeCheck)
  [Element] -> (Element -> UI ()) -> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Element]
nodesCheckboxes ((Element -> UI ()) -> UI ()) -> (Element -> UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ \Element
checkbox ->
    UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
checkbox UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element Bool Bool -> Bool -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element Bool Bool
UI.checked Bool
showThem

toggleViewMode
  :: UI.Window
  -> String
  -> Element
  -> [UI Element]
  -> [UI Element]
  -> UI ()
toggleViewMode :: Window
-> String -> Element -> [UI Element] -> [UI Element] -> UI ()
toggleViewMode Window
window String
newValue Element
rootElem [UI Element]
childrenToAdd [UI Element]
childrenToDelete = do
  -- Store current view mode in the view mode button.
  Window -> String -> (UI Element -> UI Element) -> UI ()
forElementWithId Window
window (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
ViewModeButton) (ReadWriteAttr Element String String
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String String
UI.value String
newValue)
  -- Delete these elements from DOM.
  (UI Element -> UI (UI ())) -> [UI Element] -> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Element -> UI ()) -> UI Element -> UI (UI ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> UI ()
UI.delete) [UI Element]
childrenToDelete
  -- Explicitly remove current children of rootElem and set the new ones.
  UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
rootElem UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element [Element] ()
-> [Element] -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element [Element] ()
UI.children []
  UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
rootElem UI Element -> [UI Element] -> UI Element
#+ [UI Element]
childrenToAdd

-- | If all checkboxes are checked - "Show all" button should be disabled.
--   If at least one of them are unchecked - "Show all" button should be enabled.
changeStatusOfShowAllButton
  :: UI.Window
  -> HTMLId
  -> HTMLClass
  -> UI ()
changeStatusOfShowAllButton :: Window -> HTMLId -> HTMLClass -> UI ()
changeStatusOfShowAllButton Window
window HTMLId
anId HTMLClass
aClass =
  Window -> String -> UI (Maybe Element)
UI.getElementById Window
window (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
anId) UI (Maybe Element) -> (Maybe Element -> UI ()) -> UI ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Element
button -> do
      [Element]
checkboxes <- Window -> String -> UI [Element]
UI.getElementsByClassName Window
window (HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
aClass)
      [Bool]
statuses <- (Element -> UI Bool) -> [Element] -> UI [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ReadWriteAttr Element Bool Bool -> Element -> UI Bool
forall x i o. ReadWriteAttr x i o -> x -> UI o
UI.get ReadWriteAttr Element Bool Bool
UI.checked) [Element]
checkboxes
      if (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool
True Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==) [Bool]
statuses
        then UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
button UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3Disabled] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])
        else UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
button UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])
    Maybe Element
Nothing -> () -> UI ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | If all checkboxes are unchecked - "Hide all" button should be disabled.
--   If at least one of them are checked - "Hide all" button should be enabled.
changeStatusOfHideAllButton
  :: UI.Window
  -> HTMLId
  -> HTMLClass
  -> UI ()
changeStatusOfHideAllButton :: Window -> HTMLId -> HTMLClass -> UI ()
changeStatusOfHideAllButton Window
window HTMLId
anId HTMLClass
aClass =
  Window -> String -> UI (Maybe Element)
UI.getElementById Window
window (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
anId) UI (Maybe Element) -> (Maybe Element -> UI ()) -> UI ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Element
button -> do
      [Element]
checkboxes <- Window -> String -> UI [Element]
UI.getElementsByClassName Window
window (HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
aClass)
      [Bool]
statuses <- (Element -> UI Bool) -> [Element] -> UI [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ReadWriteAttr Element Bool Bool -> Element -> UI Bool
forall x i o. ReadWriteAttr x i o -> x -> UI o
UI.get ReadWriteAttr Element Bool Bool
UI.checked) [Element]
checkboxes
      if (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool
False Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==) [Bool]
statuses
        then UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
button UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3BorderBottom, HTMLW3Class
W3Disabled] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])
        else UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
button UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3BorderBottom] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])
    Maybe Element
Nothing -> () -> UI ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

mkMetricsSelector
  :: UI.Window
  -> UI [UI Element]
mkMetricsSelector :: Window -> UI [UI Element]
mkMetricsSelector Window
window = do
  Element
showAllMetricsButton <- HTMLId -> UI Element
showAllButton HTMLId
ShowAllMetricsButton
  Element
hideAllMetricsButton <- HTMLId -> UI Element
hideAllButton HTMLId
HideAllMetricsButton

  UI (UI ()) -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI (UI ()) -> UI ()) -> UI (UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ Event () -> (() -> UI ()) -> UI (UI ())
forall a void. Event a -> (a -> UI void) -> UI (UI ())
UI.onEvent (Element -> Event ()
UI.click Element
showAllMetricsButton) ((() -> UI ()) -> UI (UI ())) -> (() -> UI ()) -> UI (UI ())
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
    Window -> [ElementName] -> UI ()
showAllMetrics Window
window [ElementName]
allMetricsNames
    UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
showAllMetricsButton UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3Disabled] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])
    UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
hideAllMetricsButton UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3BorderBottom] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])

  UI (UI ()) -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI (UI ()) -> UI ()) -> UI (UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ Event () -> (() -> UI ()) -> UI (UI ())
forall a void. Event a -> (a -> UI void) -> UI (UI ())
UI.onEvent (Element -> Event ()
UI.click Element
hideAllMetricsButton) ((() -> UI ()) -> UI (UI ())) -> (() -> UI ()) -> UI (UI ())
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
    Window -> [ElementName] -> UI ()
hideAllMetrics Window
window [ElementName]
allMetricsNames
    UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
showAllMetricsButton UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])
    UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
hideAllMetricsButton UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.class_ ([HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3BorderBottom, HTMLW3Class
W3Disabled] [HTMLW3Class] -> [HTMLClass] -> String
<+> [])

  [UI Element]
checkboxes <-
    [ElementName]
-> (ElementName -> UI (UI Element)) -> UI [UI Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ElementName]
allMetricsNames ((ElementName -> UI (UI Element)) -> UI [UI Element])
-> (ElementName -> UI (UI Element)) -> UI [UI Element]
forall a b. (a -> b) -> a -> b
$ \ElementName
aName ->
      Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element (Element -> UI Element) -> UI Element -> UI (UI Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> ElementName -> UI Element
mkCheckbox Window
window ElementName
aName

  [UI Element] -> UI [UI Element]
forall (m :: * -> *) a. Monad m => a -> m a
return ([UI Element] -> UI [UI Element])
-> [UI Element] -> UI [UI Element]
forall a b. (a -> b) -> a -> b
$    [Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
showAllMetricsButton]
           [UI Element] -> [UI Element] -> [UI Element]
forall a. [a] -> [a] -> [a]
++ [Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
hideAllMetricsButton]
           [UI Element] -> [UI Element] -> [UI Element]
forall a. [a] -> [a] -> [a]
++ [UI Element]
checkboxes

mkCheckbox
  :: UI.Window
  -> ElementName
  -> UI Element
mkCheckbox :: Window -> ElementName -> UI Element
mkCheckbox Window
window ElementName
elemName = do
  Element
metricCheckbox
    <- UI Element
UI.input UI Element -> String -> UI Element
#. [HTMLW3Class
W3Check] [HTMLW3Class] -> [HTMLClass] -> String
<+> [HTMLClass
SelectMetricCheck]
                # set UI.type_ "checkbox"
                # set UI.checked True
                #+ []
  UI (UI ()) -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI (UI ()) -> UI ()) -> UI (UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ Event Bool -> (Bool -> UI ()) -> UI (UI ())
forall a void. Event a -> (a -> UI void) -> UI (UI ())
UI.onEvent (Element -> Event Bool
UI.checkedChange Element
metricCheckbox) ((Bool -> UI ()) -> UI (UI ())) -> (Bool -> UI ()) -> UI (UI ())
forall a b. (a -> b) -> a -> b
$ \Bool
isChecked -> do
    let action :: UI Element -> UI Element
action = if Bool
isChecked then UI Element -> UI Element
showRow else UI Element -> UI Element
hideIt
    Window -> String -> (UI Element -> UI Element) -> UI ()
forElementWithId Window
window (ElementName -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ElementName
elemName) UI Element -> UI Element
action
    Window -> HTMLId -> HTMLClass -> UI ()
changeStatusOfShowAllButton Window
window HTMLId
ShowAllMetricsButton HTMLClass
SelectMetricCheck
    Window -> HTMLId -> HTMLClass -> UI ()
changeStatusOfHideAllButton Window
window HTMLId
HideAllMetricsButton HTMLClass
SelectMetricCheck

  UI Element
UI.div UI Element -> String -> UI Element
#. HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
SelectMetricCheckArea UI Element -> [UI Element] -> UI Element
#+
    [ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
metricCheckbox
    , UI Element
UI.label UI Element -> [UI Element] -> UI Element
#+ [String -> UI Element
UI.string (String -> UI Element) -> String -> UI Element
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ ElementName -> (String, String)
metricLabel ElementName
elemName]
    ]

forElementWithId
  :: UI.Window
  -> String
  -> (UI Element -> UI Element)
  -> UI ()
forElementWithId :: Window -> String -> (UI Element -> UI Element) -> UI ()
forElementWithId Window
window String
anId UI Element -> UI Element
action =
  Window -> String -> UI (Maybe Element)
UI.getElementById Window
window String
anId UI (Maybe Element) -> (Maybe Element -> UI ()) -> UI ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Element
el -> UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
el UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# UI Element -> UI Element
action
    Maybe Element
Nothing -> () -> UI ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

showAllMetrics, hideAllMetrics
  :: UI.Window
  -> [ElementName]
  -> UI ()
showAllMetrics :: Window -> [ElementName] -> UI ()
showAllMetrics = Bool -> Window -> [ElementName] -> UI ()
changeMetricsVisibility Bool
True
hideAllMetrics :: Window -> [ElementName] -> UI ()
hideAllMetrics = Bool -> Window -> [ElementName] -> UI ()
changeMetricsVisibility Bool
False

changeMetricsVisibility
  :: Bool
  -> UI.Window
  -> [ElementName]
  -> UI ()
changeMetricsVisibility :: Bool -> Window -> [ElementName] -> UI ()
changeMetricsVisibility Bool
showThem Window
window [ElementName]
metricsElems = do
  [ElementName] -> (ElementName -> UI ()) -> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ElementName]
metricsElems ((ElementName -> UI ()) -> UI ())
-> (ElementName -> UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ \ElementName
elemName ->
    Window -> String -> (UI Element -> UI Element) -> UI ()
forElementWithId Window
window (ElementName -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ElementName
elemName) (if Bool
showThem then UI Element -> UI Element
showRow else UI Element -> UI Element
hideIt)
  [Element]
metricsCheckboxes <- Window -> String -> UI [Element]
UI.getElementsByClassName Window
window (HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
SelectMetricCheck)
  [Element] -> (Element -> UI ()) -> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Element]
metricsCheckboxes ((Element -> UI ()) -> UI ()) -> (Element -> UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ \Element
checkbox ->
    UI Element -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI Element -> UI ()) -> UI Element -> UI ()
forall a b. (a -> b) -> a -> b
$ Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element Element
checkbox UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element Bool Bool -> Bool -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element Bool Bool
UI.checked Bool
showThem

showAllButton, hideAllButton :: HTMLId -> UI Element
showAllButton :: HTMLId -> UI Element
showAllButton HTMLId
anId = HTMLId -> [HTMLW3Class] -> String -> String -> UI Element
mkButton HTMLId
anId [HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3Disabled]     String
"show.svg" String
"Show all"
hideAllButton :: HTMLId -> UI Element
hideAllButton HTMLId
anId = HTMLId -> [HTMLW3Class] -> String -> String -> UI Element
mkButton HTMLId
anId [HTMLW3Class
W3BarItem, HTMLW3Class
W3Button, HTMLW3Class
W3BorderBottom] String
"hide.svg" String
"Hide all"

mkButton
  :: HTMLId
  -> [HTMLW3Class]
  -> String
  -> String
  -> UI Element
mkButton :: HTMLId -> [HTMLW3Class] -> String -> String -> UI Element
mkButton HTMLId
anId [HTMLW3Class]
w3Classes String
icon String
label =
  UI Element
UI.anchor UI Element -> String -> UI Element
## HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
anId UI Element -> String -> UI Element
#. [HTMLW3Class]
w3Classes [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.href String
"#" UI Element -> [UI Element] -> UI Element
#+
    [ UI Element
UI.img UI Element -> String -> UI Element
#. HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
ShowHideIcon UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.src (String
"/static/images/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
icon)
    , String -> UI Element
string String
label
    ]