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