module Frontend.Component.Dashboard where

import Prelude

import CSS (color)
import Color (toHexString)
import Data.Array (length)
import Data.DateTime (diff)
import Data.Foldable (for_)
import Data.Formatter.Number (formatOrShowNumber)
import Data.Int (floor, toNumber)
import Data.Maybe (Maybe(..))
import Data.Monoid (guard)
import Data.Newtype (unwrap)
import Data.Symbol (SProxy(..))
import Data.Time.Duration (class Duration, Days(..), Hours(..), Minutes(..), Seconds(..), convertDuration)
import Data.Tuple (Tuple(..))
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Class.Console (log)
import Frontend.Api (fetchInstantInterval)
import Frontend.Component.Plot as Plot
import Frontend.Dom (card)
import Frontend.Draw (canvasShape, colorToCss, hashedColor, imageShape, metersToPixels)
import Frontend.Route (Route(..), routeCodec)
import Frontend.Types (Box(..), Config(..), Info(..), Vec2(..))
import Frontend.UPlot (defaultOpts, defaultSeries, defaultXAxis, noAxis)
import Frontend.Util (classes, datetimeToSeconds, enumerate, formatDateTime')
import Graphics.Canvas (CanvasImageSource)
import Graphics.Canvas as Canvas
import Halogen (liftEffect)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.CSS as CSS
import Halogen.HTML.Properties as HP
import Routing.Duplex (print)


type State =
  { info :: Info
  , config :: Config
  , mapImage :: CanvasImageSource
  }

type Slots =
  ( plot :: H.Slot Plot.Query Void Unit
  )

data Action
  = Initialize
  | SetInput Input

type Input = { info :: Info, config :: Config, mapImage :: CanvasImageSource }

_plot = (SProxy :: SProxy "plot")

component :: forall query output m. MonadAff m => H.Component HH.HTML query Input output m
component = H.mkComponent
  { initialState: \{info, config, mapImage} ->
    { info
    , config
    , mapImage
    }
  , render
  , eval: H.mkEval H.defaultEval
    { handleAction = handleAction
    , initialize = Just Initialize
    , receive = Just <<< SetInput
    }
  }

tableRow :: forall a s m. String -> String -> H.ComponentHTML a s m
tableRow label value = HH.tr_
  [ HH.td_ [ HH.text label ]
  , HH.td_ [ HH.text value ]
  ]

formatDuration :: forall d. Duration d => d -> String
formatDuration duration = let
  Days d = convertDuration duration
  Hours h = convertDuration duration
  ds = show $ floor d
  hs = show $ floor h - (floor d * 24)
  in guard (floor d > 0) (ds <> " days ") <> hs <> " hours"

basicInformation :: forall a s m. MonadAff m => String -> Info -> Config -> H.ComponentHTML a s m
basicInformation cls (Info info) (Config config) =
  card [cls]
    [ HH.text "Basic Information" ]
    [ HH.table [ classes ["info-table"] ]
      [ tableRow "Recording Start" $
        formatDateTime' info.first_dt
      , tableRow "Recording End" $
        formatDateTime' info.last_dt
      , tableRow "Time Span" $
        formatDuration (info.last_dt `diff` info.first_dt :: Days)
      , tableRow "Number of Data Points" $
        formatOrShowNumber "0,0" (toNumber info.n_entries)
      , tableRow "Recording Length" $
        formatDuration (Seconds $ toNumber info.n_entries * config.predict_stride)
      ]
    ]

sceneConfiguration :: forall a s m. MonadAff m => String -> Config -> H.ComponentHTML a s m
sceneConfiguration cls (Config config) =
  card [cls]
    [ HH.text "Scene Configuration" ]
    [ HH.table [ classes ["info-table"] ]
      [ tableRow "Number of Cameras" $
          show (length config.cameras)
      , tableRow "Frames per Second" $
          formatOrShowNumber "0.0" (1.0 / config.predict_stride)
      , tableRow "Maximum Number of Objects" $
          show config.n_objects
      , tableRow "Minimum Tracklet Length" $
          show config.min_tracklet_len <> " frames"
      , tableRow "Warmup Period" $
          show config.toss_first <> " frames"
      , tableRow "Quantization" $
          show config.grid_px_size <> " m"
      , tableRow "Bounding Box" $
          show config.bbox
      , tableRow "GPU ID" $
          show config.gpu
      ]
    , HH.div [ classes [] ]
      [ HH.text "Zones:"
      , HH.br_
      , HH.ul [] $ enumerate config.zones <#> \(Tuple i zone) ->
        HH.li [CSS.style (color $ colorToCss (hashedColor i))] [HH.text zone.name]
      ]
    , HH.div [ classes ["mt-4"] ]
      [ HH.i_ [ HH.a [ HP.href ("/web/#" <> print routeCodec Cameras) ] [ HH.text "show cameras" ] ]
      , HH.br_
      , HH.i_
        [ HH.text "show raw config:"
          , HH.a [ classes ["mx-1"], HP.href "/info/tracker.yaml" ] [ HH.text "yaml" ]
          , HH.text "|"
          , HH.a [ classes ["mx-1"], HP.href "/config" ] [ HH.text "json" ]
          ]
      ]
    ]

sceneMap :: forall a s m. MonadAff m => CanvasImageSource -> H.ComponentHTML a s m
sceneMap mapImage = let
  {width, height} = imageShape mapImage
  in card []
    [ HH.text "Scene Map" ]
    [ HH.canvas [ HP.id_ "map-canvas", HP.width width, HP.height height ]
    ]

render :: forall a m. MonadAff m => State -> H.ComponentHTML a Slots m
render state = let
  plotOpts = defaultOpts
    { height = 100.0
    , axes = [defaultXAxis, noAxis]
    , series = [defaultSeries, defaultSeries { fill="#4e73df" }]
    }
  in
  HH.div [ classes ["row"] ]
    [ HH.div [ classes ["col-lg-8"]]
      [ card []
        [ HH.text "Recording History" ]
        [ HH.slot _plot unit Plot.component plotOpts (const Nothing)
        ]
      , HH.div [ classes ["row"] ]
        [ basicInformation "col-xl-6" state.info state.config
        , sceneConfiguration "col-xl-6" state.config
        ]
      ]
    , HH.div [ classes ["col-lg-4"] ]
      [ sceneMap state.mapImage
      ]
    ]

handleAction :: forall output m. MonadAff m => Action -> H.HalogenM State Action Slots output m Unit
handleAction = case _ of
  Initialize -> do
    {info: Info info, config: Config config, mapImage} <- H.get

    -- Draw recording timeline
    instantRange <- liftAff $ fetchInstantInterval info.first_dt info.last_dt (Minutes 10.0)
    for_ instantRange \instants -> do
      let x = instants <#> (unwrap >>> _.timestamp >>> datetimeToSeconds >>> Just)
          y = instants <#> (unwrap >>> _.objects >>> map (const 1.0))
      void $ H.query _plot unit $ H.tell (\a -> Plot.SetData [x, y] a)

    -- draw the map
    mCanvas <- liftEffect $ Canvas.getCanvasElementById "map-canvas"
    liftEffect case mCanvas of
      Nothing -> log "Can't locate canvas."
      Just canvas -> do
        ctx <- Canvas.getContext2D canvas
        Canvas.setGlobalAlpha ctx 1.0
        Canvas.drawImage ctx mapImage 0.0 0.0
        Canvas.setGlobalAlpha ctx 0.1
        cshape <- canvasShape canvas
        for_ (enumerate config.zones) \(Tuple i zone) -> do
          let Box {x0, x1, y0, y1} = zone.box
              V2 x y = metersToPixels cshape config.bbox (V2 x0 y0)
              V2 xx yy = metersToPixels cshape config.bbox (V2 x1 y1)
          Canvas.setFillStyle ctx (toHexString $ hashedColor i)
          Canvas.beginPath ctx
          Canvas.rect ctx {x, y, width: xx - x, height: yy - y}
          Canvas.fill ctx

  SetInput { info, config } -> do
    H.modify_ _ { info = info, config = config }
    handleAction Initialize