module Frontend.Tracklet.Filter where

import Prelude

import Data.Array (dropWhile, head, init, last, tail, zipWith)
import Data.DateTime (DateTime, diff)
import Data.Foldable (sum)
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Time.Duration (class Duration, Seconds(..), convertDuration)
import Frontend.Types (Box(..), Vec2(..), Tracklet)
import Math (sqrt)

type TrackletFilter = Tracklet -> Boolean

-- Boolean algebra for tracklet filters is automatically implemented.
-- (true, false, and, or, not, implies) are for free


distanceAtLeast :: Number -> TrackletFilter
distanceAtLeast n t = (_ >= n) $ sum $ fromMaybe [0.0] $ (zipWith dist <$> init t <*> tail t) where
  dist {p: V2 x1 y1} {p: V2 x2 y2} = sqrt $ (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)


durationAtLeast :: forall d. Duration d => d -> TrackletFilter
durationAtLeast d t = fromMaybe false do
  h <- head t
  l <- last t
  let d' = diff l.t h.t :: Seconds
  pure $ d' >= (convertDuration d)


insideBox :: Box -> PointFilter
insideBox (Box {x0, y0, x1, y1}) {p: (V2 x y)} =
    x0 <= x && x <= x1 && y0 <= y && y <= y1


first :: PointFilter -> Tracklet -> Boolean
first = runParser <<< one


type PointFilter = { t :: DateTime, p :: Vec2 } -> Boolean

-- LL(0) parser
type Parser = Tracklet -> Maybe Tracklet

runParser :: Parser -> Tracklet -> Boolean
runParser p = isJust <<< p

any :: PointFilter -> Parser
any f = until f `andThen` one f

until :: PointFilter -> Parser
until f = many (not <$> f)

many :: PointFilter -> Parser
many f = Just <<< dropWhile f

one :: PointFilter -> Parser
one f t = case f <$> head t of
  Just true -> tail t
  _ -> Nothing

andThen :: Parser -> Parser -> Parser
andThen p q t = p t >>= q

type HLine = {x0 :: Number, x1 :: Number, y :: Number}
data Direction = Up | Dn

duration :: forall d. Duration d => d -> Parser
duration d t = do
  h <- head t
  let pred = dropWhile (\x -> (diff x.t h.t :: Seconds) < convertDuration d) t
  case pred of
    [] -> Nothing
    l -> Just l

hLine :: HLine -> Direction -> Parser
hLine {x0, x1, y} dir = let
  rt = Box {x0, x1, y0: y + 0.5, y1: y + 2.0}
  rb = Box {x0, x1, y0: y - 2.0, y1: y - 0.5}
  {r1, r2} = case dir of
    Dn -> {r1: rt, r2: rb}
    Up -> {r1: rb, r2: rt}
  in until (insideBox r1) `andThen` one (insideBox r1) `andThen` until (insideBox r2) `andThen` one (insideBox r2)