{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Zwirn.Core.Types where

{-
    Types.hs - defines all core types and classes
    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 (join)
import Control.Monad.Identity
import Data.Bifunctor
import Data.Functor (void)
import Zwirn.Core.Time

data Value i a
  = Value {forall i a. Value i a -> a
value :: !a, forall i a. Value i a -> Time
time :: Time, forall i a. Value i a -> [i]
info :: [i]}
  deriving (Value i a -> Value i a -> Bool
(Value i a -> Value i a -> Bool)
-> (Value i a -> Value i a -> Bool) -> Eq (Value i a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i a. (Eq a, Eq i) => Value i a -> Value i a -> Bool
$c== :: forall i a. (Eq a, Eq i) => Value i a -> Value i a -> Bool
== :: Value i a -> Value i a -> Bool
$c/= :: forall i a. (Eq a, Eq i) => Value i a -> Value i a -> Bool
/= :: Value i a -> Value i a -> Bool
Eq, Int -> Value i a -> ShowS
[Value i a] -> ShowS
Value i a -> String
(Int -> Value i a -> ShowS)
-> (Value i a -> String)
-> ([Value i a] -> ShowS)
-> Show (Value i a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i a. (Show a, Show i) => Int -> Value i a -> ShowS
forall i a. (Show a, Show i) => [Value i a] -> ShowS
forall i a. (Show a, Show i) => Value i a -> String
$cshowsPrec :: forall i a. (Show a, Show i) => Int -> Value i a -> ShowS
showsPrec :: Int -> Value i a -> ShowS
$cshow :: forall i a. (Show a, Show i) => Value i a -> String
show :: Value i a -> String
$cshowList :: forall i a. (Show a, Show i) => [Value i a] -> ShowS
showList :: [Value i a] -> ShowS
Show, Eq (Value i a)
Eq (Value i a) =>
(Value i a -> Value i a -> Ordering)
-> (Value i a -> Value i a -> Bool)
-> (Value i a -> Value i a -> Bool)
-> (Value i a -> Value i a -> Bool)
-> (Value i a -> Value i a -> Bool)
-> (Value i a -> Value i a -> Value i a)
-> (Value i a -> Value i a -> Value i a)
-> Ord (Value i a)
Value i a -> Value i a -> Bool
Value i a -> Value i a -> Ordering
Value i a -> Value i a -> Value i a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall i a. (Ord a, Ord i) => Eq (Value i a)
forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Bool
forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Ordering
forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Value i a
$ccompare :: forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Ordering
compare :: Value i a -> Value i a -> Ordering
$c< :: forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Bool
< :: Value i a -> Value i a -> Bool
$c<= :: forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Bool
<= :: Value i a -> Value i a -> Bool
$c> :: forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Bool
> :: Value i a -> Value i a -> Bool
$c>= :: forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Bool
>= :: Value i a -> Value i a -> Bool
$cmax :: forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Value i a
max :: Value i a -> Value i a -> Value i a
$cmin :: forall i a. (Ord a, Ord i) => Value i a -> Value i a -> Value i a
min :: Value i a -> Value i a -> Value i a
Ord, (forall a b. (a -> b) -> Value i a -> Value i b)
-> (forall a b. a -> Value i b -> Value i a) -> Functor (Value i)
forall a b. a -> Value i b -> Value i a
forall a b. (a -> b) -> Value i a -> Value i b
forall i a b. a -> Value i b -> Value i a
forall i a b. (a -> b) -> Value i a -> Value i b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall i a b. (a -> b) -> Value i a -> Value i b
fmap :: forall a b. (a -> b) -> Value i a -> Value i b
$c<$ :: forall i a b. a -> Value i b -> Value i a
<$ :: forall a b. a -> Value i b -> Value i a
Functor)

newtype ZwirnT k st i a = ZwirnT {forall (k :: * -> *) st i a.
ZwirnT k st i a -> Time -> st -> k (Value i a, st)
unZwirnT :: Time -> st -> k (Value i a, st)}

unzwirn :: ZwirnT k st i a -> Time -> st -> k (Value i a, st)
unzwirn :: forall (k :: * -> *) st i a.
ZwirnT k st i a -> Time -> st -> k (Value i a, st)
unzwirn = 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)
unZwirnT

zwirn :: (Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
zwirn :: 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
forall (k :: * -> *) st i a.
(Time -> st -> k (Value i a, st)) -> ZwirnT k st i a
ZwirnT

-- | represents instances of k that allow for a special zwirn with no values
class HasSilence k where
  silence :: ZwirnT k st i a

class ToList k where
  toList :: k a -> [a]

infixl 4 *>

infixl 4 <*

class (Applicative f) => MultiApplicative f where
  liftA2Left :: (a -> b -> c) -> f a -> f b -> f c
  liftA2Right :: (a -> b -> c) -> f a -> f b -> f c
  liftA2Both :: (a -> b -> c) -> f a -> f b -> f c
  liftA2Both = (a -> b -> c) -> f a -> f b -> f c
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  (*>) :: f (a -> b) -> f a -> f b
  (*>) = ((a -> b) -> a -> b) -> f (a -> b) -> f a -> f b
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Right (a -> b) -> a -> b
forall a. a -> a
id
  (<*) :: f (a -> b) -> f a -> f b
  (<*) = ((a -> b) -> a -> b) -> f (a -> b) -> f a -> f b
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Right (a -> b) -> a -> b
forall a. a -> a
id

class (MultiApplicative m, Monad m) => MultiMonad m where
  innerJoin :: m (m a) -> m a
  innerJoin = m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
  outerJoin :: m (m a) -> m a
  squeezeJoin :: m (m a) -> m a

instance ToList [] where
  toList :: forall a. [a] -> [a]
toList = [a] -> [a]
forall a. a -> a
id

instance ToList Identity where
  toList :: forall a. Identity a -> [a]
toList (Identity a
x) = a -> [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

instance MultiApplicative Identity where
  liftA2Left :: forall a b c.
(a -> b -> c) -> Identity a -> Identity b -> Identity c
liftA2Left a -> b -> c
f Identity a
x Identity b
y = c -> Identity c
forall a. a -> Identity a
Identity (c -> Identity c) -> c -> Identity c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f (Identity a -> a
forall a. Identity a -> a
runIdentity Identity a
x) (Identity b -> b
forall a. Identity a -> a
runIdentity Identity b
y)
  liftA2Right :: forall a b c.
(a -> b -> c) -> Identity a -> Identity b -> Identity c
liftA2Right a -> b -> c
f Identity a
x Identity b
y = c -> Identity c
forall a. a -> Identity a
Identity (c -> Identity c) -> c -> Identity c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f (Identity a -> a
forall a. Identity a -> a
runIdentity Identity a
x) (Identity b -> b
forall a. Identity a -> a
runIdentity Identity b
y)

instance MultiMonad Identity where
  innerJoin :: forall a. Identity (Identity a) -> Identity a
innerJoin (Identity Identity a
x) = Identity a
x
  outerJoin :: forall a. Identity (Identity a) -> Identity a
outerJoin (Identity Identity a
x) = Identity a
x
  squeezeJoin :: forall a. Identity (Identity a) -> Identity a
squeezeJoin (Identity Identity a
x) = Identity a
x

instance Applicative (Value i) where
  pure :: forall a. a -> Value i a
pure a
x = a -> Time -> [i] -> Value i a
forall i a. a -> Time -> [i] -> Value i a
Value a
x Time
0 []
  liftA2 :: forall a b c. (a -> b -> c) -> Value i a -> Value i b -> Value i c
liftA2 a -> b -> c
f (Value a
x Time
t1 [i]
i1) (Value b
y Time
t2 [i]
i2) = c -> Time -> [i] -> Value i c
forall i a. a -> Time -> [i] -> Value i a
Value (a -> b -> c
f a
x b
y) Time
t1 ([i]
i1 [i] -> [i] -> [i]
forall a. [a] -> [a] -> [a]
++ [i]
i2)

instance MultiApplicative (Value i) where
  liftA2Left :: forall a b c. (a -> b -> c) -> Value i a -> Value i b -> Value i c
liftA2Left = (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
  liftA2Right :: forall a b c. (a -> b -> c) -> Value i a -> Value i b -> Value i c
liftA2Right a -> b -> c
f (Value a
x Time
t1 [i]
i1) (Value b
y Time
t2 [i]
i2) = c -> Time -> [i] -> Value i c
forall i a. a -> Time -> [i] -> Value i a
Value (a -> b -> c
f a
x b
y) Time
t2 ([i]
i1 [i] -> [i] -> [i]
forall a. [a] -> [a] -> [a]
++ [i]
i2)