module Zwirn.Core.Core where

{-
    Core.hs - core functions and instances
    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 Control.Applicative
import Control.Monad (join)
import Control.Monad.Identity
import Data.Bifunctor
import Data.Fixed (mod')
import Data.Functor (void)
import Music.Theory.Bjorklund (bjorklund, iseq)
import Zwirn.Core.Time
import Zwirn.Core.Tree
import Zwirn.Core.Types

-- | indicates the current time
now :: (Applicative k) => ZwirnT k st i Time
now :: forall (k :: * -> *) st i. Applicative k => ZwirnT k st i Time
now = (Time -> st -> k (Value i Time, st)) -> ZwirnT k st i Time
forall st (k :: * -> *) i a.
(Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
zwirn ((Time -> st -> k (Value i Time, st)) -> ZwirnT k st i Time)
-> (Time -> st -> k (Value i Time, st)) -> ZwirnT k st i Time
forall a b. (a -> b) -> a -> b
$ \Time
t st
st -> (Value i Time, st) -> k (Value i Time, st)
forall a. a -> k a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time -> Time -> [i] -> Value i Time
forall i a. a -> Time -> [i] -> Value i a
Value Time
t Time
t [], st
st)

-- | indicates the current cycle
cyc :: (Applicative k) => ZwirnT k st i Int
cyc :: forall (k :: * -> *) st i. Applicative k => ZwirnT k st i Int
cyc = (Time -> Int) -> ZwirnT k st i Time -> ZwirnT k st i Int
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 Time -> Int
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ZwirnT k st i Time
forall (k :: * -> *) st i. Applicative k => ZwirnT k st i Time
now

-- higher level helper functions

withInner :: (k (Value i a, st) -> k (Value i b, st)) -> ZwirnT k st i a -> ZwirnT k st i b
withInner :: forall (k :: * -> *) i a st b.
(k (Value i a, st) -> k (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
withInner k (Value i a, st) -> k (Value i b, st)
f ZwirnT k st i a
x = (Time -> st -> k (Value i b, st)) -> ZwirnT k st i b
forall st (k :: * -> *) i a.
(Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
zwirn ((Time -> st -> k (Value i b, st)) -> ZwirnT k st i b)
-> (Time -> st -> k (Value i b, st)) -> ZwirnT k st i b
forall a b. (a -> b) -> a -> b
$ \Time
t st
st -> k (Value i a, st) -> k (Value i b, st)
f (k (Value i a, st) -> k (Value i b, st))
-> k (Value i a, st) -> k (Value i b, 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
x Time
t st
st

withInnerAndTime :: (Time -> k (Value i a, st) -> k (Value i b, st)) -> ZwirnT k st i a -> ZwirnT k st i b
withInnerAndTime :: forall (k :: * -> *) i a st b.
(Time -> k (Value i a, st) -> k (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
withInnerAndTime Time -> k (Value i a, st) -> k (Value i b, st)
f ZwirnT k st i a
x = (Time -> st -> k (Value i b, st)) -> ZwirnT k st i b
forall st (k :: * -> *) i a.
(Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
zwirn ((Time -> st -> k (Value i b, st)) -> ZwirnT k st i b)
-> (Time -> st -> k (Value i b, st)) -> ZwirnT k st i b
forall a b. (a -> b) -> a -> b
$ \Time
t st
st -> Time -> k (Value i a, st) -> k (Value i b, st)
f Time
t (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)

withInnerTimeState :: (Time -> st -> k (Value i a, st) -> k (Value i b, st)) -> ZwirnT k st i a -> ZwirnT k st i b
withInnerTimeState :: forall st (k :: * -> *) i a b.
(Time -> st -> k (Value i a, st) -> k (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
withInnerTimeState Time -> st -> k (Value i a, st) -> k (Value i b, st)
f ZwirnT k st i a
x = (Time -> st -> k (Value i b, st)) -> ZwirnT k st i b
forall st (k :: * -> *) i a.
(Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
zwirn ((Time -> st -> k (Value i b, st)) -> ZwirnT k st i b)
-> (Time -> st -> k (Value i b, st)) -> ZwirnT k st i b
forall a b. (a -> b) -> a -> b
$ \Time
t st
st -> Time -> st -> k (Value i a, st) -> k (Value i b, st)
f Time
t st
st (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)

withInner2 :: (k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st)) -> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
withInner2 :: forall (k :: * -> *) i a st b c.
(k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st))
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
withInner2 k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st)
f ZwirnT k st i a
x ZwirnT k st i b
y = (Time -> st -> k (Value i c, st)) -> ZwirnT k st i c
forall st (k :: * -> *) i a.
(Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
zwirn ((Time -> st -> k (Value i c, st)) -> ZwirnT k st i c)
-> (Time -> st -> k (Value i c, st)) -> ZwirnT k st i c
forall a b. (a -> b) -> a -> b
$ \Time
t st
st -> k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st)
f (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) (ZwirnT k st i b -> Time -> st -> k (Value i b, st)
forall (k :: * -> *) st i a.
ZwirnT k st i a -> Time -> st -> k (Value i a, st)
unzwirn ZwirnT k st i b
y Time
t st
st)

withValueState :: (Functor k) => ((Value i a, st) -> (Value i b, st)) -> ZwirnT k st i a -> ZwirnT k st i b
withValueState :: forall (k :: * -> *) i a st b.
Functor k =>
((Value i a, st) -> (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
withValueState (Value i a, st) -> (Value i b, st)
f = (k (Value i a, st) -> k (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
forall (k :: * -> *) i a st b.
(k (Value i a, st) -> k (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
withInner (((Value i a, st) -> (Value i b, st))
-> k (Value i a, st) -> k (Value i b, st)
forall a b. (a -> b) -> k a -> k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value i a, st) -> (Value i b, st)
f)

withValue :: (Functor k) => (Value i a -> Value i b) -> ZwirnT k st i a -> ZwirnT k st i b
withValue :: forall (k :: * -> *) i a b st.
Functor k =>
(Value i a -> Value i b) -> ZwirnT k st i a -> ZwirnT k st i b
withValue Value i a -> Value i b
f = ((Value i a, st) -> (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
forall (k :: * -> *) i a st b.
Functor k =>
((Value i a, st) -> (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
withValueState ((Value i a -> Value i b) -> (Value i a, st) -> (Value i b, 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 Value i a -> Value i b
f)

withA :: (Functor k) => (a -> a) -> ZwirnT k st i a -> ZwirnT k st i a
withA :: forall (k :: * -> *) a st i.
Functor k =>
(a -> a) -> ZwirnT k st i a -> ZwirnT k st i a
withA a -> a
f = (Value i a -> Value i a) -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) i a b st.
Functor k =>
(Value i a -> Value i b) -> ZwirnT k st i a -> ZwirnT k st i b
withValue (\Value i a
v -> Value i a
v {value = f $ value v})

withTime :: (Functor k) => (Time -> Time) -> ZwirnT k st i a -> ZwirnT k st i a
withTime :: forall (k :: * -> *) st i a.
Functor k =>
(Time -> Time) -> ZwirnT k st i a -> ZwirnT k st i a
withTime Time -> Time
f = (Value i a -> Value i a) -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) i a b st.
Functor k =>
(Value i a -> Value i b) -> ZwirnT k st i a -> ZwirnT k st i b
withValue (\Value i a
v -> Value i a
v {time = f $ time v})

withInfo :: (Functor k) => (i -> i) -> ZwirnT k st i a -> ZwirnT k st i a
withInfo :: forall (k :: * -> *) i st a.
Functor k =>
(i -> i) -> ZwirnT k st i a -> ZwirnT k st i a
withInfo i -> i
f = (Value i a -> Value i a) -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) i a b st.
Functor k =>
(Value i a -> Value i b) -> ZwirnT k st i a -> ZwirnT k st i b
withValue (\Value i a
v -> Value i a
v {info = f <$> info v})

withInfos :: (Functor k) => ([i] -> [i]) -> ZwirnT k st i a -> ZwirnT k st i a
withInfos :: forall (k :: * -> *) i st a.
Functor k =>
([i] -> [i]) -> ZwirnT k st i a -> ZwirnT k st i a
withInfos [i] -> [i]
f = (Value i a -> Value i a) -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) i a b st.
Functor k =>
(Value i a -> Value i b) -> ZwirnT k st i a -> ZwirnT k st i b
withValue (\Value i a
v -> Value i a
v {info = f $ info v})

addInfo :: (Functor k) => i -> ZwirnT k st i a -> ZwirnT k st i a
addInfo :: forall (k :: * -> *) i st a.
Functor k =>
i -> ZwirnT k st i a -> ZwirnT k st i a
addInfo i
i = ([i] -> [i]) -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) i st a.
Functor k =>
([i] -> [i]) -> ZwirnT k st i a -> ZwirnT k st i a
withInfos ([i] -> [i] -> [i]
forall a b. a -> b -> a
const [i
i])

removeInfo :: (Functor k) => ZwirnT k st i a -> ZwirnT k st i a
removeInfo :: forall (k :: * -> *) st i a.
Functor k =>
ZwirnT k st i a -> ZwirnT k st i a
removeInfo = ([i] -> [i]) -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) i st a.
Functor k =>
([i] -> [i]) -> ZwirnT k st i a -> ZwirnT k st i a
withInfos ([i] -> [i] -> [i]
forall a b. a -> b -> a
const [])

withState :: (Functor k) => (st -> st) -> ZwirnT k st i a -> ZwirnT k st i a
withState :: forall (k :: * -> *) st i a.
Functor k =>
(st -> st) -> ZwirnT k st i a -> ZwirnT k st i a
withState st -> st
f = ((Value i a, st) -> (Value i a, st))
-> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) i a st b.
Functor k =>
((Value i a, st) -> (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
withValueState ((st -> st) -> (Value i a, st) -> (Value i a, st)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second st -> st
f)

fromSignal :: (Applicative k) => (Time -> Time) -> ZwirnT k st i Time
fromSignal :: forall (k :: * -> *) st i.
Applicative k =>
(Time -> Time) -> ZwirnT k st i Time
fromSignal Time -> Time
f = Time -> Time
f (Time -> Time) -> ZwirnT k st i Time -> ZwirnT k st i Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT k st i Time
forall (k :: * -> *) st i. Applicative k => ZwirnT k st i Time
now

getInner :: (Functor k) => ZwirnT k st i a -> ZwirnT k st i Time
getInner :: forall (k :: * -> *) st i a.
Functor k =>
ZwirnT k st i a -> ZwirnT k st i Time
getInner = (Value i a -> Value i Time)
-> ZwirnT k st i a -> ZwirnT k st i Time
forall (k :: * -> *) i a b st.
Functor k =>
(Value i a -> Value i b) -> ZwirnT k st i a -> ZwirnT k st i b
withValue (\Value i a
v -> Value i a
v {value = time v})

-- instances

-- | just lifts, only operates on the values
instance (Semigroup a, Applicative k) => Semigroup (ZwirnT k st i a) where
  <> :: ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
(<>) = (a -> a -> a)
-> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
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 -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Monoid a, Applicative k) => Monoid (ZwirnT k st i a) where
  mempty :: ZwirnT k st i a
mempty = a -> ZwirnT k st i a
forall a. a -> ZwirnT k st i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

instance (Functor k) => Functor (ZwirnT k st i) where
  fmap :: forall a b. (a -> b) -> ZwirnT k st i a -> ZwirnT k st i b
fmap a -> b
f = (k (Value i a, st) -> k (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
forall (k :: * -> *) i a st b.
(k (Value i a, st) -> k (Value i b, st))
-> ZwirnT k st i a -> ZwirnT k st i b
withInner (((Value i a, st) -> (Value i b, st))
-> k (Value i a, st) -> k (Value i b, st)
forall a b. (a -> b) -> k a -> k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Value i a, st) -> (Value i b, st))
 -> k (Value i a, st) -> k (Value i b, st))
-> ((Value i a, st) -> (Value i b, st))
-> k (Value i a, st)
-> k (Value i b, st)
forall a b. (a -> b) -> a -> b
$ (Value i a -> Value i b) -> (Value i a, st) -> (Value i b, 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 ((a -> b) -> Value i a -> Value i b
forall a b. (a -> b) -> Value i a -> Value i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f))

instance (Applicative k) => Applicative (ZwirnT k st i) where
  pure :: forall a. a -> ZwirnT k st i a
pure 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 -> (Value i a, st) -> k (Value i a, st)
forall a. a -> k a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Time -> [i] -> Value i a
forall i a. a -> Time -> [i] -> Value i a
Value a
x Time
t [], st
st)
  liftA2 :: forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
liftA2 a -> b -> c
f = (k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st))
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (k :: * -> *) i a st b c.
(k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st))
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
withInner2 (((Value i a, st) -> (Value i b, st) -> (Value i c, st))
-> k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st)
forall a b c. (a -> b -> c) -> k a -> k b -> k c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\(Value i a
v1, st
st1) (Value i b
v2, st
_) -> ((a -> b -> c) -> Value i a -> Value i b -> Value i c
forall a b c. (a -> b -> c) -> Value i a -> Value i b -> Value i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Value i a
v1 Value i b
v2, st
st1)))

instance (MultiApplicative k) => MultiApplicative (ZwirnT k st i) where
  liftA2Left :: forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
liftA2Left a -> b -> c
f = (k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st))
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (k :: * -> *) i a st b c.
(k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st))
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
withInner2 (((Value i a, st) -> (Value i b, st) -> (Value i c, st))
-> k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st)
forall a b c. (a -> b -> c) -> k a -> k b -> k c
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Left (\(Value i a
v1, st
st1) (Value i b
v2, st
_) -> ((a -> b -> c) -> Value i a -> Value i b -> Value i c
forall a b c. (a -> b -> c) -> Value i a -> Value i b -> Value i c
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Left a -> b -> c
f Value i a
v1 Value i b
v2, st
st1)))
  liftA2Right :: forall a b c.
(a -> b -> c)
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
liftA2Right a -> b -> c
f = (k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st))
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
forall (k :: * -> *) i a st b c.
(k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st))
-> ZwirnT k st i a -> ZwirnT k st i b -> ZwirnT k st i c
withInner2 (((Value i a, st) -> (Value i b, st) -> (Value i c, st))
-> k (Value i a, st) -> k (Value i b, st) -> k (Value i c, st)
forall a b c. (a -> b -> c) -> k a -> k b -> k c
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Right (\(Value i a
v1, st
st1) (Value i b
v2, st
_) -> ((a -> b -> c) -> Value i a -> Value i b -> Value i c
forall a b c. (a -> b -> c) -> Value i a -> Value i b -> Value i c
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Right a -> b -> c
f Value i a
v1 Value i b
v2, st
st1)))

instance (Monad k) => Monad (ZwirnT k st i) where
  >>= :: forall a b.
ZwirnT k st i a -> (a -> ZwirnT k st i b) -> ZwirnT k st i b
(>>=) ZwirnT k st i a
x a -> ZwirnT k st i b
f = ZwirnT k st i (ZwirnT k st i b) -> ZwirnT k st i b
forall {k :: * -> *} {st} {i} {a}.
Monad k =>
ZwirnT k st i (ZwirnT k st i a) -> ZwirnT k st i a
innerJoin (ZwirnT k st i (ZwirnT k st i b) -> ZwirnT k st i b)
-> ZwirnT k st i (ZwirnT k st i b) -> ZwirnT k st i b
forall a b. (a -> b) -> a -> b
$ (a -> ZwirnT k st i b)
-> ZwirnT k st i a -> ZwirnT k st i (ZwirnT k st i b)
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 a -> ZwirnT k st i b
f ZwirnT k st i a
x
    where
      innerJoin :: ZwirnT k st i (ZwirnT k st i a) -> ZwirnT k st i a
innerJoin ZwirnT k st i (ZwirnT k st i a)
pp = (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)
q
        where
          q :: Time -> st -> k (Value i a, st)
q Time
t st
st = (\(Value i (ZwirnT k st i a)
z, st
st') -> (Value i a -> Value i a) -> (Value i a, st) -> (Value 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 ([i] -> Value i a -> Value i a
forall {i} {a}. [i] -> Value i a -> Value i a
mergeInfo (Value i (ZwirnT k st i a) -> [i]
forall i a. Value i a -> [i]
info Value i (ZwirnT k st i a)
z)) ((Value i a, st) -> (Value i a, st))
-> k (Value i a, st) -> k (Value i a, st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 (Value i (ZwirnT k st i a) -> ZwirnT k st i a
forall i a. Value i a -> a
value Value i (ZwirnT k st i a)
z) Time
t st
st') ((Value i (ZwirnT k st i a), st) -> k (Value i a, st))
-> k (Value i (ZwirnT k st i a), st) -> k (Value i a, st)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< k (Value i (ZwirnT k st i a), st)
outer
            where
              outer :: k (Value i (ZwirnT k st i a), st)
outer = ZwirnT k st i (ZwirnT k st i a)
-> Time -> st -> k (Value i (ZwirnT k st 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 (ZwirnT k st i a)
pp Time
t st
st
              mergeInfo :: [i] -> Value i a -> Value i a
mergeInfo [i]
i Value i a
v = Value i a
v {info = info v ++ i}

instance (MultiMonad k) => MultiMonad (ZwirnT k st i) where
  outerJoin :: forall a. ZwirnT k st i (ZwirnT k st i a) -> ZwirnT k st i a
outerJoin ZwirnT k st i (ZwirnT k st i a)
pp = (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)
q
    where
      q :: Time -> st -> k (Value i a, st)
q Time
t st
st = k (k (Value i a, st)) -> k (Value i a, st)
forall a. k (k a) -> k a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
outerJoin (k (k (Value i a, st)) -> k (Value i a, st))
-> k (k (Value i a, st)) -> k (Value i a, st)
forall a b. (a -> b) -> a -> b
$ (\(Value i (ZwirnT k st i a)
z, st
st') -> (Value i a -> Value i a) -> (Value i a, st) -> (Value 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 (\Value i a
v -> Value i a
v {time = time z, info = info v ++ info z}) ((Value i a, st) -> (Value i a, st))
-> k (Value i a, st) -> k (Value i a, st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 (Value i (ZwirnT k st i a) -> ZwirnT k st i a
forall i a. Value i a -> a
value Value i (ZwirnT k st i a)
z) Time
t st
st') ((Value i (ZwirnT k st i a), st) -> k (Value i a, st))
-> k (Value i (ZwirnT k st i a), st) -> k (k (Value i a, st))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k (Value i (ZwirnT k st i a), st)
outer
        where
          outer :: k (Value i (ZwirnT k st i a), st)
outer = ZwirnT k st i (ZwirnT k st i a)
-> Time -> st -> k (Value i (ZwirnT k st 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 (ZwirnT k st i a)
pp Time
t st
st

  squeezeJoin :: forall a. ZwirnT k st i (ZwirnT k st i a) -> ZwirnT k st i a
squeezeJoin ZwirnT k st i (ZwirnT k st i a)
pp = (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)
q
    where
      q :: Time -> st -> k (Value i a, st)
q Time
t st
st = k (k (Value i a, st)) -> k (Value i a, st)
forall a. k (k a) -> k a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
squeezeJoin (k (k (Value i a, st)) -> k (Value i a, st))
-> k (k (Value i a, st)) -> k (Value i a, st)
forall a b. (a -> b) -> a -> b
$ (\(Value i (ZwirnT k st i a)
z, st
st') -> (Value i a -> Value i a) -> (Value i a, st) -> (Value 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 ([i] -> Value i a -> Value i a
forall {i} {a}. [i] -> Value i a -> Value i a
mergeInfo (Value i (ZwirnT k st i a) -> [i]
forall i a. Value i a -> [i]
info Value i (ZwirnT k st i a)
z)) ((Value i a, st) -> (Value i a, st))
-> k (Value i a, st) -> k (Value i a, st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 (Value i (ZwirnT k st i a) -> ZwirnT k st i a
forall i a. Value i a -> a
value Value i (ZwirnT k st i a)
z) (Value i (ZwirnT k st i a) -> Time
forall i a. Value i a -> Time
time Value i (ZwirnT k st i a)
z) st
st') ((Value i (ZwirnT k st i a), st) -> k (Value i a, st))
-> k (Value i (ZwirnT k st i a), st) -> k (k (Value i a, st))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k (Value i (ZwirnT k st i a), st)
outer
        where
          outer :: k (Value i (ZwirnT k st i a), st)
outer = ZwirnT k st i (ZwirnT k st i a)
-> Time -> st -> k (Value i (ZwirnT k st 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 (ZwirnT k st i a)
pp Time
t st
st
          mergeInfo :: [i] -> Value i a -> Value i a
mergeInfo [i]
i Value i a
v = Value i a
v {info = info v ++ i}

outerApply :: (MultiMonad m) => m (m a -> m b) -> m a -> m b
outerApply :: forall (m :: * -> *) a b.
MultiMonad m =>
m (m a -> m b) -> m a -> m b
outerApply m (m a -> m b)
f m a
x = m (m b) -> m b
forall a. m (m a) -> m a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
outerJoin (m (m b) -> m b) -> m (m b) -> m b
forall a b. (a -> b) -> a -> b
$ m (m a -> m b)
f m (m a -> m b) -> m (m a) -> m (m b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a -> m (m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
x

innerApply :: (Monad m) => m (m a -> m b) -> m a -> m b
innerApply :: forall (m :: * -> *) a b. Monad m => m (m a -> m b) -> m a -> m b
innerApply m (m a -> m b)
f m a
x = m (m b) -> m b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m b) -> m b) -> m (m b) -> m b
forall a b. (a -> b) -> a -> b
$ m (m a -> m b)
f m (m a -> m b) -> m (m a) -> m (m b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a -> m (m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
x

squeezeApply :: (MultiMonad m) => m (m a -> m b) -> m a -> m b
squeezeApply :: forall (m :: * -> *) a b.
MultiMonad m =>
m (m a -> m b) -> m a -> m b
squeezeApply m (m a -> m b)
f m a
x = m (m b) -> m b
forall a. m (m a) -> m a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
squeezeJoin (m (m b) -> m b) -> m (m b) -> m b
forall a b. (a -> b) -> a -> b
$ m (m a -> m b)
f m (m a -> m b) -> m (m a) -> m (m b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a -> m (m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
x

zipApply :: (MultiMonad k) => ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i b) -> ZwirnT k st i a -> ZwirnT k st i b
zipApply :: forall (k :: * -> *) st i a b.
MultiMonad k =>
ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i b)
-> ZwirnT k st i a -> ZwirnT k st i b
zipApply ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i b)
fs ZwirnT k st i a
x = (Time -> st -> k (Value i b, st)) -> ZwirnT k st i b
forall st (k :: * -> *) i a.
(Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
zwirn Time -> st -> k (Value i b, st)
q
  where
    q :: Time -> st -> k (Value i b, st)
q Time
t st
st = k (k (Value i b, st)) -> k (Value i b, st)
forall a. k (k a) -> k a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
innerJoin (k (k (Value i b, st)) -> k (Value i b, st))
-> k (k (Value i b, st)) -> k (Value i b, st)
forall a b. (a -> b) -> a -> b
$ (\ZwirnT k st i b
c -> ZwirnT k st i b -> Time -> st -> k (Value i b, st)
forall (k :: * -> *) st i a.
ZwirnT k st i a -> Time -> st -> k (Value i a, st)
unzwirn ZwirnT k st i b
c Time
t st
st) (ZwirnT k st i b -> k (Value i b, st))
-> ((Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
    -> ZwirnT k st i b)
-> (Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
-> k (Value i b, st)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ZwirnT k st i a -> ZwirnT k st i b)
-> ZwirnT k st i a -> ZwirnT k st i b
forall a b. (a -> b) -> a -> b
$ ZwirnT k st i a
x) ((ZwirnT k st i a -> ZwirnT k st i b) -> ZwirnT k st i b)
-> ((Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
    -> ZwirnT k st i a -> ZwirnT k st i b)
-> (Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
-> ZwirnT k st i b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value i (ZwirnT k st i a -> ZwirnT k st i b)
-> ZwirnT k st i a -> ZwirnT k st i b
forall i a. Value i a -> a
value (Value i (ZwirnT k st i a -> ZwirnT k st i b)
 -> ZwirnT k st i a -> ZwirnT k st i b)
-> ((Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
    -> Value i (ZwirnT k st i a -> ZwirnT k st i b))
-> (Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
-> ZwirnT k st i a
-> ZwirnT k st i b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
-> Value i (ZwirnT k st i a -> ZwirnT k st i b)
forall a b. (a, b) -> a
fst ((Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
 -> k (Value i b, st))
-> k (Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
-> k (k (Value i b, st))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i b)
-> Time
-> st
-> k (Value i (ZwirnT k st i a -> ZwirnT k st i b), st)
forall (k :: * -> *) st i a.
ZwirnT k st i a -> Time -> st -> k (Value i a, st)
unzwirn ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i b)
fs Time
t st
st

squeezeMap :: (MultiMonad m) => (m a -> m b) -> m a -> m b
squeezeMap :: forall (m :: * -> *) a b.
MultiMonad m =>
(m a -> m b) -> m a -> m b
squeezeMap m a -> m b
f m a
x = m (m b) -> m b
forall a. m (m a) -> m a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
squeezeJoin (m (m b) -> m b) -> m (m b) -> m b
forall a b. (a -> b) -> a -> b
$ (a -> m b) -> m a -> m (m b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m a -> m b
f (m a -> m b) -> (a -> m a) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) m a
x

mapZ :: (MultiMonad m) => m (m a -> m b) -> m a -> m b
mapZ :: forall (m :: * -> *) a b.
MultiMonad m =>
m (m a -> m b) -> m a -> m b
mapZ m (m a -> m b)
fp m a
xp = m (m b) -> m b
forall a. m (m a) -> m a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
squeezeJoin (m (m b) -> m b) -> m (m b) -> m b
forall a b. (a -> b) -> a -> b
$ (a -> m b) -> m a -> m (m b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m (m a -> m b) -> m a -> m b
forall (m :: * -> *) a b.
MultiMonad m =>
m (m a -> m b) -> m a -> m b
squeezeApply m (m a -> m b)
fp (m a -> m b) -> (a -> m a) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) m a
xp

infixl 4 <$$>

(<$$>) :: (Monad m) => m (m a -> m b) -> m a -> m b
<$$> :: forall (m :: * -> *) a b. Monad m => m (m a -> m b) -> m a -> m b
(<$$>) = m (m a -> m b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => m (m a -> m b) -> m a -> m b
innerApply

enumerateFromByTo :: (Ord a, Num a) => a -> a -> a -> [a]
enumerateFromByTo :: forall a. (Ord a, Num a) => a -> a -> a -> [a]
enumerateFromByTo a
x a
y a
z
  | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 = []
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
z = if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y then [a
x] else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> a -> a -> [a]
forall a. (Ord a, Num a) => a -> a -> a -> [a]
enumerateFromByTo (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y) a
y a
z
  | Bool
otherwise = if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y then [a
x] else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> a -> a -> [a]
forall a. (Ord a, Num a) => a -> a -> a -> [a]
enumerateFromByTo (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y) a
y a
z

enumerateFromThenTo :: (Ord a, Num a) => a -> a -> a -> [a]
enumerateFromThenTo :: forall a. (Ord a, Num a) => a -> a -> a -> [a]
enumerateFromThenTo a
x a
y
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = a -> a -> a -> [a]
forall a. (Ord a, Num a) => a -> a -> a -> [a]
enumerateFromByTo a
x (a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
x)
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = a -> a -> a -> [a]
forall a. (Ord a, Num a) => a -> a -> a -> [a]
enumerateFromByTo a
x (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y)

enumerateFromTo :: (Ord a, Num a) => a -> a -> [a]
enumerateFromTo :: forall a. (Ord a, Num a) => a -> a -> [a]
enumerateFromTo a
x = a -> a -> a -> [a]
forall a. (Ord a, Num a) => a -> a -> a -> [a]
enumerateFromByTo a
x a
1