{-# LANGUAGE RecordWildCards #-}

module Unison.Util.Star2
  ( Star2 (Star2),
    fact,
    insertD1,
    insertD2,
    deleteD1,
    deleteD2,
    deleteFact,
    deletePrimaryD1,
    d1,
    d2,
    difference,
    lookupD1,
    mapD2,
    memberD1,
    replaceFacts,
  )
where

import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.Prelude
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as R

-- Represents a set of (fact, d1, d2, d2), but indexed using a star schema so
-- it can be efficiently queried from any of the dimensions.
data Star2 fact d1 d2 = Star2
  { forall fact d1 d2. Star2 fact d1 d2 -> Set fact
fact :: Set fact,
    forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 :: Relation fact d1,
    forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
d2 :: Relation fact d2
  }
  deriving (Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
(Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool)
-> (Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool)
-> Eq (Star2 fact d1 d2)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall fact d1 d2.
(Eq fact, Eq d1, Eq d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
$c== :: forall fact d1 d2.
(Eq fact, Eq d1, Eq d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
== :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
$c/= :: forall fact d1 d2.
(Eq fact, Eq d1, Eq d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
/= :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
Eq, Eq (Star2 fact d1 d2)
Eq (Star2 fact d1 d2) =>
(Star2 fact d1 d2 -> Star2 fact d1 d2 -> Ordering)
-> (Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool)
-> (Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool)
-> (Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool)
-> (Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool)
-> (Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2)
-> (Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2)
-> Ord (Star2 fact d1 d2)
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Ordering
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
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 fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Eq (Star2 fact d1 d2)
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Ordering
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
$ccompare :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Ordering
compare :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Ordering
$c< :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
< :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
$c<= :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
<= :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
$c> :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
> :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
$c>= :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
>= :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Bool
$cmax :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
max :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
$cmin :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
min :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
Ord, Int -> Star2 fact d1 d2 -> ShowS
[Star2 fact d1 d2] -> ShowS
Star2 fact d1 d2 -> String
(Int -> Star2 fact d1 d2 -> ShowS)
-> (Star2 fact d1 d2 -> String)
-> ([Star2 fact d1 d2] -> ShowS)
-> Show (Star2 fact d1 d2)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall fact d1 d2.
(Show fact, Show d1, Show d2) =>
Int -> Star2 fact d1 d2 -> ShowS
forall fact d1 d2.
(Show fact, Show d1, Show d2) =>
[Star2 fact d1 d2] -> ShowS
forall fact d1 d2.
(Show fact, Show d1, Show d2) =>
Star2 fact d1 d2 -> String
$cshowsPrec :: forall fact d1 d2.
(Show fact, Show d1, Show d2) =>
Int -> Star2 fact d1 d2 -> ShowS
showsPrec :: Int -> Star2 fact d1 d2 -> ShowS
$cshow :: forall fact d1 d2.
(Show fact, Show d1, Show d2) =>
Star2 fact d1 d2 -> String
show :: Star2 fact d1 d2 -> String
$cshowList :: forall fact d1 d2.
(Show fact, Show d1, Show d2) =>
[Star2 fact d1 d2] -> ShowS
showList :: [Star2 fact d1 d2] -> ShowS
Show)

-- Produce the cross-product across all the dimensions

-- `difference a b` contains only the facts from `a` that are absent from `b`
-- or differ along any of the dimensions `d1..d2`.
difference ::
  (Ord fact, Ord d1, Ord d2) =>
  Star2 fact d1 d2 ->
  Star2 fact d1 d2 ->
  Star2 fact d1 d2
difference :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
difference Star2 fact d1 d2
a Star2 fact d1 d2
b = Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
forall fact d1 d2.
Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
Star2 Set fact
facts Relation fact d1
d1s Relation fact d2
d2s
  where
    d1s :: Relation fact d1
d1s = Relation fact d1 -> Relation fact d1 -> Relation fact d1
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
R.difference (Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
a) (Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
b)
    d2s :: Relation fact d2
d2s = Relation fact d2 -> Relation fact d2 -> Relation fact d2
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
R.difference (Star2 fact d1 d2 -> Relation fact d2
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
d2 Star2 fact d1 d2
a) (Star2 fact d1 d2 -> Relation fact d2
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
d2 Star2 fact d1 d2
b)
    facts :: Set fact
facts = Relation fact d1 -> Set fact
forall a b. Relation a b -> Set a
R.dom Relation fact d1
d1s Set fact -> Set fact -> Set fact
forall a. Semigroup a => a -> a -> a
<> Relation fact d2 -> Set fact
forall a b. Relation a b -> Set a
R.dom Relation fact d2
d2s

mapD2 :: (Ord fact, Ord d2, Ord d2a) => (d2 -> d2a) -> Star2 fact d1 d2 -> Star2 fact d1 d2a
mapD2 :: forall fact d2 d2a d1.
(Ord fact, Ord d2, Ord d2a) =>
(d2 -> d2a) -> Star2 fact d1 d2 -> Star2 fact d1 d2a
mapD2 d2 -> d2a
f Star2 fact d1 d2
s = Star2 fact d1 d2
s {d2 = R.mapRan f (d2 s)}

-- Deletes tuples of the form (fact, d1, _, _).
-- If no other (fact, dk, _, _) tuples exist for any other dk, then
-- `fact` is removed from the `fact` set and from the other dimensions as well,
-- that is, (fact, d1) is treated as a primary key.
deletePrimaryD1 ::
  (Ord fact, Ord d1, Ord d2) =>
  (fact, d1) ->
  Star2 fact d1 d2 ->
  Star2 fact d1 d2
deletePrimaryD1 :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
(fact, d1) -> Star2 fact d1 d2 -> Star2 fact d1 d2
deletePrimaryD1 (fact
f, d1
x) Star2 fact d1 d2
s =
  let d1' :: Relation fact d1
d1' = fact -> d1 -> Relation fact d1 -> Relation fact d1
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
R.delete fact
f d1
x (Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
s)
      otherX :: Set d1
otherX = fact -> Relation fact d1 -> Set d1
forall a b. Ord a => a -> Relation a b -> Set b
R.lookupDom fact
f Relation fact d1
d1'
   in if Set d1 -> Bool
forall a. Set a -> Bool
Set.null Set d1
otherX
        then Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
forall fact d1 d2.
Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
Star2 (fact -> Set fact -> Set fact
forall a. Ord a => a -> Set a -> Set a
Set.delete fact
f (Star2 fact d1 d2 -> Set fact
forall fact d1 d2. Star2 fact d1 d2 -> Set fact
fact Star2 fact d1 d2
s)) Relation fact d1
d1' (fact -> Relation fact d2 -> Relation fact d2
forall a b. (Ord a, Ord b) => a -> Relation a b -> Relation a b
R.deleteDom fact
f (Star2 fact d1 d2 -> Relation fact d2
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
d2 Star2 fact d1 d2
s))
        else Star2 fact d1 d2
s {d1 = d1'}

-- Deletes tuples of the form (_, d1, _, _).
deleteD1 ::
  (Ord fact, Ord d1, Ord d2) =>
  d1 ->
  Star2 fact d1 d2 ->
  Star2 fact d1 d2
deleteD1 :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
d1 -> Star2 fact d1 d2 -> Star2 fact d1 d2
deleteD1 d1
x Star2 fact d1 d2
s =
  let d1' :: Relation fact d1
d1' = d1 -> Relation fact d1 -> Relation fact d1
forall a b. (Ord a, Ord b) => b -> Relation a b -> Relation a b
R.deleteRan d1
x (Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
s)
      deadFacts :: Set fact
deadFacts = d1 -> Relation fact d1 -> Set fact
forall b a. Ord b => b -> Relation a b -> Set a
R.lookupRan d1
x (Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
s)
      newFacts :: Set fact
newFacts = Set fact -> Set fact -> Set fact
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Star2 fact d1 d2 -> Set fact
forall fact d1 d2. Star2 fact d1 d2 -> Set fact
fact Star2 fact d1 d2
s) Set fact
deadFacts
      d2' :: Relation fact d2
d2' = Set fact -> Relation fact d2 -> Relation fact d2
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
R.subtractDom Set fact
deadFacts (Star2 fact d1 d2 -> Relation fact d2
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
d2 Star2 fact d1 d2
s)
   in Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
forall fact d1 d2.
Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
Star2
        Set fact
newFacts
        Relation fact d1
d1'
        Relation fact d2
d2'

lookupD1 :: (Ord fact, Ord d1) => d1 -> Star2 fact d1 d2 -> Set fact
lookupD1 :: forall fact d1 d2.
(Ord fact, Ord d1) =>
d1 -> Star2 fact d1 d2 -> Set fact
lookupD1 d1
x Star2 fact d1 d2
s = d1 -> Relation fact d1 -> Set fact
forall b a. Ord b => b -> Relation a b -> Set a
R.lookupRan d1
x (Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
s)

insertD1 ::
  (Ord fact, Ord d1) =>
  (fact, d1) ->
  Star2 fact d1 d2 ->
  Star2 fact d1 d2
insertD1 :: forall fact d1 d2.
(Ord fact, Ord d1) =>
(fact, d1) -> Star2 fact d1 d2 -> Star2 fact d1 d2
insertD1 (fact
f, d1
x) Star2 fact d1 d2
s =
  Star2 fact d1 d2
s
    { fact = Set.insert f (fact s),
      d1 = R.insert f x (d1 s)
    }

insertD2 ::
  (Ord fact, Ord d2) =>
  (fact, d2) ->
  Star2 fact d1 d2 ->
  Star2 fact d1 d2
insertD2 :: forall fact d2 d1.
(Ord fact, Ord d2) =>
(fact, d2) -> Star2 fact d1 d2 -> Star2 fact d1 d2
insertD2 (fact
f, d2
x) Star2 fact d1 d2
s =
  Star2 fact d1 d2
s
    { fact = Set.insert f (fact s),
      d2 = R.insert f x (d2 s)
    }

memberD1 :: (Ord fact, Ord d1) => (fact, d1) -> Star2 fact d1 d2 -> Bool
memberD1 :: forall fact d1 d2.
(Ord fact, Ord d1) =>
(fact, d1) -> Star2 fact d1 d2 -> Bool
memberD1 (fact
f, d1
x) Star2 fact d1 d2
s = fact -> d1 -> Relation fact d1 -> Bool
forall a b. (Ord a, Ord b) => a -> b -> Relation a b -> Bool
R.member fact
f d1
x (Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
s)

deleteD2 ::
  (Ord fact, Ord d1, Ord d2) =>
  (fact, d2) ->
  Star2 fact d1 d2 ->
  Star2 fact d1 d2
deleteD2 :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
(fact, d2) -> Star2 fact d1 d2 -> Star2 fact d1 d2
deleteD2 (fact
f, d2
x) Star2 fact d1 d2
s = fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
forall fact d1 d2.
Ord fact =>
fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
garbageCollect fact
f (Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
forall fact d1 d2.
Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
Star2 (Star2 fact d1 d2 -> Set fact
forall fact d1 d2. Star2 fact d1 d2 -> Set fact
fact Star2 fact d1 d2
s) (Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
s) Relation fact d2
d2')
  where
    d2' :: Relation fact d2
d2' = fact -> d2 -> Relation fact d2 -> Relation fact d2
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
R.delete fact
f d2
x (Star2 fact d1 d2 -> Relation fact d2
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
d2 Star2 fact d1 d2
s)

-- | Given a possibly-invalid Star2, which may contain the given fact in its fact set that are not related to any d1,
-- d2, or d2, return a valid Star2, with this fact possibly removed.
garbageCollect :: (Ord fact) => fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
garbageCollect :: forall fact d1 d2.
Ord fact =>
fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
garbageCollect fact
f Star2 fact d1 d2
star =
  Star2 fact d1 d2
star
    { fact =
        if R.memberDom f (d1 star) || R.memberDom f (d2 star)
          then fact star
          else Set.delete f (fact star)
    }

deleteFact ::
  (Ord fact, Ord d1, Ord d2) =>
  Set fact ->
  Star2 fact d1 d2 ->
  Star2 fact d1 d2
deleteFact :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Set fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
deleteFact Set fact
facts Star2 {Set fact
Relation fact d1
Relation fact d2
$sel:fact:Star2 :: forall fact d1 d2. Star2 fact d1 d2 -> Set fact
$sel:d1:Star2 :: forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
$sel:d2:Star2 :: forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
fact :: Set fact
d1 :: Relation fact d1
d2 :: Relation fact d2
..} =
  Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
forall fact d1 d2.
Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
Star2
    (Set fact
fact Set fact -> Set fact -> Set fact
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set fact
facts)
    (Set fact
facts Set fact -> Relation fact d1 -> Relation fact d1
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
R.<|| Relation fact d1
d1)
    (Set fact
facts Set fact -> Relation fact d2 -> Relation fact d2
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
R.<|| Relation fact d2
d2)

-- Efficiently replace facts with those in the provided `Map`.
-- The `apply` function can be used to add other dimensions
-- in the same traversal. It is given `apply old new s` where
-- s is the current `Star` being accumulated.
--
-- Currently used by update propagation but likely useful for
-- other bulk rewriting of namespaces.
replaceFacts ::
  (Ord fact, Ord d1, Ord d2) =>
  (fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2) ->
  Map fact fact ->
  Star2 fact d1 d2 ->
  Star2 fact d1 d2
replaceFacts :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
(fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2)
-> Map fact fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
replaceFacts fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
apply Map fact fact
m Star2 fact d1 d2
s =
  let -- the intersection of `fact` and the replacement keys is often small,
      -- so we compute that first (which can happen in O(size of intersection))
      -- rather than iterating over one or the other
      replaceable :: Set fact
replaceable = Map fact fact -> Set fact
forall k a. Map k a -> Set k
Map.keysSet Map fact fact
m Set fact -> Set fact -> Set fact
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Star2 fact d1 d2 -> Set fact
forall fact d1 d2. Star2 fact d1 d2 -> Set fact
fact Star2 fact d1 d2
s
      go :: Star2 fact d1 d2 -> fact -> Star2 fact d1 d2
go Star2 fact d1 d2
s fact
old = fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
apply fact
old fact
new (Star2 fact d1 d2 -> Star2 fact d1 d2)
-> Star2 fact d1 d2 -> Star2 fact d1 d2
forall a b. (a -> b) -> a -> b
$ fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
replaceFact fact
old fact
new Star2 fact d1 d2
s
        where
          new :: fact
new = fact -> fact -> Map fact fact -> fact
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault fact
old fact
old Map fact fact
m
   in (Star2 fact d1 d2 -> fact -> Star2 fact d1 d2)
-> Star2 fact d1 d2 -> Set fact -> Star2 fact d1 d2
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Star2 fact d1 d2 -> fact -> Star2 fact d1 d2
go Star2 fact d1 d2
s Set fact
replaceable

replaceFact ::
  (Ord fact, Ord d1, Ord d2) =>
  fact ->
  fact ->
  Star2 fact d1 d2 ->
  Star2 fact d1 d2
replaceFact :: forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
replaceFact fact
f fact
f' s :: Star2 fact d1 d2
s@Star2 {Set fact
Relation fact d1
Relation fact d2
$sel:fact:Star2 :: forall fact d1 d2. Star2 fact d1 d2 -> Set fact
$sel:d1:Star2 :: forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
$sel:d2:Star2 :: forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
fact :: Set fact
d1 :: Relation fact d1
d2 :: Relation fact d2
..} =
  if fact -> Set fact -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember fact
f Set fact
fact
    then Star2 fact d1 d2
s
    else
      Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
forall fact d1 d2.
Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
Star2
        (fact -> Set fact -> Set fact
forall a. Ord a => a -> Set a -> Set a
Set.insert fact
f' (Set fact -> Set fact)
-> (Set fact -> Set fact) -> Set fact -> Set fact
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fact -> Set fact -> Set fact
forall a. Ord a => a -> Set a -> Set a
Set.delete fact
f (Set fact -> Set fact) -> Set fact -> Set fact
forall a b. (a -> b) -> a -> b
$ Set fact
fact)
        (fact -> fact -> Relation fact d1 -> Relation fact d1
forall a b.
(Ord a, Ord b) =>
a -> a -> Relation a b -> Relation a b
R.replaceDom fact
f fact
f' Relation fact d1
d1)
        (fact -> fact -> Relation fact d2 -> Relation fact d2
forall a b.
(Ord a, Ord b) =>
a -> a -> Relation a b -> Relation a b
R.replaceDom fact
f fact
f' Relation fact d2
d2)

instance (Ord fact, Ord d1, Ord d2) => Semigroup (Star2 fact d1 d2) where
  Star2 fact d1 d2
s1 <> :: Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
<> Star2 fact d1 d2
s2 = Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
forall fact d1 d2.
Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
Star2 Set fact
fact' Relation fact d1
d1' Relation fact d2
d2'
    where
      fact' :: Set fact
fact' = Star2 fact d1 d2 -> Set fact
forall fact d1 d2. Star2 fact d1 d2 -> Set fact
fact Star2 fact d1 d2
s1 Set fact -> Set fact -> Set fact
forall a. Semigroup a => a -> a -> a
<> Star2 fact d1 d2 -> Set fact
forall fact d1 d2. Star2 fact d1 d2 -> Set fact
fact Star2 fact d1 d2
s2
      d1' :: Relation fact d1
d1' = Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
s1 Relation fact d1 -> Relation fact d1 -> Relation fact d1
forall a. Semigroup a => a -> a -> a
<> Star2 fact d1 d2 -> Relation fact d1
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
d1 Star2 fact d1 d2
s2
      d2' :: Relation fact d2
d2' = Star2 fact d1 d2 -> Relation fact d2
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
d2 Star2 fact d1 d2
s1 Relation fact d2 -> Relation fact d2 -> Relation fact d2
forall a. Semigroup a => a -> a -> a
<> Star2 fact d1 d2 -> Relation fact d2
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
d2 Star2 fact d1 d2
s2

instance (Ord fact, Ord d1, Ord d2) => Monoid (Star2 fact d1 d2) where
  mempty :: Star2 fact d1 d2
mempty = Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
forall fact d1 d2.
Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
Star2 Set fact
forall a. Monoid a => a
mempty Relation fact d1
forall a. Monoid a => a
mempty Relation fact d2
forall a. Monoid a => a
mempty