{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Edison.Concrete.FingerTree
-- Copyright   :  (c) Ross Paterson, Ralf Hinze 2006
-- License     :  BSD-style
-- Maintainer  :  robdockins AT fastmail DOT fm
-- Stability   :  internal (non-stable)
-- Portability :  non-portable (MPTCs and functional dependencies)
--
-- A general sequence representation with arbitrary annotations, for
-- use as a base for implementations of various collection types, as
-- described in section 4 of
--
--    * Ralf Hinze and Ross Paterson,
--      \"Finger trees: a simple general-purpose data structure\",
--      /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
--      <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
--
-- This data structure forms the basis of the "Data.Edison.Seq.FingerSeq"
-- sequence data structure.
--
-- An amortized running time is given for each operation, with /n/
-- referring to the length of the sequence.  These bounds hold even in
-- a persistent (shared) setting.
--
-----------------------------------------------------------------------------

{------------------------------------------------------------------

Copyright 2004, 2008, The University Court of the University of Glasgow.
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.

- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.

- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE.

-----------------------------------------------------------------------------}


module Data.Edison.Concrete.FingerTree (
        FingerTree,
        Split(..),

        empty, singleton, lcons, rcons, append,
        fromList, toList, null, size, lview, rview,
        split, takeUntil, dropUntil, splitTree,
        reverse, mapTree, foldFT, reduce1, reduce1',
        strict, strictWith, structuralInvariant

        -- traverse'
        ) where

import Prelude hiding (null, reverse)
import Data.Monoid
import Test.QuickCheck

import Data.Edison.Prelude

import Control.Monad (liftM2, liftM3, liftM4)
import qualified Control.Monad.Fail as Fail


infixr 5 `lcons`
infixl 5 `rcons0`

data Digit a
        = One a
        | Two a a
        | Three a a a
        | Four a a a a
        deriving Int -> Digit a -> ShowS
forall a. Show a => Int -> Digit a -> ShowS
forall a. Show a => [Digit a] -> ShowS
forall a. Show a => Digit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Digit a] -> ShowS
$cshowList :: forall a. Show a => [Digit a] -> ShowS
show :: Digit a -> String
$cshow :: forall a. Show a => Digit a -> String
showsPrec :: Int -> Digit a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Digit a -> ShowS
Show

foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit :: forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit b -> b -> b
_ a -> b
f (One a
a) = a -> b
f a
a
foldDigit b -> b -> b
mapp a -> b
f (Two a
a a
b) = a -> b
f a
a b -> b -> b
`mapp` a -> b
f a
b
foldDigit b -> b -> b
mapp a -> b
f (Three a
a a
b a
c) = a -> b
f a
a b -> b -> b
`mapp` a -> b
f a
b b -> b -> b
`mapp` a -> b
f a
c
foldDigit b -> b -> b
mapp a -> b
f (Four a
a a
b a
c a
d) = a -> b
f a
a b -> b -> b
`mapp` a -> b
f a
b b -> b -> b
`mapp` a -> b
f a
c b -> b -> b
`mapp` a -> b
f a
d

reduceDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b
reduceDigit :: forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
reduceDigit b -> b -> b
_ a -> b
f (One a
a) = a -> b
f a
a
reduceDigit b -> b -> b
mapp a -> b
f (Two a
a a
b) = a -> b
f a
a b -> b -> b
`mapp` a -> b
f a
b
reduceDigit b -> b -> b
mapp a -> b
f (Three a
a a
b a
c) = a -> b
f a
a b -> b -> b
`mapp` a -> b
f a
b b -> b -> b
`mapp` a -> b
f a
c
reduceDigit b -> b -> b
mapp a -> b
f (Four a
a a
b a
c a
d) = (a -> b
f a
a b -> b -> b
`mapp` a -> b
f a
b) b -> b -> b
`mapp` (a -> b
f a
c b -> b -> b
`mapp` a -> b
f a
d)

digitToList :: Digit a -> [a] -> [a]
digitToList :: forall a. Digit a -> [a] -> [a]
digitToList (One a
a)        [a]
xs = a
a forall a. a -> [a] -> [a]
: [a]
xs
digitToList (Two a
a a
b)      [a]
xs = a
a forall a. a -> [a] -> [a]
: a
b forall a. a -> [a] -> [a]
: [a]
xs
digitToList (Three a
a a
b a
c)  [a]
xs = a
a forall a. a -> [a] -> [a]
: a
b forall a. a -> [a] -> [a]
: a
c forall a. a -> [a] -> [a]
: [a]
xs
digitToList (Four a
a a
b a
c a
d) [a]
xs = a
a forall a. a -> [a] -> [a]
: a
b forall a. a -> [a] -> [a]
: a
c forall a. a -> [a] -> [a]
: a
d forall a. a -> [a] -> [a]
: [a]
xs

sizeDigit :: (a -> Int) -> Digit a -> Int
sizeDigit :: forall a. (a -> Int) -> Digit a -> Int
sizeDigit a -> Int
f (One a
x)        = a -> Int
f a
x
sizeDigit a -> Int
f (Two a
x a
y)      = a -> Int
f a
x forall a. Num a => a -> a -> a
+ a -> Int
f a
y
sizeDigit a -> Int
f (Three a
x a
y a
z)  = a -> Int
f a
x forall a. Num a => a -> a -> a
+ a -> Int
f a
y forall a. Num a => a -> a -> a
+ a -> Int
f a
z
sizeDigit a -> Int
f (Four a
x a
y a
z a
w) = a -> Int
f a
x forall a. Num a => a -> a -> a
+ a -> Int
f a
y forall a. Num a => a -> a -> a
+ a -> Int
f a
z forall a. Num a => a -> a -> a
+ a -> Int
f a
w

instance (Measured v a) => Measured v (Digit a) where
        measure :: Digit a -> v
measure = forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit forall a. Monoid a => a -> a -> a
mappend forall v a. Measured v a => a -> v
measure

data Node v a = Node2 !v a a | Node3 !v a a a
        deriving Int -> Node v a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v a. (Show v, Show a) => Int -> Node v a -> ShowS
forall v a. (Show v, Show a) => [Node v a] -> ShowS
forall v a. (Show v, Show a) => Node v a -> String
showList :: [Node v a] -> ShowS
$cshowList :: forall v a. (Show v, Show a) => [Node v a] -> ShowS
show :: Node v a -> String
$cshow :: forall v a. (Show v, Show a) => Node v a -> String
showsPrec :: Int -> Node v a -> ShowS
$cshowsPrec :: forall v a. (Show v, Show a) => Int -> Node v a -> ShowS
Show

sizeNode :: (a -> Int) -> Node v a -> Int
sizeNode :: forall a v. (a -> Int) -> Node v a -> Int
sizeNode a -> Int
f (Node2 v
_ a
x a
y)   = a -> Int
f a
x forall a. Num a => a -> a -> a
+ a -> Int
f a
y
sizeNode a -> Int
f (Node3 v
_ a
x a
y a
z) = a -> Int
f a
x forall a. Num a => a -> a -> a
+ a -> Int
f a
y forall a. Num a => a -> a -> a
+ a -> Int
f a
z

foldNode :: (b -> b -> b) -> (a -> b) -> Node v a -> b
foldNode :: forall b a v. (b -> b -> b) -> (a -> b) -> Node v a -> b
foldNode b -> b -> b
mapp a -> b
f (Node2 v
_ a
a a
b)   = a -> b
f a
a b -> b -> b
`mapp` a -> b
f a
b
foldNode b -> b -> b
mapp a -> b
f (Node3 v
_ a
a a
b a
c) = a -> b
f a
a b -> b -> b
`mapp` a -> b
f a
b b -> b -> b
`mapp` a -> b
f a
c

nodeToList :: Node v a -> [a] -> [a]
nodeToList :: forall v a. Node v a -> [a] -> [a]
nodeToList (Node2 v
_ a
a a
b)   [a]
xs = a
a forall a. a -> [a] -> [a]
: a
b forall a. a -> [a] -> [a]
: [a]
xs
nodeToList (Node3 v
_ a
a a
b a
c) [a]
xs = a
a forall a. a -> [a] -> [a]
: a
b forall a. a -> [a] -> [a]
: a
c forall a. a -> [a] -> [a]
: [a]
xs

node2        ::  (Measured v a) => a -> a -> Node v a
node2 :: forall v a. Measured v a => a -> a -> Node v a
node2 a
a a
b    =   forall v a. v -> a -> a -> Node v a
Node2 (forall v a. Measured v a => a -> v
measure a
a forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
b) a
a a
b

node3        ::  (Measured v a) => a -> a -> a -> Node v a
node3 :: forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c  =   forall v a. v -> a -> a -> a -> Node v a
Node3 (forall v a. Measured v a => a -> v
measure a
a forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
b forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
c) a
a a
b a
c

instance (Monoid v) => Measured v (Node v a) where
        measure :: Node v a -> v
measure (Node2 v
v a
_ a
_)    =  v
v
        measure (Node3 v
v a
_ a
_ a
_)  =  v
v

nodeToDigit :: Node v a -> Digit a
nodeToDigit :: forall v a. Node v a -> Digit a
nodeToDigit (Node2 v
_ a
a a
b) = forall a. a -> a -> Digit a
Two a
a a
b
nodeToDigit (Node3 v
_ a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three a
a a
b a
c


-- | Finger trees with element type @a@, annotated with measures of type @v@.
-- The operations enforce the constraint @'Measured' v a@.
data FingerTree v a
        = Empty
        | Single a
        | Deep !v !(Digit a) (FingerTree v (Node v a)) !(Digit a)

deep ::  (Measured v a) =>
         Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep :: forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr FingerTree v (Node v a)
m Digit a
sf  =   forall v a.
v
-> Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
Deep ((forall v a. Measured v a => a -> v
measure Digit a
pr forall v a. Measured v a => v -> FingerTree v a -> v
`mappendVal` FingerTree v (Node v a)
m) forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure Digit a
sf) Digit a
pr FingerTree v (Node v a)
m Digit a
sf

structuralInvariant :: (Eq v, Measured v a) => FingerTree v a -> Bool
structuralInvariant :: forall v a. (Eq v, Measured v a) => FingerTree v a -> Bool
structuralInvariant FingerTree v a
Empty      = Bool
True
structuralInvariant (Single a
_) = Bool
True
structuralInvariant (Deep v
v Digit a
pr FingerTree v (Node v a)
m Digit a
sf) =
     v
v forall a. Eq a => a -> a -> Bool
== forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit forall a. Monoid a => a -> a -> a
mappend forall v a. Measured v a => a -> v
measure Digit a
pr forall a. Monoid a => a -> a -> a
`mappend`
          forall b a v. b -> (b -> b -> b) -> (a -> b) -> FingerTree v a -> b
foldFT    forall a. Monoid a => a
mempty forall a. Monoid a => a -> a -> a
mappend (forall b a v. (b -> b -> b) -> (a -> b) -> Node v a -> b
foldNode forall a. Monoid a => a -> a -> a
mappend forall v a. Measured v a => a -> v
measure) FingerTree v (Node v a)
m forall a. Monoid a => a -> a -> a
`mappend`
          forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit forall a. Monoid a => a -> a -> a
mappend forall v a. Measured v a => a -> v
measure Digit a
sf

instance (Measured v a) => Measured v (FingerTree v a) where
        measure :: FingerTree v a -> v
measure FingerTree v a
Empty           =  forall a. Monoid a => a
mempty
        measure (Single a
x)      =  forall v a. Measured v a => a -> v
measure a
x
        measure (Deep v
v Digit a
_ FingerTree v (Node v a)
_ Digit a
_)  =  v
v

sizeFT :: (a -> Int) -> FingerTree v a -> Int
sizeFT :: forall a v. (a -> Int) -> FingerTree v a -> Int
sizeFT a -> Int
_ FingerTree v a
Empty            = Int
0
sizeFT a -> Int
f (Single a
x)       = a -> Int
f a
x
sizeFT a -> Int
f (Deep v
_ Digit a
d1 FingerTree v (Node v a)
m Digit a
d2) = forall a. (a -> Int) -> Digit a -> Int
sizeDigit a -> Int
f Digit a
d1 forall a. Num a => a -> a -> a
+ forall a v. (a -> Int) -> FingerTree v a -> Int
sizeFT (forall a v. (a -> Int) -> Node v a -> Int
sizeNode a -> Int
f) FingerTree v (Node v a)
m forall a. Num a => a -> a -> a
+ forall a. (a -> Int) -> Digit a -> Int
sizeDigit a -> Int
f Digit a
d2

size :: FingerTree v a -> Int
size :: forall v a. FingerTree v a -> Int
size = forall a v. (a -> Int) -> FingerTree v a -> Int
sizeFT (forall a b. a -> b -> a
const Int
1)

foldFT :: b -> (b -> b -> b) -> (a -> b) -> FingerTree v a -> b
foldFT :: forall b a v. b -> (b -> b -> b) -> (a -> b) -> FingerTree v a -> b
foldFT b
mz b -> b -> b
_ a -> b
_ FingerTree v a
Empty      = b
mz
foldFT b
_ b -> b -> b
_ a -> b
f (Single a
x) = a -> b
f a
x
foldFT b
mz b -> b -> b
mapp a -> b
f (Deep v
_ Digit a
pr FingerTree v (Node v a)
m Digit a
sf) =
             forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit  b -> b -> b
mapp a -> b
f Digit a
pr b -> b -> b
`mapp` forall b a v. b -> (b -> b -> b) -> (a -> b) -> FingerTree v a -> b
foldFT b
mz b -> b -> b
mapp (forall b a v. (b -> b -> b) -> (a -> b) -> Node v a -> b
foldNode b -> b -> b
mapp a -> b
f) FingerTree v (Node v a)
m b -> b -> b
`mapp` forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit b -> b -> b
mapp a -> b
f Digit a
sf

ftToList :: FingerTree v a -> [a] -> [a]
ftToList :: forall v a. FingerTree v a -> [a] -> [a]
ftToList FingerTree v a
Empty [a]
xs             = [a]
xs
ftToList (Single a
a) [a]
xs        = a
a forall a. a -> [a] -> [a]
: [a]
xs
ftToList (Deep v
_ Digit a
d1 FingerTree v (Node v a)
ft Digit a
d2) [a]
xs = forall a. Digit a -> [a] -> [a]
digitToList Digit a
d1 (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall v a. Node v a -> [a] -> [a]
nodeToList [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. FingerTree v a -> [a] -> [a]
ftToList FingerTree v (Node v a)
ft forall a b. (a -> b) -> a -> b
$ []) forall a. [a] -> [a] -> [a]
++ (forall a. Digit a -> [a] -> [a]
digitToList Digit a
d2 [a]
xs)

toList :: FingerTree v a -> [a]
toList :: forall v a. FingerTree v a -> [a]
toList FingerTree v a
ft = forall v a. FingerTree v a -> [a] -> [a]
ftToList FingerTree v a
ft []

reduce1_aux :: (b -> b -> b) -> (a -> b) -> Digit a -> FingerTree v (Node v a) -> Digit a -> b
reduce1_aux :: forall b a v.
(b -> b -> b)
-> (a -> b) -> Digit a -> FingerTree v (Node v a) -> Digit a -> b
reduce1_aux b -> b -> b
mapp a -> b
f Digit a
pr FingerTree v (Node v a)
Empty Digit a
sf =
     (forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
reduceDigit b -> b -> b
mapp a -> b
f Digit a
pr) b -> b -> b
`mapp`
     (forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
reduceDigit b -> b -> b
mapp a -> b
f Digit a
sf)

reduce1_aux b -> b -> b
mapp a -> b
f Digit a
pr (Single Node v a
x) Digit a
sf =
     (forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
reduceDigit b -> b -> b
mapp a -> b
f Digit a
pr) b -> b -> b
`mapp`
     (forall b a v. (b -> b -> b) -> (a -> b) -> Node v a -> b
foldNode b -> b -> b
mapp a -> b
f Node v a
x)     b -> b -> b
`mapp`
     (forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
reduceDigit b -> b -> b
mapp a -> b
f Digit a
sf)

reduce1_aux b -> b -> b
mapp a -> b
f Digit a
pr (Deep v
_ Digit (Node v a)
pr' FingerTree v (Node v (Node v a))
m Digit (Node v a)
sf') Digit a
sf =
     (forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
reduceDigit b -> b -> b
mapp a -> b
f Digit a
pr) b -> b -> b
`mapp`
     (forall b a v.
(b -> b -> b)
-> (a -> b) -> Digit a -> FingerTree v (Node v a) -> Digit a -> b
reduce1_aux b -> b -> b
mapp
        (forall b a v. (b -> b -> b) -> (a -> b) -> Node v a -> b
foldNode b -> b -> b
mapp a -> b
f)
            Digit (Node v a)
pr' FingerTree v (Node v (Node v a))
m Digit (Node v a)
sf')       b -> b -> b
`mapp`
     (forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
reduceDigit b -> b -> b
mapp a -> b
f Digit a
sf)

reduce1 :: (a -> a -> a) -> FingerTree v a -> a
reduce1 :: forall a v. (a -> a -> a) -> FingerTree v a -> a
reduce1 a -> a -> a
_ FingerTree v a
Empty             = forall a. HasCallStack => String -> a
error String
"FingerTree.reduce1: empty tree"
reduce1 a -> a -> a
_ (Single a
x)        = a
x
reduce1 a -> a -> a
mapp (Deep v
_ Digit a
pr FingerTree v (Node v a)
m Digit a
sf)  = forall b a v.
(b -> b -> b)
-> (a -> b) -> Digit a -> FingerTree v (Node v a) -> Digit a -> b
reduce1_aux a -> a -> a
mapp forall a. a -> a
id Digit a
pr FingerTree v (Node v a)
m Digit a
sf

reduce1' :: (a -> a -> a) -> FingerTree v a -> a
reduce1' :: forall a v. (a -> a -> a) -> FingerTree v a -> a
reduce1' a -> a -> a
_ FingerTree v a
Empty            = forall a. HasCallStack => String -> a
error String
"FingerTree.reduce1': empty tree"
reduce1' a -> a -> a
_ (Single a
x)       = a
x
reduce1' a -> a -> a
mapp (Deep v
_ Digit a
pr FingerTree v (Node v a)
m Digit a
sf) = forall b a v.
(b -> b -> b)
-> (a -> b) -> Digit a -> FingerTree v (Node v a) -> Digit a -> b
reduce1_aux a -> a -> a
mapp' forall a. a -> a
id Digit a
pr FingerTree v (Node v a)
m Digit a
sf
  where mapp' :: a -> a -> a
mapp' a
x a
y = a
x seq :: forall a b. a -> b -> b
`seq` a
y seq :: forall a b. a -> b -> b
`seq` a -> a -> a
mapp a
x a
y


strict :: FingerTree v a -> FingerTree v a
strict :: forall v a. FingerTree v a -> FingerTree v a
strict FingerTree v a
xs = forall b a v. b -> (b -> b -> b) -> (a -> b) -> FingerTree v a -> b
foldFT () seq :: forall a b. a -> b -> b
seq (forall a b. a -> b -> a
const ()) FingerTree v a
xs seq :: forall a b. a -> b -> b
`seq` FingerTree v a
xs

strictWith :: (a -> b) -> FingerTree v a -> FingerTree v a
strictWith :: forall a b v. (a -> b) -> FingerTree v a -> FingerTree v a
strictWith a -> b
f FingerTree v a
xs = forall b a v. b -> (b -> b -> b) -> (a -> b) -> FingerTree v a -> b
foldFT () seq :: forall a b. a -> b -> b
seq (\a
x -> a -> b
f a
x seq :: forall a b. a -> b -> b
`seq` ()) FingerTree v a
xs seq :: forall a b. a -> b -> b
`seq` FingerTree v a
xs

instance (Measured v a, Eq a) => Eq (FingerTree v a) where
        FingerTree v a
xs == :: FingerTree v a -> FingerTree v a -> Bool
== FingerTree v a
ys = forall v a. FingerTree v a -> [a]
toList FingerTree v a
xs forall a. Eq a => a -> a -> Bool
== forall v a. FingerTree v a -> [a]
toList FingerTree v a
ys

instance (Measured v a, Ord a) => Ord (FingerTree v a) where
        compare :: FingerTree v a -> FingerTree v a -> Ordering
compare FingerTree v a
xs FingerTree v a
ys = forall a. Ord a => a -> a -> Ordering
compare (forall v a. FingerTree v a -> [a]
toList FingerTree v a
xs) (forall v a. FingerTree v a -> [a]
toList FingerTree v a
ys)

instance (Measured v a, Show a) => Show (FingerTree v a) where
        showsPrec :: Int -> FingerTree v a -> ShowS
showsPrec Int
p FingerTree v a
xs = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
                String -> ShowS
showString String
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall v a. FingerTree v a -> [a]
toList FingerTree v a
xs)

mapTree :: (Measured v2 a2) =>
        (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
mapTree :: forall v2 a2 a1 v1.
Measured v2 a2 =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
mapTree a1 -> a2
_ FingerTree v1 a1
Empty = forall v a. FingerTree v a
Empty
mapTree a1 -> a2
f (Single a1
x) = forall v a. a -> FingerTree v a
Single (a1 -> a2
f a1
x)
mapTree a1 -> a2
f (Deep v1
_ Digit a1
pr FingerTree v1 (Node v1 a1)
m Digit a1
sf) =
        forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a b. (a -> b) -> Digit a -> Digit b
mapDigit a1 -> a2
f Digit a1
pr) (forall v2 a2 a1 v1.
Measured v2 a2 =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
mapTree (forall v2 a2 a1 v1.
Measured v2 a2 =>
(a1 -> a2) -> Node v1 a1 -> Node v2 a2
mapNode a1 -> a2
f) FingerTree v1 (Node v1 a1)
m) (forall a b. (a -> b) -> Digit a -> Digit b
mapDigit a1 -> a2
f Digit a1
sf)

mapNode :: (Measured v2 a2) =>
        (a1 -> a2) -> Node v1 a1 -> Node v2 a2
mapNode :: forall v2 a2 a1 v1.
Measured v2 a2 =>
(a1 -> a2) -> Node v1 a1 -> Node v2 a2
mapNode a1 -> a2
f (Node2 v1
_ a1
a a1
b) = forall v a. Measured v a => a -> a -> Node v a
node2 (a1 -> a2
f a1
a) (a1 -> a2
f a1
b)
mapNode a1 -> a2
f (Node3 v1
_ a1
a a1
b a1
c) = forall v a. Measured v a => a -> a -> a -> Node v a
node3 (a1 -> a2
f a1
a) (a1 -> a2
f a1
b) (a1 -> a2
f a1
c)

mapDigit :: (a -> b) -> Digit a -> Digit b
mapDigit :: forall a b. (a -> b) -> Digit a -> Digit b
mapDigit a -> b
f (One a
a) = forall a. a -> Digit a
One (a -> b
f a
a)
mapDigit a -> b
f (Two a
a a
b) = forall a. a -> a -> Digit a
Two (a -> b
f a
a) (a -> b
f a
b)
mapDigit a -> b
f (Three a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)
mapDigit a -> b
f (Four a
a a
b a
c a
d) = forall a. a -> a -> a -> a -> Digit a
Four (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c) (a -> b
f a
d)


{-
-- | Like 'traverse', but with a more constrained type.
traverse' :: (Measured v1 a1, Measured v2 a2, Applicative f) =>
        (a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
traverse' = traverseTree

traverseTree :: (Measured v2 a2, Applicative f) =>
        (a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
traverseTree _ Empty = pure Empty
traverseTree f (Single x) = Single <$> f x
traverseTree f (Deep _ pr m sf) =
        deep <$> traverseDigit f pr <*> traverseTree (traverseNode f) m <*> traverseDigit f sf

traverseNode :: (Measured v2 a2, Applicative f) =>
        (a1 -> f a2) -> Node v1 a1 -> f (Node v2 a2)
traverseNode f (Node2 _ a b) = node2 <$> f a <*> f b
traverseNode f (Node3 _ a b c) = node3 <$> f a <*> f b <*> f c

traverseDigit :: (Applicative f) => (a -> f b) -> Digit a -> f (Digit b)
traverseDigit f (One a) = One <$> f a
traverseDigit f (Two a b) = Two <$> f a <*> f b
traverseDigit f (Three a b c) = Three <$> f a <*> f b <*> f c
traverseDigit f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d
-}

-- | /O(1)/. The empty sequence.
empty :: Measured v a => FingerTree v a
empty :: forall v a. Measured v a => FingerTree v a
empty = forall v a. FingerTree v a
Empty

-- | /O(1)/. A singleton sequence.
singleton :: Measured v a => a -> FingerTree v a
singleton :: forall v a. Measured v a => a -> FingerTree v a
singleton = forall v a. a -> FingerTree v a
Single

-- | /O(n)/. Create a sequence from a finite list of elements.
fromList :: (Measured v a) => [a] -> FingerTree v a
fromList :: forall v a. Measured v a => [a] -> FingerTree v a
fromList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
lcons forall v a. FingerTree v a
Empty

-- | /O(1)/. Add an element to the left end of a sequence.
lcons :: (Measured v a) => a -> FingerTree v a -> FingerTree v a
a
a lcons :: forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
Empty         =  forall v a. a -> FingerTree v a
Single a
a
a
a `lcons` Single a
b              =  forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a. a -> Digit a
One a
a) forall v a. FingerTree v a
Empty (forall a. a -> Digit a
One a
b)
a
a `lcons` Deep v
_ (Four a
b a
c a
d a
e) FingerTree v (Node v a)
m Digit a
sf = FingerTree v (Node v a)
m seq :: forall a b. a -> b -> b
`seq`
        forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a. a -> a -> Digit a
Two a
a a
b) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
c a
d a
e forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v (Node v a)
m) Digit a
sf
a
a `lcons` Deep v
_ Digit a
pr FingerTree v (Node v a)
m Digit a
sf        =  forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a. a -> Digit a -> Digit a
consDigit a
a Digit a
pr) FingerTree v (Node v a)
m Digit a
sf

consDigit :: a -> Digit a -> Digit a
consDigit :: forall a. a -> Digit a -> Digit a
consDigit a
a (One a
b) = forall a. a -> a -> Digit a
Two a
a a
b
consDigit a
a (Two a
b a
c) = forall a. a -> a -> a -> Digit a
Three a
a a
b a
c
consDigit a
a (Three a
b a
c a
d) = forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d
consDigit a
_ Digit a
_ = forall a. HasCallStack => String -> a
error String
"FingerTree.consDigit: bug!"

-- | /O(1)/. Add an element to the right end of a sequence.
rcons ::  (Measured v a) => a -> FingerTree v a -> FingerTree v a
rcons :: forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
rcons = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
rcons0

rcons0 :: (Measured v a) => FingerTree v a -> a -> FingerTree v a
FingerTree v a
Empty rcons0 :: forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
a                =  forall v a. a -> FingerTree v a
Single a
a
Single a
a `rcons0` a
b             =  forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a. a -> Digit a
One a
a) forall v a. FingerTree v a
Empty (forall a. a -> Digit a
One a
b)
Deep v
_ Digit a
pr FingerTree v (Node v a)
m (Four a
a a
b a
c a
d) `rcons0` a
e = FingerTree v (Node v a)
m seq :: forall a b. a -> b -> b
`seq`
        forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr (FingerTree v (Node v a)
m forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall a. a -> a -> Digit a
Two a
d a
e)
Deep v
_ Digit a
pr FingerTree v (Node v a)
m Digit a
sf `rcons0` a
x       =  forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr FingerTree v (Node v a)
m (forall a. Digit a -> a -> Digit a
snocDigit Digit a
sf a
x)

snocDigit :: Digit a -> a -> Digit a
snocDigit :: forall a. Digit a -> a -> Digit a
snocDigit (One a
a) a
b = forall a. a -> a -> Digit a
Two a
a a
b
snocDigit (Two a
a a
b) a
c = forall a. a -> a -> a -> Digit a
Three a
a a
b a
c
snocDigit (Three a
a a
b a
c) a
d = forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d
snocDigit Digit a
_ a
_ = forall a. HasCallStack => String -> a
error String
"FingerTree.snocDigit: bug!"

-- | /O(1)/. Is this the empty sequence?
null :: (Measured v a) => FingerTree v a -> Bool
null :: forall v a. Measured v a => FingerTree v a -> Bool
null FingerTree v a
Empty = Bool
True
null FingerTree v a
_ = Bool
False

-- | /O(1)/. Analyse the left end of a sequence.
lview :: (Measured v a, Fail.MonadFail m) => FingerTree v a -> m (a,FingerTree v a)
lview :: forall v a (m :: * -> *).
(Measured v a, MonadFail m) =>
FingerTree v a -> m (a, FingerTree v a)
lview FingerTree v a
Empty                 =  forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"FingerTree.lview: empty tree"
lview (Single a
x)            =  forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, forall v a. FingerTree v a
Empty)
lview (Deep v
_ (One a
x) FingerTree v (Node v a)
m Digit a
sf) =  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
x forall a b. (a -> b) -> a -> b
$
        case forall v a (m :: * -> *).
(Measured v a, MonadFail m) =>
FingerTree v a -> m (a, FingerTree v a)
lview FingerTree v (Node v a)
m of
          Maybe (Node v a, FingerTree v (Node v a))
Nothing     -> forall v a. Measured v a => Digit a -> FingerTree v a
digitToTree Digit a
sf
          Just (Node v a
a,FingerTree v (Node v a)
m') -> forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall v a. Node v a -> Digit a
nodeToDigit Node v a
a) FingerTree v (Node v a)
m' Digit a
sf

lview (Deep v
_ Digit a
pr FingerTree v (Node v a)
m Digit a
sf)      =  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Digit a -> a
lheadDigit Digit a
pr, forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a. Digit a -> Digit a
ltailDigit Digit a
pr) FingerTree v (Node v a)
m Digit a
sf)

lheadDigit :: Digit a -> a
lheadDigit :: forall a. Digit a -> a
lheadDigit (One a
a) = a
a
lheadDigit (Two a
a a
_) = a
a
lheadDigit (Three a
a a
_ a
_) = a
a
lheadDigit (Four a
a a
_ a
_ a
_) = a
a

ltailDigit :: Digit a -> Digit a
ltailDigit :: forall a. Digit a -> Digit a
ltailDigit (Two a
_ a
b) = forall a. a -> Digit a
One a
b
ltailDigit (Three a
_ a
b a
c) = forall a. a -> a -> Digit a
Two a
b a
c
ltailDigit (Four a
_ a
b a
c a
d) = forall a. a -> a -> a -> Digit a
Three a
b a
c a
d
ltailDigit Digit a
_ = forall a. HasCallStack => String -> a
error String
"FingerTree.ltailDigit: bug!"

-- | /O(1)/. Analyse the right end of a sequence.
rview :: (Measured v a, Fail.MonadFail m) => FingerTree v a -> m (a, FingerTree v a)
rview :: forall v a (m :: * -> *).
(Measured v a, MonadFail m) =>
FingerTree v a -> m (a, FingerTree v a)
rview FingerTree v a
Empty                  = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"FingerTree.rview: empty tree"
rview (Single a
x)             = forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, forall v a. FingerTree v a
Empty)
rview (Deep v
_ Digit a
pr FingerTree v (Node v a)
m (One a
x))  = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
x forall a b. (a -> b) -> a -> b
$
        case forall v a (m :: * -> *).
(Measured v a, MonadFail m) =>
FingerTree v a -> m (a, FingerTree v a)
rview FingerTree v (Node v a)
m of
           Maybe (Node v a, FingerTree v (Node v a))
Nothing      -> forall v a. Measured v a => Digit a -> FingerTree v a
digitToTree Digit a
pr
           Just (Node v a
a,FingerTree v (Node v a)
m')  -> forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr FingerTree v (Node v a)
m' (forall v a. Node v a -> Digit a
nodeToDigit Node v a
a)

rview (Deep v
_ Digit a
pr FingerTree v (Node v a)
m Digit a
sf)       =  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Digit a -> a
rheadDigit Digit a
sf, forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr FingerTree v (Node v a)
m (forall a. Digit a -> Digit a
rtailDigit Digit a
sf))


rheadDigit :: Digit a -> a
rheadDigit :: forall a. Digit a -> a
rheadDigit (One a
a) = a
a
rheadDigit (Two a
_ a
b) = a
b
rheadDigit (Three a
_ a
_ a
c) = a
c
rheadDigit (Four a
_ a
_ a
_ a
d) = a
d

rtailDigit :: Digit a -> Digit a
rtailDigit :: forall a. Digit a -> Digit a
rtailDigit (Two a
a a
_) = forall a. a -> Digit a
One a
a
rtailDigit (Three a
a a
b a
_) = forall a. a -> a -> Digit a
Two a
a a
b
rtailDigit (Four a
a a
b a
c a
_) = forall a. a -> a -> a -> Digit a
Three a
a a
b a
c
rtailDigit Digit a
_ = forall a. HasCallStack => String -> a
error String
"FingerTree.rtailDigit: bug!"

digitToTree :: (Measured v a) => Digit a -> FingerTree v a
digitToTree :: forall v a. Measured v a => Digit a -> FingerTree v a
digitToTree (One a
a) = forall v a. a -> FingerTree v a
Single a
a
digitToTree (Two a
a a
b) = forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a. a -> Digit a
One a
a) forall v a. FingerTree v a
Empty (forall a. a -> Digit a
One a
b)
digitToTree (Three a
a a
b a
c) = forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a. a -> a -> Digit a
Two a
a a
b) forall v a. FingerTree v a
Empty (forall a. a -> Digit a
One a
c)
digitToTree (Four a
a a
b a
c a
d) = forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a. a -> a -> Digit a
Two a
a a
b) forall v a. FingerTree v a
Empty (forall a. a -> a -> Digit a
Two a
c a
d)


-- | /O(log(min(n1,n2)))/. Concatenate two sequences.
append :: (Measured v a) => FingerTree v a -> FingerTree v a -> FingerTree v a
append :: forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
append =  forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
appendTree0

appendTree0 :: (Measured v a) => FingerTree v a -> FingerTree v a -> FingerTree v a
appendTree0 :: forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
appendTree0 FingerTree v a
Empty FingerTree v a
xs =
        FingerTree v a
xs
appendTree0 FingerTree v a
xs FingerTree v a
Empty =
        FingerTree v a
xs
appendTree0 (Single a
x) FingerTree v a
xs =
        a
x forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
xs
appendTree0 FingerTree v a
xs (Single a
x) =
        FingerTree v a
xs forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
x
appendTree0 (Deep v
_ Digit a
pr1 FingerTree v (Node v a)
m1 Digit a
sf1) (Deep v
_ Digit a
pr2 FingerTree v (Node v a)
m2 Digit a
sf2) =
        forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr1 (forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits0 FingerTree v (Node v a)
m1 Digit a
sf1 Digit a
pr2 FingerTree v (Node v a)
m2) Digit a
sf2

addDigits0 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)
addDigits0 :: forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits0 FingerTree v (Node v a)
m1 (One a
a) (One a
b) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> FingerTree v a -> FingerTree v a
appendTree1 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> Node v a
node2 a
a a
b) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (One a
a) (Two a
b a
c) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> FingerTree v a -> FingerTree v a
appendTree1 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (One a
a) (Three a
b a
c a
d) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> Node v a
node2 a
a a
b) (forall v a. Measured v a => a -> a -> Node v a
node2 a
c a
d) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (One a
a) (Four a
b a
c a
d a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Two a
a a
b) (One a
c) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> FingerTree v a -> FingerTree v a
appendTree1 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Two a
a a
b) (Two a
c a
d) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> Node v a
node2 a
a a
b) (forall v a. Measured v a => a -> a -> Node v a
node2 a
c a
d) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Two a
a a
b) (Three a
c a
d a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Two a
a a
b) (Four a
c a
d a
e a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) (One a
d) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> Node v a
node2 a
a a
b) (forall v a. Measured v a => a -> a -> Node v a
node2 a
c a
d) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) (Two a
d a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) (Three a
d a
e a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) (Four a
d a
e a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) (One a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) (Two a
e a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) (Three a
e a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits0 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) (Four a
e a
f a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2

appendTree1 :: (Measured v a) => FingerTree v a -> a -> FingerTree v a -> FingerTree v a
appendTree1 :: forall v a.
Measured v a =>
FingerTree v a -> a -> FingerTree v a -> FingerTree v a
appendTree1 FingerTree v a
Empty a
a FingerTree v a
xs =
        a
a forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
xs
appendTree1 FingerTree v a
xs a
a FingerTree v a
Empty =
        FingerTree v a
xs forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
a
appendTree1 (Single a
x) a
a FingerTree v a
xs =
        a
x forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` (a
a forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
xs)
appendTree1 FingerTree v a
xs a
a (Single a
x) =
        FingerTree v a
xs forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
a forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
x
appendTree1 (Deep v
_ Digit a
pr1 FingerTree v (Node v a)
m1 Digit a
sf1) a
a (Deep v
_ Digit a
pr2 FingerTree v (Node v a)
m2 Digit a
sf2) =
        forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr1 (forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits1 FingerTree v (Node v a)
m1 Digit a
sf1 a
a Digit a
pr2 FingerTree v (Node v a)
m2) Digit a
sf2

addDigits1 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)
addDigits1 :: forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits1 FingerTree v (Node v a)
m1 (One a
a) a
b (One a
c) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> FingerTree v a -> FingerTree v a
appendTree1 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (One a
a) a
b (Two a
c a
d) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> Node v a
node2 a
a a
b) (forall v a. Measured v a => a -> a -> Node v a
node2 a
c a
d) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (One a
a) a
b (Three a
c a
d a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (One a
a) a
b (Four a
c a
d a
e a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c (One a
d) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> Node v a
node2 a
a a
b) (forall v a. Measured v a => a -> a -> Node v a
node2 a
c a
d) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c (Two a
d a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c (Three a
d a
e a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c (Four a
d a
e a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d (One a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d (Two a
e a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d (Three a
e a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d (Four a
e a
f a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e (One a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e (Two a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e (Three a
f a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits1 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e (Four a
f a
g a
h a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2

appendTree2 :: (Measured v a) => FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 :: forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v a
Empty a
a a
b FingerTree v a
xs =
        a
a forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` (a
b forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
xs)
appendTree2 FingerTree v a
xs a
a a
b FingerTree v a
Empty =
        FingerTree v a
xs forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
a forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
b
appendTree2 (Single a
x) a
a a
b FingerTree v a
xs =
        a
x forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` (a
a forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` (a
b forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
xs))
appendTree2 FingerTree v a
xs a
a a
b (Single a
x) =
        FingerTree v a
xs forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
a forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
b forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
x
appendTree2 (Deep v
_ Digit a
pr1 FingerTree v (Node v a)
m1 Digit a
sf1) a
a a
b (Deep v
_ Digit a
pr2 FingerTree v (Node v a)
m2 Digit a
sf2) =
        forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr1 (forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> a
-> a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits2 FingerTree v (Node v a)
m1 Digit a
sf1 a
a a
b Digit a
pr2 FingerTree v (Node v a)
m2) Digit a
sf2

addDigits2 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)
addDigits2 :: forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> a
-> a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits2 FingerTree v (Node v a)
m1 (One a
a) a
b a
c (One a
d) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> Node v a
node2 a
a a
b) (forall v a. Measured v a => a -> a -> Node v a
node2 a
c a
d) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (One a
a) a
b a
c (Two a
d a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (One a
a) a
b a
c (Three a
d a
e a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (One a
a) a
b a
c (Four a
d a
e a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d (One a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d (Two a
e a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d (Three a
e a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d (Four a
e a
f a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e (One a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e (Two a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e (Three a
f a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e (Four a
f a
g a
h a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f (One a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f (Two a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f (Three a
g a
h a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2
addDigits2 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f (Four a
g a
h a
i a
j) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) (forall v a. Measured v a => a -> a -> Node v a
node2 a
i a
j) FingerTree v (Node v a)
m2

appendTree3 :: (Measured v a) => FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 :: forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v a
Empty a
a a
b a
c FingerTree v a
xs =
        a
a forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` (a
b forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` (a
c forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
xs))
appendTree3 FingerTree v a
xs a
a a
b a
c FingerTree v a
Empty =
        FingerTree v a
xs forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
a forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
b forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
c
appendTree3 (Single a
x) a
a a
b a
c FingerTree v a
xs =
        a
x forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` (a
a forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` (a
b forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` (a
c forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
xs)))
appendTree3 FingerTree v a
xs a
a a
b a
c (Single a
x) =
        FingerTree v a
xs forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
a forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
b forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
c forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
x
appendTree3 (Deep v
_ Digit a
pr1 FingerTree v (Node v a)
m1 Digit a
sf1) a
a a
b a
c (Deep v
_ Digit a
pr2 FingerTree v (Node v a)
m2 Digit a
sf2) =
        forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr1 (forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> a
-> a
-> a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits3 FingerTree v (Node v a)
m1 Digit a
sf1 a
a a
b a
c Digit a
pr2 FingerTree v (Node v a)
m2) Digit a
sf2

addDigits3 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)
addDigits3 :: forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> a
-> a
-> a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits3 FingerTree v (Node v a)
m1 (One a
a) a
b a
c a
d (One a
e) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (One a
a) a
b a
c a
d (Two a
e a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (One a
a) a
b a
c a
d (Three a
e a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (One a
a) a
b a
c a
d (Four a
e a
f a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d a
e (One a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d a
e (Two a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d a
e (Three a
f a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d a
e (Four a
f a
g a
h a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e a
f (One a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e a
f (Two a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e a
f (Three a
g a
h a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e a
f (Four a
g a
h a
i a
j) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) (forall v a. Measured v a => a -> a -> Node v a
node2 a
i a
j) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f a
g (One a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f a
g (Two a
h a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f a
g (Three a
h a
i a
j) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) (forall v a. Measured v a => a -> a -> Node v a
node2 a
i a
j) FingerTree v (Node v a)
m2
addDigits3 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f a
g (Four a
h a
i a
j a
k) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) (forall v a. Measured v a => a -> a -> Node v a
node2 a
j a
k) FingerTree v (Node v a)
m2

appendTree4 :: (Measured v a) => FingerTree v a -> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 :: forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v a
Empty a
a a
b a
c a
d FingerTree v a
xs =
        a
a forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` a
b forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` a
c forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` a
d forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
xs
appendTree4 FingerTree v a
xs a
a a
b a
c a
d FingerTree v a
Empty =
        FingerTree v a
xs forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
a forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
b forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
c forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
d
appendTree4 (Single a
x) a
a a
b a
c a
d FingerTree v a
xs =
        a
x forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` a
a forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` a
b forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` a
c forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` a
d forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
xs
appendTree4 FingerTree v a
xs a
a a
b a
c a
d (Single a
x) =
        FingerTree v a
xs forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
a forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
b forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
c forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
d forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
`rcons0` a
x
appendTree4 (Deep v
_ Digit a
pr1 FingerTree v (Node v a)
m1 Digit a
sf1) a
a a
b a
c a
d (Deep v
_ Digit a
pr2 FingerTree v (Node v a)
m2 Digit a
sf2) =
        forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr1 (forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> a
-> a
-> a
-> a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits4 FingerTree v (Node v a)
m1 Digit a
sf1 a
a a
b a
c a
d Digit a
pr2 FingerTree v (Node v a)
m2) Digit a
sf2

addDigits4 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> a -> a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)
addDigits4 :: forall v a.
Measured v a =>
FingerTree v (Node v a)
-> Digit a
-> a
-> a
-> a
-> a
-> Digit a
-> FingerTree v (Node v a)
-> FingerTree v (Node v a)
addDigits4 FingerTree v (Node v a)
m1 (One a
a) a
b a
c a
d a
e (One a
f) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree2 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (One a
a) a
b a
c a
d a
e (Two a
f a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (One a
a) a
b a
c a
d a
e (Three a
f a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (One a
a) a
b a
c a
d a
e (Four a
f a
g a
h a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d a
e a
f (One a
g) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> Node v a
node2 a
d a
e) (forall v a. Measured v a => a -> a -> Node v a
node2 a
f a
g) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d a
e a
f (Two a
g a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d a
e a
f (Three a
g a
h a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Two a
a a
b) a
c a
d a
e a
f (Four a
g a
h a
i a
j) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) (forall v a. Measured v a => a -> a -> Node v a
node2 a
i a
j) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e a
f a
g (One a
h) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e a
f a
g (Two a
h a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e a
f a
g (Three a
h a
i a
j) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) (forall v a. Measured v a => a -> a -> Node v a
node2 a
i a
j) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Three a
a a
b a
c) a
d a
e a
f a
g (Four a
h a
i a
j a
k) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) (forall v a. Measured v a => a -> a -> Node v a
node2 a
j a
k) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f a
g a
h (One a
i) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree3 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f a
g a
h (Two a
i a
j) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> Node v a
node2 a
g a
h) (forall v a. Measured v a => a -> a -> Node v a
node2 a
i a
j) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f a
g a
h (Three a
i a
j a
k) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) (forall v a. Measured v a => a -> a -> Node v a
node2 a
j a
k) FingerTree v (Node v a)
m2
addDigits4 FingerTree v (Node v a)
m1 (Four a
a a
b a
c a
d) a
e a
f a
g a
h (Four a
i a
j a
k a
l) FingerTree v (Node v a)
m2 =
        forall v a.
Measured v a =>
FingerTree v a
-> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
appendTree4 FingerTree v (Node v a)
m1 (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
a a
b a
c) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
d a
e a
f) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
g a
h a
i) (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
j a
k a
l) FingerTree v (Node v a)
m2


-- | /O(log(min(i,n-i)))/. Split a sequence at a point where the predicate
-- on the accumulated measure changes from 'False' to 'True'.
split ::  (Measured v a) =>
          (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split :: forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split v -> Bool
_p FingerTree v a
Empty  =  (forall v a. FingerTree v a
Empty, forall v a. FingerTree v a
Empty)
split v -> Bool
p FingerTree v a
xs
  | v -> Bool
p (forall v a. Measured v a => a -> v
measure FingerTree v a
xs) =  (FingerTree v a
l, a
x forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
`lcons` FingerTree v a
r)
  | Bool
otherwise   =  (FingerTree v a
xs, forall v a. FingerTree v a
Empty)
  where Split FingerTree v a
l a
x FingerTree v a
r = forall v a.
Measured v a =>
(v -> Bool) -> v -> FingerTree v a -> Split (FingerTree v a) a
splitTree v -> Bool
p forall a. Monoid a => a
mempty FingerTree v a
xs

takeUntil :: (Measured v a) => (v -> Bool) -> FingerTree v a -> FingerTree v a
takeUntil :: forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> FingerTree v a
takeUntil v -> Bool
p  =  forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split v -> Bool
p

dropUntil :: (Measured v a) => (v -> Bool) -> FingerTree v a -> FingerTree v a
dropUntil :: forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> FingerTree v a
dropUntil v -> Bool
p  =  forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
split v -> Bool
p

data Split t a = Split t a t

splitTree ::    (Measured v a) =>
                (v -> Bool) -> v -> FingerTree v a -> Split (FingerTree v a) a
splitTree :: forall v a.
Measured v a =>
(v -> Bool) -> v -> FingerTree v a -> Split (FingerTree v a) a
splitTree v -> Bool
_ v
_ FingerTree v a
Empty = forall a. HasCallStack => String -> a
error String
"FingerTree.splitTree: bug!"
splitTree v -> Bool
_p v
_i (Single a
x) = forall t a. t -> a -> t -> Split t a
Split forall v a. FingerTree v a
Empty a
x forall v a. FingerTree v a
Empty
splitTree v -> Bool
p v
i (Deep v
_ Digit a
pr FingerTree v (Node v a)
m Digit a
sf)
  | v -> Bool
p v
vpr       =  let  Split Maybe (Digit a)
l a
x Maybe (Digit a)
r     =  forall v a.
Measured v a =>
(v -> Bool) -> v -> Digit a -> Split (Maybe (Digit a)) a
splitDigit v -> Bool
p v
i Digit a
pr
                   in   forall t a. t -> a -> t -> Split t a
Split (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall v a. FingerTree v a
Empty forall v a. Measured v a => Digit a -> FingerTree v a
digitToTree Maybe (Digit a)
l) a
x (forall v a.
Measured v a =>
Maybe (Digit a)
-> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deepL Maybe (Digit a)
r FingerTree v (Node v a)
m Digit a
sf)
  | v -> Bool
p v
vm        =  let  Split FingerTree v (Node v a)
ml Node v a
xs FingerTree v (Node v a)
mr  =  forall v a.
Measured v a =>
(v -> Bool) -> v -> FingerTree v a -> Split (FingerTree v a) a
splitTree v -> Bool
p v
vpr FingerTree v (Node v a)
m
                        Split Maybe (Digit a)
l a
x Maybe (Digit a)
r     =  forall v a.
Measured v a =>
(v -> Bool) -> v -> Node v a -> Split (Maybe (Digit a)) a
splitNode v -> Bool
p (v
vpr forall v a. Measured v a => v -> FingerTree v a -> v
`mappendVal` FingerTree v (Node v a)
ml) Node v a
xs
                   in   forall t a. t -> a -> t -> Split t a
Split (forall v a.
Measured v a =>
Digit a
-> FingerTree v (Node v a) -> Maybe (Digit a) -> FingerTree v a
deepR Digit a
pr  FingerTree v (Node v a)
ml Maybe (Digit a)
l) a
x (forall v a.
Measured v a =>
Maybe (Digit a)
-> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deepL Maybe (Digit a)
r FingerTree v (Node v a)
mr Digit a
sf)
  | Bool
otherwise   =  let  Split Maybe (Digit a)
l a
x Maybe (Digit a)
r     =  forall v a.
Measured v a =>
(v -> Bool) -> v -> Digit a -> Split (Maybe (Digit a)) a
splitDigit v -> Bool
p v
vm Digit a
sf
                   in   forall t a. t -> a -> t -> Split t a
Split (forall v a.
Measured v a =>
Digit a
-> FingerTree v (Node v a) -> Maybe (Digit a) -> FingerTree v a
deepR Digit a
pr  FingerTree v (Node v a)
m  Maybe (Digit a)
l) a
x (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall v a. FingerTree v a
Empty forall v a. Measured v a => Digit a -> FingerTree v a
digitToTree Maybe (Digit a)
r)
  where vpr :: v
vpr     =  v
i    forall a. Monoid a => a -> a -> a
`mappend`  forall v a. Measured v a => a -> v
measure Digit a
pr
        vm :: v
vm      =  v
vpr  forall v a. Measured v a => v -> FingerTree v a -> v
`mappendVal` FingerTree v (Node v a)
m

mappendVal :: (Measured v a) => v -> FingerTree v a -> v
mappendVal :: forall v a. Measured v a => v -> FingerTree v a -> v
mappendVal v
v FingerTree v a
Empty = v
v
mappendVal v
v FingerTree v a
t = v
v forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure FingerTree v a
t

deepL          ::  (Measured v a) =>
        Maybe (Digit a) -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deepL :: forall v a.
Measured v a =>
Maybe (Digit a)
-> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deepL Maybe (Digit a)
Nothing FingerTree v (Node v a)
m Digit a
sf      =   case forall v a (m :: * -> *).
(Measured v a, MonadFail m) =>
FingerTree v a -> m (a, FingerTree v a)
lview FingerTree v (Node v a)
m of
        Maybe (Node v a, FingerTree v (Node v a))
Nothing     ->  forall v a. Measured v a => Digit a -> FingerTree v a
digitToTree Digit a
sf
        Just (Node v a
a,FingerTree v (Node v a)
m') ->  forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall v a. Node v a -> Digit a
nodeToDigit Node v a
a) FingerTree v (Node v a)
m' Digit a
sf
deepL (Just Digit a
pr) FingerTree v (Node v a)
m Digit a
sf    =   forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr FingerTree v (Node v a)
m Digit a
sf

deepR          ::  (Measured v a) =>
        Digit a -> FingerTree v (Node v a) -> Maybe (Digit a) -> FingerTree v a
deepR :: forall v a.
Measured v a =>
Digit a
-> FingerTree v (Node v a) -> Maybe (Digit a) -> FingerTree v a
deepR Digit a
pr FingerTree v (Node v a)
m Maybe (Digit a)
Nothing      =   case forall v a (m :: * -> *).
(Measured v a, MonadFail m) =>
FingerTree v a -> m (a, FingerTree v a)
rview FingerTree v (Node v a)
m of
        Maybe (Node v a, FingerTree v (Node v a))
Nothing     ->  forall v a. Measured v a => Digit a -> FingerTree v a
digitToTree Digit a
pr
        Just (Node v a
a,FingerTree v (Node v a)
m') ->  forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr FingerTree v (Node v a)
m' (forall v a. Node v a -> Digit a
nodeToDigit Node v a
a)
deepR Digit a
pr FingerTree v (Node v a)
m (Just Digit a
sf)    =   forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pr FingerTree v (Node v a)
m Digit a
sf

splitNode :: (Measured v a) => (v -> Bool) -> v -> Node v a ->
                Split (Maybe (Digit a)) a
splitNode :: forall v a.
Measured v a =>
(v -> Bool) -> v -> Node v a -> Split (Maybe (Digit a)) a
splitNode v -> Bool
p v
i (Node2 v
_ a
a a
b)
  | v -> Bool
p v
va        = forall t a. t -> a -> t -> Split t a
Split forall a. Maybe a
Nothing a
a (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
b))
  | Bool
otherwise   = forall t a. t -> a -> t -> Split t a
Split (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
a)) a
b forall a. Maybe a
Nothing
  where va :: v
va      = v
i forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
a
splitNode v -> Bool
p v
i (Node3 v
_ a
a a
b a
c)
  | v -> Bool
p v
va        = forall t a. t -> a -> t -> Split t a
Split forall a. Maybe a
Nothing a
a (forall a. a -> Maybe a
Just (forall a. a -> a -> Digit a
Two a
b a
c))
  | v -> Bool
p v
vab       = forall t a. t -> a -> t -> Split t a
Split (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
a)) a
b (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
c))
  | Bool
otherwise   = forall t a. t -> a -> t -> Split t a
Split (forall a. a -> Maybe a
Just (forall a. a -> a -> Digit a
Two a
a a
b)) a
c forall a. Maybe a
Nothing
  where va :: v
va      = v
i forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
a
        vab :: v
vab     = v
va forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
b

splitDigit :: (Measured v a) => (v -> Bool) -> v -> Digit a ->
                Split (Maybe (Digit a)) a
splitDigit :: forall v a.
Measured v a =>
(v -> Bool) -> v -> Digit a -> Split (Maybe (Digit a)) a
splitDigit v -> Bool
_ v
i (One a
a) = v
i seq :: forall a b. a -> b -> b
`seq` forall t a. t -> a -> t -> Split t a
Split forall a. Maybe a
Nothing a
a forall a. Maybe a
Nothing
splitDigit v -> Bool
p v
i (Two a
a a
b)
  | v -> Bool
p v
va        = forall t a. t -> a -> t -> Split t a
Split forall a. Maybe a
Nothing a
a (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
b))
  | Bool
otherwise   = forall t a. t -> a -> t -> Split t a
Split (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
a)) a
b forall a. Maybe a
Nothing
  where va :: v
va      = v
i forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
a
splitDigit v -> Bool
p v
i (Three a
a a
b a
c)
  | v -> Bool
p v
va        = forall t a. t -> a -> t -> Split t a
Split forall a. Maybe a
Nothing a
a (forall a. a -> Maybe a
Just (forall a. a -> a -> Digit a
Two a
b a
c))
  | v -> Bool
p v
vab       = forall t a. t -> a -> t -> Split t a
Split (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
a)) a
b (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
c))
  | Bool
otherwise   = forall t a. t -> a -> t -> Split t a
Split (forall a. a -> Maybe a
Just (forall a. a -> a -> Digit a
Two a
a a
b)) a
c forall a. Maybe a
Nothing
  where va :: v
va      = v
i forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
a
        vab :: v
vab     = v
va forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
b
splitDigit v -> Bool
p v
i (Four a
a a
b a
c a
d)
  | v -> Bool
p v
va        = forall t a. t -> a -> t -> Split t a
Split forall a. Maybe a
Nothing a
a (forall a. a -> Maybe a
Just (forall a. a -> a -> a -> Digit a
Three a
b a
c a
d))
  | v -> Bool
p v
vab       = forall t a. t -> a -> t -> Split t a
Split (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
a)) a
b (forall a. a -> Maybe a
Just (forall a. a -> a -> Digit a
Two a
c a
d))
  | v -> Bool
p v
vabc      = forall t a. t -> a -> t -> Split t a
Split (forall a. a -> Maybe a
Just (forall a. a -> a -> Digit a
Two a
a a
b)) a
c (forall a. a -> Maybe a
Just (forall a. a -> Digit a
One a
d))
  | Bool
otherwise   = forall t a. t -> a -> t -> Split t a
Split (forall a. a -> Maybe a
Just (forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)) a
d forall a. Maybe a
Nothing
  where va :: v
va      = v
i forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
a
        vab :: v
vab     = v
va forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
b
        vabc :: v
vabc    = v
vab forall a. Monoid a => a -> a -> a
`mappend` forall v a. Measured v a => a -> v
measure a
c


-- | /O(n)/. The reverse of a sequence.
reverse :: (Measured v a) => FingerTree v a -> FingerTree v a
reverse :: forall v a. Measured v a => FingerTree v a -> FingerTree v a
reverse = forall v2 a2 a1 v1.
Measured v2 a2 =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
reverseTree forall a. a -> a
id

reverseTree :: (Measured v2 a2) => (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
reverseTree :: forall v2 a2 a1 v1.
Measured v2 a2 =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
reverseTree a1 -> a2
_ FingerTree v1 a1
Empty = forall v a. FingerTree v a
Empty
reverseTree a1 -> a2
f (Single a1
x) = forall v a. a -> FingerTree v a
Single (a1 -> a2
f a1
x)
reverseTree a1 -> a2
f (Deep v1
_ Digit a1
pr FingerTree v1 (Node v1 a1)
m Digit a1
sf) =
        forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep (forall a b. (a -> b) -> Digit a -> Digit b
reverseDigit a1 -> a2
f Digit a1
sf) (forall v2 a2 a1 v1.
Measured v2 a2 =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
reverseTree (forall v2 a2 a1 v1.
Measured v2 a2 =>
(a1 -> a2) -> Node v1 a1 -> Node v2 a2
reverseNode a1 -> a2
f) FingerTree v1 (Node v1 a1)
m) (forall a b. (a -> b) -> Digit a -> Digit b
reverseDigit a1 -> a2
f Digit a1
pr)

reverseNode :: (Measured v2 a2) => (a1 -> a2) -> Node v1 a1 -> Node v2 a2
reverseNode :: forall v2 a2 a1 v1.
Measured v2 a2 =>
(a1 -> a2) -> Node v1 a1 -> Node v2 a2
reverseNode a1 -> a2
f (Node2 v1
_ a1
a a1
b) = forall v a. Measured v a => a -> a -> Node v a
node2 (a1 -> a2
f a1
b) (a1 -> a2
f a1
a)
reverseNode a1 -> a2
f (Node3 v1
_ a1
a a1
b a1
c) = forall v a. Measured v a => a -> a -> a -> Node v a
node3 (a1 -> a2
f a1
c) (a1 -> a2
f a1
b) (a1 -> a2
f a1
a)

reverseDigit :: (a -> b) -> Digit a -> Digit b
reverseDigit :: forall a b. (a -> b) -> Digit a -> Digit b
reverseDigit a -> b
f (One a
a) = forall a. a -> Digit a
One (a -> b
f a
a)
reverseDigit a -> b
f (Two a
a a
b) = forall a. a -> a -> Digit a
Two (a -> b
f a
b) (a -> b
f a
a)
reverseDigit a -> b
f (Three a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three (a -> b
f a
c) (a -> b
f a
b) (a -> b
f a
a)
reverseDigit a -> b
f (Four a
a a
b a
c a
d) = forall a. a -> a -> a -> a -> Digit a
Four (a -> b
f a
d) (a -> b
f a
c) (a -> b
f a
b) (a -> b
f a
a)

two :: Monad m => m a -> m (a, a)
two :: forall (m :: * -> *) a. Monad m => m a -> m (a, a)
two m a
m = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) m a
m m a
m

three :: Monad m => m a -> m (a, a, a)
three :: forall (m :: * -> *) a. Monad m => m a -> m (a, a, a)
three m a
m = forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) m a
m m a
m m a
m

four :: Monad m => m a -> m (a, a, a, a)
four :: forall (m :: * -> *) a. Monad m => m a -> m (a, a, a, a)
four m a
m = forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 (,,,) m a
m m a
m m a
m m a
m

instance (Arbitrary a) => Arbitrary (Digit a) where
  arbitrary :: Gen (Digit a)
arbitrary = forall a. [Gen a] -> Gen a
oneof
              [ forall a. Arbitrary a => Gen a
arbitrary       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x         -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Digit a
One a
x)
              , forall (m :: * -> *) a. Monad m => m a -> m (a, a)
two forall a. Arbitrary a => Gen a
arbitrary   forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x,a
y)     -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> a -> Digit a
Two a
x a
y)
              , forall (m :: * -> *) a. Monad m => m a -> m (a, a, a)
three forall a. Arbitrary a => Gen a
arbitrary forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x,a
y,a
z)   -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> a -> a -> Digit a
Three a
x a
y a
z)
              , forall (m :: * -> *) a. Monad m => m a -> m (a, a, a, a)
four forall a. Arbitrary a => Gen a
arbitrary  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x,a
y,a
z,a
w) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> a -> a -> a -> Digit a
Four a
x a
y a
z a
w)
              ]


instance (CoArbitrary a) => CoArbitrary (Digit a) where
  coarbitrary :: forall b. Digit a -> Gen b -> Gen b
coarbitrary Digit a
p = case Digit a
p of
      One a
x        -> forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
x
      Two a
x a
y      -> forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
y
      Three a
x a
y a
z  -> forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
y
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
z
      Four a
x a
y a
z a
w -> forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
y
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
w


instance (Measured v a, Arbitrary a) => Arbitrary (Node v a) where
  arbitrary :: Gen (Node v a)
arbitrary = forall a. [Gen a] -> Gen a
oneof
              [ forall (m :: * -> *) a. Monad m => m a -> m (a, a)
two forall a. Arbitrary a => Gen a
arbitrary   forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x,a
y)     -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall v a. Measured v a => a -> a -> Node v a
node2 a
x a
y)
              , forall (m :: * -> *) a. Monad m => m a -> m (a, a, a)
three forall a. Arbitrary a => Gen a
arbitrary forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x,a
y,a
z)   -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall v a. Measured v a => a -> a -> a -> Node v a
node3 a
x a
y a
z)
              ]

instance (Measured v a, CoArbitrary a) => CoArbitrary (Node v a) where
  coarbitrary :: forall b. Node v a -> Gen b -> Gen b
coarbitrary Node v a
p = case Node v a
p of
       Node2 v
_ a
x a
y   -> forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
y
       Node3 v
_ a
x a
y a
z -> forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
z


instance (Measured v a, Arbitrary a) => Arbitrary (FingerTree v a) where
  arbitrary :: Gen (FingerTree v a)
arbitrary = forall a. [Gen a] -> Gen a
oneof
               [ forall (m :: * -> *) a. Monad m => a -> m a
return forall v a. FingerTree v a
Empty
               , forall a. Arbitrary a => Gen a
arbitrary forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. a -> FingerTree v a
Single
               , do
                   Digit a
pf <- forall a. Arbitrary a => Gen a
arbitrary
                   FingerTree v (Node v a)
m  <- forall a. Arbitrary a => Gen a
arbitrary
                   Digit a
sf <- forall a. Arbitrary a => Gen a
arbitrary
                   forall (m :: * -> *) a. Monad m => a -> m a
return (forall v a.
Measured v a =>
Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
deep Digit a
pf FingerTree v (Node v a)
m Digit a
sf)
               ]

instance (Measured v a, CoArbitrary a) => CoArbitrary (FingerTree v a) where
  coarbitrary :: forall b. FingerTree v a -> Gen b -> Gen b
coarbitrary FingerTree v a
p = case FingerTree v a
p of
         FingerTree v a
Empty          -> forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
0
         Single a
x       -> forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
x
         Deep v
_ Digit a
sf FingerTree v (Node v a)
m Digit a
pf -> forall n a. Integral n => n -> Gen a -> Gen a
variant Integer
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Digit a
sf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary FingerTree v (Node v a)
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Digit a
pf