module Zwirn.Core.State where

{-
    State.hs - functions manipulating the underlying state of signals
    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.Monad.Identity
import qualified Data.Map as Map
import Zwirn.Core.Cord
import Zwirn.Core.Core
import Zwirn.Core.Types

--- functions modifying the state

modify' :: (st -> st) -> ZwirnT k st i a -> ZwirnT k st i a
modify' :: forall st (k :: * -> *) i a.
(st -> st) -> ZwirnT k st i a -> ZwirnT k st i a
modify' st -> st
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 -> 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
f st
st)

modify :: (MultiMonad k) => (ZwirnT k st i st -> ZwirnT k st i st) -> ZwirnT k st i a -> ZwirnT k st i a
modify :: forall (k :: * -> *) st i a.
MultiMonad k =>
(ZwirnT k st i st -> ZwirnT k st i st)
-> ZwirnT k st i a -> ZwirnT k st i a
modify ZwirnT k st i st -> ZwirnT k st i st
f ZwirnT k st i a
x = ZwirnT k st i st -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) st i a.
Monad k =>
ZwirnT k st i st -> ZwirnT k st i a -> ZwirnT k st i a
set (ZwirnT k st i st -> ZwirnT k st i st
f (ZwirnT k st i a -> ZwirnT k st i st
forall (k :: * -> *) st i a.
Applicative k =>
ZwirnT k st i a -> ZwirnT k st i st
get ZwirnT k st i a
x)) ZwirnT k st i a
x

get :: (Applicative k) => ZwirnT k st i a -> ZwirnT k st i st
get :: forall (k :: * -> *) st i a.
Applicative k =>
ZwirnT k st i a -> ZwirnT k st i st
get = ((Value i a, st) -> (Value i st, st))
-> ZwirnT k st i a -> ZwirnT k st i st
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
v, st
st) -> ((a -> st) -> Value i a -> Value i st
forall a b. (a -> b) -> Value i a -> Value i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (st -> a -> st
forall a b. a -> b -> a
const st
st) Value i a
v, st
st))

set :: (Monad k) => ZwirnT k st i st -> ZwirnT k st i a -> ZwirnT k st i a
set :: forall (k :: * -> *) st i a.
Monad k =>
ZwirnT k st i st -> ZwirnT k st i a -> ZwirnT k st i a
set ZwirnT k st i st
st ZwirnT k st i a
a = (st -> st) -> ZwirnT k st i a -> ZwirnT k st i a
forall (k :: * -> *) st i a.
Functor k =>
(st -> st) -> ZwirnT k st i a -> ZwirnT k st i a
withState ((st -> st) -> ZwirnT k st i a -> ZwirnT k st i a)
-> (st -> st -> st) -> st -> ZwirnT k st i a -> ZwirnT k st i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> st -> st
forall a b. a -> b -> a
const (st -> ZwirnT k st i a -> ZwirnT k st i a)
-> ZwirnT k st i st
-> ZwirnT k st i (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 st
st 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
a

-- functions to act on state that is a map

-- | get value of specific key, providing a function in case key is not found
getMap :: (MultiMonad k, Ord key) => (Maybe b -> ZwirnT k (Map.Map key b) i b) -> ZwirnT k (Map.Map key b) i key -> ZwirnT k (Map.Map key b) i b
getMap :: forall (k :: * -> *) key b i.
(MultiMonad k, Ord key) =>
(Maybe b -> ZwirnT k (Map key b) i b)
-> ZwirnT k (Map key b) i key -> ZwirnT k (Map key b) i b
getMap Maybe b -> ZwirnT k (Map key b) i b
fromLookup ZwirnT k (Map key b) i key
xc = ZwirnT k (Map key b) i (ZwirnT k (Map key b) i b)
-> ZwirnT k (Map key b) i b
forall a.
ZwirnT k (Map key b) i (ZwirnT k (Map key b) i a)
-> ZwirnT k (Map key b) i a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
innerJoin (ZwirnT k (Map key b) i (ZwirnT k (Map key b) i b)
 -> ZwirnT k (Map key b) i b)
-> ZwirnT k (Map key b) i (ZwirnT k (Map key b) i b)
-> ZwirnT k (Map key b) i b
forall a b. (a -> b) -> a -> b
$ (key -> Map key b -> ZwirnT k (Map key b) i b)
-> ZwirnT k (Map key b) i key
-> ZwirnT k (Map key b) i (Map key b)
-> ZwirnT k (Map key b) i (ZwirnT k (Map key b) i b)
forall a b c.
(a -> b -> c)
-> ZwirnT k (Map key b) i a
-> ZwirnT k (Map key b) i b
-> ZwirnT k (Map key b) i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\key
k Map key b
l -> Maybe b -> ZwirnT k (Map key b) i b
fromLookup (Maybe b -> ZwirnT k (Map key b) i b)
-> Maybe b -> ZwirnT k (Map key b) i b
forall a b. (a -> b) -> a -> b
$ key -> Map key b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
k Map key b
l) ZwirnT k (Map key b) i key
xc (ZwirnT k (Map key b) i () -> ZwirnT k (Map key b) i (Map key b)
forall (k :: * -> *) st i a.
Applicative k =>
ZwirnT k st i a -> ZwirnT k st i st
get (() -> ZwirnT k (Map key b) i ()
forall a. a -> ZwirnT k (Map key b) i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))

-- | set value of given key
setMap :: (Monad k, Ord key) => ZwirnT k (Map.Map key b) i key -> ZwirnT k (Map.Map key b) i b -> ZwirnT k (Map.Map key b) i a -> ZwirnT k (Map.Map key b) i a
setMap :: forall (k :: * -> *) key b i a.
(Monad k, Ord key) =>
ZwirnT k (Map key b) i key
-> ZwirnT k (Map key b) i b
-> ZwirnT k (Map key b) i a
-> ZwirnT k (Map key b) i a
setMap ZwirnT k (Map key b) i key
key ZwirnT k (Map key b) i b
b = ZwirnT k (Map key b) i (Map key b)
-> ZwirnT k (Map key b) i a -> ZwirnT k (Map key b) i a
forall (k :: * -> *) st i a.
Monad k =>
ZwirnT k st i st -> ZwirnT k st i a -> ZwirnT k st i a
set ((key -> b -> Map key b -> Map key b)
-> ZwirnT k (Map key b) i key
-> ZwirnT k (Map key b) i b
-> ZwirnT k (Map key b) i (Map key b -> Map key b)
forall a b c.
(a -> b -> c)
-> ZwirnT k (Map key b) i a
-> ZwirnT k (Map key b) i b
-> ZwirnT k (Map key b) i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 key -> b -> Map key b -> Map key b
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ZwirnT k (Map key b) i key
key ZwirnT k (Map key b) i b
b ZwirnT k (Map key b) i (Map key b -> Map key b)
-> ZwirnT k (Map key b) i (Map key b)
-> ZwirnT k (Map key b) i (Map key b)
forall a b.
ZwirnT k (Map key b) i (a -> b)
-> ZwirnT k (Map key b) i a -> ZwirnT k (Map key b) i b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZwirnT k (Map key b) i () -> ZwirnT k (Map key b) i (Map key b)
forall (k :: * -> *) st i a.
Applicative k =>
ZwirnT k st i a -> ZwirnT k st i st
get (() -> ZwirnT k (Map key b) i ()
forall a. a -> ZwirnT k (Map key b) i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))

-- | modify
modifyMap :: (MultiMonad k, Ord key) => (Maybe b -> ZwirnT k (Map.Map key b) i b) -> ZwirnT k (Map.Map key b) i key -> (ZwirnT k (Map.Map key b) i b -> ZwirnT k (Map.Map key b) i b) -> ZwirnT k (Map.Map key b) i a -> ZwirnT k (Map.Map key b) i a
modifyMap :: forall (k :: * -> *) key b i a.
(MultiMonad k, Ord key) =>
(Maybe b -> ZwirnT k (Map key b) i b)
-> ZwirnT k (Map key b) i key
-> (ZwirnT k (Map key b) i b -> ZwirnT k (Map key b) i b)
-> ZwirnT k (Map key b) i a
-> ZwirnT k (Map key b) i a
modifyMap Maybe b -> ZwirnT k (Map key b) i b
fromLookup ZwirnT k (Map key b) i key
key ZwirnT k (Map key b) i b -> ZwirnT k (Map key b) i b
f = ZwirnT k (Map key b) i key
-> ZwirnT k (Map key b) i b
-> ZwirnT k (Map key b) i a
-> ZwirnT k (Map key b) i a
forall (k :: * -> *) key b i a.
(Monad k, Ord key) =>
ZwirnT k (Map key b) i key
-> ZwirnT k (Map key b) i b
-> ZwirnT k (Map key b) i a
-> ZwirnT k (Map key b) i a
setMap ZwirnT k (Map key b) i key
key (ZwirnT k (Map key b) i b -> ZwirnT k (Map key b) i b
f ((Maybe b -> ZwirnT k (Map key b) i b)
-> ZwirnT k (Map key b) i key -> ZwirnT k (Map key b) i b
forall (k :: * -> *) key b i.
(MultiMonad k, Ord key) =>
(Maybe b -> ZwirnT k (Map key b) i b)
-> ZwirnT k (Map key b) i key -> ZwirnT k (Map key b) i b
getMap Maybe b -> ZwirnT k (Map key b) i b
fromLookup ZwirnT k (Map key b) i key
key))