{-# LANGUAGE RecordWildCards #-}

module U.Codebase.Causal
  ( Causal (..),
    emap,
    hoist,
  )
where

import Data.Function (on)
import Data.Map.Strict qualified as Map
import Unison.Prelude

data Causal m hc he pe e = Causal
  { forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
causalHash :: hc,
    forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
valueHash :: he,
    forall (m :: * -> *) hc he pe e.
Causal m hc he pe e -> Map hc (m (Causal m hc he pe pe))
parents :: Map hc (m (Causal m hc he pe pe)),
    forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
value :: m e
  }
  deriving stock ((forall a b.
 (a -> b) -> Causal m hc he pe a -> Causal m hc he pe b)
-> (forall a b. a -> Causal m hc he pe b -> Causal m hc he pe a)
-> Functor (Causal m hc he pe)
forall a b. a -> Causal m hc he pe b -> Causal m hc he pe a
forall a b. (a -> b) -> Causal m hc he pe a -> Causal m hc he pe b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) hc he pe a b.
Functor m =>
a -> Causal m hc he pe b -> Causal m hc he pe a
forall (m :: * -> *) hc he pe a b.
Functor m =>
(a -> b) -> Causal m hc he pe a -> Causal m hc he pe b
$cfmap :: forall (m :: * -> *) hc he pe a b.
Functor m =>
(a -> b) -> Causal m hc he pe a -> Causal m hc he pe b
fmap :: forall a b. (a -> b) -> Causal m hc he pe a -> Causal m hc he pe b
$c<$ :: forall (m :: * -> *) hc he pe a b.
Functor m =>
a -> Causal m hc he pe b -> Causal m hc he pe a
<$ :: forall a b. a -> Causal m hc he pe b -> Causal m hc he pe a
Functor, (forall x. Causal m hc he pe e -> Rep (Causal m hc he pe e) x)
-> (forall x. Rep (Causal m hc he pe e) x -> Causal m hc he pe e)
-> Generic (Causal m hc he pe e)
forall x. Rep (Causal m hc he pe e) x -> Causal m hc he pe e
forall x. Causal m hc he pe e -> Rep (Causal m hc he pe e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) hc he pe e x.
Rep (Causal m hc he pe e) x -> Causal m hc he pe e
forall (m :: * -> *) hc he pe e x.
Causal m hc he pe e -> Rep (Causal m hc he pe e) x
$cfrom :: forall (m :: * -> *) hc he pe e x.
Causal m hc he pe e -> Rep (Causal m hc he pe e) x
from :: forall x. Causal m hc he pe e -> Rep (Causal m hc he pe e) x
$cto :: forall (m :: * -> *) hc he pe e x.
Rep (Causal m hc he pe e) x -> Causal m hc he pe e
to :: forall x. Rep (Causal m hc he pe e) x -> Causal m hc he pe e
Generic)

instance (Eq hc) => Eq (Causal m hc he pe e) where
  == :: Causal m hc he pe e -> Causal m hc he pe e -> Bool
(==) = hc -> hc -> Bool
forall a. Eq a => a -> a -> Bool
(==) (hc -> hc -> Bool)
-> (Causal m hc he pe e -> hc)
-> Causal m hc he pe e
-> Causal m hc he pe e
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Causal m hc he pe e -> hc
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
causalHash

-- | @emap f g@ maps over the values and parents' values with @f@ and @g@.
emap :: (Functor m) => (e -> e') -> (pe -> pe') -> Causal m hc he pe e -> Causal m hc he pe' e'
emap :: forall (m :: * -> *) e e' pe pe' hc he.
Functor m =>
(e -> e')
-> (pe -> pe') -> Causal m hc he pe e -> Causal m hc he pe' e'
emap e -> e'
f pe -> pe'
g causal :: Causal m hc he pe e
causal@Causal {Map hc (m (Causal m hc he pe pe))
$sel:parents:Causal :: forall (m :: * -> *) hc he pe e.
Causal m hc he pe e -> Map hc (m (Causal m hc he pe pe))
parents :: Map hc (m (Causal m hc he pe pe))
parents, m e
$sel:value:Causal :: forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
value :: m e
value} =
  Causal m hc he pe e
causal
    { parents = Map.map (fmap (emap g g)) parents,
      value = f <$> value
    }

hoist :: (Functor n) => (forall x. m x -> n x) -> Causal m hc he pe e -> Causal n hc he pe e
hoist :: forall (n :: * -> *) (m :: * -> *) hc he pe e.
Functor n =>
(forall x. m x -> n x)
-> Causal m hc he pe e -> Causal n hc he pe e
hoist forall x. m x -> n x
f (Causal {hc
he
m e
Map hc (m (Causal m hc he pe pe))
$sel:causalHash:Causal :: forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
$sel:valueHash:Causal :: forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
$sel:parents:Causal :: forall (m :: * -> *) hc he pe e.
Causal m hc he pe e -> Map hc (m (Causal m hc he pe pe))
$sel:value:Causal :: forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
causalHash :: hc
valueHash :: he
parents :: Map hc (m (Causal m hc he pe pe))
value :: m e
..}) =
  Causal
    { $sel:parents:Causal :: Map hc (n (Causal n hc he pe pe))
parents = Map hc (m (Causal m hc he pe pe))
parents Map hc (m (Causal m hc he pe pe))
-> (Map hc (m (Causal m hc he pe pe))
    -> Map hc (n (Causal m hc he pe pe)))
-> Map hc (n (Causal m hc he pe pe))
forall a b. a -> (a -> b) -> b
& (m (Causal m hc he pe pe) -> n (Causal m hc he pe pe))
-> Map hc (m (Causal m hc he pe pe))
-> Map hc (n (Causal m hc he pe pe))
forall a b. (a -> b) -> Map hc a -> Map hc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (Causal m hc he pe pe) -> n (Causal m hc he pe pe)
forall x. m x -> n x
f Map hc (n (Causal m hc he pe pe))
-> (Map hc (n (Causal m hc he pe pe))
    -> Map hc (n (Causal n hc he pe pe)))
-> Map hc (n (Causal n hc he pe pe))
forall a b. a -> (a -> b) -> b
& ((n (Causal m hc he pe pe) -> n (Causal n hc he pe pe))
-> Map hc (n (Causal m hc he pe pe))
-> Map hc (n (Causal n hc he pe pe))
forall a b. (a -> b) -> Map hc a -> Map hc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((n (Causal m hc he pe pe) -> n (Causal n hc he pe pe))
 -> Map hc (n (Causal m hc he pe pe))
 -> Map hc (n (Causal n hc he pe pe)))
-> ((Causal m hc he pe pe -> Causal n hc he pe pe)
    -> n (Causal m hc he pe pe) -> n (Causal n hc he pe pe))
-> (Causal m hc he pe pe -> Causal n hc he pe pe)
-> Map hc (n (Causal m hc he pe pe))
-> Map hc (n (Causal n hc he pe pe))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Causal m hc he pe pe -> Causal n hc he pe pe)
-> n (Causal m hc he pe pe) -> n (Causal n hc he pe pe)
forall a b. (a -> b) -> n a -> n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((forall x. m x -> n x)
-> Causal m hc he pe pe -> Causal n hc he pe pe
forall (n :: * -> *) (m :: * -> *) hc he pe e.
Functor n =>
(forall x. m x -> n x)
-> Causal m hc he pe e -> Causal n hc he pe e
hoist m x -> n x
forall x. m x -> n x
f),
      $sel:value:Causal :: n e
value = m e -> n e
forall x. m x -> n x
f m e
value,
      hc
he
$sel:causalHash:Causal :: hc
$sel:valueHash:Causal :: he
causalHash :: hc
valueHash :: he
..
    }