{-# 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 :: Time
precision = Time
0.001

instance (Show a, Num st, ToList k) => Show (ZwirnT k st i a) where
  show :: ZwirnT k st i a -> String
show ZwirnT k st i a
cord = [(Time, a)] -> String
forall a. Show a => a -> String
show ([(Time, a)] -> String) -> [(Time, a)] -> String
forall a b. (a -> b) -> a -> b
$ (Time, Time) -> st -> ZwirnT k st i a -> [(Time, a)]
forall (k :: * -> *) st i a.
ToList k =>
(Time, Time) -> st -> ZwirnT k st i a -> [(Time, a)]
findAllValuesWithTime (Rational -> Rational -> Time
Time Rational
0 Rational
1, Rational -> Rational -> Time
Time Rational
1 Rational
1) st
0 ZwirnT k st i a
cord

findAllValuesWithTimeStateInfo :: (ToList k) => (Time, Time) -> st -> ZwirnT k st i a -> [(Time, a, st, [i])]
findAllValuesWithTimeStateInfo :: forall (k :: * -> *) st i a.
ToList k =>
(Time, Time) -> st -> ZwirnT k st i a -> [(Time, a, st, [i])]
findAllValuesWithTimeStateInfo (Time
from, Time
to) st
st ZwirnT k st i a
z = ((Time, Value i a, st) -> (Time, a, st, [i]))
-> [(Time, Value i a, st)] -> [(Time, a, st, [i])]
forall a b. (a -> b) -> [a] -> [b]
map (Time, Value i a, st) -> (Time, a, st, [i])
forall {i} {b} {c}. (Time, Value i b, c) -> (Time, b, c, [i])
fixTime ([(Time, Value i a, st)] -> [(Time, a, st, [i])])
-> [(Time, Value i a, st)] -> [(Time, a, st, [i])]
forall a b. (a -> b) -> a -> b
$ Time
-> Time -> Time -> st -> ZwirnT k st i a -> [(Time, Value i a, st)]
forall (k :: * -> *) st i a.
ToList k =>
Time
-> Time -> Time -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findAllBreakpoints Time
from Time
to Time
precision st
st ZwirnT k st i a
z
  where
    fixTime :: (Time, Value i b, c) -> (Time, b, c, [i])
fixTime (Time
t, Value b
v Time
d [i]
i, c
st) = if Time -> Rational
tDiff Time
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0 then (Time
t, b
v, c
st, [i]
i) else (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
precision, b
v, c
st, [i]
i)

findAllValuesWithTimeState :: (ToList k) => (Time, Time) -> st -> ZwirnT k st i a -> [(Time, a, st)]
findAllValuesWithTimeState :: forall (k :: * -> *) st i a.
ToList k =>
(Time, Time) -> st -> ZwirnT k st i a -> [(Time, a, st)]
findAllValuesWithTimeState (Time
from, Time
to) st
st ZwirnT k st i a
z = ((Time, Value i a, st) -> (Time, a, st))
-> [(Time, Value i a, st)] -> [(Time, a, st)]
forall a b. (a -> b) -> [a] -> [b]
map (Time, Value i a, st) -> (Time, a, st)
forall {i} {b} {c}. (Time, Value i b, c) -> (Time, b, c)
fixTime ([(Time, Value i a, st)] -> [(Time, a, st)])
-> [(Time, Value i a, st)] -> [(Time, a, st)]
forall a b. (a -> b) -> a -> b
$ Time
-> Time -> Time -> st -> ZwirnT k st i a -> [(Time, Value i a, st)]
forall (k :: * -> *) st i a.
ToList k =>
Time
-> Time -> Time -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findAllBreakpoints Time
from Time
to Time
precision st
st ZwirnT k st i a
z
  where
    fixTime :: (Time, Value i b, c) -> (Time, b, c)
fixTime (Time
t, Value b
v Time
d [i]
_, c
st) = if Time -> Rational
tDiff Time
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0 then (Time
t, b
v, c
st) else (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
precision, b
v, c
st)

findAllValuesWithTime :: (ToList k) => (Time, Time) -> st -> ZwirnT k st i a -> [(Time, a)]
findAllValuesWithTime :: forall (k :: * -> *) st i a.
ToList k =>
(Time, Time) -> st -> ZwirnT k st i a -> [(Time, a)]
findAllValuesWithTime (Time
from, Time
to) st
st ZwirnT k st i a
z = ((Time, Value i a, st) -> (Time, a))
-> [(Time, Value i a, st)] -> [(Time, a)]
forall a b. (a -> b) -> [a] -> [b]
map (Time, Value i a, st) -> (Time, a)
forall {i} {b} {c}. (Time, Value i b, c) -> (Time, b)
fixTime ([(Time, Value i a, st)] -> [(Time, a)])
-> [(Time, Value i a, st)] -> [(Time, a)]
forall a b. (a -> b) -> a -> b
$ Time
-> Time -> Time -> st -> ZwirnT k st i a -> [(Time, Value i a, st)]
forall (k :: * -> *) st i a.
ToList k =>
Time
-> Time -> Time -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findAllBreakpoints Time
from Time
to Time
precision st
st ZwirnT k st i a
z
  where
    fixTime :: (Time, Value i b, c) -> (Time, b)
fixTime (Time
t, Value b
v Time
d [i]
_, c
st) = if Time -> Rational
tDiff Time
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0 then (Time
t, b
v) else (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
precision, b
v)

findAll :: (ToList k) => (Time, Time) -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findAll :: forall (k :: * -> *) st i a.
ToList k =>
(Time, Time) -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findAll (Time
from, Time
to) st
st ZwirnT k st i a
z = ((Time, Value i a, st) -> (Time, Value i a, st))
-> [(Time, Value i a, st)] -> [(Time, Value i a, st)]
forall a b. (a -> b) -> [a] -> [b]
map (Time, Value i a, st) -> (Time, Value i a, st)
forall {i} {a} {c}. (Time, Value i a, c) -> (Time, Value i a, c)
fixTime ([(Time, Value i a, st)] -> [(Time, Value i a, st)])
-> [(Time, Value i a, st)] -> [(Time, Value i a, st)]
forall a b. (a -> b) -> a -> b
$ Time
-> Time -> Time -> st -> ZwirnT k st i a -> [(Time, Value i a, st)]
forall (k :: * -> *) st i a.
ToList k =>
Time
-> Time -> Time -> st -> ZwirnT k st i a -> [Breakpoint st i a]
findAllBreakpoints Time
from Time
to Time
precision st
st ZwirnT k st i a
z
  where
    fixTime :: (Time, Value i a, c) -> (Time, Value i a, c)
fixTime (Time
t, v :: Value i a
v@(Value a
_ Time
d [i]
_), c
st) = if Time -> Rational
tDiff Time
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0 then (Time
t, Value i a
v, c
st) else (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
precision, Value i a
v, c
st)

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

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

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

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

breakConditions :: [Time] -> [Time] -> [Bool]
breakConditions :: [Time] -> [Time] -> [Bool]
breakConditions [] [] = []
breakConditions [] xs :: [Time]
xs@(Time
_ : [Time]
_) = (Time -> Bool) -> [Time] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Time -> Bool
breakCondition [Time]
xs
breakConditions xs :: [Time]
xs@(Time
_ : [Time]
_) [] = (Time -> Bool) -> [Time] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Time -> Bool
breakCondition [Time]
xs
breakConditions [Time]
xs [Time]
ys = (Time -> Time -> Bool) -> [Time] -> [Time] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Right Time -> Time -> Bool
breakConditionCombined [Time]
xs [Time]
ys

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

breakCondition :: Time -> Bool
breakCondition :: Time -> Bool
breakCondition (Time Rational
inner Rational
scale)
  | Rational
scale Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0 = Rational
inner Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Time -> Rational
tTime Time
precision Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational -> Rational
forall a. Num a => a -> a
abs Rational
scale
  | Rational -> Rational
forall a. Num a => a -> a
abs (Rational
inner Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
1) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Time -> Rational
tTime Time
precision Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational -> Rational
forall a. Num a => a -> a
abs Rational
scale = Bool
True
  | Bool
otherwise = Bool
False