{-# LANGUAGE DeriveTraversable #-}

-- | A 'LexTree' is a map designed to reconstruct the lexical structure (tree of scopes) of a source file, given an unordered list of scopes.
-- Values are inserted with a pair source locations as its key.
-- For a given key, we can then ask what the smallest enclosing scope is.
--
-- For example, in the snippet below the smallest scope containing @x@ is @b@.
-- @
--      x
-- |      a      |
--    |  b  |
--                   |   c   |
-- @
--
-- Scopes are not allowed to overlap.
--
-- The purpose of this data structure is to find out what surrounding definition a certain use site belongs to.
module Calligraphy.Util.LexTree
  ( LexTree (..),
    TreeError (..),
    Calligraphy.Util.LexTree.lookup,
    lookupOuter,
    insert,
    emptyLexTree,
    foldLexTree,
    insertWith,
    height,
    toList,
    bin,
    shift,
  )
where

import Control.Applicative

data LexTree p a
  = Tip
  | Bin
      {-# UNPACK #-} !Int
      -- ^ Height
      !(LexTree p a)
      -- ^ Scopes at the same level, left of this one
      !p
      -- ^ Left-hand bound of this scope (inclusive)
      a
      !(LexTree p a)
      -- ^ Children
      !p
      -- ^ Right-hand bound of this scope (exclusive)
      !(LexTree p a)
      -- ^ Scopes at the same level, right of this entry
  deriving (Int -> LexTree p a -> ShowS
[LexTree p a] -> ShowS
LexTree p a -> String
(Int -> LexTree p a -> ShowS)
-> (LexTree p a -> String)
-> ([LexTree p a] -> ShowS)
-> Show (LexTree p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show p, Show a) => Int -> LexTree p a -> ShowS
forall p a. (Show p, Show a) => [LexTree p a] -> ShowS
forall p a. (Show p, Show a) => LexTree p a -> String
showList :: [LexTree p a] -> ShowS
$cshowList :: forall p a. (Show p, Show a) => [LexTree p a] -> ShowS
show :: LexTree p a -> String
$cshow :: forall p a. (Show p, Show a) => LexTree p a -> String
showsPrec :: Int -> LexTree p a -> ShowS
$cshowsPrec :: forall p a. (Show p, Show a) => Int -> LexTree p a -> ShowS
Show, a -> LexTree p b -> LexTree p a
(a -> b) -> LexTree p a -> LexTree p b
(forall a b. (a -> b) -> LexTree p a -> LexTree p b)
-> (forall a b. a -> LexTree p b -> LexTree p a)
-> Functor (LexTree p)
forall a b. a -> LexTree p b -> LexTree p a
forall a b. (a -> b) -> LexTree p a -> LexTree p b
forall p a b. a -> LexTree p b -> LexTree p a
forall p a b. (a -> b) -> LexTree p a -> LexTree p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LexTree p b -> LexTree p a
$c<$ :: forall p a b. a -> LexTree p b -> LexTree p a
fmap :: (a -> b) -> LexTree p a -> LexTree p b
$cfmap :: forall p a b. (a -> b) -> LexTree p a -> LexTree p b
Functor, LexTree p a -> Bool
(a -> m) -> LexTree p a -> m
(a -> b -> b) -> b -> LexTree p a -> b
(forall m. Monoid m => LexTree p m -> m)
-> (forall m a. Monoid m => (a -> m) -> LexTree p a -> m)
-> (forall m a. Monoid m => (a -> m) -> LexTree p a -> m)
-> (forall a b. (a -> b -> b) -> b -> LexTree p a -> b)
-> (forall a b. (a -> b -> b) -> b -> LexTree p a -> b)
-> (forall b a. (b -> a -> b) -> b -> LexTree p a -> b)
-> (forall b a. (b -> a -> b) -> b -> LexTree p a -> b)
-> (forall a. (a -> a -> a) -> LexTree p a -> a)
-> (forall a. (a -> a -> a) -> LexTree p a -> a)
-> (forall a. LexTree p a -> [a])
-> (forall a. LexTree p a -> Bool)
-> (forall a. LexTree p a -> Int)
-> (forall a. Eq a => a -> LexTree p a -> Bool)
-> (forall a. Ord a => LexTree p a -> a)
-> (forall a. Ord a => LexTree p a -> a)
-> (forall a. Num a => LexTree p a -> a)
-> (forall a. Num a => LexTree p a -> a)
-> Foldable (LexTree p)
forall a. Eq a => a -> LexTree p a -> Bool
forall a. Num a => LexTree p a -> a
forall a. Ord a => LexTree p a -> a
forall m. Monoid m => LexTree p m -> m
forall a. LexTree p a -> Bool
forall a. LexTree p a -> Int
forall a. LexTree p a -> [a]
forall a. (a -> a -> a) -> LexTree p a -> a
forall p a. Eq a => a -> LexTree p a -> Bool
forall p a. Num a => LexTree p a -> a
forall p a. Ord a => LexTree p a -> a
forall m a. Monoid m => (a -> m) -> LexTree p a -> m
forall p m. Monoid m => LexTree p m -> m
forall p a. LexTree p a -> Bool
forall p a. LexTree p a -> Int
forall p a. LexTree p a -> [a]
forall b a. (b -> a -> b) -> b -> LexTree p a -> b
forall a b. (a -> b -> b) -> b -> LexTree p a -> b
forall p a. (a -> a -> a) -> LexTree p a -> a
forall p m a. Monoid m => (a -> m) -> LexTree p a -> m
forall p b a. (b -> a -> b) -> b -> LexTree p a -> b
forall p a b. (a -> b -> b) -> b -> LexTree p 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 :: LexTree p a -> a
$cproduct :: forall p a. Num a => LexTree p a -> a
sum :: LexTree p a -> a
$csum :: forall p a. Num a => LexTree p a -> a
minimum :: LexTree p a -> a
$cminimum :: forall p a. Ord a => LexTree p a -> a
maximum :: LexTree p a -> a
$cmaximum :: forall p a. Ord a => LexTree p a -> a
elem :: a -> LexTree p a -> Bool
$celem :: forall p a. Eq a => a -> LexTree p a -> Bool
length :: LexTree p a -> Int
$clength :: forall p a. LexTree p a -> Int
null :: LexTree p a -> Bool
$cnull :: forall p a. LexTree p a -> Bool
toList :: LexTree p a -> [a]
$ctoList :: forall p a. LexTree p a -> [a]
foldl1 :: (a -> a -> a) -> LexTree p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> LexTree p a -> a
foldr1 :: (a -> a -> a) -> LexTree p a -> a
$cfoldr1 :: forall p a. (a -> a -> a) -> LexTree p a -> a
foldl' :: (b -> a -> b) -> b -> LexTree p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> LexTree p a -> b
foldl :: (b -> a -> b) -> b -> LexTree p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> LexTree p a -> b
foldr' :: (a -> b -> b) -> b -> LexTree p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> LexTree p a -> b
foldr :: (a -> b -> b) -> b -> LexTree p a -> b
$cfoldr :: forall p a b. (a -> b -> b) -> b -> LexTree p a -> b
foldMap' :: (a -> m) -> LexTree p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> LexTree p a -> m
foldMap :: (a -> m) -> LexTree p a -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> LexTree p a -> m
fold :: LexTree p m -> m
$cfold :: forall p m. Monoid m => LexTree p m -> m
Foldable, Functor (LexTree p)
Foldable (LexTree p)
Functor (LexTree p)
-> Foldable (LexTree p)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> LexTree p a -> f (LexTree p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LexTree p (f a) -> f (LexTree p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LexTree p a -> m (LexTree p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LexTree p (m a) -> m (LexTree p a))
-> Traversable (LexTree p)
(a -> f b) -> LexTree p a -> f (LexTree p b)
forall p. Functor (LexTree p)
forall p. Foldable (LexTree p)
forall p (m :: * -> *) a.
Monad m =>
LexTree p (m a) -> m (LexTree p a)
forall p (f :: * -> *) a.
Applicative f =>
LexTree p (f a) -> f (LexTree p a)
forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LexTree p a -> m (LexTree p b)
forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LexTree p a -> f (LexTree p b)
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 =>
LexTree p (m a) -> m (LexTree p a)
forall (f :: * -> *) a.
Applicative f =>
LexTree p (f a) -> f (LexTree p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LexTree p a -> m (LexTree p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LexTree p a -> f (LexTree p b)
sequence :: LexTree p (m a) -> m (LexTree p a)
$csequence :: forall p (m :: * -> *) a.
Monad m =>
LexTree p (m a) -> m (LexTree p a)
mapM :: (a -> m b) -> LexTree p a -> m (LexTree p b)
$cmapM :: forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LexTree p a -> m (LexTree p b)
sequenceA :: LexTree p (f a) -> f (LexTree p a)
$csequenceA :: forall p (f :: * -> *) a.
Applicative f =>
LexTree p (f a) -> f (LexTree p a)
traverse :: (a -> f b) -> LexTree p a -> f (LexTree p b)
$ctraverse :: forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LexTree p a -> f (LexTree p b)
$cp2Traversable :: forall p. Foldable (LexTree p)
$cp1Traversable :: forall p. Functor (LexTree p)
Traversable)

instance (Eq p, Eq a) => Eq (LexTree p a) where
  LexTree p a
ta == :: LexTree p a -> LexTree p a -> Bool
== LexTree p a
tb = LexTree p a -> [(p, a, p)]
forall p a. LexTree p a -> [(p, a, p)]
toList LexTree p a
ta [(p, a, p)] -> [(p, a, p)] -> Bool
forall a. Eq a => a -> a -> Bool
== LexTree p a -> [(p, a, p)]
forall p a. LexTree p a -> [(p, a, p)]
toList LexTree p a
tb

lookup :: Ord p => p -> LexTree p a -> Maybe a
lookup :: p -> LexTree p a -> Maybe a
lookup p
p = Maybe a
-> (Maybe a -> p -> a -> Maybe a -> p -> Maybe a -> Maybe a)
-> LexTree p a
-> Maybe a
forall r p a.
r -> (r -> p -> a -> r -> p -> r -> r) -> LexTree p a -> r
foldLexTree Maybe a
forall a. Maybe a
Nothing Maybe a -> p -> a -> Maybe a -> p -> Maybe a -> Maybe a
forall a. Maybe a -> p -> a -> Maybe a -> p -> Maybe a -> Maybe a
f
  where
    f :: Maybe a -> p -> a -> Maybe a -> p -> Maybe a -> Maybe a
f Maybe a
ls p
l a
a Maybe a
m p
r Maybe a
rs
      | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
l Bool -> Bool -> Bool
&& p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
r = Maybe a
m Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Maybe a
forall a. a -> Maybe a
Just a
a
      | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
l = Maybe a
ls
      | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
r = Maybe a
rs
      | Bool
otherwise = String -> Maybe a
forall a. HasCallStack => String -> a
error String
"impossible"

lookupOuter :: Ord p => p -> LexTree p a -> Maybe a
lookupOuter :: p -> LexTree p a -> Maybe a
lookupOuter p
p = Maybe a
-> (Maybe a -> p -> a -> Maybe a -> p -> Maybe a -> Maybe a)
-> LexTree p a
-> Maybe a
forall r p a.
r -> (r -> p -> a -> r -> p -> r -> r) -> LexTree p a -> r
foldLexTree Maybe a
forall a. Maybe a
Nothing Maybe a -> p -> a -> Maybe a -> p -> Maybe a -> Maybe a
forall a p. Maybe a -> p -> a -> p -> p -> Maybe a -> Maybe a
f
  where
    f :: Maybe a -> p -> a -> p -> p -> Maybe a -> Maybe a
f Maybe a
ls p
l a
a p
_ p
r Maybe a
rs
      | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
l Bool -> Bool -> Bool
&& p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
r = a -> Maybe a
forall a. a -> Maybe a
Just a
a
      | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
l = Maybe a
ls
      | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
r = Maybe a
rs
      | Bool
otherwise = String -> Maybe a
forall a. HasCallStack => String -> a
error String
"impossible"

toList :: LexTree p a -> [(p, a, p)]
toList :: LexTree p a -> [(p, a, p)]
toList LexTree p a
t = ([(p, a, p)] -> [(p, a, p)])
-> (([(p, a, p)] -> [(p, a, p)])
    -> p
    -> a
    -> ([(p, a, p)] -> [(p, a, p)])
    -> p
    -> ([(p, a, p)] -> [(p, a, p)])
    -> [(p, a, p)]
    -> [(p, a, p)])
-> LexTree p a
-> [(p, a, p)]
-> [(p, a, p)]
forall r p a.
r -> (r -> p -> a -> r -> p -> r -> r) -> LexTree p a -> r
foldLexTree [(p, a, p)] -> [(p, a, p)]
forall a. a -> a
id ([(p, a, p)] -> [(p, a, p)])
-> p
-> a
-> ([(p, a, p)] -> [(p, a, p)])
-> p
-> ([(p, a, p)] -> [(p, a, p)])
-> [(p, a, p)]
-> [(p, a, p)]
forall a b c c b a.
([(a, b, c)] -> c)
-> a -> b -> (b -> [(a, b, c)]) -> c -> (a -> b) -> a -> c
f LexTree p a
t []
  where
    f :: ([(a, b, c)] -> c)
-> a -> b -> (b -> [(a, b, c)]) -> c -> (a -> b) -> a -> c
f [(a, b, c)] -> c
ls a
l b
a b -> [(a, b, c)]
m c
r a -> b
rs = [(a, b, c)] -> c
ls ([(a, b, c)] -> c) -> (a -> [(a, b, c)]) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a
l, b
a, c
r) (a, b, c) -> [(a, b, c)] -> [(a, b, c)]
forall a. a -> [a] -> [a]
:) ([(a, b, c)] -> [(a, b, c)])
-> (a -> [(a, b, c)]) -> a -> [(a, b, c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [(a, b, c)]
m (b -> [(a, b, c)]) -> (a -> b) -> a -> [(a, b, c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
rs

foldLexTree :: r -> (r -> p -> a -> r -> p -> r -> r) -> LexTree p a -> r
foldLexTree :: r -> (r -> p -> a -> r -> p -> r -> r) -> LexTree p a -> r
foldLexTree r
fTip r -> p -> a -> r -> p -> r -> r
fBin = LexTree p a -> r
go
  where
    go :: LexTree p a -> r
go LexTree p a
Tip = r
fTip
    go (Bin Int
_ LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rs) = r -> p -> a -> r -> p -> r -> r
fBin (LexTree p a -> r
go LexTree p a
ls) p
l a
a (LexTree p a -> r
go LexTree p a
ms) p
r (LexTree p a -> r
go LexTree p a
rs)

emptyLexTree :: LexTree p a
emptyLexTree :: LexTree p a
emptyLexTree = LexTree p a
forall p a. LexTree p a
Tip

{-# INLINE height #-}
height :: LexTree p a -> Int
height :: LexTree p a -> Int
height LexTree p a
Tip = Int
0
height (Bin Int
h LexTree p a
_ p
_ a
_ LexTree p a
_ p
_ LexTree p a
_) = Int
h

shift :: Num p => p -> LexTree p a -> LexTree p a
shift :: p -> LexTree p a -> LexTree p a
shift p
p = LexTree p a -> LexTree p a
forall a. LexTree p a -> LexTree p a
go
  where
    go :: LexTree p a -> LexTree p a
go LexTree p a
Tip = LexTree p a
forall p a. LexTree p a
Tip
    go (Bin Int
h LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rs) = Int
-> LexTree p a
-> p
-> a
-> LexTree p a
-> p
-> LexTree p a
-> LexTree p a
forall p a.
Int
-> LexTree p a
-> p
-> a
-> LexTree p a
-> p
-> LexTree p a
-> LexTree p a
Bin Int
h (LexTree p a -> LexTree p a
go LexTree p a
ls) (p
l p -> p -> p
forall a. Num a => a -> a -> a
+ p
p) a
a (LexTree p a -> LexTree p a
go LexTree p a
ms) (p
r p -> p -> p
forall a. Num a => a -> a -> a
+ p
p) (LexTree p a -> LexTree p a
go LexTree p a
rs)

data TreeError p a
  = -- | Nonsensical bounds, i.e. a left-hand bound larger than the right-hand obund
    InvalidBounds p a p
  | -- | Two identical scopes
    OverlappingBounds a a p p
  | -- | An attempt to split halfway through a scope, usually the result of two partially overlapping scopes
    MidSplit
  | -- | Attempting to insert a scope that would not form a tree structure
    LexicalError p a p (LexTree p a)
  deriving (a -> TreeError p b -> TreeError p a
(a -> b) -> TreeError p a -> TreeError p b
(forall a b. (a -> b) -> TreeError p a -> TreeError p b)
-> (forall a b. a -> TreeError p b -> TreeError p a)
-> Functor (TreeError p)
forall a b. a -> TreeError p b -> TreeError p a
forall a b. (a -> b) -> TreeError p a -> TreeError p b
forall p a b. a -> TreeError p b -> TreeError p a
forall p a b. (a -> b) -> TreeError p a -> TreeError p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TreeError p b -> TreeError p a
$c<$ :: forall p a b. a -> TreeError p b -> TreeError p a
fmap :: (a -> b) -> TreeError p a -> TreeError p b
$cfmap :: forall p a b. (a -> b) -> TreeError p a -> TreeError p b
Functor, TreeError p a -> Bool
(a -> m) -> TreeError p a -> m
(a -> b -> b) -> b -> TreeError p a -> b
(forall m. Monoid m => TreeError p m -> m)
-> (forall m a. Monoid m => (a -> m) -> TreeError p a -> m)
-> (forall m a. Monoid m => (a -> m) -> TreeError p a -> m)
-> (forall a b. (a -> b -> b) -> b -> TreeError p a -> b)
-> (forall a b. (a -> b -> b) -> b -> TreeError p a -> b)
-> (forall b a. (b -> a -> b) -> b -> TreeError p a -> b)
-> (forall b a. (b -> a -> b) -> b -> TreeError p a -> b)
-> (forall a. (a -> a -> a) -> TreeError p a -> a)
-> (forall a. (a -> a -> a) -> TreeError p a -> a)
-> (forall a. TreeError p a -> [a])
-> (forall a. TreeError p a -> Bool)
-> (forall a. TreeError p a -> Int)
-> (forall a. Eq a => a -> TreeError p a -> Bool)
-> (forall a. Ord a => TreeError p a -> a)
-> (forall a. Ord a => TreeError p a -> a)
-> (forall a. Num a => TreeError p a -> a)
-> (forall a. Num a => TreeError p a -> a)
-> Foldable (TreeError p)
forall a. Eq a => a -> TreeError p a -> Bool
forall a. Num a => TreeError p a -> a
forall a. Ord a => TreeError p a -> a
forall m. Monoid m => TreeError p m -> m
forall a. TreeError p a -> Bool
forall a. TreeError p a -> Int
forall a. TreeError p a -> [a]
forall a. (a -> a -> a) -> TreeError p a -> a
forall p a. Eq a => a -> TreeError p a -> Bool
forall p a. Num a => TreeError p a -> a
forall p a. Ord a => TreeError p a -> a
forall m a. Monoid m => (a -> m) -> TreeError p a -> m
forall p m. Monoid m => TreeError p m -> m
forall p a. TreeError p a -> Bool
forall p a. TreeError p a -> Int
forall p a. TreeError p a -> [a]
forall b a. (b -> a -> b) -> b -> TreeError p a -> b
forall a b. (a -> b -> b) -> b -> TreeError p a -> b
forall p a. (a -> a -> a) -> TreeError p a -> a
forall p m a. Monoid m => (a -> m) -> TreeError p a -> m
forall p b a. (b -> a -> b) -> b -> TreeError p a -> b
forall p a b. (a -> b -> b) -> b -> TreeError p 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 :: TreeError p a -> a
$cproduct :: forall p a. Num a => TreeError p a -> a
sum :: TreeError p a -> a
$csum :: forall p a. Num a => TreeError p a -> a
minimum :: TreeError p a -> a
$cminimum :: forall p a. Ord a => TreeError p a -> a
maximum :: TreeError p a -> a
$cmaximum :: forall p a. Ord a => TreeError p a -> a
elem :: a -> TreeError p a -> Bool
$celem :: forall p a. Eq a => a -> TreeError p a -> Bool
length :: TreeError p a -> Int
$clength :: forall p a. TreeError p a -> Int
null :: TreeError p a -> Bool
$cnull :: forall p a. TreeError p a -> Bool
toList :: TreeError p a -> [a]
$ctoList :: forall p a. TreeError p a -> [a]
foldl1 :: (a -> a -> a) -> TreeError p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> TreeError p a -> a
foldr1 :: (a -> a -> a) -> TreeError p a -> a
$cfoldr1 :: forall p a. (a -> a -> a) -> TreeError p a -> a
foldl' :: (b -> a -> b) -> b -> TreeError p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> TreeError p a -> b
foldl :: (b -> a -> b) -> b -> TreeError p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> TreeError p a -> b
foldr' :: (a -> b -> b) -> b -> TreeError p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> TreeError p a -> b
foldr :: (a -> b -> b) -> b -> TreeError p a -> b
$cfoldr :: forall p a b. (a -> b -> b) -> b -> TreeError p a -> b
foldMap' :: (a -> m) -> TreeError p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> TreeError p a -> m
foldMap :: (a -> m) -> TreeError p a -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> TreeError p a -> m
fold :: TreeError p m -> m
$cfold :: forall p m. Monoid m => TreeError p m -> m
Foldable, Functor (TreeError p)
Foldable (TreeError p)
Functor (TreeError p)
-> Foldable (TreeError p)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> TreeError p a -> f (TreeError p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TreeError p (f a) -> f (TreeError p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TreeError p a -> m (TreeError p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TreeError p (m a) -> m (TreeError p a))
-> Traversable (TreeError p)
(a -> f b) -> TreeError p a -> f (TreeError p b)
forall p. Functor (TreeError p)
forall p. Foldable (TreeError p)
forall p (m :: * -> *) a.
Monad m =>
TreeError p (m a) -> m (TreeError p a)
forall p (f :: * -> *) a.
Applicative f =>
TreeError p (f a) -> f (TreeError p a)
forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TreeError p a -> m (TreeError p b)
forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TreeError p a -> f (TreeError p b)
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 =>
TreeError p (m a) -> m (TreeError p a)
forall (f :: * -> *) a.
Applicative f =>
TreeError p (f a) -> f (TreeError p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TreeError p a -> m (TreeError p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TreeError p a -> f (TreeError p b)
sequence :: TreeError p (m a) -> m (TreeError p a)
$csequence :: forall p (m :: * -> *) a.
Monad m =>
TreeError p (m a) -> m (TreeError p a)
mapM :: (a -> m b) -> TreeError p a -> m (TreeError p b)
$cmapM :: forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TreeError p a -> m (TreeError p b)
sequenceA :: TreeError p (f a) -> f (TreeError p a)
$csequenceA :: forall p (f :: * -> *) a.
Applicative f =>
TreeError p (f a) -> f (TreeError p a)
traverse :: (a -> f b) -> TreeError p a -> f (TreeError p b)
$ctraverse :: forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TreeError p a -> f (TreeError p b)
$cp2Traversable :: forall p. Foldable (TreeError p)
$cp1Traversable :: forall p. Functor (TreeError p)
Traversable, TreeError p a -> TreeError p a -> Bool
(TreeError p a -> TreeError p a -> Bool)
-> (TreeError p a -> TreeError p a -> Bool) -> Eq (TreeError p a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p a. (Eq p, Eq a) => TreeError p a -> TreeError p a -> Bool
/= :: TreeError p a -> TreeError p a -> Bool
$c/= :: forall p a. (Eq p, Eq a) => TreeError p a -> TreeError p a -> Bool
== :: TreeError p a -> TreeError p a -> Bool
$c== :: forall p a. (Eq p, Eq a) => TreeError p a -> TreeError p a -> Bool
Eq, Int -> TreeError p a -> ShowS
[TreeError p a] -> ShowS
TreeError p a -> String
(Int -> TreeError p a -> ShowS)
-> (TreeError p a -> String)
-> ([TreeError p a] -> ShowS)
-> Show (TreeError p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show p, Show a) => Int -> TreeError p a -> ShowS
forall p a. (Show p, Show a) => [TreeError p a] -> ShowS
forall p a. (Show p, Show a) => TreeError p a -> String
showList :: [TreeError p a] -> ShowS
$cshowList :: forall p a. (Show p, Show a) => [TreeError p a] -> ShowS
show :: TreeError p a -> String
$cshow :: forall p a. (Show p, Show a) => TreeError p a -> String
showsPrec :: Int -> TreeError p a -> ShowS
$cshowsPrec :: forall p a. (Show p, Show a) => Int -> TreeError p a -> ShowS
Show)

{-# INLINE bin' #-}
bin' :: LexTree p a -> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' :: LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rs = Int
-> LexTree p a
-> p
-> a
-> LexTree p a
-> p
-> LexTree p a
-> LexTree p a
forall p a.
Int
-> LexTree p a
-> p
-> a
-> LexTree p a
-> p
-> LexTree p a
-> LexTree p a
Bin (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (LexTree p a -> Int
forall p a. LexTree p a -> Int
height LexTree p a
ls) (LexTree p a -> Int
forall p a. LexTree p a -> Int
height LexTree p a
rs) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rs

-- | Only works if the height difference of the two trees is at most 2
{-# INLINE bin #-}
bin :: LexTree p a -> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin :: LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin (Bin Int
lh LexTree p a
lls p
ll a
la LexTree p a
lms p
lr LexTree p a
lrs) p
l a
a LexTree p a
ms p
r LexTree p a
rs
  | Int
lh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LexTree p a -> Int
forall p a. LexTree p a -> Int
height LexTree p a
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 =
      case LexTree p a
lrs of
        Bin Int
lrh LexTree p a
lrls p
lrl a
lra LexTree p a
lrms p
lrr LexTree p a
lrrs | Int
lrh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LexTree p a -> Int
forall p a. LexTree p a -> Int
height LexTree p a
lls -> LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' (LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' LexTree p a
lls p
ll a
la LexTree p a
lms p
lr LexTree p a
lrls) p
lrl a
lra LexTree p a
lrms p
lrr (LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' LexTree p a
lrrs p
l a
a LexTree p a
ms p
r LexTree p a
rs)
        LexTree p a
_ -> LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' LexTree p a
lls p
ll a
la LexTree p a
lms p
lr (LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' LexTree p a
lrs p
l a
a LexTree p a
ms p
r LexTree p a
rs)
bin LexTree p a
ls p
l a
a LexTree p a
ms p
r (Bin Int
rh LexTree p a
rls p
rl a
ra LexTree p a
rms p
rr LexTree p a
rrs)
  | Int
rh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LexTree p a -> Int
forall p a. LexTree p a -> Int
height LexTree p a
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 =
      case LexTree p a
rls of
        Bin Int
rlh LexTree p a
rlls p
rll a
rla LexTree p a
rlms p
rlr LexTree p a
rlrs | Int
rlh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LexTree p a -> Int
forall p a. LexTree p a -> Int
height LexTree p a
rrs -> LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' (LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rlls) p
rll a
rla LexTree p a
rlms p
rlr (LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' LexTree p a
rlrs p
rl a
ra LexTree p a
rms p
rr LexTree p a
rrs)
        LexTree p a
_ -> LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' (LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rls) p
rl a
ra LexTree p a
rms p
rr LexTree p a
rrs
bin LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rs = LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin' LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rs

split :: Ord p => p -> LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
split :: p
-> LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
split p
p = LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
forall a p a.
LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
go
  where
    go :: LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
go LexTree p a
Tip = (LexTree p a, LexTree p a)
-> Either (TreeError p a) (LexTree p a, LexTree p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexTree p a
forall p a. LexTree p a
Tip, LexTree p a
forall p a. LexTree p a
Tip)
    go (Bin Int
_ LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rs)
      | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
l = do
          (LexTree p a
ll, LexTree p a
lr) <- LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
go LexTree p a
ls
          (LexTree p a, LexTree p a)
-> Either (TreeError p a) (LexTree p a, LexTree p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexTree p a
ll, LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin LexTree p a
lr p
l a
a LexTree p a
ms p
r LexTree p a
rs)
      | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
r = do
          (LexTree p a
rl, LexTree p a
rr) <- LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
go LexTree p a
rs
          (LexTree p a, LexTree p a)
-> Either (TreeError p a) (LexTree p a, LexTree p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rl, LexTree p a
rr)
      | Bool
otherwise = TreeError p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
forall a b. a -> Either a b
Left TreeError p a
forall p a. TreeError p a
MidSplit

{-# INLINE insertWith #-}
insertWith :: Ord p => (a -> a -> Maybe a) -> p -> a -> p -> LexTree p a -> Either (TreeError p a) (LexTree p a)
insertWith :: (a -> a -> Maybe a)
-> p
-> a
-> p
-> LexTree p a
-> Either (TreeError p a) (LexTree p a)
insertWith a -> a -> Maybe a
f p
il a
ia p
ir LexTree p a
t
  | p
il p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
ir = TreeError p a -> Either (TreeError p a) (LexTree p a)
forall a b. a -> Either a b
Left (TreeError p a -> Either (TreeError p a) (LexTree p a))
-> TreeError p a -> Either (TreeError p a) (LexTree p a)
forall a b. (a -> b) -> a -> b
$ p -> a -> p -> TreeError p a
forall p a. p -> a -> p -> TreeError p a
InvalidBounds p
il a
ia p
ir
  | Bool
otherwise = LexTree p a -> Either (TreeError p a) (LexTree p a)
go LexTree p a
t
  where
    go :: LexTree p a -> Either (TreeError p a) (LexTree p a)
go LexTree p a
Tip = LexTree p a -> Either (TreeError p a) (LexTree p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexTree p a -> Either (TreeError p a) (LexTree p a))
-> LexTree p a -> Either (TreeError p a) (LexTree p a)
forall a b. (a -> b) -> a -> b
$ LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin LexTree p a
forall p a. LexTree p a
Tip p
il a
ia LexTree p a
forall p a. LexTree p a
Tip p
ir LexTree p a
forall p a. LexTree p a
Tip
    go (Bin Int
h LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rs)
      | p
ir p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
l = ((LexTree p a -> LexTree p a)
 -> Either (TreeError p a) (LexTree p a)
 -> Either (TreeError p a) (LexTree p a))
-> Either (TreeError p a) (LexTree p a)
-> (LexTree p a -> LexTree p a)
-> Either (TreeError p a) (LexTree p a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (LexTree p a -> LexTree p a)
-> Either (TreeError p a) (LexTree p a)
-> Either (TreeError p a) (LexTree p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LexTree p a -> Either (TreeError p a) (LexTree p a)
go LexTree p a
ls) ((LexTree p a -> LexTree p a)
 -> Either (TreeError p a) (LexTree p a))
-> (LexTree p a -> LexTree p a)
-> Either (TreeError p a) (LexTree p a)
forall a b. (a -> b) -> a -> b
$ \LexTree p a
ls' -> LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin LexTree p a
ls' p
l a
a LexTree p a
ms p
r LexTree p a
rs
      | p
il p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
r = ((LexTree p a -> LexTree p a)
 -> Either (TreeError p a) (LexTree p a)
 -> Either (TreeError p a) (LexTree p a))
-> Either (TreeError p a) (LexTree p a)
-> (LexTree p a -> LexTree p a)
-> Either (TreeError p a) (LexTree p a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (LexTree p a -> LexTree p a)
-> Either (TreeError p a) (LexTree p a)
-> Either (TreeError p a) (LexTree p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LexTree p a -> Either (TreeError p a) (LexTree p a)
go LexTree p a
rs) ((LexTree p a -> LexTree p a)
 -> Either (TreeError p a) (LexTree p a))
-> (LexTree p a -> LexTree p a)
-> Either (TreeError p a) (LexTree p a)
forall a b. (a -> b) -> a -> b
$ \LexTree p a
rs' -> LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin LexTree p a
ls p
l a
a LexTree p a
ms p
r LexTree p a
rs'
      | p
il p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
l Bool -> Bool -> Bool
&& p
ir p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
r = case a -> a -> Maybe a
f a
ia a
a of
          Just a
a' -> LexTree p a -> Either (TreeError p a) (LexTree p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexTree p a -> Either (TreeError p a) (LexTree p a))
-> LexTree p a -> Either (TreeError p a) (LexTree p a)
forall a b. (a -> b) -> a -> b
$ Int
-> LexTree p a
-> p
-> a
-> LexTree p a
-> p
-> LexTree p a
-> LexTree p a
forall p a.
Int
-> LexTree p a
-> p
-> a
-> LexTree p a
-> p
-> LexTree p a
-> LexTree p a
Bin Int
h LexTree p a
ls p
l a
a' LexTree p a
ms p
r LexTree p a
rs
          Maybe a
Nothing -> TreeError p a -> Either (TreeError p a) (LexTree p a)
forall a b. a -> Either a b
Left (TreeError p a -> Either (TreeError p a) (LexTree p a))
-> TreeError p a -> Either (TreeError p a) (LexTree p a)
forall a b. (a -> b) -> a -> b
$ a -> a -> p -> p -> TreeError p a
forall p a. a -> a -> p -> p -> TreeError p a
OverlappingBounds a
ia a
a p
il p
ir
      | p
il p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
l Bool -> Bool -> Bool
&& p
ir p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
r = ((LexTree p a -> LexTree p a)
 -> Either (TreeError p a) (LexTree p a)
 -> Either (TreeError p a) (LexTree p a))
-> Either (TreeError p a) (LexTree p a)
-> (LexTree p a -> LexTree p a)
-> Either (TreeError p a) (LexTree p a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (LexTree p a -> LexTree p a)
-> Either (TreeError p a) (LexTree p a)
-> Either (TreeError p a) (LexTree p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LexTree p a -> Either (TreeError p a) (LexTree p a)
go LexTree p a
ms) ((LexTree p a -> LexTree p a)
 -> Either (TreeError p a) (LexTree p a))
-> (LexTree p a -> LexTree p a)
-> Either (TreeError p a) (LexTree p a)
forall a b. (a -> b) -> a -> b
$ \LexTree p a
ms' -> LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin LexTree p a
ls p
l a
a LexTree p a
ms' p
r LexTree p a
rs
      | p
il p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
l Bool -> Bool -> Bool
&& p
ir p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
r = do
          (LexTree p a
ll, LexTree p a
lr) <- p
-> LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
forall p a.
Ord p =>
p
-> LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
split p
il LexTree p a
ls
          (LexTree p a
rl, LexTree p a
rr) <- p
-> LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
forall p a.
Ord p =>
p
-> LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
split p
ir LexTree p a
rs
          LexTree p a -> Either (TreeError p a) (LexTree p a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexTree p a -> Either (TreeError p a) (LexTree p a))
-> LexTree p a -> Either (TreeError p a) (LexTree p a)
forall a b. (a -> b) -> a -> b
$ LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin LexTree p a
ll p
il a
ia (LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
forall p a.
LexTree p a
-> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
bin LexTree p a
lr p
l a
a LexTree p a
ms p
r LexTree p a
rl) p
ir LexTree p a
rr
      | Bool
otherwise = TreeError p a -> Either (TreeError p a) (LexTree p a)
forall a b. a -> Either a b
Left (TreeError p a -> Either (TreeError p a) (LexTree p a))
-> TreeError p a -> Either (TreeError p a) (LexTree p a)
forall a b. (a -> b) -> a -> b
$ p -> a -> p -> LexTree p a -> TreeError p a
forall p a. p -> a -> p -> LexTree p a -> TreeError p a
LexicalError p
il a
ia p
ir LexTree p a
t

insert :: Ord p => p -> a -> p -> LexTree p a -> Either (TreeError p a) (LexTree p a)
insert :: p -> a -> p -> LexTree p a -> Either (TreeError p a) (LexTree p a)
insert = (a -> a -> Maybe a)
-> p
-> a
-> p
-> LexTree p a
-> Either (TreeError p a) (LexTree p a)
forall p a.
Ord p =>
(a -> a -> Maybe a)
-> p
-> a
-> p
-> LexTree p a
-> Either (TreeError p a) (LexTree p a)
insertWith (\a
_ a
_ -> Maybe a
forall a. Maybe a
Nothing)