Query.hs

{-# LANGUAGE BangPatterns #-}

module Zwirn.Core.Query where

{-
    Query.hs - querying signals for breakpoints
    (i.e. the zeroes of the fractional part of the inner time of a signal)
    Copyright (C) 2025, Martin Gius

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Data.Bifunctor
import Zwirn.Core.Core
import Zwirn.Core.Time
import Zwirn.Core.Tree
import Zwirn.Core.Types

type Breakpoint st i a = (Time, Value i a, st)

precision :: Time
precision = 0.001

instance (Show a, Num st, ToList k) => Show (ZwirnT k st i a) where
  show cord = show $ findAllValuesWithTime (Time 0 1, Time 1 1) 0 cord

findAllValuesWithTimeStateInfo :: (ToList k) => (Time, Time) -> st -> ZwirnT k st i a -> [(Time, a, st, [i])]
findAllValuesWithTimeStateInfo (from, to) st z = map fixTime $ findAllBreakpoints from to precision st z
  where
    fixTime (t, Value v d i, st) = if tDiff d > 0 then (t, v, st, i) else (t - precision, v, st, i)

findAllValuesWithTimeState :: (ToList k) => (Time, Time) -> st -> ZwirnT k st i a -> [(Time, a, st)]
findAllValuesWithTimeState (from, to) st z = map fixTime $ findAllBreakpoints from to precision st z
  where
    fixTime (t, Value v d _, st) = if tDiff d > 0 then (t, v, st) else (t - precision, v, st)

findAllValuesWithTime :: (ToList k) => (Time, Time) -> st -> ZwirnT k st i a -> [(Time, a)]
findAllValuesWithTime (from, to) st z = map fixTime $ findAllBreakpoints from to precision st z
  where
    fixTime (t, Value v d _, st) = if tDiff d > 0 then (t, v) else (t - precision, v)

findAll :: (ToList k) => (Time, Time) -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findAll (from, to) st z = map fixTime $ findAllBreakpoints from to precision st z
  where
    fixTime (t, v@(Value _ d _), st) = if tDiff d > 0 then (t, v, st) else (t - precision, v, st)

findNextBreakpoint :: (ToList k) => Time -> Time -> Time -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findNextBreakpoint time to precision st pat = findNextBreakpoint' time to precision start st pat
  where
    start = map (\(Value _ i _, _) -> frac i) $ toList $ unzwirn pat time st

findNextBreakpoint' :: (ToList k) => Time -> Time -> Time -> [Time] -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findNextBreakpoint' !prevTime to precision prevs st pat
  | now <= to = if or bps then concat $ zipWith zipper bps vs else findNextBreakpoint' now to precision times st pat
  | or bps = concat $ zipWith zipper bps vs
  | otherwise = []
  where
    now = prevTime + precision
    vs = toList $ unzwirn pat now st
    vals = map (value . fst) vs
    times = map (frac . time . fst) vs
    bps = breakConditions prevs times
    zipper True (v, st') = [(now, v, st')]
    zipper False _ = []

findAllBreakpoints :: (ToList k) => Time -> Time -> Time -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findAllBreakpoints from to precision = findAllBreakpoints' (from - precision) (to - 2 * precision) precision

findAllBreakpoints' :: (ToList k) => Time -> Time -> Time -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findAllBreakpoints' !from to precision st pat = case findNextBreakpoint from to precision st pat of
  [] -> []
  (bp@(t, _, st') : bps) -> bp : bps ++ findAllBreakpoints' t to precision st' pat

breakConditions :: [Time] -> [Time] -> [Bool]
breakConditions [] [] = []
breakConditions [] xs@(_ : _) = map breakCondition xs
breakConditions xs@(_ : _) [] = map breakCondition xs
breakConditions xs ys = liftA2Right breakConditionCombined xs ys

breakConditionCombined :: Time -> Time -> Bool
breakConditionCombined prev now = breakCondition now && not (breakCondition prev)

breakCondition :: Time -> Bool
breakCondition (Time inner scale)
  | scale > 0 = inner <= tTime precision * abs scale
  | abs (inner - 1) <= tTime precision * abs scale = True
  | otherwise = False