{-# LANGUAGE PatternSynonyms      #-}
{-# LANGUAGE RoleAnnotations      #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.QuadTree.Internal where

import Control.Applicative (liftA2)
import Data.Maybe (isJust)
import Data.Monoid (Ap(..))
import GHC.Generics (Generic)
import Linear.V2
import Linear.V4


------------------------------------------------------------------------------
-- | An axis-aligned bounding box in 3-space.
data Rect a = Rect
  { forall a. Rect a -> V2 a
r_pos  :: !(V2 a)
  , forall a. Rect a -> V2 a
r_size :: !(V2 a)
  }
  deriving stock (Int -> Rect a -> ShowS
forall a. Show a => Int -> Rect a -> ShowS
forall a. Show a => [Rect a] -> ShowS
forall a. Show a => Rect a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rect a] -> ShowS
$cshowList :: forall a. Show a => [Rect a] -> ShowS
show :: Rect a -> String
$cshow :: forall a. Show a => Rect a -> String
showsPrec :: Int -> Rect a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Rect a -> ShowS
Show, ReadPrec [Rect a]
ReadPrec (Rect a)
ReadS [Rect a]
forall a. Read a => ReadPrec [Rect a]
forall a. Read a => ReadPrec (Rect a)
forall a. Read a => Int -> ReadS (Rect a)
forall a. Read a => ReadS [Rect a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rect a]
$creadListPrec :: forall a. Read a => ReadPrec [Rect a]
readPrec :: ReadPrec (Rect a)
$creadPrec :: forall a. Read a => ReadPrec (Rect a)
readList :: ReadS [Rect a]
$creadList :: forall a. Read a => ReadS [Rect a]
readsPrec :: Int -> ReadS (Rect a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Rect a)
Read, Rect a -> Rect a -> Bool
forall a. Eq a => Rect a -> Rect a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rect a -> Rect a -> Bool
$c/= :: forall a. Eq a => Rect a -> Rect a -> Bool
== :: Rect a -> Rect a -> Bool
$c== :: forall a. Eq a => Rect a -> Rect a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Rect a) x -> Rect a
forall a x. Rect a -> Rep (Rect a) x
$cto :: forall a x. Rep (Rect a) x -> Rect a
$cfrom :: forall a x. Rect a -> Rep (Rect a) x
Generic, Rect a -> Rect a -> Bool
Rect a -> Rect a -> Ordering
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 {a}. Ord a => Eq (Rect a)
forall a. Ord a => Rect a -> Rect a -> Bool
forall a. Ord a => Rect a -> Rect a -> Ordering
forall a. Ord a => Rect a -> Rect a -> Rect a
min :: Rect a -> Rect a -> Rect a
$cmin :: forall a. Ord a => Rect a -> Rect a -> Rect a
max :: Rect a -> Rect a -> Rect a
$cmax :: forall a. Ord a => Rect a -> Rect a -> Rect a
>= :: Rect a -> Rect a -> Bool
$c>= :: forall a. Ord a => Rect a -> Rect a -> Bool
> :: Rect a -> Rect a -> Bool
$c> :: forall a. Ord a => Rect a -> Rect a -> Bool
<= :: Rect a -> Rect a -> Bool
$c<= :: forall a. Ord a => Rect a -> Rect a -> Bool
< :: Rect a -> Rect a -> Bool
$c< :: forall a. Ord a => Rect a -> Rect a -> Bool
compare :: Rect a -> Rect a -> Ordering
$ccompare :: forall a. Ord a => Rect a -> Rect a -> Ordering
Ord, forall a b. a -> Rect b -> Rect a
forall a b. (a -> b) -> Rect a -> Rect b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Rect b -> Rect a
$c<$ :: forall a b. a -> Rect b -> Rect a
fmap :: forall a b. (a -> b) -> Rect a -> Rect b
$cfmap :: forall a b. (a -> b) -> Rect a -> Rect b
Functor)


------------------------------------------------------------------------------
r_x, r_y, r_w, r_h :: Rect a -> a
r_x :: forall a. Rect a -> a
r_x (Rect (V2 a
x a
_) (V2 a
_ a
_)) = a
x
r_y :: forall a. Rect a -> a
r_y (Rect (V2 a
_ a
y) (V2 a
_ a
_)) = a
y
r_w :: forall a. Rect a -> a
r_w (Rect (V2 a
_ a
_) (V2 a
w a
_)) = a
w
r_h :: forall a. Rect a -> a
r_h (Rect (V2 a
_ a
_) (V2 a
_ a
h)) = a
h


------------------------------------------------------------------------------
-- | @'containsRect' c1 c2@ is true when @c2@ is inside or equal to @c1@.
rectContainsRect :: (Num a, Ord a) => Rect a -> Rect a -> Bool
rectContainsRect :: forall a. (Num a, Ord a) => Rect a -> Rect a -> Bool
rectContainsRect r1 :: Rect a
r1@(Rect (V2 a
bx a
by) (V2 a
bw a
bh)) r2 :: Rect a
r2@(Rect (V2 a
sx a
sy) (V2 a
sw a
sh)) =
  Rect a
r1 forall a. Eq a => a -> a -> Bool
== Rect a
r2 Bool -> Bool -> Bool
||
  forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [ a
bx forall a. Ord a => a -> a -> Bool
<= a
sx
    , a
by forall a. Ord a => a -> a -> Bool
<= a
sy
    , a
sx forall a. Num a => a -> a -> a
+ a
sw forall a. Ord a => a -> a -> Bool
<= a
bx forall a. Num a => a -> a -> a
+ a
bw
    , a
sy forall a. Num a => a -> a -> a
+ a
sh forall a. Ord a => a -> a -> Bool
<= a
by forall a. Num a => a -> a -> a
+ a
bh
    ]


------------------------------------------------------------------------------
-- | Does the rect contain a given point?
rectContainsPoint :: (Ord a, Num a) => Rect a -> V2 a -> Bool
rectContainsPoint :: forall a. (Ord a, Num a) => Rect a -> V2 a -> Bool
rectContainsPoint (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect V2 a
_ (V2 a
w a
h)) V2 a
_
  | a
w forall a. Ord a => a -> a -> Bool
<= a
0 Bool -> Bool -> Bool
|| a
h forall a. Ord a => a -> a -> Bool
<= a
0
  = Bool
False
rectContainsPoint (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect (V2 a
x a
y) (V2 a
w a
h)) (V2 a
tx a
ty) =
  forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [ a
x forall a. Ord a => a -> a -> Bool
<= a
tx
    , a
y forall a. Ord a => a -> a -> Bool
<= a
ty
    , a
tx forall a. Ord a => a -> a -> Bool
< a
x forall a. Num a => a -> a -> a
+ a
w
    , a
ty forall a. Ord a => a -> a -> Bool
< a
y forall a. Num a => a -> a -> a
+ a
h
    ]

------------------------------------------------------------------------------
-- | Get the co-ordinates of the corners of a 'Rect'.
rectCorners :: Num a => Rect a -> V4 (V2 a)
rectCorners :: forall a. Num a => Rect a -> V4 (V2 a)
rectCorners (Rect (V2 a
x a
y) (V2 a
w a
h)) =
  let p :: V2 a
p = forall a. a -> a -> V2 a
V2 a
x a
y
      dx :: V2 a
dx = forall a. a -> a -> V2 a
V2 a
w a
0
      dy :: V2 a
dy = forall a. a -> a -> V2 a
V2 a
0 a
h
   in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (V2 a
p forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> V4 a
V4 V2 a
0   V2 a
dx         V2 a
dy       (V2 a
dx forall a. Num a => a -> a -> a
+ V2 a
dy)


------------------------------------------------------------------------------
-- | 'Control.Monad.Free.Free', but with better instances.
data Free a
  = Fill a
  | Split (V4 (Free a))
  deriving (forall a b. a -> Free b -> Free a
forall a b. (a -> b) -> Free a -> Free b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Free b -> Free a
$c<$ :: forall a b. a -> Free b -> Free a
fmap :: forall a b. (a -> b) -> Free a -> Free b
$cfmap :: forall a b. (a -> b) -> Free a -> Free b
Functor, forall a. Eq a => a -> Free a -> Bool
forall a. Num a => Free a -> a
forall a. Ord a => Free a -> a
forall m. Monoid m => Free m -> m
forall a. Free a -> Bool
forall a. Free a -> Int
forall a. Free a -> [a]
forall a. (a -> a -> a) -> Free a -> a
forall m a. Monoid m => (a -> m) -> Free a -> m
forall b a. (b -> a -> b) -> b -> Free a -> b
forall a b. (a -> b -> b) -> b -> Free a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Free a -> a
$cproduct :: forall a. Num a => Free a -> a
sum :: forall a. Num a => Free a -> a
$csum :: forall a. Num a => Free a -> a
minimum :: forall a. Ord a => Free a -> a
$cminimum :: forall a. Ord a => Free a -> a
maximum :: forall a. Ord a => Free a -> a
$cmaximum :: forall a. Ord a => Free a -> a
elem :: forall a. Eq a => a -> Free a -> Bool
$celem :: forall a. Eq a => a -> Free a -> Bool
length :: forall a. Free a -> Int
$clength :: forall a. Free a -> Int
null :: forall a. Free a -> Bool
$cnull :: forall a. Free a -> Bool
toList :: forall a. Free a -> [a]
$ctoList :: forall a. Free a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Free a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Free a -> a
foldr1 :: forall a. (a -> a -> a) -> Free a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Free a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Free a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Free a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Free a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Free a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Free a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Free a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Free a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Free a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Free a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Free a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Free a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Free a -> m
fold :: forall m. Monoid m => Free m -> m
$cfold :: forall m. Monoid m => Free m -> m
Foldable, Functor Free
Foldable Free
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Free (m a) -> m (Free a)
forall (f :: * -> *) a. Applicative f => Free (f a) -> f (Free a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Free a -> m (Free b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Free a -> f (Free b)
sequence :: forall (m :: * -> *) a. Monad m => Free (m a) -> m (Free a)
$csequence :: forall (m :: * -> *) a. Monad m => Free (m a) -> m (Free a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Free a -> m (Free b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Free a -> m (Free b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Free (f a) -> f (Free a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Free (f a) -> f (Free a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Free a -> f (Free b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Free a -> f (Free b)
Traversable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Free a) x -> Free a
forall a x. Free a -> Rep (Free a) x
$cto :: forall a x. Rep (Free a) x -> Free a
$cfrom :: forall a x. Free a -> Rep (Free a) x
Generic)

deriving via Ap Free a instance (Semigroup a) => Semigroup (Free a)
deriving via Ap Free a instance (Monoid    a) => Monoid    (Free a)

deriving stock instance (Show a) => Show (Free a)

instance (Eq a) => Eq (Free a) where
  Fill a
a   == :: Free a -> Free a -> Bool
== Fill a
b    = a
a             forall a. Eq a => a -> a -> Bool
== a
b
  Split V4 (Free a)
qu == Split V4 (Free a)
qu' = V4 (Free a)
qu            forall a. Eq a => a -> a -> Bool
== V4 (Free a)
qu'
  Fill a
a   == Split V4 (Free a)
qu  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) forall a. Eq a => a -> a -> Bool
== V4 (Free a)
qu
  Split V4 (Free a)
qu == Fill a
a    = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) forall a. Eq a => a -> a -> Bool
== V4 (Free a)
qu

instance Applicative Free where
  pure :: forall a. a -> Free a
pure = forall a. a -> Free a
Fill
  liftA2 :: forall a b c. (a -> b -> c) -> Free a -> Free b -> Free c
liftA2 a -> b -> c
fabc (Fill a
a) (Fill b
b) = forall a. a -> Free a
Fill forall a b. (a -> b) -> a -> b
$ a -> b -> c
fabc a
a b
b
  liftA2 a -> b -> c
fabc (Fill a
a) (Split V4 (Free b)
qu) = forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
fabc a
a)) V4 (Free b)
qu
  liftA2 a -> b -> c
fabc (Split V4 (Free a)
qu) (Fill b
b) = forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip  a -> b -> c
fabc b
b)) V4 (Free a)
qu
  liftA2 a -> b -> c
fabc (Split V4 (Free a)
qu) (Split V4 (Free b)
qu') = forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
fabc) V4 (Free a)
qu V4 (Free b)
qu'

instance Monad Free where
  Fill a
a >>= :: forall a b. Free a -> (a -> Free b) -> Free b
>>= a -> Free b
f = a -> Free b
f a
a
  Split V4 (Free a)
qu >>= a -> Free b
f = forall a. V4 (Free a) -> Free a
Split forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Free b
f) V4 (Free a)
qu


------------------------------------------------------------------------------
-- | Normalize a 'Rect' so it has a positive 'r_size'.
normalize :: (Num a, Ord a) => Rect a -> Rect a
normalize :: forall a. (Num a, Ord a) => Rect a -> Rect a
normalize q :: Rect a
q@(Rect (V2 a
x a
y) (V2 a
w a
h))
  | a
w forall a. Ord a => a -> a -> Bool
< a
0 = let w' :: a
w' = forall a. Num a => a -> a
abs a
w in forall a. (Num a, Ord a) => Rect a -> Rect a
normalize forall a b. (a -> b) -> a -> b
$ forall a. V2 a -> V2 a -> Rect a
Rect (forall a. a -> a -> V2 a
V2 (a
x forall a. Num a => a -> a -> a
- a
w') a
y) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 a
w' a
h
  | a
h forall a. Ord a => a -> a -> Bool
< a
0 = let h' :: a
h' = forall a. Num a => a -> a
abs a
h in forall a. (Num a, Ord a) => Rect a -> Rect a
normalize forall a b. (a -> b) -> a -> b
$ forall a. V2 a -> V2 a -> Rect a
Rect (forall a. a -> a -> V2 a
V2 a
x (a
y forall a. Num a => a -> a -> a
- a
h')) forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 a
w a
h'
  | Bool
otherwise = Rect a
q


------------------------------------------------------------------------------
-- | Do two 'Rect's intersect?
intersects :: (Ord a, Num a) => Rect a -> Rect a -> Bool
intersects :: forall a. (Ord a, Num a) => Rect a -> Rect a -> Bool
intersects Rect a
r1 Rect a
r2 = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a. (Ord a, Num a) => Rect a -> Rect a -> Maybe (Rect a)
getIntersect Rect a
r1 Rect a
r2


------------------------------------------------------------------------------
-- | Get the area of a 'Rect'.
rectSize :: Num a => Rect a -> a
rectSize :: forall a. Num a => Rect a -> a
rectSize (Rect V2 a
_ (V2 a
w a
h)) = a
w forall a. Num a => a -> a -> a
* a
h


------------------------------------------------------------------------------
-- | Compute the intersection of two 'Rect's.
getIntersect :: (Ord a, Num a) => Rect a -> Rect a -> Maybe (Rect a)
getIntersect :: forall a. (Ord a, Num a) => Rect a -> Rect a -> Maybe (Rect a)
getIntersect (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect a
r1) (forall a. (Num a, Ord a) => Rect a -> Rect a
normalize -> Rect a
r2)
 | forall a. Num a => Rect a -> a
rectSize Rect a
r1 forall a. Eq a => a -> a -> Bool
== a
0 = forall a. a -> Maybe a
Just Rect a
r1
 | forall a. Num a => Rect a -> a
rectSize Rect a
r2 forall a. Eq a => a -> a -> Bool
== a
0 = forall a. a -> Maybe a
Just Rect a
r2
 | Bool
otherwise =
  let x0 :: a
x0 = forall a. Ord a => a -> a -> a
max (forall a. Rect a -> a
r_x Rect a
r1) (forall a. Rect a -> a
r_x Rect a
r2)
      y0 :: a
y0 = forall a. Ord a => a -> a -> a
max (forall a. Rect a -> a
r_y Rect a
r1) (forall a. Rect a -> a
r_y Rect a
r2)
      x1 :: a
x1 = forall a. Ord a => a -> a -> a
min (forall a. Rect a -> a
r_x Rect a
r1 forall a. Num a => a -> a -> a
+ forall a. Rect a -> a
r_w Rect a
r1) (forall a. Rect a -> a
r_x Rect a
r2 forall a. Num a => a -> a -> a
+ forall a. Rect a -> a
r_w Rect a
r2)
      y1 :: a
y1 = forall a. Ord a => a -> a -> a
min (forall a. Rect a -> a
r_y Rect a
r1 forall a. Num a => a -> a -> a
+ forall a. Rect a -> a
r_h Rect a
r1) (forall a. Rect a -> a
r_y Rect a
r2 forall a. Num a => a -> a -> a
+ forall a. Rect a -> a
r_h Rect a
r2)
      w :: a
w = a
x1 forall a. Num a => a -> a -> a
- a
x0
      h :: a
h = a
y1 forall a. Num a => a -> a -> a
- a
y0
   in case a
0 forall a. Ord a => a -> a -> Bool
< a
w Bool -> Bool -> Bool
&& a
0 forall a. Ord a => a -> a -> Bool
< a
h of
        Bool
True -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. V2 a -> V2 a -> Rect a
Rect (forall a. a -> a -> V2 a
V2 a
x0 a
y0) (forall a. a -> a -> V2 a
V2 a
w a
h)
        Bool
False -> forall a. Maybe a
Nothing


unwrap :: Free a -> V4 (Free a)
unwrap :: forall a. Free a -> V4 (Free a)
unwrap (Fill a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
unwrap (Split V4 (Free a)
qu) = V4 (Free a)
qu


------------------------------------------------------------------------------
-- | Join together 'Split' constructors which all contain the same value.
fuse :: Eq a => Free a -> Free a
fuse :: forall a. Eq a => Free a -> Free a
fuse (Fill a
a) = forall a. a -> Free a
Fill a
a
fuse (Split V4 (Free a)
q) = forall a. Eq a => V4 (Free a) -> Free a
doFuse forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Eq a => Free a -> Free a
fuse V4 (Free a)
q


doFuse :: Eq a => V4 (Free a) -> Free a
doFuse :: forall a. Eq a => V4 (Free a) -> Free a
doFuse (V4 (Fill a
a) (Fill a
b) (Fill a
c) (Fill a
d))
  | a
a forall a. Eq a => a -> a -> Bool
== a
b
  , a
b forall a. Eq a => a -> a -> Bool
== a
c
  , a
c forall a. Eq a => a -> a -> Bool
== a
d
  = forall a. a -> Free a
Fill a
a
doFuse V4 (Free a)
q = forall a. V4 (Free a) -> Free a
Split V4 (Free a)
q