{- -----------------------------------------------------------------------------
Copyright 2020-2021 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeFamilies #-}

module Base.MergeTree (
  MergeTree,
  matchOnlyLeaf,
  mergeAllM,
  mergeAnyM,
  mergeLeaf,
  pairMergeTree,
  reduceMergeTree,
) where

import Data.List (intercalate)

import Base.CompilerError
import Base.Mergeable


data MergeTree a =
  MergeAny [MergeTree a] |
  MergeAll [MergeTree a] |
  MergeLeaf a
  deriving (MergeTree a -> MergeTree a -> Bool
(MergeTree a -> MergeTree a -> Bool)
-> (MergeTree a -> MergeTree a -> Bool) -> Eq (MergeTree a)
forall a. Eq a => MergeTree a -> MergeTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeTree a -> MergeTree a -> Bool
$c/= :: forall a. Eq a => MergeTree a -> MergeTree a -> Bool
== :: MergeTree a -> MergeTree a -> Bool
$c== :: forall a. Eq a => MergeTree a -> MergeTree a -> Bool
Eq)

mergeLeaf :: a -> MergeTree a
mergeLeaf :: a -> MergeTree a
mergeLeaf = a -> MergeTree a
forall a. a -> MergeTree a
MergeLeaf

instance Show a => Show (MergeTree a) where
  show :: MergeTree a -> String
show = ([String] -> String)
-> ([String] -> String) -> (a -> String) -> MergeTree a -> String
forall b a.
([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon [String] -> String
anyOp [String] -> String
allOp a -> String
forall a. Show a => a -> String
leafOp where
    anyOp :: [String] -> String
anyOp [String]
xs = String
"mergeAny [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    allOp :: [String] -> String
allOp [String]
xs = String
"mergeAll [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    leafOp :: a -> String
leafOp a
x = String
"mergeLeaf " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x

instance PreserveMerge (MergeTree a) where
  type T (MergeTree a) = a
  convertMerge :: (T (MergeTree a) -> b) -> MergeTree a -> b
convertMerge = ([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
forall b a.
([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon [b] -> b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny [b] -> b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll

reduceMergeTree :: PreserveMerge a => ([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree :: ([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree [b] -> b
anyOp [b] -> b
allOp T a -> b
leafOp = ([b] -> b) -> ([b] -> b) -> (T a -> b) -> MergeTree (T a) -> b
forall b a.
([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon [b] -> b
anyOp [b] -> b
allOp T a -> b
leafOp (MergeTree (T a) -> b) -> (a -> MergeTree (T a)) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MergeTree (T a)
forall a. PreserveMerge a => a -> MergeTree (T a)
toMergeTree

toMergeTree :: PreserveMerge a => a -> MergeTree (T a)
toMergeTree :: a -> MergeTree (T a)
toMergeTree = (T a -> MergeTree (T a)) -> a -> MergeTree (T a)
forall a b. (PreserveMerge a, Mergeable b) => (T a -> b) -> a -> b
convertMerge T a -> MergeTree (T a)
forall a. a -> MergeTree a
mergeLeaf

reduceMergeCommon :: ([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon :: ([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon [b] -> b
anyOp [b] -> b
allOp a -> b
leafOp = MergeTree a -> b
reduce where
  reduce :: MergeTree a -> b
reduce (MergeAny [MergeTree a]
xs) = [b] -> b
anyOp ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (MergeTree a -> b) -> [MergeTree a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map MergeTree a -> b
reduce [MergeTree a]
xs
  reduce (MergeAll [MergeTree a]
xs) = [b] -> b
allOp ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (MergeTree a -> b) -> [MergeTree a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map MergeTree a -> b
reduce [MergeTree a]
xs
  reduce (MergeLeaf a
x) = a -> b
leafOp a
x

pairMergeTree :: (PreserveMerge a, PreserveMerge b) =>
  ([c] -> c) -> ([c] -> c) -> (T a -> T b -> c) -> a -> b -> c
pairMergeTree :: ([c] -> c) -> ([c] -> c) -> (T a -> T b -> c) -> a -> b -> c
pairMergeTree [c] -> c
anyOp [c] -> c
allOp T a -> T b -> c
leafOp a
x b
y = MergeTree (T a) -> MergeTree (T b) -> c
pair (a -> MergeTree (T a)
forall a. PreserveMerge a => a -> MergeTree (T a)
toMergeTree a
x) (b -> MergeTree (T b)
forall a. PreserveMerge a => a -> MergeTree (T a)
toMergeTree b
y) where
  pair :: MergeTree (T a) -> MergeTree (T b) -> c
pair (MergeLeaf T a
x2) (MergeLeaf T b
y2) = T a
x2 T a -> T b -> c
`leafOp` T b
y2
  pair x2 :: MergeTree (T a)
x2@(MergeAll [MergeTree (T a)]
xs) y2 :: MergeTree (T b)
y2@(MergeAny [MergeTree (T b)]
ys) =
    [c] -> c
anyOp ([c] -> c) -> [c] -> c
forall a b. (a -> b) -> a -> b
$ [c]
leafComp [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++ [c]
leftComp [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++ [c]
rightComp where
    ([MergeTree (T a)]
xs2,[T a]
xl) = [MergeTree (T a)] -> ([MergeTree (T a)], [T a])
forall a. [MergeTree a] -> ([MergeTree a], [a])
separateLeaves [MergeTree (T a)]
xs
    ([MergeTree (T b)]
ys2,[T b]
yl) = [MergeTree (T b)] -> ([MergeTree (T b)], [T b])
forall a. [MergeTree a] -> ([MergeTree a], [a])
separateLeaves [MergeTree (T b)]
ys
    -- Non-leaves need the entire other side available.
    leftComp :: [c]
leftComp  = (MergeTree (T a) -> c) -> [MergeTree (T a)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (MergeTree (T a) -> MergeTree (T b) -> c
`pair` MergeTree (T b)
y2) [MergeTree (T a)]
xs2
    rightComp :: [c]
rightComp = (MergeTree (T b) -> c) -> [MergeTree (T b)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (MergeTree (T a)
x2 MergeTree (T a) -> MergeTree (T b) -> c
`pair`) [MergeTree (T b)]
ys2
    -- Leaves can be expanded either side first.
    leafComp :: [c]
leafComp = do
      T a
xx <- [T a]
xl
      T b
yy <- [T b]
yl
      [T a
xx T a -> T b -> c
`leafOp` T b
yy]
  -- NOTE: allOp is expanded first so that anyOp is ignored when either both
  -- sides are minBound or both sides are maxBound. This allows
  -- pairMergeTree mergeAny mergeAll (==) to be a partial order.
  pair (MergeAny [MergeTree (T a)]
xs) MergeTree (T b)
y2 = [c] -> c
allOp ([c] -> c) -> [c] -> c
forall a b. (a -> b) -> a -> b
$ (MergeTree (T a) -> c) -> [MergeTree (T a)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (MergeTree (T a) -> MergeTree (T b) -> c
`pair` MergeTree (T b)
y2) [MergeTree (T a)]
xs
  pair MergeTree (T a)
x2 (MergeAll [MergeTree (T b)]
ys) = [c] -> c
allOp ([c] -> c) -> [c] -> c
forall a b. (a -> b) -> a -> b
$ (MergeTree (T b) -> c) -> [MergeTree (T b)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (MergeTree (T a)
x2 MergeTree (T a) -> MergeTree (T b) -> c
`pair`) [MergeTree (T b)]
ys
  pair (MergeAll [MergeTree (T a)]
xs) MergeTree (T b)
y2 = [c] -> c
anyOp ([c] -> c) -> [c] -> c
forall a b. (a -> b) -> a -> b
$ (MergeTree (T a) -> c) -> [MergeTree (T a)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (MergeTree (T a) -> MergeTree (T b) -> c
`pair` MergeTree (T b)
y2) [MergeTree (T a)]
xs
  pair MergeTree (T a)
x2 (MergeAny [MergeTree (T b)]
ys) = [c] -> c
anyOp ([c] -> c) -> [c] -> c
forall a b. (a -> b) -> a -> b
$ (MergeTree (T b) -> c) -> [MergeTree (T b)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (MergeTree (T a)
x2 MergeTree (T a) -> MergeTree (T b) -> c
`pair`) [MergeTree (T b)]
ys
  separateLeaves :: [MergeTree a] -> ([MergeTree a], [a])
separateLeaves = (MergeTree a -> ([MergeTree a], [a]) -> ([MergeTree a], [a]))
-> ([MergeTree a], [a]) -> [MergeTree a] -> ([MergeTree a], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MergeTree a -> ([MergeTree a], [a]) -> ([MergeTree a], [a])
forall a.
MergeTree a -> ([MergeTree a], [a]) -> ([MergeTree a], [a])
split ([],[]) where
    split :: MergeTree a -> ([MergeTree a], [a]) -> ([MergeTree a], [a])
split (MergeLeaf a
x2) ([MergeTree a]
ms,[a]
ls) = ([MergeTree a]
ms,a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls)
    split MergeTree a
x2             ([MergeTree a]
ms,[a]
ls) = (MergeTree a
x2MergeTree a -> [MergeTree a] -> [MergeTree a]
forall a. a -> [a] -> [a]
:[MergeTree a]
ms,[a]
ls)

instance Functor MergeTree where
  fmap :: (a -> b) -> MergeTree a -> MergeTree b
fmap a -> b
f = ([MergeTree b] -> MergeTree b)
-> ([MergeTree b] -> MergeTree b)
-> (a -> MergeTree b)
-> MergeTree a
-> MergeTree b
forall b a.
([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon [MergeTree b] -> MergeTree b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny [MergeTree b] -> MergeTree b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll (b -> MergeTree b
forall a. a -> MergeTree a
mergeLeaf (b -> MergeTree b) -> (a -> b) -> a -> MergeTree b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Applicative MergeTree where
  pure :: a -> MergeTree a
pure = a -> MergeTree a
forall a. a -> MergeTree a
mergeLeaf
  MergeTree (a -> b)
f <*> :: MergeTree (a -> b) -> MergeTree a -> MergeTree b
<*> MergeTree a
x = ([MergeTree b] -> MergeTree b)
-> ([MergeTree b] -> MergeTree b)
-> ((a -> b) -> MergeTree b)
-> MergeTree (a -> b)
-> MergeTree b
forall b a.
([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon [MergeTree b] -> MergeTree b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny [MergeTree b] -> MergeTree b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll ((a -> b) -> MergeTree a -> MergeTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MergeTree a
x) MergeTree (a -> b)
f

instance Monad MergeTree where
  return :: a -> MergeTree a
return = a -> MergeTree a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  MergeTree a
x >>= :: MergeTree a -> (a -> MergeTree b) -> MergeTree b
>>= a -> MergeTree b
f = ([MergeTree b] -> MergeTree b)
-> ([MergeTree b] -> MergeTree b)
-> (a -> MergeTree b)
-> MergeTree a
-> MergeTree b
forall b a.
([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon [MergeTree b] -> MergeTree b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny [MergeTree b] -> MergeTree b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll a -> MergeTree b
f MergeTree a
x

instance Foldable MergeTree where
  foldr :: (a -> b -> b) -> b -> MergeTree a -> b
foldr a -> b -> b
f b
y = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
y ([a] -> b) -> (MergeTree a -> [a]) -> MergeTree a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[a]] -> [a])
-> ([[a]] -> [a]) -> (a -> [a]) -> MergeTree a -> [a]
forall b a.
([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])

instance Traversable MergeTree where
  traverse :: (a -> f b) -> MergeTree a -> f (MergeTree b)
traverse a -> f b
f = ([f (MergeTree b)] -> f (MergeTree b))
-> ([f (MergeTree b)] -> f (MergeTree b))
-> (a -> f (MergeTree b))
-> MergeTree a
-> f (MergeTree b)
forall b a.
([b] -> b) -> ([b] -> b) -> (a -> b) -> MergeTree a -> b
reduceMergeCommon [f (MergeTree b)] -> f (MergeTree b)
anyOp [f (MergeTree b)] -> f (MergeTree b)
allOp a -> f (MergeTree b)
leafOp where
    anyOp :: [f (MergeTree b)] -> f (MergeTree b)
anyOp = ([MergeTree b] -> MergeTree b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny ([MergeTree b] -> MergeTree b)
-> f [MergeTree b] -> f (MergeTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (f [MergeTree b] -> f (MergeTree b))
-> ([f (MergeTree b)] -> f [MergeTree b])
-> [f (MergeTree b)]
-> f (MergeTree b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ([MergeTree b] -> [MergeTree b])
 -> f [MergeTree b] -> f [MergeTree b])
-> f [MergeTree b]
-> [f ([MergeTree b] -> [MergeTree b])]
-> f [MergeTree b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f ([MergeTree b] -> [MergeTree b])
-> f [MergeTree b] -> f [MergeTree b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ([MergeTree b] -> f [MergeTree b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ([f ([MergeTree b] -> [MergeTree b])] -> f [MergeTree b])
-> ([f (MergeTree b)] -> [f ([MergeTree b] -> [MergeTree b])])
-> [f (MergeTree b)]
-> f [MergeTree b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f (MergeTree b) -> f ([MergeTree b] -> [MergeTree b]))
-> [f (MergeTree b)] -> [f ([MergeTree b] -> [MergeTree b])]
forall a b. (a -> b) -> [a] -> [b]
map ((MergeTree b -> [MergeTree b] -> [MergeTree b])
-> f (MergeTree b) -> f ([MergeTree b] -> [MergeTree b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:)))
    allOp :: [f (MergeTree b)] -> f (MergeTree b)
allOp = ([MergeTree b] -> MergeTree b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll ([MergeTree b] -> MergeTree b)
-> f [MergeTree b] -> f (MergeTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (f [MergeTree b] -> f (MergeTree b))
-> ([f (MergeTree b)] -> f [MergeTree b])
-> [f (MergeTree b)]
-> f (MergeTree b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ([MergeTree b] -> [MergeTree b])
 -> f [MergeTree b] -> f [MergeTree b])
-> f [MergeTree b]
-> [f ([MergeTree b] -> [MergeTree b])]
-> f [MergeTree b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f ([MergeTree b] -> [MergeTree b])
-> f [MergeTree b] -> f [MergeTree b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ([MergeTree b] -> f [MergeTree b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ([f ([MergeTree b] -> [MergeTree b])] -> f [MergeTree b])
-> ([f (MergeTree b)] -> [f ([MergeTree b] -> [MergeTree b])])
-> [f (MergeTree b)]
-> f [MergeTree b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f (MergeTree b) -> f ([MergeTree b] -> [MergeTree b]))
-> [f (MergeTree b)] -> [f ([MergeTree b] -> [MergeTree b])]
forall a b. (a -> b) -> [a] -> [b]
map ((MergeTree b -> [MergeTree b] -> [MergeTree b])
-> f (MergeTree b) -> f ([MergeTree b] -> [MergeTree b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:)))
    leafOp :: a -> f (MergeTree b)
leafOp = (b -> MergeTree b
forall a. a -> MergeTree a
mergeLeaf (b -> MergeTree b) -> f b -> f (MergeTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (f b -> f (MergeTree b)) -> (a -> f b) -> a -> f (MergeTree b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f

instance Mergeable (MergeTree a) where
  mergeAny :: f (MergeTree a) -> MergeTree a
mergeAny = [MergeTree a] -> MergeTree a
forall a. [MergeTree a] -> MergeTree a
unnest ([MergeTree a] -> MergeTree a)
-> (f (MergeTree a) -> [MergeTree a])
-> f (MergeTree a)
-> MergeTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MergeTree a -> [MergeTree a] -> [MergeTree a])
-> [MergeTree a] -> f (MergeTree a) -> [MergeTree a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([MergeTree a] -> [MergeTree a] -> [MergeTree a]
forall a. [a] -> [a] -> [a]
(++) ([MergeTree a] -> [MergeTree a] -> [MergeTree a])
-> (MergeTree a -> [MergeTree a])
-> MergeTree a
-> [MergeTree a]
-> [MergeTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MergeTree a -> [MergeTree a]
forall a. MergeTree a -> [MergeTree a]
flattenAny) [] where
    flattenAny :: MergeTree a -> [MergeTree a]
flattenAny (MergeAny [MergeTree a]
xs) = [MergeTree a]
xs
    flattenAny MergeTree a
x             = [MergeTree a
x]
    unnest :: [MergeTree a] -> MergeTree a
unnest [MergeTree a
x] = MergeTree a
x
    unnest [MergeTree a]
xs  = [MergeTree a] -> MergeTree a
forall a. [MergeTree a] -> MergeTree a
MergeAny [MergeTree a]
xs
  mergeAll :: f (MergeTree a) -> MergeTree a
mergeAll = [MergeTree a] -> MergeTree a
forall a. [MergeTree a] -> MergeTree a
unnest ([MergeTree a] -> MergeTree a)
-> (f (MergeTree a) -> [MergeTree a])
-> f (MergeTree a)
-> MergeTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MergeTree a -> [MergeTree a] -> [MergeTree a])
-> [MergeTree a] -> f (MergeTree a) -> [MergeTree a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([MergeTree a] -> [MergeTree a] -> [MergeTree a]
forall a. [a] -> [a] -> [a]
(++) ([MergeTree a] -> [MergeTree a] -> [MergeTree a])
-> (MergeTree a -> [MergeTree a])
-> MergeTree a
-> [MergeTree a]
-> [MergeTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MergeTree a -> [MergeTree a]
forall a. MergeTree a -> [MergeTree a]
flattenAll) [] where
    flattenAll :: MergeTree a -> [MergeTree a]
flattenAll (MergeAll [MergeTree a]
xs) = [MergeTree a]
xs
    flattenAll MergeTree a
x             = [MergeTree a
x]
    unnest :: [MergeTree a] -> MergeTree a
unnest [MergeTree a
x] = MergeTree a
x
    unnest [MergeTree a]
xs  = [MergeTree a] -> MergeTree a
forall a. [MergeTree a] -> MergeTree a
MergeAll [MergeTree a]
xs

instance Bounded (MergeTree a) where
  minBound :: MergeTree a
minBound = Maybe (MergeTree a) -> MergeTree a
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny Maybe (MergeTree a)
forall a. Maybe a
Nothing
  maxBound :: MergeTree a
maxBound = Maybe (MergeTree a) -> MergeTree a
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll Maybe (MergeTree a)
forall a. Maybe a
Nothing

mergeAnyM :: (PreserveMerge a, CollectErrorsM m) => [m a] -> m a
mergeAnyM :: [m a] -> m a
mergeAnyM [m a]
xs = do
  [m a] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectFirstM_ [m a]
xs
  ([a] -> a) -> m [a] -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny (m [a] -> m a) -> m [a] -> m a
forall a b. (a -> b) -> a -> b
$ [m a] -> m [a]
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m [a]
collectAnyM [m a]
xs

mergeAllM :: (PreserveMerge a, CollectErrorsM m) => [m a] -> m a
mergeAllM :: [m a] -> m a
mergeAllM = ([a] -> a) -> m [a] -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll (m [a] -> m a) -> ([m a] -> m [a]) -> [m a] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m a] -> m [a]
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m [a]
collectAllM

matchOnlyLeaf :: (PreserveMerge a, CollectErrorsM m) => a -> m (T a)
matchOnlyLeaf :: a -> m (T a)
matchOnlyLeaf = ([m (T a)] -> m (T a))
-> ([m (T a)] -> m (T a)) -> (T a -> m (T a)) -> a -> m (T a)
forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree (m (T a) -> [m (T a)] -> m (T a)
forall a b. a -> b -> a
const m (T a)
forall (m :: * -> *) a. CollectErrorsM m => m a
emptyErrorM) (m (T a) -> [m (T a)] -> m (T a)
forall a b. a -> b -> a
const m (T a)
forall (m :: * -> *) a. CollectErrorsM m => m a
emptyErrorM) T a -> m (T a)
forall (m :: * -> *) a. Monad m => a -> m a
return