module Frontend.Types where

import Prelude

import Data.Argonaut.Core (Json)
import Data.Argonaut.Decode (class DecodeJson, JsonDecodeError(..), decodeJson, (.:))
import Data.Array (zipWith, (!!))
import Data.DateTime (DateTime)
import Data.DateTime.Instant (fromDateTime, unInstant)
import Data.Either (Either(..), note)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe)
import Data.Newtype (class Newtype, unwrap)
import Data.Traversable (for)
import Data.Tuple (Tuple(..))
import Foreign.Object as FO
import Frontend.Util (secondsToDateTime)


dateTimeToSeconds :: DateTime -> Number
dateTimeToSeconds = (_ / 1000.0) <<< unwrap <<< unInstant <<< fromDateTime

data Vec2 = V2 Number Number
newtype Box = Box { x0 :: Number, y0 :: Number, x1 :: Number, y1 :: Number }

newtype Object = Object
  { id :: Int
  , pos :: Vec2
  , gap :: Int
  , heading :: Vec2
  }

newtype Instant = Instant
  { timestamp :: DateTime
  , objects :: Array Object
  }

newtype MaybeInstant = MaybeInstant
  { timestamp :: DateTime
  , objects :: Maybe (Array Object)
  }

type Tracklet = Array
  { t :: DateTime
  , p :: Vec2
  }

newtype Tracklets = Tracklets (Array Tracklet)

newtype Info = Info
  { n_entries :: Int
  , first_dt :: DateTime
  , last_dt :: DateTime
  }

type Zone =
  { name :: String
  , box :: Box
  }

newtype Config = Config
  { bbox :: Box
  , grid_px_size :: Number
  , n_objects :: Int
  , model_path :: String
  , min_tracklet_len :: Int
  , predict_stride :: Number
  , toss_first :: Int
  , gpu :: Int
  , map :: String
  , zones :: Array Zone
  , cameras :: Array
    { name :: String
    , width :: Int
    , height :: Int
    , calib :: String
    , image :: String
    }
  }

derive instance genericVec2 :: Generic Vec2 _

instance showBox :: Show Box where
  show (Box {x0, y0, x1, y1}) = "x: " <> show [x0, x1] <> " m, y: " <> show [y0, y1] <> " m"

instance showVec2 :: Show Vec2 where
  show = genericShow

derive instance genericObject :: Generic Object _
derive instance newtypeObject :: Newtype Object _

instance showObject :: Show Object where
  show = genericShow

derive instance genericInstant :: Generic Instant _
derive instance newtypeInstant :: Newtype Instant _

instance showInstant :: Show Instant where
  show = genericShow

derive instance genericMaybeInstant :: Generic MaybeInstant _
derive instance newtypeMaybeInstant :: Newtype MaybeInstant _

instance showMaybeInstant :: Show MaybeInstant where
  show = genericShow

derive instance genericTracklets :: Generic Tracklets _
derive instance newtypeTracklets :: Newtype Tracklets _

instance showTracklets :: Show Tracklets where
  show = genericShow

derive instance genericInfo :: Generic Info _
derive instance newtypeInfo :: Newtype Info _

instance showInfo :: Show Info where
  show = genericShow

derive instance genericConfig :: Generic Config _
derive instance newtypeConfig :: Newtype Config _

instance showConfig :: Show Config where
  show = genericShow


instance decodeJsonVec2 :: DecodeJson Vec2 where
  decodeJson json = case decodeJson json of
    Left err -> Left err
    Right (Tuple a b) -> Right (V2 a b)


instance decodeJsonObject :: DecodeJson Object where
  decodeJson json = Object <$> decodeJson json


instance decodeBox :: DecodeJson Box where
  decodeJson :: Json -> Either JsonDecodeError Box
  decodeJson json = do
    o <- decodeJson json
    case o of
      [x0, y0, x1, y1] -> pure $ Box { x0, y0, x1, y1 }
      _ -> Left $ TypeMismatch "Bounding box must have 4 elements."

instance decodeJsonInstant :: DecodeJson Instant where
  decodeJson :: Json -> Either JsonDecodeError Instant
  decodeJson json = do
    o <- decodeJson json
    ts <- o .: "timestamp"
    objects <- o .: "objects"
    timestamp <- note (TypeMismatch "Invalid Timestamp") $ secondsToDateTime ts
    pure $ Instant { timestamp: timestamp, objects }

instance decodeJsonMaybeInstant :: DecodeJson MaybeInstant where
  decodeJson :: Json -> Either JsonDecodeError MaybeInstant
  decodeJson json = do
    o <- decodeJson json
    ts <- o .: "timestamp"
    objects <- o .: "objects"
    timestamp <- note (TypeMismatch "Invalid Timestamp") $ secondsToDateTime ts
    pure $ MaybeInstant { timestamp: timestamp, objects }

instance decodeJsonInfo :: DecodeJson Info where
  decodeJson :: Json -> Either JsonDecodeError Info
  decodeJson json = do
    o <- decodeJson json
    n_entries <- o .: "entries"
    first_ts <- o .: "first_ts"
    last_ts <- o .: "last_ts"

    first_dt <- note (TypeMismatch "Invalid Timestamp") $ secondsToDateTime first_ts
    last_dt <- note (TypeMismatch "Invalid Timestamp") $ secondsToDateTime last_ts

    pure $ Info { n_entries, first_dt, last_dt }


instance decodeJsonConfig :: DecodeJson Config where
  decodeJson :: Json -> Either JsonDecodeError Config
  decodeJson json = do
    o <- decodeJson json
    bbox <- o .: "bbox"
    grid_px_size <- o .: "grid_px_size"
    n_objects <- o .: "n_objects"
    model_path <- o .: "model_path"
    min_tracklet_len <- o .: "min_tracklet_len"
    predict_stride <- o .: "predict_stride"
    toss_first <- o .: "toss_first"
    gpu <- o .: "gpu"
    map <- o .: "map"

    zones' <- o .: "zones" :: Either JsonDecodeError (Array Json)
    zones <- for zones' \zone -> do
      z <- decodeJson zone
      name <- z .: "name"
      box <- z .: "box"
      pure { name, box: Box box }

    cs <- o .: "cameras" :: Either JsonDecodeError (Array Json)
    cameras <- for cs \cj -> do
      c <- decodeJson cj
      name <- c .: "name"
      width <- c .: "w"
      height <- c .: "h"
      calib <- c .: "calib"
      image <- c .: "image"
      pure { name: name, width, height, calib, image }

    pure $ Config
      { bbox, grid_px_size, n_objects, model_path
      , min_tracklet_len, predict_stride, toss_first
      , gpu, map, zones, cameras }


instance decodeJsonTracklets :: DecodeJson Tracklets where
  decodeJson :: Json -> Either JsonDecodeError Tracklets
  decodeJson json = do
    let arrayErr = TypeMismatch "Invalid array length."
    tracklets <- decodeJson json :: Either JsonDecodeError (Array (FO.Object Json))
    res <- for tracklets \tracklet -> do
      tt <- tracklet .: "t"
      px <- tracklet .: "x"
      py <- tracklet .: "y"
      dt <- note (TypeMismatch "Invalid timestamp.") $ for tt secondsToDateTime
      Right $ zipWith (\t p -> {t, p}) dt (zipWith V2 px py)
    let r = res
    pure $ Tracklets res