{-# LANGUAGE ScopedTypeVariables #-}

{- |
     Module     : Data.R2Tree.Double.Debug
     Copyright  : Copyright (c) 2015, Birte Wagner, Sebastian Philipp
                  Copyright (c) 2022, Oleksii Divak
     License    : MIT

     Maintainer : Oleksii Divak
     Stability  : experimental
     Portability: not portable

     Functions that expose the innerworkings of an 'R2Tree', but are completely safe
     to use otherwise.
-}

module Data.R2Tree.Double.Debug
  ( showsTree

  , Validity (..)
  , Reason (..)
  , validate
  ) where

import           Data.R2Tree.Double.Internal



-- | \(\mathcal{O}(n)\).
--   Shows the internal structure of the R-tree.
showsTree :: (a -> ShowS) -> R2Tree a -> ShowS
showsTree :: forall a. (a -> ShowS) -> R2Tree a -> ShowS
showsTree a -> ShowS
f = ShowS -> Int -> R2Tree a -> ShowS
go ShowS
forall a. a -> a
id Int
0
  where
    {-# INLINE mbr #-}
    mbr :: MBR -> ShowS
mbr (UnsafeMBR Double
xmin Double
ymin Double
xmax Double
ymax) = (Double, Double, Double, Double) -> ShowS
forall a. Show a => a -> ShowS
shows (Double
xmin, Double
ymin, Double
xmax, Double
ymax)

    {-# INLINE offset #-}
    offset :: t -> ShowS
offset t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0    = ShowS
forall a. a -> a
id
      | Bool
otherwise = Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ShowS
offset (t
i t -> t -> t
forall a. Num a => a -> a -> a
- t
1)

    go :: ShowS -> Int -> R2Tree a -> ShowS
go ShowS
s (Int
i :: Int) R2Tree a
n =
      Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset Int
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        case R2Tree a
n of
          Node2 MBR
ba R2Tree a
a MBR
bb R2Tree a
b           ->
            String -> ShowS
showString String
"Node 2" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Int -> R2Tree a -> ShowS
go (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
ba) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) R2Tree a
a
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Int -> R2Tree a -> ShowS
go (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bb) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) R2Tree a
b

          Node3 MBR
ba R2Tree a
a MBR
bb R2Tree a
b MBR
bc R2Tree a
c      ->
            String -> ShowS
showString String
"Node 3" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Int -> R2Tree a -> ShowS
go (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
ba) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) R2Tree a
a
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Int -> R2Tree a -> ShowS
go (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bb) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) R2Tree a
b
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Int -> R2Tree a -> ShowS
go (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bc) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) R2Tree a
c

          Node4 MBR
ba R2Tree a
a MBR
bb R2Tree a
b MBR
bc R2Tree a
c MBR
bd R2Tree a
d ->
            String -> ShowS
showString String
"Node 4" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Int -> R2Tree a -> ShowS
go (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
ba) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) R2Tree a
a
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Int -> R2Tree a -> ShowS
go (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bb) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) R2Tree a
b
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Int -> R2Tree a -> ShowS
go (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bc) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) R2Tree a
c
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Int -> R2Tree a -> ShowS
go (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bd) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) R2Tree a
d

          Leaf2 MBR
ba a
a MBR
bb a
b           ->
            String -> ShowS
showString String
"Leaf 2" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
ba ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
a
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bb ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
b

          Leaf3 MBR
ba a
a MBR
bb a
b MBR
bc a
c      ->
            String -> ShowS
showString String
"Leaf 3" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
ba ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
a
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bb ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
b
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
c

          Leaf4 MBR
ba a
a MBR
bb a
b MBR
bc a
c MBR
bd a
d ->
            String -> ShowS
showString String
"Leaf 4" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
ba ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
a
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bb ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
b
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
c
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bd ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
d

          Leaf1 MBR
bx a
x                ->
            String -> ShowS
showString String
"Leaf 1" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall {t}. (Ord t, Num t) => t -> ShowS
offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBR -> ShowS
mbr MBR
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
x

          R2Tree a
Empty                    ->
            String -> ShowS
showString String
"Empty" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s



-- | Whether the tree is well-formed.
data Validity = Valid
              | Invalid Reason
                deriving Int -> Validity -> ShowS
[Validity] -> ShowS
Validity -> String
(Int -> Validity -> ShowS)
-> (Validity -> String) -> ([Validity] -> ShowS) -> Show Validity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Validity -> ShowS
showsPrec :: Int -> Validity -> ShowS
$cshow :: Validity -> String
show :: Validity -> String
$cshowList :: [Validity] -> ShowS
showList :: [Validity] -> ShowS
Show

-- | Reason for why the tree is considered malformed.
data Reason = -- | Not all nodes are at the same depth.
              UnbalancedTree
              -- | Node does not enclose all inner t'MBR's properly.
            | MalformedNode MBR
              -- | Found a 'Leaf1' node not at root level.
            | FoundLeaf1
              -- | Found an 'Empty' node not at root level.
            | FoundEmpty
              deriving Int -> Reason -> ShowS
[Reason] -> ShowS
Reason -> String
(Int -> Reason -> ShowS)
-> (Reason -> String) -> ([Reason] -> ShowS) -> Show Reason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reason -> ShowS
showsPrec :: Int -> Reason -> ShowS
$cshow :: Reason -> String
show :: Reason -> String
$cshowList :: [Reason] -> ShowS
showList :: [Reason] -> ShowS
Show



data Carry = Carry Int
           | Broken Reason

carry2 :: Carry -> Carry -> Carry
carry2 :: Carry -> Carry -> Carry
carry2 (Carry Int
i) (Carry Int
j)
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j    = Int -> Carry
Carry (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  | Bool
otherwise = Reason -> Carry
Broken Reason
UnbalancedTree

carry2 (Carry Int
_) Carry
b         = Carry
b
carry2 Carry
a         Carry
_         = Carry
a

carry3 :: Carry -> Carry -> Carry -> Carry
carry3 :: Carry -> Carry -> Carry -> Carry
carry3 (Carry Int
i) (Carry Int
j) (Carry Int
k)
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k = Int -> Carry
Carry (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  | Bool
otherwise      = Reason -> Carry
Broken Reason
UnbalancedTree

carry3 (Carry Int
_) (Carry Int
_) Carry
c         = Carry
c
carry3 (Carry Int
_) Carry
b         Carry
_         = Carry
b
carry3 Carry
a         Carry
_         Carry
_         = Carry
a

carry4 :: Carry -> Carry -> Carry -> Carry -> Carry
carry4 :: Carry -> Carry -> Carry -> Carry -> Carry
carry4 (Carry Int
i) (Carry Int
j) (Carry Int
k) (Carry Int
l)
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l = Int -> Carry
Carry (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  | Bool
otherwise              = Reason -> Carry
Broken Reason
UnbalancedTree

carry4 (Carry Int
_) (Carry Int
_) (Carry Int
_) Carry
d         = Carry
d
carry4 (Carry Int
_) (Carry Int
_) Carry
c         Carry
_         = Carry
c
carry4 (Carry Int
_) Carry
b         Carry
_         Carry
_         = Carry
b
carry4 Carry
a         Carry
_         Carry
_         Carry
_         = Carry
a



-- | \(\mathcal{O}(n)\).
--   Checks whether the tree is well-formed.
validate :: R2Tree a -> Validity
validate :: forall a. R2Tree a -> Validity
validate R2Tree a
t =
  case R2Tree a
t of
    Leaf1 MBR
_ a
_ -> Validity
Valid
    R2Tree a
Empty     -> Validity
Valid
    R2Tree a
_         ->
      case Maybe MBR -> R2Tree a -> Carry
forall {a}. Maybe MBR -> R2Tree a -> Carry
go Maybe MBR
forall a. Maybe a
Nothing R2Tree a
t of
        Carry Int
_  -> Validity
Valid
        Broken Reason
r -> Reason -> Validity
Invalid Reason
r
  where
    go :: Maybe MBR -> R2Tree a -> Carry
go Maybe MBR
mbx R2Tree a
x =
      case R2Tree a
x of
        Node2 MBR
ba R2Tree a
a MBR
bb R2Tree a
b
          | Just MBR
bx <- Maybe MBR
mbx, MBR
bx MBR -> MBR -> Bool
forall a. Eq a => a -> a -> Bool
/= MBR -> MBR -> MBR
unionMBR MBR
ba MBR
bb -> Reason -> Carry
Broken (Reason -> Carry) -> Reason -> Carry
forall a b. (a -> b) -> a -> b
$ MBR -> Reason
MalformedNode MBR
bx
          | Bool
otherwise ->
              Carry -> Carry -> Carry
carry2 (Maybe MBR -> R2Tree a -> Carry
go (MBR -> Maybe MBR
forall a. a -> Maybe a
Just MBR
ba) R2Tree a
a)
                     (Maybe MBR -> R2Tree a -> Carry
go (MBR -> Maybe MBR
forall a. a -> Maybe a
Just MBR
bb) R2Tree a
b)

        Node3 MBR
ba R2Tree a
a MBR
bb R2Tree a
b MBR
bc R2Tree a
c
          | Just MBR
bx <- Maybe MBR
mbx, MBR
bx MBR -> MBR -> Bool
forall a. Eq a => a -> a -> Bool
/= MBR -> MBR -> MBR
unionMBR (MBR -> MBR -> MBR
unionMBR MBR
ba MBR
bb) MBR
bc -> Reason -> Carry
Broken (Reason -> Carry) -> Reason -> Carry
forall a b. (a -> b) -> a -> b
$ MBR -> Reason
MalformedNode MBR
bx
          | Bool
otherwise ->
              Carry -> Carry -> Carry -> Carry
carry3 (Maybe MBR -> R2Tree a -> Carry
go (MBR -> Maybe MBR
forall a. a -> Maybe a
Just MBR
ba) R2Tree a
a)
                     (Maybe MBR -> R2Tree a -> Carry
go (MBR -> Maybe MBR
forall a. a -> Maybe a
Just MBR
bb) R2Tree a
b)
                     (Maybe MBR -> R2Tree a -> Carry
go (MBR -> Maybe MBR
forall a. a -> Maybe a
Just MBR
bc) R2Tree a
c)

        Node4 MBR
ba R2Tree a
a MBR
bb R2Tree a
b MBR
bc R2Tree a
c MBR
bd R2Tree a
d
          | Just MBR
bx <- Maybe MBR
mbx
          , MBR
bx MBR -> MBR -> Bool
forall a. Eq a => a -> a -> Bool
/= MBR -> MBR -> MBR
unionMBR (MBR -> MBR -> MBR
unionMBR (MBR -> MBR -> MBR
unionMBR MBR
ba MBR
bb) MBR
bc) MBR
bd -> Reason -> Carry
Broken (Reason -> Carry) -> Reason -> Carry
forall a b. (a -> b) -> a -> b
$ MBR -> Reason
MalformedNode MBR
bx

          | Bool
otherwise ->
              Carry -> Carry -> Carry -> Carry -> Carry
carry4 (Maybe MBR -> R2Tree a -> Carry
go (MBR -> Maybe MBR
forall a. a -> Maybe a
Just MBR
ba) R2Tree a
a)
                     (Maybe MBR -> R2Tree a -> Carry
go (MBR -> Maybe MBR
forall a. a -> Maybe a
Just MBR
bb) R2Tree a
b)
                     (Maybe MBR -> R2Tree a -> Carry
go (MBR -> Maybe MBR
forall a. a -> Maybe a
Just MBR
bc) R2Tree a
c)
                     (Maybe MBR -> R2Tree a -> Carry
go (MBR -> Maybe MBR
forall a. a -> Maybe a
Just MBR
bd) R2Tree a
d)

        Leaf2 MBR
ba a
_ MBR
bb a
_
          | Just MBR
bx <- Maybe MBR
mbx, MBR
bx MBR -> MBR -> Bool
forall a. Eq a => a -> a -> Bool
/= MBR -> MBR -> MBR
unionMBR MBR
ba MBR
bb -> Reason -> Carry
Broken (Reason -> Carry) -> Reason -> Carry
forall a b. (a -> b) -> a -> b
$ MBR -> Reason
MalformedNode MBR
bx
          | Bool
otherwise -> Int -> Carry
Carry Int
0

        Leaf3 MBR
ba a
_ MBR
bb a
_ MBR
bc a
_
          | Just MBR
bx <- Maybe MBR
mbx, MBR
bx MBR -> MBR -> Bool
forall a. Eq a => a -> a -> Bool
/= MBR -> MBR -> MBR
unionMBR (MBR -> MBR -> MBR
unionMBR MBR
ba MBR
bb) MBR
bc -> Reason -> Carry
Broken (Reason -> Carry) -> Reason -> Carry
forall a b. (a -> b) -> a -> b
$ MBR -> Reason
MalformedNode MBR
bx
          | Bool
otherwise -> Int -> Carry
Carry Int
0

        Leaf4 MBR
ba a
_ MBR
bb a
_ MBR
bc a
_ MBR
bd a
_
          | Just MBR
bx <- Maybe MBR
mbx
          , MBR
bx MBR -> MBR -> Bool
forall a. Eq a => a -> a -> Bool
/= MBR -> MBR -> MBR
unionMBR (MBR -> MBR -> MBR
unionMBR (MBR -> MBR -> MBR
unionMBR MBR
ba MBR
bb) MBR
bc) MBR
bd -> Reason -> Carry
Broken (Reason -> Carry) -> Reason -> Carry
forall a b. (a -> b) -> a -> b
$ MBR -> Reason
MalformedNode MBR
bx

          | Bool
otherwise -> Int -> Carry
Carry Int
0

        Leaf1 MBR
_  a
_ -> Reason -> Carry
Broken Reason
FoundLeaf1
        R2Tree a
Empty      -> Reason -> Carry
Broken Reason
FoundEmpty