{-# LANGUAGE RecordWildCards #-}

module Unison.Util.Relation4 where

import Data.Function (on)
import Data.List.Extra (nubOrd)
import Data.Map qualified as Map
import Data.Ord (comparing)
import Data.Semigroup (Sum (Sum, getSum))
import Unison.Prelude hiding (empty, toList)
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as R
import Unison.Util.Relation3 (Relation3 (Relation3))
import Unison.Util.Relation3 qualified as R3
import Prelude

data Relation4 a b c d = Relation4
  { forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 :: Map a (Relation3 b c d),
    forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d2 :: Map b (Relation3 a c d),
    forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 :: Map c (Relation3 a b d),
    forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d4 :: Map d (Relation3 a b c)
  }

instance (Eq a, Eq b, Eq c, Eq d) => Eq (Relation4 a b c d) where
  == :: Relation4 a b c d -> Relation4 a b c d -> Bool
(==) = Map a (Relation3 b c d) -> Map a (Relation3 b c d) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Map a (Relation3 b c d) -> Map a (Relation3 b c d) -> Bool)
-> (Relation4 a b c d -> Map a (Relation3 b c d))
-> Relation4 a b c d
-> Relation4 a b c d
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1

instance (Ord a, Ord b, Ord c, Ord d) => Ord (Relation4 a b c d) where
  compare :: Relation4 a b c d -> Relation4 a b c d -> Ordering
compare = (Relation4 a b c d -> Map a (Relation3 b c d))
-> Relation4 a b c d -> Relation4 a b c d -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1

instance (Show a, Show b, Show c, Show d) => Show (Relation4 a b c d) where
  show :: Relation4 a b c d -> String
show = [(a, b, c, d)] -> String
forall a. Show a => a -> String
show ([(a, b, c, d)] -> String)
-> (Relation4 a b c d -> [(a, b, c, d)])
-> Relation4 a b c d
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> [(a, b, c, d)]
forall a b c d. Relation4 a b c d -> [(a, b, c, d)]
toList

size :: (Ord a, Ord b, Ord c, Ord d) => Relation4 a b c d -> Int
size :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Relation4 a b c d -> Int
size = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int)
-> (Relation4 a b c d -> Sum Int) -> Relation4 a b c d -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relation3 b c d -> Sum Int) -> Map a (Relation3 b c d) -> Sum Int
forall m a. Monoid m => (a -> m) -> Map a a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int)
-> (Relation3 b c d -> Int) -> Relation3 b c d -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation3 b c d -> Int
forall a b c. (Ord a, Ord b, Ord c) => Relation3 a b c -> Int
R3.size) (Map a (Relation3 b c d) -> Sum Int)
-> (Relation4 a b c d -> Map a (Relation3 b c d))
-> Relation4 a b c d
-> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1

toNestedList :: Relation4 a b c d -> [(a, (b, (c, d)))]
toNestedList :: forall a b c d. Relation4 a b c d -> [(a, (b, (c, d)))]
toNestedList Relation4 a b c d
r4 =
  [ (a
a, (b, (c, d))
bcd)
    | (a
a, Relation3 b c d
r3) <- Map a (Relation3 b c d) -> [(a, Relation3 b c d)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map a (Relation3 b c d) -> [(a, Relation3 b c d)])
-> Map a (Relation3 b c d) -> [(a, Relation3 b c d)]
forall a b. (a -> b) -> a -> b
$ Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 Relation4 a b c d
r4,
      (b, (c, d))
bcd <- Relation3 b c d -> [(b, (c, d))]
forall a b c. Relation3 a b c -> [(a, (b, c))]
R3.toNestedList Relation3 b c d
r3
  ]

toList :: Relation4 a b c d -> [(a, b, c, d)]
toList :: forall a b c d. Relation4 a b c d -> [(a, b, c, d)]
toList = ((a, (b, (c, d))) -> (a, b, c, d))
-> [(a, (b, (c, d)))] -> [(a, b, c, d)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
a, (b
b, (c
c, d
d))) -> (a
a, b
b, c
c, d
d)) ([(a, (b, (c, d)))] -> [(a, b, c, d)])
-> (Relation4 a b c d -> [(a, (b, (c, d)))])
-> Relation4 a b c d
-> [(a, b, c, d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> [(a, (b, (c, d)))]
forall a b c d. Relation4 a b c d -> [(a, (b, (c, d)))]
toNestedList

empty :: (Ord a, Ord b, Ord c, Ord d) => Relation4 a b c d
empty :: forall a b c d. (Ord a, Ord b, Ord c, Ord d) => Relation4 a b c d
empty = Relation4 a b c d
forall a. Monoid a => a
mempty

null :: Relation4 a b c d -> Bool
null :: forall a b c d. Relation4 a b c d -> Bool
null Relation4 a b c d
r = Map a (Relation3 b c d) -> Bool
forall k a. Map k a -> Bool
Map.null (Map a (Relation3 b c d) -> Bool)
-> Map a (Relation3 b c d) -> Bool
forall a b. (a -> b) -> a -> b
$ Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 Relation4 a b c d
r

fromList :: (Ord a, Ord b, Ord c, Ord d) => [(a, b, c, d)] -> Relation4 a b c d
fromList :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
[(a, b, c, d)] -> Relation4 a b c d
fromList [(a, b, c, d)]
xs = [(a, b, c, d)] -> Relation4 a b c d -> Relation4 a b c d
forall (f :: * -> *) a b c d.
(Foldable f, Ord a, Ord b, Ord c, Ord d) =>
f (a, b, c, d) -> Relation4 a b c d -> Relation4 a b c d
insertAll [(a, b, c, d)]
xs Relation4 a b c d
forall a b c d. (Ord a, Ord b, Ord c, Ord d) => Relation4 a b c d
empty

filter :: (Ord a, Ord b, Ord c, Ord d) => ((a, b, c, d) -> Bool) -> Relation4 a b c d -> Relation4 a b c d
filter :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
((a, b, c, d) -> Bool) -> Relation4 a b c d -> Relation4 a b c d
filter (a, b, c, d) -> Bool
f = [(a, b, c, d)] -> Relation4 a b c d
forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
[(a, b, c, d)] -> Relation4 a b c d
fromList ([(a, b, c, d)] -> Relation4 a b c d)
-> (Relation4 a b c d -> [(a, b, c, d)])
-> Relation4 a b c d
-> Relation4 a b c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, c, d) -> Bool) -> [(a, b, c, d)] -> [(a, b, c, d)]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (a, b, c, d) -> Bool
f ([(a, b, c, d)] -> [(a, b, c, d)])
-> (Relation4 a b c d -> [(a, b, c, d)])
-> Relation4 a b c d
-> [(a, b, c, d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> [(a, b, c, d)]
forall a b c d. Relation4 a b c d -> [(a, b, c, d)]
toList

memberD13 :: (Ord a, Ord c) => a -> c -> Relation4 a b c d -> Bool
memberD13 :: forall a c b d.
(Ord a, Ord c) =>
a -> c -> Relation4 a b c d -> Bool
memberD13 a
a c
c Relation4 a b c d
r4 =
  case a -> Map a (Relation3 b c d) -> Maybe (Relation3 b c d)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
a (Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 Relation4 a b c d
r4) of
    Maybe (Relation3 b c d)
Nothing -> Bool
False
    Just Relation3 b c d
r3 -> c -> Relation3 b c d -> Bool
forall b a c. Ord b => b -> Relation3 a b c -> Bool
R3.memberD2 c
c Relation3 b c d
r3

selectD3 ::
  (Ord a, Ord b, Ord c, Ord d) =>
  c ->
  Relation4 a b c d ->
  Relation4 a b c d
selectD3 :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
c -> Relation4 a b c d -> Relation4 a b c d
selectD3 c
c Relation4 a b c d
r =
  [(a, b, c, d)] -> Relation4 a b c d
forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
[(a, b, c, d)] -> Relation4 a b c d
fromList [(a
a, b
b, c
c, d
d) | (a
a, b
b, d
d) <- [(a, b, d)]
-> (Relation3 a b d -> [(a, b, d)])
-> Maybe (Relation3 a b d)
-> [(a, b, d)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Relation3 a b d -> [(a, b, d)]
forall a b c. Relation3 a b c -> [(a, b, c)]
R3.toList (Maybe (Relation3 a b d) -> [(a, b, d)])
-> Maybe (Relation3 a b d) -> [(a, b, d)]
forall a b. (a -> b) -> a -> b
$ c -> Map c (Relation3 a b d) -> Maybe (Relation3 a b d)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup c
c (Relation4 a b c d -> Map c (Relation3 a b d)
forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 Relation4 a b c d
r)]

selectD34 ::
  (Ord a, Ord b, Ord c, Ord d) =>
  c ->
  d ->
  Relation4 a b c d ->
  Relation4 a b c d
selectD34 :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
c -> d -> Relation4 a b c d -> Relation4 a b c d
selectD34 c
c d
d Relation4 a b c d
r =
  [(a, b, c, d)] -> Relation4 a b c d
forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
[(a, b, c, d)] -> Relation4 a b c d
fromList
    [ (a
a, b
b, c
c, d
d)
      | (a
a, b
b) <-
          [(a, b)]
-> (Relation3 a b d -> [(a, b)])
-> Maybe (Relation3 a b d)
-> [(a, b)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            []
            ([(a, b)]
-> (Relation a b -> [(a, b)]) -> Maybe (Relation a b) -> [(a, b)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
R.toList (Maybe (Relation a b) -> [(a, b)])
-> (Relation3 a b d -> Maybe (Relation a b))
-> Relation3 a b d
-> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Map d (Relation a b) -> Maybe (Relation a b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup d
d (Map d (Relation a b) -> Maybe (Relation a b))
-> (Relation3 a b d -> Map d (Relation a b))
-> Relation3 a b d
-> Maybe (Relation a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation3 a b d -> Map d (Relation a b)
forall a b c. Relation3 a b c -> Map c (Relation a b)
R3.d3)
            (c -> Map c (Relation3 a b d) -> Maybe (Relation3 a b d)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup c
c (Relation4 a b c d -> Map c (Relation3 a b d)
forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 Relation4 a b c d
r))
    ]

restrict34d12 ::
  (Ord a, Ord b, Ord c, Ord d) =>
  (c, d) ->
  Relation4 a b c d ->
  Relation a b
restrict34d12 :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
(c, d) -> Relation4 a b c d -> Relation a b
restrict34d12 (c
c, d
d) Relation4 {Map c (Relation3 a b d)
d3 :: forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 :: Map c (Relation3 a b d)
d3} =
  Relation a b -> Maybe (Relation a b) -> Relation a b
forall a. a -> Maybe a -> a
fromMaybe Relation a b
forall a b. Relation a b
R.empty do
    Relation3 a b d
abd <- c -> Map c (Relation3 a b d) -> Maybe (Relation3 a b d)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup c
c Map c (Relation3 a b d)
d3
    d -> Map d (Relation a b) -> Maybe (Relation a b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup d
d (Relation3 a b d -> Map d (Relation a b)
forall a b c. Relation3 a b c -> Map c (Relation a b)
R3.d3 Relation3 a b d
abd)

keys :: Relation4 a b c d -> (Set a, Set b, Set c, Set d)
keys :: forall a b c d. Relation4 a b c d -> (Set a, Set b, Set c, Set d)
keys Relation4 {Map a (Relation3 b c d)
d1 :: forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 :: Map a (Relation3 b c d)
d1, Map b (Relation3 a c d)
d2 :: forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d2 :: Map b (Relation3 a c d)
d2, Map c (Relation3 a b d)
d3 :: forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 :: Map c (Relation3 a b d)
d3, Map d (Relation3 a b c)
d4 :: forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d4 :: Map d (Relation3 a b c)
d4} =
  (Map a (Relation3 b c d) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Relation3 b c d)
d1, Map b (Relation3 a c d) -> Set b
forall k a. Map k a -> Set k
Map.keysSet Map b (Relation3 a c d)
d2, Map c (Relation3 a b d) -> Set c
forall k a. Map k a -> Set k
Map.keysSet Map c (Relation3 a b d)
d3, Map d (Relation3 a b c) -> Set d
forall k a. Map k a -> Set k
Map.keysSet Map d (Relation3 a b c)
d4)

lookupD1 :: (Ord a, Ord b, Ord c, Ord d) => a -> Relation4 a b c d -> Relation3 b c d
lookupD1 :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
a -> Relation4 a b c d -> Relation3 b c d
lookupD1 a
a = Relation3 b c d -> Maybe (Relation3 b c d) -> Relation3 b c d
forall a. a -> Maybe a -> a
fromMaybe Relation3 b c d
forall a. Monoid a => a
mempty (Maybe (Relation3 b c d) -> Relation3 b c d)
-> (Relation4 a b c d -> Maybe (Relation3 b c d))
-> Relation4 a b c d
-> Relation3 b c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Map a (Relation3 b c d) -> Maybe (Relation3 b c d)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
a (Map a (Relation3 b c d) -> Maybe (Relation3 b c d))
-> (Relation4 a b c d -> Map a (Relation3 b c d))
-> Relation4 a b c d
-> Maybe (Relation3 b c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1

lookupD2 :: (Ord a, Ord b, Ord c, Ord d) => b -> Relation4 a b c d -> Relation3 a c d
lookupD2 :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
b -> Relation4 a b c d -> Relation3 a c d
lookupD2 b
b = Relation3 a c d -> Maybe (Relation3 a c d) -> Relation3 a c d
forall a. a -> Maybe a -> a
fromMaybe Relation3 a c d
forall a. Monoid a => a
mempty (Maybe (Relation3 a c d) -> Relation3 a c d)
-> (Relation4 a b c d -> Maybe (Relation3 a c d))
-> Relation4 a b c d
-> Relation3 a c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Map b (Relation3 a c d) -> Maybe (Relation3 a c d)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup b
b (Map b (Relation3 a c d) -> Maybe (Relation3 a c d))
-> (Relation4 a b c d -> Map b (Relation3 a c d))
-> Relation4 a b c d
-> Maybe (Relation3 a c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> Map b (Relation3 a c d)
forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d2

d1set :: (Ord a) => Relation4 a b c d -> Set a
d1set :: forall a b c d. Ord a => Relation4 a b c d -> Set a
d1set = Map a (Relation3 b c d) -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a (Relation3 b c d) -> Set a)
-> (Relation4 a b c d -> Map a (Relation3 b c d))
-> Relation4 a b c d
-> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1

d12 :: (Ord a, Ord b) => Relation4 a b c d -> Relation a b
d12 :: forall a b c d. (Ord a, Ord b) => Relation4 a b c d -> Relation a b
d12 = Map a (Set b) -> Relation a b
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
R.fromMultimap (Map a (Set b) -> Relation a b)
-> (Relation4 a b c d -> Map a (Set b))
-> Relation4 a b c d
-> Relation a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relation3 b c d -> Set b)
-> Map a (Relation3 b c d) -> Map a (Set b)
forall a b. (a -> b) -> Map a a -> Map a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map b (Relation c d) -> Set b
forall k a. Map k a -> Set k
Map.keysSet (Map b (Relation c d) -> Set b)
-> (Relation3 b c d -> Map b (Relation c d))
-> Relation3 b c d
-> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation3 b c d -> Map b (Relation c d)
forall a b c. Relation3 a b c -> Map a (Relation b c)
R3.d1) (Map a (Relation3 b c d) -> Map a (Set b))
-> (Relation4 a b c d -> Map a (Relation3 b c d))
-> Relation4 a b c d
-> Map a (Set b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1

d13 :: (Ord a, Ord c) => Relation4 a b c d -> Relation a c
d13 :: forall a c b d. (Ord a, Ord c) => Relation4 a b c d -> Relation a c
d13 = Map a (Set c) -> Relation a c
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
R.fromMultimap (Map a (Set c) -> Relation a c)
-> (Relation4 a b c d -> Map a (Set c))
-> Relation4 a b c d
-> Relation a c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relation3 b c d -> Set c)
-> Map a (Relation3 b c d) -> Map a (Set c)
forall a b. (a -> b) -> Map a a -> Map a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map c (Relation b d) -> Set c
forall k a. Map k a -> Set k
Map.keysSet (Map c (Relation b d) -> Set c)
-> (Relation3 b c d -> Map c (Relation b d))
-> Relation3 b c d
-> Set c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation3 b c d -> Map c (Relation b d)
forall a b c. Relation3 a b c -> Map b (Relation a c)
R3.d2) (Map a (Relation3 b c d) -> Map a (Set c))
-> (Relation4 a b c d -> Map a (Relation3 b c d))
-> Relation4 a b c d
-> Map a (Set c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1

d34 :: (Ord c, Ord d) => Relation4 a b c d -> Relation c d
d34 :: forall c d a b. (Ord c, Ord d) => Relation4 a b c d -> Relation c d
d34 = Map c (Set d) -> Relation c d
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
R.fromMultimap (Map c (Set d) -> Relation c d)
-> (Relation4 a b c d -> Map c (Set d))
-> Relation4 a b c d
-> Relation c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relation3 a b d -> Set d)
-> Map c (Relation3 a b d) -> Map c (Set d)
forall a b. (a -> b) -> Map c a -> Map c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map d (Relation a b) -> Set d
forall k a. Map k a -> Set k
Map.keysSet (Map d (Relation a b) -> Set d)
-> (Relation3 a b d -> Map d (Relation a b))
-> Relation3 a b d
-> Set d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation3 a b d -> Map d (Relation a b)
forall a b c. Relation3 a b c -> Map c (Relation a b)
R3.d3) (Map c (Relation3 a b d) -> Map c (Set d))
-> (Relation4 a b c d -> Map c (Relation3 a b d))
-> Relation4 a b c d
-> Map c (Set d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> Map c (Relation3 a b d)
forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3

-- | Project out a relation that only includes the 1st, 2nd, and 4th dimensions.
d124 :: (Ord a, Ord b, Ord c, Ord d) => Relation4 a b c d -> Relation3 a b d
d124 :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Relation4 a b c d -> Relation3 a b d
d124 Relation4 {Map a (Relation3 b c d)
d1 :: forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 :: Map a (Relation3 b c d)
d1, Map b (Relation3 a c d)
d2 :: forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d2 :: Map b (Relation3 a c d)
d2, Map d (Relation3 a b c)
d4 :: forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d4 :: Map d (Relation3 a b c)
d4} =
  Relation3
    { d1 :: Map a (Relation b d)
d1 = (Relation3 b c d -> Relation b d)
-> Map a (Relation3 b c d) -> Map a (Relation b d)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Relation3 b c d -> Relation b d
forall a b c. Relation3 a b c -> Relation a c
R3.d13 Map a (Relation3 b c d)
d1,
      d2 :: Map b (Relation a d)
d2 = (Relation3 a c d -> Relation a d)
-> Map b (Relation3 a c d) -> Map b (Relation a d)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Relation3 a c d -> Relation a d
forall a b c. Relation3 a b c -> Relation a c
R3.d13 Map b (Relation3 a c d)
d2,
      d3 :: Map d (Relation a b)
d3 = (Relation3 a b c -> Relation a b)
-> Map d (Relation3 a b c) -> Map d (Relation a b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Relation3 a b c -> Relation a b
forall a b c. Relation3 a b c -> Relation a b
R3.d12 Map d (Relation3 a b c)
d4
    }

-- | Project out a relation that only includes the 2nd, 3rd, and 4th dimensions.
d234 :: (Ord a, Ord b, Ord c, Ord d) => Relation4 a b c d -> Relation3 b c d
d234 :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Relation4 a b c d -> Relation3 b c d
d234 Relation4 {Map b (Relation3 a c d)
d2 :: forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d2 :: Map b (Relation3 a c d)
d2, Map c (Relation3 a b d)
d3 :: forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 :: Map c (Relation3 a b d)
d3, Map d (Relation3 a b c)
d4 :: forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d4 :: Map d (Relation3 a b c)
d4} =
  Relation3
    { d1 :: Map b (Relation c d)
d1 = (Relation3 a c d -> Relation c d)
-> Map b (Relation3 a c d) -> Map b (Relation c d)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Relation3 a c d -> Relation c d
forall a b c. Relation3 a b c -> Relation b c
R3.d23 Map b (Relation3 a c d)
d2,
      d2 :: Map c (Relation b d)
d2 = (Relation3 a b d -> Relation b d)
-> Map c (Relation3 a b d) -> Map c (Relation b d)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Relation3 a b d -> Relation b d
forall a b c. Relation3 a b c -> Relation b c
R3.d23 Map c (Relation3 a b d)
d3,
      d3 :: Map d (Relation b c)
d3 = (Relation3 a b c -> Relation b c)
-> Map d (Relation3 a b c) -> Map d (Relation b c)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Relation3 a b c -> Relation b c
forall a b c. Relation3 a b c -> Relation b c
R3.d23 Map d (Relation3 a b c)
d4
    }

-- todo: make me faster
d12s :: (Ord a, Ord b) => Relation4 a b c d -> [(a, b)]
d12s :: forall a b c d. (Ord a, Ord b) => Relation4 a b c d -> [(a, b)]
d12s = [(a, b)] -> [(a, b)]
forall a. Ord a => [a] -> [a]
nubOrd ([(a, b)] -> [(a, b)])
-> (Relation4 a b c d -> [(a, b)]) -> Relation4 a b c d -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, (b, (c, d))) -> (a, b)) -> [(a, (b, (c, d)))] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
a, (b
b, (c, d)
_)) -> (a
a, b
b)) ([(a, (b, (c, d)))] -> [(a, b)])
-> (Relation4 a b c d -> [(a, (b, (c, d)))])
-> Relation4 a b c d
-> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> [(a, (b, (c, d)))]
forall a b c d. Relation4 a b c d -> [(a, (b, (c, d)))]
toNestedList

d3s :: Relation4 a b c d -> Set c
d3s :: forall a b c d. Relation4 a b c d -> Set c
d3s = Map c (Relation3 a b d) -> Set c
forall k a. Map k a -> Set k
Map.keysSet (Map c (Relation3 a b d) -> Set c)
-> (Relation4 a b c d -> Map c (Relation3 a b d))
-> Relation4 a b c d
-> Set c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> Map c (Relation3 a b d)
forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3

d4s :: Relation4 a b c d -> Set d
d4s :: forall a b c d. Relation4 a b c d -> Set d
d4s = Map d (Relation3 a b c) -> Set d
forall k a. Map k a -> Set k
Map.keysSet (Map d (Relation3 a b c) -> Set d)
-> (Relation4 a b c d -> Map d (Relation3 a b c))
-> Relation4 a b c d
-> Set d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation4 a b c d -> Map d (Relation3 a b c)
forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d4

-- e.g. Map.toList (d1 r) >>= \(a, r3) -> (a,) <$> Map.keys (R3.d1 r3)

insert,
  delete ::
    (Ord a, Ord b, Ord c, Ord d) =>
    a ->
    b ->
    c ->
    d ->
    Relation4 a b c d ->
    Relation4 a b c d
insert :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
a -> b -> c -> d -> Relation4 a b c d -> Relation4 a b c d
insert a
a b
b c
c d
d Relation4 {Map a (Relation3 b c d)
Map b (Relation3 a c d)
Map c (Relation3 a b d)
Map d (Relation3 a b c)
d1 :: forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d2 :: forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d3 :: forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d4 :: forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d1 :: Map a (Relation3 b c d)
d2 :: Map b (Relation3 a c d)
d3 :: Map c (Relation3 a b d)
d4 :: Map d (Relation3 a b c)
..} =
  Map a (Relation3 b c d)
-> Map b (Relation3 a c d)
-> Map c (Relation3 a b d)
-> Map d (Relation3 a b c)
-> Relation4 a b c d
forall a b c d.
Map a (Relation3 b c d)
-> Map b (Relation3 a c d)
-> Map c (Relation3 a b d)
-> Map d (Relation3 a b c)
-> Relation4 a b c d
Relation4
    ((Maybe (Relation3 b c d) -> Maybe (Relation3 b c d))
-> a -> Map a (Relation3 b c d) -> Map a (Relation3 b c d)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (b -> c -> d -> Maybe (Relation3 b c d) -> Maybe (Relation3 b c d)
forall {a} {b} {c}.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
ins b
b c
c d
d) a
a Map a (Relation3 b c d)
d1)
    ((Maybe (Relation3 a c d) -> Maybe (Relation3 a c d))
-> b -> Map b (Relation3 a c d) -> Map b (Relation3 a c d)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (a -> c -> d -> Maybe (Relation3 a c d) -> Maybe (Relation3 a c d)
forall {a} {b} {c}.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
ins a
a c
c d
d) b
b Map b (Relation3 a c d)
d2)
    ((Maybe (Relation3 a b d) -> Maybe (Relation3 a b d))
-> c -> Map c (Relation3 a b d) -> Map c (Relation3 a b d)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (a -> b -> d -> Maybe (Relation3 a b d) -> Maybe (Relation3 a b d)
forall {a} {b} {c}.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
ins a
a b
b d
d) c
c Map c (Relation3 a b d)
d3)
    ((Maybe (Relation3 a b c) -> Maybe (Relation3 a b c))
-> d -> Map d (Relation3 a b c) -> Map d (Relation3 a b c)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
forall {a} {b} {c}.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
ins a
a b
b c
c) d
d Map d (Relation3 a b c)
d4)
  where
    ins :: a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
ins a
x b
y c
z = Relation3 a b c -> Maybe (Relation3 a b c)
forall a. a -> Maybe a
Just (Relation3 a b c -> Maybe (Relation3 a b c))
-> (Maybe (Relation3 a b c) -> Relation3 a b c)
-> Maybe (Relation3 a b c)
-> Maybe (Relation3 a b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> Relation3 a b c -> Relation3 a b c
forall a b c.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Relation3 a b c -> Relation3 a b c
R3.insert a
x b
y c
z (Relation3 a b c -> Relation3 a b c)
-> (Maybe (Relation3 a b c) -> Relation3 a b c)
-> Maybe (Relation3 a b c)
-> Relation3 a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation3 a b c -> Maybe (Relation3 a b c) -> Relation3 a b c
forall a. a -> Maybe a -> a
fromMaybe Relation3 a b c
forall a. Monoid a => a
mempty
delete :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
a -> b -> c -> d -> Relation4 a b c d -> Relation4 a b c d
delete a
a b
b c
c d
d Relation4 {Map a (Relation3 b c d)
Map b (Relation3 a c d)
Map c (Relation3 a b d)
Map d (Relation3 a b c)
d1 :: forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d2 :: forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d3 :: forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d4 :: forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d1 :: Map a (Relation3 b c d)
d2 :: Map b (Relation3 a c d)
d3 :: Map c (Relation3 a b d)
d4 :: Map d (Relation3 a b c)
..} =
  Map a (Relation3 b c d)
-> Map b (Relation3 a c d)
-> Map c (Relation3 a b d)
-> Map d (Relation3 a b c)
-> Relation4 a b c d
forall a b c d.
Map a (Relation3 b c d)
-> Map b (Relation3 a c d)
-> Map c (Relation3 a b d)
-> Map d (Relation3 a b c)
-> Relation4 a b c d
Relation4
    ((Maybe (Relation3 b c d) -> Maybe (Relation3 b c d))
-> a -> Map a (Relation3 b c d) -> Map a (Relation3 b c d)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (b -> c -> d -> Maybe (Relation3 b c d) -> Maybe (Relation3 b c d)
forall {a} {b} {c}.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
del b
b c
c d
d) a
a Map a (Relation3 b c d)
d1)
    ((Maybe (Relation3 a c d) -> Maybe (Relation3 a c d))
-> b -> Map b (Relation3 a c d) -> Map b (Relation3 a c d)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (a -> c -> d -> Maybe (Relation3 a c d) -> Maybe (Relation3 a c d)
forall {a} {b} {c}.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
del a
a c
c d
d) b
b Map b (Relation3 a c d)
d2)
    ((Maybe (Relation3 a b d) -> Maybe (Relation3 a b d))
-> c -> Map c (Relation3 a b d) -> Map c (Relation3 a b d)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (a -> b -> d -> Maybe (Relation3 a b d) -> Maybe (Relation3 a b d)
forall {a} {b} {c}.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
del a
a b
b d
d) c
c Map c (Relation3 a b d)
d3)
    ((Maybe (Relation3 a b c) -> Maybe (Relation3 a b c))
-> d -> Map d (Relation3 a b c) -> Map d (Relation3 a b c)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
forall {a} {b} {c}.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Maybe (Relation3 a b c) -> Maybe (Relation3 a b c)
del a
a b
b c
c) d
d Map d (Relation3 a b c)
d4)
  where
    del :: p -> p -> p -> Maybe (Relation3 p p p) -> Maybe (Relation3 p p p)
del p
_ p
_ p
_ Maybe (Relation3 p p p)
Nothing = Maybe (Relation3 p p p)
forall a. Maybe a
Nothing
    del p
x p
y p
z (Just Relation3 p p p
r) =
      let r' :: Relation3 p p p
r' = p -> p -> p -> Relation3 p p p -> Relation3 p p p
forall a b c.
(Ord a, Ord b, Ord c) =>
a -> b -> c -> Relation3 a b c -> Relation3 a b c
R3.delete p
x p
y p
z Relation3 p p p
r
       in if Relation3 p p p
r' Relation3 p p p -> Relation3 p p p -> Bool
forall a. Eq a => a -> a -> Bool
== Relation3 p p p
forall a. Monoid a => a
mempty then Maybe (Relation3 p p p)
forall a. Maybe a
Nothing else Relation3 p p p -> Maybe (Relation3 p p p)
forall a. a -> Maybe a
Just Relation3 p p p
r'

mapD2 :: (Ord a, Ord b, Ord b', Ord c, Ord d) => (b -> b') -> Relation4 a b c d -> Relation4 a b' c d
mapD2 :: forall a b b' c d.
(Ord a, Ord b, Ord b', Ord c, Ord d) =>
(b -> b') -> Relation4 a b c d -> Relation4 a b' c d
mapD2 b -> b'
f Relation4 {Map a (Relation3 b c d)
d1 :: forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 :: Map a (Relation3 b c d)
d1, Map b (Relation3 a c d)
d2 :: forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d2 :: Map b (Relation3 a c d)
d2, Map c (Relation3 a b d)
d3 :: forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 :: Map c (Relation3 a b d)
d3, Map d (Relation3 a b c)
d4 :: forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d4 :: Map d (Relation3 a b c)
d4} =
  Relation4
    { d1 :: Map a (Relation3 b' c d)
d1 = (Relation3 b c d -> Relation3 b' c d)
-> Map a (Relation3 b c d) -> Map a (Relation3 b' c d)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> b') -> Relation3 b c d -> Relation3 b' c d
forall a a' b c.
(Ord a, Ord a', Ord b, Ord c) =>
(a -> a') -> Relation3 a b c -> Relation3 a' b c
R3.mapD1 b -> b'
f) Map a (Relation3 b c d)
d1,
      d2 :: Map b' (Relation3 a c d)
d2 = (Relation3 a c d -> Relation3 a c d -> Relation3 a c d)
-> (b -> b') -> Map b (Relation3 a c d) -> Map b' (Relation3 a c d)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith Relation3 a c d -> Relation3 a c d -> Relation3 a c d
forall a b c.
(Ord a, Ord b, Ord c) =>
Relation3 a b c -> Relation3 a b c -> Relation3 a b c
R3.union b -> b'
f Map b (Relation3 a c d)
d2,
      d3 :: Map c (Relation3 a b' d)
d3 = (Relation3 a b d -> Relation3 a b' d)
-> Map c (Relation3 a b d) -> Map c (Relation3 a b' d)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> b') -> Relation3 a b d -> Relation3 a b' d
forall a b b' c.
(Ord a, Ord b, Ord b', Ord c) =>
(b -> b') -> Relation3 a b c -> Relation3 a b' c
R3.mapD2 b -> b'
f) Map c (Relation3 a b d)
d3,
      d4 :: Map d (Relation3 a b' c)
d4 = (Relation3 a b c -> Relation3 a b' c)
-> Map d (Relation3 a b c) -> Map d (Relation3 a b' c)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> b') -> Relation3 a b c -> Relation3 a b' c
forall a b b' c.
(Ord a, Ord b, Ord b', Ord c) =>
(b -> b') -> Relation3 a b c -> Relation3 a b' c
R3.mapD2 b -> b'
f) Map d (Relation3 a b c)
d4
    }

-- | Like 'mapD2', but takes a function that must be monotonic; i.e. @compare x y == compare (f x) (f y)@.
mapD2Monotonic :: (Ord a, Ord b, Ord b', Ord c, Ord d) => (b -> b') -> Relation4 a b c d -> Relation4 a b' c d
mapD2Monotonic :: forall a b b' c d.
(Ord a, Ord b, Ord b', Ord c, Ord d) =>
(b -> b') -> Relation4 a b c d -> Relation4 a b' c d
mapD2Monotonic b -> b'
f Relation4 {Map a (Relation3 b c d)
d1 :: forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 :: Map a (Relation3 b c d)
d1, Map b (Relation3 a c d)
d2 :: forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d2 :: Map b (Relation3 a c d)
d2, Map c (Relation3 a b d)
d3 :: forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 :: Map c (Relation3 a b d)
d3, Map d (Relation3 a b c)
d4 :: forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d4 :: Map d (Relation3 a b c)
d4} =
  Relation4
    { d1 :: Map a (Relation3 b' c d)
d1 = (Relation3 b c d -> Relation3 b' c d)
-> Map a (Relation3 b c d) -> Map a (Relation3 b' c d)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> b') -> Relation3 b c d -> Relation3 b' c d
forall a a' b c.
(Ord a, Ord a', Ord b, Ord c) =>
(a -> a') -> Relation3 a b c -> Relation3 a' b c
R3.mapD1Monotonic b -> b'
f) Map a (Relation3 b c d)
d1,
      d2 :: Map b' (Relation3 a c d)
d2 = (b -> b') -> Map b (Relation3 a c d) -> Map b' (Relation3 a c d)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic b -> b'
f Map b (Relation3 a c d)
d2,
      d3 :: Map c (Relation3 a b' d)
d3 = (Relation3 a b d -> Relation3 a b' d)
-> Map c (Relation3 a b d) -> Map c (Relation3 a b' d)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> b') -> Relation3 a b d -> Relation3 a b' d
forall a b b' c.
(Ord a, Ord b, Ord b', Ord c) =>
(b -> b') -> Relation3 a b c -> Relation3 a b' c
R3.mapD2Monotonic b -> b'
f) Map c (Relation3 a b d)
d3,
      d4 :: Map d (Relation3 a b' c)
d4 = (Relation3 a b c -> Relation3 a b' c)
-> Map d (Relation3 a b c) -> Map d (Relation3 a b' c)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> b') -> Relation3 a b c -> Relation3 a b' c
forall a b b' c.
(Ord a, Ord b, Ord b', Ord c) =>
(b -> b') -> Relation3 a b c -> Relation3 a b' c
R3.mapD2Monotonic b -> b'
f) Map d (Relation3 a b c)
d4
    }

insertAll ::
  (Foldable f) =>
  (Ord a) =>
  (Ord b) =>
  (Ord c) =>
  (Ord d) =>
  f (a, b, c, d) ->
  Relation4 a b c d ->
  Relation4 a b c d
insertAll :: forall (f :: * -> *) a b c d.
(Foldable f, Ord a, Ord b, Ord c, Ord d) =>
f (a, b, c, d) -> Relation4 a b c d -> Relation4 a b c d
insertAll f (a, b, c, d)
f Relation4 a b c d
r = (Relation4 a b c d -> (a, b, c, d) -> Relation4 a b c d)
-> Relation4 a b c d -> f (a, b, c, d) -> Relation4 a b c d
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Relation4 a b c d
r (a, b, c, d)
x -> (a -> b -> c -> d -> Relation4 a b c d -> Relation4 a b c d)
-> (a, b, c, d) -> Relation4 a b c d -> Relation4 a b c d
forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 a -> b -> c -> d -> Relation4 a b c d -> Relation4 a b c d
forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
a -> b -> c -> d -> Relation4 a b c d -> Relation4 a b c d
insert (a, b, c, d)
x Relation4 a b c d
r) Relation4 a b c d
r f (a, b, c, d)
f

instance (Ord a, Ord b, Ord c, Ord d) => Semigroup (Relation4 a b c d) where
  Relation4 a b c d
s1 <> :: Relation4 a b c d -> Relation4 a b c d -> Relation4 a b c d
<> Relation4 a b c d
s2 = Map a (Relation3 b c d)
-> Map b (Relation3 a c d)
-> Map c (Relation3 a b d)
-> Map d (Relation3 a b c)
-> Relation4 a b c d
forall a b c d.
Map a (Relation3 b c d)
-> Map b (Relation3 a c d)
-> Map c (Relation3 a b d)
-> Map d (Relation3 a b c)
-> Relation4 a b c d
Relation4 Map a (Relation3 b c d)
d1' Map b (Relation3 a c d)
d2' Map c (Relation3 a b d)
d3' Map d (Relation3 a b c)
d4'
    where
      d1' :: Map a (Relation3 b c d)
d1' = (Relation3 b c d -> Relation3 b c d -> Relation3 b c d)
-> Map a (Relation3 b c d)
-> Map a (Relation3 b c d)
-> Map a (Relation3 b c d)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Relation3 b c d -> Relation3 b c d -> Relation3 b c d
forall a. Semigroup a => a -> a -> a
(<>) (Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 Relation4 a b c d
s1) (Relation4 a b c d -> Map a (Relation3 b c d)
forall a b c d. Relation4 a b c d -> Map a (Relation3 b c d)
d1 Relation4 a b c d
s2)
      d2' :: Map b (Relation3 a c d)
d2' = (Relation3 a c d -> Relation3 a c d -> Relation3 a c d)
-> Map b (Relation3 a c d)
-> Map b (Relation3 a c d)
-> Map b (Relation3 a c d)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Relation3 a c d -> Relation3 a c d -> Relation3 a c d
forall a. Semigroup a => a -> a -> a
(<>) (Relation4 a b c d -> Map b (Relation3 a c d)
forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d2 Relation4 a b c d
s1) (Relation4 a b c d -> Map b (Relation3 a c d)
forall a b c d. Relation4 a b c d -> Map b (Relation3 a c d)
d2 Relation4 a b c d
s2)
      d3' :: Map c (Relation3 a b d)
d3' = (Relation3 a b d -> Relation3 a b d -> Relation3 a b d)
-> Map c (Relation3 a b d)
-> Map c (Relation3 a b d)
-> Map c (Relation3 a b d)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Relation3 a b d -> Relation3 a b d -> Relation3 a b d
forall a. Semigroup a => a -> a -> a
(<>) (Relation4 a b c d -> Map c (Relation3 a b d)
forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 Relation4 a b c d
s1) (Relation4 a b c d -> Map c (Relation3 a b d)
forall a b c d. Relation4 a b c d -> Map c (Relation3 a b d)
d3 Relation4 a b c d
s2)
      d4' :: Map d (Relation3 a b c)
d4' = (Relation3 a b c -> Relation3 a b c -> Relation3 a b c)
-> Map d (Relation3 a b c)
-> Map d (Relation3 a b c)
-> Map d (Relation3 a b c)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Relation3 a b c -> Relation3 a b c -> Relation3 a b c
forall a. Semigroup a => a -> a -> a
(<>) (Relation4 a b c d -> Map d (Relation3 a b c)
forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d4 Relation4 a b c d
s1) (Relation4 a b c d -> Map d (Relation3 a b c)
forall a b c d. Relation4 a b c d -> Map d (Relation3 a b c)
d4 Relation4 a b c d
s2)

instance (Ord a, Ord b, Ord c, Ord d) => Monoid (Relation4 a b c d) where
  mempty :: Relation4 a b c d
mempty = Map a (Relation3 b c d)
-> Map b (Relation3 a c d)
-> Map c (Relation3 a b d)
-> Map d (Relation3 a b c)
-> Relation4 a b c d
forall a b c d.
Map a (Relation3 b c d)
-> Map b (Relation3 a c d)
-> Map c (Relation3 a b d)
-> Map d (Relation3 a b c)
-> Relation4 a b c d
Relation4 Map a (Relation3 b c d)
forall a. Monoid a => a
mempty Map b (Relation3 a c d)
forall a. Monoid a => a
mempty Map c (Relation3 a b d)
forall a. Monoid a => a
mempty Map d (Relation3 a b c)
forall a. Monoid a => a
mempty