module Zwirn.Core.Conditional where

{-
    Conditional.hs - conditional functions
    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 (first)
import Data.Fixed (mod')
import Zwirn.Core.Core
import Zwirn.Core.Modulate
import Zwirn.Core.Time
import Zwirn.Core.Types

ifthen :: (MultiMonad k) => ZwirnT k st i Bool -> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
ifthen :: forall (k :: * -> *) st i a.
MultiMonad k =>
ZwirnT k st i Bool
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
ifthen ZwirnT k st i Bool
bz ZwirnT k st i a
xz ZwirnT k st i a
yz = ZwirnT k st i (ZwirnT k st i a) -> ZwirnT k st i a
forall a. ZwirnT k st i (ZwirnT k st i a) -> ZwirnT k st i a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
innerJoin (ZwirnT k st i (ZwirnT k st i a) -> ZwirnT k st i a)
-> ZwirnT k st i (ZwirnT k st i a) -> ZwirnT k st i a
forall a b. (a -> b) -> a -> b
$ (Time -> st -> k (Value i (ZwirnT k st i a), st))
-> ZwirnT k st i (ZwirnT k st i a)
forall st (k :: * -> *) i a.
(Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
zwirn Time -> st -> k (Value i (ZwirnT k st i a), st)
q
  where
    q :: Time -> st -> k (Value i (ZwirnT k st i a), st)
q Time
t st
st = (Value i Bool -> Value i (ZwirnT k st i a))
-> (Value i Bool, st) -> (Value i (ZwirnT k st i a), st)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Bool -> ZwirnT k st i a)
-> Value i Bool -> Value i (ZwirnT k st i a)
forall a b. (a -> b) -> Value i a -> Value i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> ZwirnT k st i a
f) ((Value i Bool, st) -> (Value i (ZwirnT k st i a), st))
-> k (Value i Bool, st) -> k (Value i (ZwirnT k st i a), st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT k st i Bool -> Time -> st -> k (Value i Bool, st)
forall (k :: * -> *) st i a.
ZwirnT k st i a -> Time -> st -> k (Value i a, st)
unzwirn ZwirnT k st i Bool
bz Time
t st
st
      where
        f :: Bool -> ZwirnT k st i a
f Bool
True = ZwirnT k st i a
xz
        f Bool
False = ZwirnT k st i a
yz

iff :: (MultiMonad k, HasSilence k) => ZwirnT k st i Bool -> ZwirnT k st i a -> ZwirnT k st i a
iff :: forall (k :: * -> *) st i a.
(MultiMonad k, HasSilence k) =>
ZwirnT k st i Bool -> ZwirnT k st i a -> ZwirnT k st i a
iff ZwirnT k st i Bool
b ZwirnT k st i a
x = ZwirnT k st i Bool
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) st i a.
MultiMonad k =>
ZwirnT k st i Bool
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
ifthen ZwirnT k st i Bool
b ZwirnT k st i a
x ZwirnT k st i a
forall st i a. ZwirnT k st i a
forall (k :: * -> *) st i a. HasSilence k => ZwirnT k st i a
silence

or :: (Applicative k) => ZwirnT k st i Bool -> ZwirnT k st i Bool -> ZwirnT k st i Bool
or :: forall (k :: * -> *) st i.
Applicative k =>
ZwirnT k st i Bool -> ZwirnT k st i Bool -> ZwirnT k st i Bool
or = (Bool -> Bool -> Bool)
-> ZwirnT k st i Bool -> ZwirnT k st i Bool -> ZwirnT k st i Bool
forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||)

and :: (Applicative k) => ZwirnT k st i Bool -> ZwirnT k st i Bool -> ZwirnT k st i Bool
and :: forall (k :: * -> *) st i.
Applicative k =>
ZwirnT k st i Bool -> ZwirnT k st i Bool -> ZwirnT k st i Bool
and = (Bool -> Bool -> Bool)
-> ZwirnT k st i Bool -> ZwirnT k st i Bool -> ZwirnT k st i Bool
forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&)

not :: (Functor k) => ZwirnT k st i Bool -> ZwirnT k st i Bool
not :: forall (k :: * -> *) st i.
Functor k =>
ZwirnT k st i Bool -> ZwirnT k st i Bool
not = (Bool -> Bool) -> ZwirnT k st i Bool -> ZwirnT k st i Bool
forall a b. (a -> b) -> ZwirnT k st i a -> ZwirnT k st i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
Prelude.not

eq :: (Eq a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
eq :: forall a (k :: * -> *) st i.
(Eq a, Applicative k) =>
ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
eq = (a -> a -> Bool)
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

leq :: (Ord a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
leq :: forall a (k :: * -> *) st i.
(Ord a, Applicative k) =>
ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
leq = (a -> a -> Bool)
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

geq :: (Ord a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
geq :: forall a (k :: * -> *) st i.
(Ord a, Applicative k) =>
ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
geq = (a -> a -> Bool)
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)

le :: (Ord a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
le :: forall a (k :: * -> *) st i.
(Ord a, Applicative k) =>
ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
le = (a -> a -> Bool)
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)

ge :: (Ord a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
ge :: forall a (k :: * -> *) st i.
(Ord a, Applicative k) =>
ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
ge = (a -> a -> Bool)
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)

while :: (MultiMonad k) => ZwirnT k st i Bool -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
while :: forall (k :: * -> *) st i a.
MultiMonad k =>
ZwirnT k st i Bool
-> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a
-> ZwirnT k st i a
while ZwirnT k st i Bool
b ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
f ZwirnT k st i a
x = ZwirnT k st i Bool
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) st i a.
MultiMonad k =>
ZwirnT k st i Bool
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
ifthen ZwirnT k st i Bool
b (ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a -> ZwirnT k st i a
forall (m :: * -> *) a b.
MultiMonad m =>
m (m a -> m b) -> m a -> m b
squeezeApply ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
f ZwirnT k st i a
x) ZwirnT k st i a
x

-- | the first value controls the period the second the length of applying the function in that period
everyFor :: (Monad k) => ZwirnT k st i Time -> ZwirnT k st i Time -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
everyFor :: forall (k :: * -> *) st i a.
Monad k =>
ZwirnT k st i Time
-> ZwirnT k st i Time
-> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a
-> ZwirnT k st i a
everyFor ZwirnT k st i Time
t1 ZwirnT k st i Time
t2 ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
f ZwirnT k st i a
x = Time
-> Time
-> (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a
-> ZwirnT k st i a
forall (k :: * -> *) st i a.
Monad k =>
Time
-> Time
-> (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a
-> ZwirnT k st i a
everyFor' (Time
 -> Time
 -> (ZwirnT k st i a -> ZwirnT k st i a)
 -> ZwirnT k st i a
 -> ZwirnT k st i a)
-> ZwirnT k st i Time
-> ZwirnT
     k
     st
     i
     (Time
      -> (ZwirnT k st i a -> ZwirnT k st i a)
      -> ZwirnT k st i a
      -> ZwirnT k st i a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT k st i Time
t1 ZwirnT
  k
  st
  i
  (Time
   -> (ZwirnT k st i a -> ZwirnT k st i a)
   -> ZwirnT k st i a
   -> ZwirnT k st i a)
-> ZwirnT k st i Time
-> ZwirnT
     k
     st
     i
     ((ZwirnT k st i a -> ZwirnT k st i a)
      -> ZwirnT k st i a -> ZwirnT k st i a)
forall a b.
ZwirnT k st i (a -> b) -> ZwirnT k st i a -> ZwirnT k st i b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZwirnT k st i Time
t2 ZwirnT
  k
  st
  i
  ((ZwirnT k st i a -> ZwirnT k st i a)
   -> ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
forall a b.
ZwirnT k st i (a -> b) -> ZwirnT k st i a -> ZwirnT k st i b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
f ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a -> ZwirnT k st i a
forall (m :: * -> *) a b. Monad m => m (m a -> m b) -> m a -> m b
<$$> ZwirnT k st i a
x
  where
    everyFor' :: (Monad k) => Time -> Time -> (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
    everyFor' :: forall (k :: * -> *) st i a.
Monad k =>
Time
-> Time
-> (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a
-> ZwirnT k st i a
everyFor' Time
per Time
for ZwirnT k st i a -> ZwirnT k st i a
f ZwirnT k st i a
x = (Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
forall st (k :: * -> *) i a.
(Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
zwirn ((Time -> st -> k (Value i a, st)) -> ZwirnT k st i a)
-> (Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
forall a b. (a -> b) -> a -> b
$ \Time
t st
st -> if Time -> Time -> Time
forall a. Real a => a -> a -> a
mod' Time
t Time
per Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
for then 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 -> ZwirnT k st i a
f ZwirnT k st i a
x) Time
t st
st else 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
x Time
t st
st

-- | applies function every period for one cycle
every :: (Monad k) => ZwirnT k st i Time -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
every :: forall (k :: * -> *) st i a.
Monad k =>
ZwirnT k st i Time
-> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a
-> ZwirnT k st i a
every ZwirnT k st i Time
x = ZwirnT k st i Time
-> ZwirnT k st i Time
-> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a
-> ZwirnT k st i a
forall (k :: * -> *) st i a.
Monad k =>
ZwirnT k st i Time
-> ZwirnT k st i Time
-> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i a
-> ZwirnT k st i a
everyFor ZwirnT k st i Time
x (Time -> ZwirnT k st i Time
forall a. a -> ZwirnT k st i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
1)