diff --git a/HaskellWorks/Data/FingerTree.hs b/HaskellWorks/Data/FingerTree.hs
deleted file mode 100644
--- a/HaskellWorks/Data/FingerTree.hs
+++ /dev/null
@@ -1,870 +0,0 @@
-{-# LANGUAGE CPP                    #-}
-{-# LANGUAGE DeriveAnyClass         #-}
-{-# LANGUAGE DeriveGeneric          #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE UndecidableInstances   #-}
-#if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Safe                   #-}
-#endif
-#if __GLASGOW_HASKELL__ >= 710
-{-# LANGUAGE AutoDeriveTypeable     #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  Data.FingerTree
--- Copyright   :  (c) Ross Paterson, Ralf Hinze 2006
--- License     :  BSD-style
--- Maintainer  :  R.Paterson@city.ac.uk
--- Stability   :  experimental
--- 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://staff.city.ac.uk/~ross/papers/FingerTree.html>
---
--- For a directly usable sequence type, see @Data.Sequence@, which is
--- a specialization of this 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.
---
--- /Note/: Many of these operations have the same names as similar
--- operations on lists in the "Prelude".  The ambiguity may be resolved
--- using either qualification or the @hiding@ clause.
---
------------------------------------------------------------------------------
-
-module HaskellWorks.Data.FingerTree (
-#if TESTING
-    FingerTree(..), Digit(..), Node(..), deep, node2, node3,
-#else
-    FingerTree,
-#endif
-    Measured(..),
-    -- * Construction
-    empty, singleton,
-    (<|), (|>), (><),
-    fromList,
-    -- * Deconstruction
-    null,
-    ViewL(..), ViewR(..), viewl, viewr,
-    split, takeUntil, dropUntil,
-    -- * Transformation
-    reverse,
-    fmap', fmapWithPos, unsafeFmap,
-    traverse', traverseWithPos, unsafeTraverse
-    -- * Example
-    -- $example
-    ) where
-
-import           Prelude             hiding (null, reverse)
-
-import           Control.Applicative (Applicative (pure, (<*>)), (<$>))
-import           Control.DeepSeq
-import           Data.Foldable       (Foldable (foldMap), toList)
-import           Data.Monoid
-import           GHC.Generics        (Generic)
-
-infixr 5 ><
-infixr 5 <|, :<
-infixl 5 |>, :>
-
--- | View of the left end of a sequence.
-data ViewL s a
-    = EmptyL        -- ^ empty sequence
-    | a :< s a      -- ^ leftmost element and the rest of the sequence
-    deriving (Eq, Ord, Show, Read, Generic, NFData)
-
--- | View of the right end of a sequence.
-data ViewR s a
-    = EmptyR        -- ^ empty sequence
-    | s a :> a      -- ^ the sequence minus the rightmost element,
-                    -- and the rightmost element
-    deriving (Eq, Ord, Show, Read, Generic, NFData)
-
-instance Functor s => Functor (ViewL s) where
-    fmap _ EmptyL    = EmptyL
-    fmap f (x :< xs) = f x :< fmap f xs
-
-instance Functor s => Functor (ViewR s) where
-    fmap _ EmptyR    = EmptyR
-    fmap f (xs :> x) = fmap f xs :> f x
-
--- | 'empty' and '><'.
-instance Measured v a => Monoid (FingerTree v a) where
-    mempty = empty
-    mappend = (><)
-
--- Explicit Digit type (Exercise 1)
-
-data Digit a
-    = One a
-    | Two a a
-    | Three a a a
-    | Four a a a a
-    deriving (Show, Generic, NFData)
-
-instance Foldable Digit where
-    foldMap f (One a)        = f a
-    foldMap f (Two a b)      = f a `mappend` f b
-    foldMap f (Three a b c)  = f a `mappend` f b `mappend` f c
-    foldMap f (Four a b c d) = f a `mappend` f b `mappend` f c `mappend` f d
-
--------------------
--- 4.1 Measurements
--------------------
-
--- | Things that can be measured.
-class (Monoid v) => Measured v a | a -> v where
-    measure :: a -> v
-
-instance (Measured v a) => Measured v (Digit a) where
-    measure = foldMap measure
-
----------------------------
--- 4.2 Caching measurements
----------------------------
-
-data Node v a = Node2 !v a a | Node3 !v a a a
-    deriving (Show, Generic, NFData)
-
-instance Foldable (Node v) where
-    foldMap f (Node2 _ a b)   = f a `mappend` f b
-    foldMap f (Node3 _ a b c) = f a `mappend` f b `mappend` f c
-
-node2        ::  (Measured v a) => a -> a -> Node v a
-node2 a b    =   Node2 (measure a `mappend` measure b) a b
-
-node3        ::  (Measured v a) => a -> a -> a -> Node v a
-node3 a b c  =   Node3 (measure a `mappend` measure b `mappend` measure c) a b c
-
-instance (Monoid v) => Measured v (Node v a) where
-    measure (Node2 v _ _)   =  v
-    measure (Node3 v _ _ _) =  v
-
-nodeToDigit :: Node v a -> Digit a
-nodeToDigit (Node2 _ a b)   = Two a b
-nodeToDigit (Node3 _ a b c) = Three a b c
-
--- | A representation of a sequence of values of type @a@, allowing
--- access to the ends in constant time, and append and split in time
--- logarithmic in the size of the smaller piece.
---
--- The collection is also parameterized by a measure type @v@, which
--- is used to specify a position in the sequence for the 'split' operation.
--- The types of the operations enforce the constraint @'Measured' v a@,
--- which also implies that the type @v@ is determined by @a@.
---
--- A variety of abstract data types can be implemented by using different
--- element types and measurements.
-data FingerTree v a
-    = Empty
-    | Single a
-    | Deep !v !(Digit a) (FingerTree v (Node v a)) !(Digit a)
-    deriving (
-#if TESTING
-    Show,
-#endif
-    Generic, NFData)
-
-deep ::  (Measured v a) =>
-     Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
-deep pr m sf = Deep ((measure pr `mappendVal` m) `mappend` measure sf) pr m sf
-
--- | /O(1)/. The cached measure of a tree.
-instance (Measured v a) => Measured v (FingerTree v a) where
-    measure Empty          =  mempty
-    measure (Single x)     =  measure x
-    measure (Deep v _ _ _) =  v
-
-instance Foldable (FingerTree v) where
-    foldMap _ Empty = mempty
-    foldMap f (Single x) = f x
-    foldMap f (Deep _ pr m sf) =
-        foldMap f pr `mappend` foldMap (foldMap f) m `mappend` foldMap f sf
-
-instance Eq a => Eq (FingerTree v a) where
-    xs == ys = toList xs == toList ys
-
-instance Ord a => Ord (FingerTree v a) where
-    compare xs ys = compare (toList xs) (toList ys)
-
-#if !TESTING
-instance Show a => Show (FingerTree v a) where
-    showsPrec p xs = showParen (p > 10) $
-        showString "fromList " . shows (toList xs)
-#endif
-
--- | Like 'fmap', but with a more constrained type.
-fmap' :: (Measured v1 a1, Measured v2 a2) =>
-    (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
-fmap' = mapTree
-
-mapTree :: (Measured v2 a2) =>
-    (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
-mapTree _ Empty = Empty
-mapTree f (Single x) = Single (f x)
-mapTree f (Deep _ pr m sf) =
-    deep (mapDigit f pr) (mapTree (mapNode f) m) (mapDigit f sf)
-
-mapNode :: (Measured v2 a2) =>
-    (a1 -> a2) -> Node v1 a1 -> Node v2 a2
-mapNode f (Node2 _ a b)   = node2 (f a) (f b)
-mapNode f (Node3 _ a b c) = node3 (f a) (f b) (f c)
-
-mapDigit :: (a -> b) -> Digit a -> Digit b
-mapDigit f (One a)        = One (f a)
-mapDigit f (Two a b)      = Two (f a) (f b)
-mapDigit f (Three a b c)  = Three (f a) (f b) (f c)
-mapDigit f (Four a b c d) = Four (f a) (f b) (f c) (f d)
-
--- | Map all elements of the tree with a function that also takes the
--- measure of the prefix of the tree to the left of the element.
-fmapWithPos :: (Measured v1 a1, Measured v2 a2) =>
-    (v1 -> a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
-fmapWithPos f = mapWPTree f mempty
-
-mapWPTree :: (Measured v1 a1, Measured v2 a2) =>
-    (v1 -> a1 -> a2) -> v1 -> FingerTree v1 a1 -> FingerTree v2 a2
-mapWPTree _ _ Empty = Empty
-mapWPTree f v (Single x) = Single (f v x)
-mapWPTree f v (Deep _ pr m sf) =
-    deep (mapWPDigit f v pr)
-         (mapWPTree (mapWPNode f) vpr m)
-         (mapWPDigit f vm sf)
-  where
-    vpr     =  v    `mappend`  measure pr
-    vm      =  vpr  `mappendVal` m
-
-mapWPNode :: (Measured v1 a1, Measured v2 a2) =>
-    (v1 -> a1 -> a2) -> v1 -> Node v1 a1 -> Node v2 a2
-mapWPNode f v (Node2 _ a b) = node2 (f v a) (f va b)
-  where
-    va      = v `mappend` measure a
-mapWPNode f v (Node3 _ a b c) = node3 (f v a) (f va b) (f vab c)
-  where
-    va      = v `mappend` measure a
-    vab     = va `mappend` measure b
-
-mapWPDigit :: (Measured v a) => (v -> a -> b) -> v -> Digit a -> Digit b
-mapWPDigit f v (One a) = One (f v a)
-mapWPDigit f v (Two a b) = Two (f v a) (f va b)
-  where
-    va      = v `mappend` measure a
-mapWPDigit f v (Three a b c) = Three (f v a) (f va b) (f vab c)
-  where
-    va      = v `mappend` measure a
-    vab     = va `mappend` measure b
-mapWPDigit f v (Four a b c d) = Four (f v a) (f va b) (f vab c) (f vabc d)
-  where
-    va      = v `mappend` measure a
-    vab     = va `mappend` measure b
-    vabc    = vab `mappend` measure c
-
--- | Like 'fmap', but safe only if the function preserves the measure.
-unsafeFmap :: (a -> b) -> FingerTree v a -> FingerTree v b
-unsafeFmap _ Empty = Empty
-unsafeFmap f (Single x) = Single (f x)
-unsafeFmap f (Deep v pr m sf) =
-    Deep v (mapDigit f pr) (unsafeFmap (unsafeFmapNode f) m) (mapDigit f sf)
-
-unsafeFmapNode :: (a -> b) -> Node v a -> Node v b
-unsafeFmapNode f (Node2 v a b)   = Node2 v (f a) (f b)
-unsafeFmapNode f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
-
--- | 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
-
--- | Traverse the tree with a function that also takes the
--- measure of the prefix of the tree to the left of the element.
-traverseWithPos :: (Measured v1 a1, Measured v2 a2, Applicative f) =>
-    (v1 -> a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
-traverseWithPos f = traverseWPTree f mempty
-
-traverseWPTree :: (Measured v1 a1, Measured v2 a2, Applicative f) =>
-    (v1 -> a1 -> f a2) -> v1 -> FingerTree v1 a1 -> f (FingerTree v2 a2)
-traverseWPTree _ _ Empty = pure Empty
-traverseWPTree f v (Single x) = Single <$> f v x
-traverseWPTree f v (Deep _ pr m sf) =
-    deep <$> traverseWPDigit f v pr <*> traverseWPTree (traverseWPNode f) vpr m <*> traverseWPDigit f vm sf
-  where
-    vpr     =  v    `mappend`  measure pr
-    vm      =  vpr  `mappendVal` m
-
-traverseWPNode :: (Measured v1 a1, Measured v2 a2, Applicative f) =>
-    (v1 -> a1 -> f a2) -> v1 -> Node v1 a1 -> f (Node v2 a2)
-traverseWPNode f v (Node2 _ a b) = node2 <$> f v a <*> f va b
-  where
-    va      = v `mappend` measure a
-traverseWPNode f v (Node3 _ a b c) = node3 <$> f v a <*> f va b <*> f vab c
-  where
-    va      = v `mappend` measure a
-    vab     = va `mappend` measure b
-
-traverseWPDigit :: (Measured v a, Applicative f) =>
-    (v -> a -> f b) -> v -> Digit a -> f (Digit b)
-traverseWPDigit f v (One a) = One <$> f v a
-traverseWPDigit f v (Two a b) = Two <$> f v a <*> f va b
-  where
-    va      = v `mappend` measure a
-traverseWPDigit f v (Three a b c) = Three <$> f v a <*> f va b <*> f vab c
-  where
-    va      = v `mappend` measure a
-    vab     = va `mappend` measure b
-traverseWPDigit f v (Four a b c d) = Four <$> f v a <*> f va b <*> f vab c <*> f vabc d
-  where
-    va      = v `mappend` measure a
-    vab     = va `mappend` measure b
-    vabc    = vab `mappend` measure c
-
--- | Like 'traverse', but safe only if the function preserves the measure.
-unsafeTraverse :: (Applicative f) =>
-    (a -> f b) -> FingerTree v a -> f (FingerTree v b)
-unsafeTraverse _ Empty = pure Empty
-unsafeTraverse f (Single x) = Single <$> f x
-unsafeTraverse f (Deep v pr m sf) =
-    Deep v <$> traverseDigit f pr <*> unsafeTraverse (unsafeTraverseNode f) m <*> traverseDigit f sf
-
-unsafeTraverseNode :: (Applicative f) =>
-    (a -> f b) -> Node v a -> f (Node v b)
-unsafeTraverseNode f (Node2 v a b)   = Node2 v <$> f a <*> f b
-unsafeTraverseNode f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
-
------------------------------------------------------
--- 4.3 Construction, deconstruction and concatenation
------------------------------------------------------
-
--- | /O(1)/. The empty sequence.
-empty :: Measured v a => FingerTree v a
-empty = Empty
-
--- | /O(1)/. A singleton sequence.
-singleton :: Measured v a => a -> FingerTree v a
-singleton = Single
-
--- | /O(n)/. Create a sequence from a finite list of elements.
-fromList :: (Measured v a) => [a] -> FingerTree v a
-fromList = foldr (<|) Empty
-
--- | /O(1)/. Add an element to the left end of a sequence.
--- Mnemonic: a triangle with the single element at the pointy end.
-(<|) :: (Measured v a) => a -> FingerTree v a -> FingerTree v a
-a <| Empty              =  Single a
-a <| Single b           =  deep (One a) Empty (One b)
-a <| Deep v (Four b c d e) m sf = m `seq`
-    Deep (measure a `mappend` v) (Two a b) (node3 c d e <| m) sf
-a <| Deep v pr m sf     =
-    Deep (measure a `mappend` v) (consDigit a pr) m sf
-
-consDigit :: a -> Digit a -> Digit a
-consDigit a (One b)        = Two a b
-consDigit a (Two b c)      = Three a b c
-consDigit a (Three b c d)  = Four a b c d
-consDigit _ (Four _ _ _ _) = illegal_argument "consDigit"
-
--- | /O(1)/. Add an element to the right end of a sequence.
--- Mnemonic: a triangle with the single element at the pointy end.
-(|>) :: (Measured v a) => FingerTree v a -> a -> FingerTree v a
-Empty |> a              =  Single a
-Single a |> b           =  deep (One a) Empty (One b)
-Deep v pr m (Four a b c d) |> e = m `seq`
-    Deep (v `mappend` measure e) pr (m |> node3 a b c) (Two d e)
-Deep v pr m sf |> x     =
-    Deep (v `mappend` measure x) pr m (snocDigit sf x)
-
-snocDigit :: Digit a -> a -> Digit a
-snocDigit (One a) b        = Two a b
-snocDigit (Two a b) c      = Three a b c
-snocDigit (Three a b c) d  = Four a b c d
-snocDigit (Four _ _ _ _) _ = illegal_argument "snocDigit"
-
--- | /O(1)/. Is this the empty sequence?
-null :: (Measured v a) => FingerTree v a -> Bool
-null Empty = True
-null _     = False
-
--- | /O(1)/. Analyse the left end of a sequence.
-viewl :: (Measured v a) => FingerTree v a -> ViewL (FingerTree v) a
-viewl Empty                 =  EmptyL
-viewl (Single x)            =  x :< Empty
-viewl (Deep _ (One x) m sf) =  x :< rotL m sf
-viewl (Deep _ pr m sf)      =  lheadDigit pr :< deep (ltailDigit pr) m sf
-
-rotL :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> FingerTree v a
-rotL m sf      =   case viewl m of
-    EmptyL  ->  digitToTree sf
-    a :< m' ->  Deep (measure m `mappend` measure sf) (nodeToDigit a) m' sf
-
-lheadDigit :: Digit a -> a
-lheadDigit (One a)        = a
-lheadDigit (Two a _)      = a
-lheadDigit (Three a _ _)  = a
-lheadDigit (Four a _ _ _) = a
-
-ltailDigit :: Digit a -> Digit a
-ltailDigit (One _)        = illegal_argument "ltailDigit"
-ltailDigit (Two _ b)      = One b
-ltailDigit (Three _ b c)  = Two b c
-ltailDigit (Four _ b c d) = Three b c d
-
--- | /O(1)/. Analyse the right end of a sequence.
-viewr :: (Measured v a) => FingerTree v a -> ViewR (FingerTree v) a
-viewr Empty                 =  EmptyR
-viewr (Single x)            =  Empty :> x
-viewr (Deep _ pr m (One x)) =  rotR pr m :> x
-viewr (Deep _ pr m sf)      =  deep pr m (rtailDigit sf) :> rheadDigit sf
-
-rotR :: (Measured v a) => Digit a -> FingerTree v (Node v a) -> FingerTree v a
-rotR pr m = case viewr m of
-    EmptyR  ->  digitToTree pr
-    m' :> a ->  Deep (measure pr `mappendVal` m) pr m' (nodeToDigit a)
-
-rheadDigit :: Digit a -> a
-rheadDigit (One a)        = a
-rheadDigit (Two _ b)      = b
-rheadDigit (Three _ _ c)  = c
-rheadDigit (Four _ _ _ d) = d
-
-rtailDigit :: Digit a -> Digit a
-rtailDigit (One _)        = illegal_argument "rtailDigit"
-rtailDigit (Two a _)      = One a
-rtailDigit (Three a b _)  = Two a b
-rtailDigit (Four a b c _) = Three a b c
-
-digitToTree :: (Measured v a) => Digit a -> FingerTree v a
-digitToTree (One a)        = Single a
-digitToTree (Two a b)      = deep (One a) Empty (One b)
-digitToTree (Three a b c)  = deep (Two a b) Empty (One c)
-digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
-
-----------------
--- Concatenation
-----------------
-
--- | /O(log(min(n1,n2)))/. Concatenate two sequences.
-(><) :: (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 Empty xs =
-    xs
-appendTree0 xs Empty =
-    xs
-appendTree0 (Single x) xs =
-    x <| xs
-appendTree0 xs (Single x) =
-    xs |> x
-appendTree0 (Deep _ pr1 m1 sf1) (Deep _ pr2 m2 sf2) =
-    deep pr1 (addDigits0 m1 sf1 pr2 m2) 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 m1 (One a) (One b) m2 =
-    appendTree1 m1 (node2 a b) m2
-addDigits0 m1 (One a) (Two b c) m2 =
-    appendTree1 m1 (node3 a b c) m2
-addDigits0 m1 (One a) (Three b c d) m2 =
-    appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits0 m1 (One a) (Four b c d e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits0 m1 (Two a b) (One c) m2 =
-    appendTree1 m1 (node3 a b c) m2
-addDigits0 m1 (Two a b) (Two c d) m2 =
-    appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits0 m1 (Two a b) (Three c d e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits0 m1 (Two a b) (Four c d e f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits0 m1 (Three a b c) (One d) m2 =
-    appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits0 m1 (Three a b c) (Two d e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits0 m1 (Three a b c) (Three d e f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits0 m1 (Three a b c) (Four d e f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits0 m1 (Four a b c d) (One e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits0 m1 (Four a b c d) (Two e f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits0 m1 (Four a b c d) (Three e f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-
-appendTree1 :: (Measured v a) => FingerTree v a -> a -> FingerTree v a -> FingerTree v a
-appendTree1 Empty a xs =
-    a <| xs
-appendTree1 xs a Empty =
-    xs |> a
-appendTree1 (Single x) a xs =
-    x <| a <| xs
-appendTree1 xs a (Single x) =
-    xs |> a |> x
-appendTree1 (Deep _ pr1 m1 sf1) a (Deep _ pr2 m2 sf2) =
-    deep pr1 (addDigits1 m1 sf1 a pr2 m2) 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 m1 (One a) b (One c) m2 =
-    appendTree1 m1 (node3 a b c) m2
-addDigits1 m1 (One a) b (Two c d) m2 =
-    appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits1 m1 (One a) b (Three c d e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits1 m1 (One a) b (Four c d e f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits1 m1 (Two a b) c (One d) m2 =
-    appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits1 m1 (Two a b) c (Two d e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits1 m1 (Two a b) c (Three d e f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits1 m1 (Two a b) c (Four d e f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits1 m1 (Three a b c) d (One e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits1 m1 (Three a b c) d (Two e f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits1 m1 (Three a b c) d (Three e f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits1 m1 (Four a b c d) e (One f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits1 m1 (Four a b c d) e (Two f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-
-appendTree2 :: (Measured v a) => FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
-appendTree2 Empty a b xs =
-    a <| b <| xs
-appendTree2 xs a b Empty =
-    xs |> a |> b
-appendTree2 (Single x) a b xs =
-    x <| a <| b <| xs
-appendTree2 xs a b (Single x) =
-    xs |> a |> b |> x
-appendTree2 (Deep _ pr1 m1 sf1) a b (Deep _ pr2 m2 sf2) =
-    deep pr1 (addDigits2 m1 sf1 a b pr2 m2) 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 m1 (One a) b c (One d) m2 =
-    appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits2 m1 (One a) b c (Two d e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits2 m1 (One a) b c (Three d e f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits2 m1 (One a) b c (Four d e f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits2 m1 (Two a b) c d (One e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits2 m1 (Two a b) c d (Two e f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits2 m1 (Two a b) c d (Three e f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits2 m1 (Three a b c) d e (One f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits2 m1 (Three a b c) d e (Two f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits2 m1 (Four a b c d) e f (One g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-
-appendTree3 :: (Measured v a) => FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
-appendTree3 Empty a b c xs =
-    a <| b <| c <| xs
-appendTree3 xs a b c Empty =
-    xs |> a |> b |> c
-appendTree3 (Single x) a b c xs =
-    x <| a <| b <| c <| xs
-appendTree3 xs a b c (Single x) =
-    xs |> a |> b |> c |> x
-appendTree3 (Deep _ pr1 m1 sf1) a b c (Deep _ pr2 m2 sf2) =
-    deep pr1 (addDigits3 m1 sf1 a b c pr2 m2) 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 m1 (One a) b c d (One e) m2 =
-    appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits3 m1 (One a) b c d (Two e f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits3 m1 (One a) b c d (Three e f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits3 m1 (One a) b c d (Four e f g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits3 m1 (Two a b) c d e (One f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits3 m1 (Two a b) c d e (Two f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits3 m1 (Three a b c) d e f (One g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits3 m1 (Four a b c d) e f g (One h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
-
-appendTree4 :: (Measured v a) => FingerTree v a -> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
-appendTree4 Empty a b c d xs =
-    a <| b <| c <| d <| xs
-appendTree4 xs a b c d Empty =
-    xs |> a |> b |> c |> d
-appendTree4 (Single x) a b c d xs =
-    x <| a <| b <| c <| d <| xs
-appendTree4 xs a b c d (Single x) =
-    xs |> a |> b |> c |> d |> x
-appendTree4 (Deep _ pr1 m1 sf1) a b c d (Deep _ pr2 m2 sf2) =
-    deep pr1 (addDigits4 m1 sf1 a b c d pr2 m2) 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 m1 (One a) b c d e (One f) m2 =
-    appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits4 m1 (One a) b c d e (Two f g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits4 m1 (One a) b c d e (Three f g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Two a b) c d e f (One g) m2 =
-    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits4 m1 (Three a b c) d e f g (One h) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
-addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
-    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
-addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
-    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
-
-----------------
--- 4.4 Splitting
-----------------
-
--- | /O(log(min(i,n-i)))/. Split a sequence at a point where the predicate
--- on the accumulated measure changes from 'False' to 'True'.
---
--- For predictable results, one should ensure that there is only one such
--- point, i.e. that the predicate is /monotonic/.
-split ::  (Measured v a) =>
-      (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
-split _ Empty  =  (Empty, Empty)
-split p xs
-  | p (measure xs) =  (l, x <| r)
-  | otherwise   =  (xs, Empty)
-  where
-    Split l x r = splitTree p mempty xs
-
--- | /O(log(min(i,n-i)))/.
--- Given a monotonic predicate @p@, @'takeUntil' p t@ is the largest
--- prefix of @t@ whose measure does not satisfy @p@.
---
--- *  @'takeUntil' p t = 'fst' ('split' p t)@
-takeUntil :: (Measured v a) => (v -> Bool) -> FingerTree v a -> FingerTree v a
-takeUntil p  =  fst . split p
-
--- | /O(log(min(i,n-i)))/.
--- Given a monotonic predicate @p@, @'dropUntil' p t@ is the rest of @t@
--- after removing the largest prefix whose measure does not satisfy @p@.
---
--- * @'dropUntil' p t = 'snd' ('split' p t)@
-dropUntil :: (Measured v a) => (v -> Bool) -> FingerTree v a -> FingerTree v a
-dropUntil p  =  snd . split 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 _ _ Empty = illegal_argument "splitTree"
-splitTree _ _ (Single x) = Split Empty x Empty
-splitTree p i (Deep _ pr m sf)
-  | p vpr       =  let  Split l x r     =  splitDigit p i pr
-                   in   Split (maybe Empty digitToTree l) x (deepL r m sf)
-  | p vm        =  let  Split ml xs mr  =  splitTree p vpr m
-                        Split l x r     =  splitNode p (vpr `mappendVal` ml) xs
-                   in   Split (deepR pr  ml l) x (deepL r mr sf)
-  | otherwise   =  let  Split l x r     =  splitDigit p vm sf
-                   in   Split (deepR pr  m  l) x (maybe Empty digitToTree r)
-  where
-    vpr     =  i    `mappend`  measure pr
-    vm      =  vpr  `mappendVal` m
-
--- Avoid relying on right identity (cf Exercise 7)
-mappendVal :: (Measured v a) => v -> FingerTree v a -> v
-mappendVal v Empty = v
-mappendVal v t     = v `mappend` measure t
-
-deepL :: (Measured v a) =>
-    Maybe (Digit a) -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
-deepL Nothing m sf   =   rotL m sf
-deepL (Just pr) m sf =   deep pr m sf
-
-deepR :: (Measured v a) =>
-    Digit a -> FingerTree v (Node v a) -> Maybe (Digit a) -> FingerTree v a
-deepR pr m Nothing   =   rotR pr m
-deepR pr m (Just sf) =   deep pr m sf
-
-splitNode :: (Measured v a) => (v -> Bool) -> v -> Node v a ->
-    Split (Maybe (Digit a)) a
-splitNode p i (Node2 _ a b)
-  | p va        = Split Nothing a (Just (One b))
-  | otherwise   = Split (Just (One a)) b Nothing
-  where
-    va      = i `mappend` measure a
-splitNode p i (Node3 _ a b c)
-  | p va        = Split Nothing a (Just (Two b c))
-  | p vab       = Split (Just (One a)) b (Just (One c))
-  | otherwise   = Split (Just (Two a b)) c Nothing
-  where
-    va      = i `mappend` measure a
-    vab     = va `mappend` measure b
-
-splitDigit :: (Measured v a) => (v -> Bool) -> v -> Digit a ->
-    Split (Maybe (Digit a)) a
-splitDigit _ i (One a) = i `seq` Split Nothing a Nothing
-splitDigit p i (Two a b)
-  | p va        = Split Nothing a (Just (One b))
-  | otherwise   = Split (Just (One a)) b Nothing
-  where
-    va      = i `mappend` measure a
-splitDigit p i (Three a b c)
-  | p va        = Split Nothing a (Just (Two b c))
-  | p vab       = Split (Just (One a)) b (Just (One c))
-  | otherwise   = Split (Just (Two a b)) c Nothing
-  where
-    va      = i `mappend` measure a
-    vab     = va `mappend` measure b
-splitDigit p i (Four a b c d)
-  | p va        = Split Nothing a (Just (Three b c d))
-  | p vab       = Split (Just (One a)) b (Just (Two c d))
-  | p vabc      = Split (Just (Two a b)) c (Just (One d))
-  | otherwise   = Split (Just (Three a b c)) d Nothing
-  where
-    va      = i `mappend` measure a
-    vab     = va `mappend` measure b
-    vabc    = vab `mappend` measure c
-
-------------------
--- Transformations
-------------------
-
--- | /O(n)/. The reverse of a sequence.
-reverse :: (Measured v a) => FingerTree v a -> FingerTree v a
-reverse = reverseTree id
-
-reverseTree :: (Measured v2 a2) => (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
-reverseTree _ Empty = Empty
-reverseTree f (Single x) = Single (f x)
-reverseTree f (Deep _ pr m sf) =
-    deep (reverseDigit f sf) (reverseTree (reverseNode f) m) (reverseDigit f pr)
-
-reverseNode :: (Measured v2 a2) => (a1 -> a2) -> Node v1 a1 -> Node v2 a2
-reverseNode f (Node2 _ a b)   = node2 (f b) (f a)
-reverseNode f (Node3 _ a b c) = node3 (f c) (f b) (f a)
-
-reverseDigit :: (a -> b) -> Digit a -> Digit b
-reverseDigit f (One a)        = One (f a)
-reverseDigit f (Two a b)      = Two (f b) (f a)
-reverseDigit f (Three a b c)  = Three (f c) (f b) (f a)
-reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
-
-illegal_argument :: String -> a
-illegal_argument name =
-    error $ "Logic error: " ++ name ++ " called with illegal argument"
-
-{- $example
-
-Particular abstract data types may be implemented by defining
-element types with suitable 'Measured' instances.
-
-(from section 4.5 of the paper)
-Simple sequences can be implemented using a 'Sum' monoid as a measure:
-
-> newtype Elem a = Elem { getElem :: a }
->
-> instance Measured (Sum Int) (Elem a) where
->     measure (Elem _) = Sum 1
->
-> newtype Seq a = Seq (FingerTree (Sum Int) (Elem a))
-
-Then the measure of a subsequence is simply its length.
-This representation supports log-time extraction of subsequences:
-
-> take :: Int -> Seq a -> Seq a
-> take k (Seq xs) = Seq (takeUntil (> Sum k) xs)
->
-> drop :: Int -> Seq a -> Seq a
-> drop k (Seq xs) = Seq (dropUntil (> Sum k) xs)
-
-The module @Data.Sequence@ is an optimized instantiation of this type.
-
-For further examples, see "Data.IntervalMap.FingerTree" and
-"Data.PriorityQueue.FingerTree".
-
--}
diff --git a/HaskellWorks/Data/IntervalMap/FingerTree.hs b/HaskellWorks/Data/IntervalMap/FingerTree.hs
deleted file mode 100644
--- a/HaskellWorks/Data/IntervalMap/FingerTree.hs
+++ /dev/null
@@ -1,220 +0,0 @@
-{-# LANGUAGE CPP                   #-}
-{-# LANGUAGE DeriveAnyClass        #-}
-{-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-#if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Safe                  #-}
-#endif
-#if __GLASGOW_HASKELL__ >= 710
-{-# LANGUAGE AutoDeriveTypeable    #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  Data.PriorityQueue.FingerTree
--- Copyright   :  (c) Ross Paterson 2008
--- License     :  BSD-style
--- Maintainer  :  R.Paterson@city.ac.uk
--- Stability   :  experimental
--- Portability :  non-portable (MPTCs and functional dependencies)
---
--- Interval maps implemented using the 'FingerTree' type, following
--- section 4.8 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://staff.city.ac.uk/~ross/papers/FingerTree.html>
---
--- An amortized running time is given for each operation, with /n/
--- referring to the size of the priority queue.  These bounds hold even
--- in a persistent (shared) setting.
---
--- /Note/: Many of these operations have the same names as similar
--- operations on lists in the "Prelude".  The ambiguity may be resolved
--- using either qualification or the @hiding@ clause.
---
------------------------------------------------------------------------------
-
-module HaskellWorks.Data.IntervalMap.FingerTree (
-    -- * Intervals
-    Interval(..), point,
-    -- * Interval maps
-    IntervalMap(..), empty, singleton, insert, union,
-    -- * Searching
-    search, intersections, dominators
-    ) where
-
-import           HaskellWorks.Data.FingerTree (FingerTree, Measured (..),
-                                               ViewL (..), (<|), (><))
-import qualified HaskellWorks.Data.FingerTree as FT
-
-import           Control.Applicative          ((<$>))
-import           Control.DeepSeq
-import           Data.Foldable                (Foldable (foldMap))
-import           Data.Monoid
-import           Data.Traversable             (Traversable (traverse))
-import           GHC.Generics
-
-----------------------------------
--- 4.8 Application: interval trees
-----------------------------------
-
--- | A closed interval.  The lower bound should be less than or equal
--- to the higher bound.
-data Interval v = Interval { low :: v, high :: v }
-    deriving (Eq, Ord, Show, Generic, NFData)
-
--- | An interval in which the lower and upper bounds are equal.
-point :: v -> Interval v
-point v = Interval v v
-
-data Node v a = Node (Interval v) a deriving (Generic, NFData)
-
-instance Functor (Node v) where
-    fmap f (Node i x) = Node i (f x)
-
-instance Foldable (Node v) where
-    foldMap f (Node _ x) = f x
-
-instance Traversable (Node v) where
-    traverse f (Node i x) = Node i <$> f x
-
--- rightmost interval (including largest lower bound) and largest upper bound.
-data IntInterval v = NoInterval | IntInterval (Interval v) v deriving (Generic, NFData)
-
-instance Ord v => Monoid (IntInterval v) where
-    mempty = NoInterval
-    NoInterval `mappend` i  = i
-    i `mappend` NoInterval  = i
-    IntInterval _ hi1 `mappend` IntInterval int2 hi2 =
-        IntInterval int2 (max hi1 hi2)
-
-instance (Ord v) => Measured (IntInterval v) (Node v a) where
-    measure (Node i _) = IntInterval i (high i)
-
--- | Map of closed intervals, possibly with duplicates.
--- The 'Foldable' and 'Traversable' instances process the intervals in
--- lexicographical order.
-newtype IntervalMap v a =
-    IntervalMap (FingerTree (IntInterval v) (Node v a))
-    deriving (Generic, NFData)
--- ordered lexicographically by interval
-
-instance Functor (IntervalMap v) where
-    fmap f (IntervalMap t) = IntervalMap (FT.unsafeFmap (fmap f) t)
-
-instance Foldable (IntervalMap v) where
-    foldMap f (IntervalMap t) = foldMap (foldMap f) t
-
-instance Traversable (IntervalMap v) where
-    traverse f (IntervalMap t) =
-        IntervalMap <$> FT.unsafeTraverse (traverse f) t
-
--- | 'empty' and 'union'.
-instance (Ord v) => Monoid (IntervalMap v a) where
-    mempty = empty
-    mappend = union
-
--- | /O(1)/.  The empty interval map.
-empty :: (Ord v) => IntervalMap v a
-empty = IntervalMap FT.empty
-
--- | /O(1)/.  Interval map with a single entry.
-singleton :: (Ord v) => Interval v -> a -> IntervalMap v a
-singleton i x = IntervalMap (FT.singleton (Node i x))
-
--- | /O(log n)/.  Insert an interval into a map.
--- The map may contain duplicate intervals; the new entry will be inserted
--- before any existing entries for the same interval.
-insert :: (Ord v) => Interval v -> a -> IntervalMap v a -> IntervalMap v a
-insert (Interval lo hi) _ m | lo > hi = m
-insert i x (IntervalMap t) = IntervalMap (l >< Node i x <| r)
-  where
-    (l, r) = FT.split larger t
-    larger (IntInterval k _) = k >= i
-    larger NoInterval        = error "larger NoInterval"
-
--- | /O(m log (n/\//m))/.  Merge two interval maps.
--- The map may contain duplicate intervals; entries with equal intervals
--- are kept in the original order.
-union  ::  (Ord v) => IntervalMap v a -> IntervalMap v a -> IntervalMap v a
-union (IntervalMap xs) (IntervalMap ys) = IntervalMap (merge1 xs ys)
-  where
-    merge1 as bs = case FT.viewl as of
-        EmptyL                  -> bs
-        a@(Node i _) :< as'     -> l >< a <| merge2 as' r
-          where
-            (l, r) = FT.split larger bs
-            larger (IntInterval k _) = k >= i
-            larger NoInterval        = error "larger NoInterval"
-    merge2 as bs = case FT.viewl bs of
-        EmptyL                  -> as
-        b@(Node i _) :< bs'     -> l >< b <| merge1 r bs'
-          where
-            (l, r) = FT.split larger as
-            larger (IntInterval k _) = k > i
-            larger NoInterval        = error "larger NoInterval"
-
--- | /O(k log (n/\//k))/.  All intervals that intersect with the given
--- interval, in lexicographical order.
-intersections :: (Ord v) => Interval v -> IntervalMap v a -> [(Interval v, a)]
-intersections i = inRange (low i) (high i)
-
--- | /O(k log (n/\//k))/.  All intervals that contain the given interval,
--- in lexicographical order.
-dominators :: (Ord v) => Interval v -> IntervalMap v a -> [(Interval v, a)]
-dominators i = inRange (high i) (low i)
-
--- | /O(k log (n/\//k))/.  All intervals that contain the given point,
--- in lexicographical order.
-search :: (Ord v) => v -> IntervalMap v a -> [(Interval v, a)]
-search p = inRange p p
-
--- | /O(k log (n/\//k))/.  All intervals that intersect with the given
--- interval, in lexicographical order.
-inRange :: (Ord v) => v -> v -> IntervalMap v a -> [(Interval v, a)]
-inRange lo hi (IntervalMap t) = matches (FT.takeUntil (greater hi) t)
-  where
-    matches xs  =  case FT.viewl (FT.dropUntil (atleast lo) xs) of
-        EmptyL          ->  []
-        Node i x :< xs' ->  (i, x) : matches xs'
-
-atleast :: (Ord v) => v -> IntInterval v -> Bool
-atleast k (IntInterval _ hi) = k <= hi
-atleast _ NoInterval         = error "atleast NoInterval"
-
-greater :: (Ord v) => v -> IntInterval v -> Bool
-greater k (IntInterval i _) = low i > k
-greater _ NoInterval        = error "greater NoInterval"
-
-{-
--- Examples
-
-mkMap :: (Ord v) => [(v, v, a)] -> IntervalMap v a
-mkMap = foldr ins empty
-  where
-    ins (lo, hi, n) = insert (Interval lo hi) n
-
-composers :: IntervalMap Int String
-composers = mkMap [
-    (1685, 1750, "Bach"),
-    (1685, 1759, "Handel"),
-    (1732, 1809, "Haydn"),
-    (1756, 1791, "Mozart"),
-    (1770, 1827, "Beethoven"),
-    (1782, 1840, "Paganini"),
-    (1797, 1828, "Schubert"),
-    (1803, 1869, "Berlioz"),
-    (1810, 1849, "Chopin"),
-    (1833, 1897, "Brahms"),
-    (1838, 1875, "Bizet")]
-
-mathematicians :: IntervalMap Int String
-mathematicians = mkMap [
-    (1642, 1727, "Newton"),
-    (1646, 1716, "Leibniz"),
-    (1707, 1783, "Euler"),
-    (1736, 1813, "Lagrange"),
-    (1777, 1855, "Gauss"),
-    (1811, 1831, "Galois")]
--}
diff --git a/HaskellWorks/Data/PriorityQueue/FingerTree.hs b/HaskellWorks/Data/PriorityQueue/FingerTree.hs
deleted file mode 100644
--- a/HaskellWorks/Data/PriorityQueue/FingerTree.hs
+++ /dev/null
@@ -1,181 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-#if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Safe #-}
-#endif
-#if __GLASGOW_HASKELL__ >= 710
-{-# LANGUAGE AutoDeriveTypeable #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  Data.PriorityQueue.FingerTree
--- Copyright   :  (c) Ross Paterson 2008
--- License     :  BSD-style
--- Maintainer  :  R.Paterson@city.ac.uk
--- Stability   :  experimental
--- Portability :  non-portable (MPTCs and functional dependencies)
---
--- Min-priority queues implemented using the 'FingerTree' type,
--- following section 4.6 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://staff.city.ac.uk/~ross/papers/FingerTree.html>
---
--- These have the same big-O complexity as skew heap implementations,
--- but are approximately an order of magnitude slower.
--- On the other hand, they are stable, so they can be used for fair
--- queueing.  They are also shallower, so that 'fmap' consumes less
--- space.
---
--- An amortized running time is given for each operation, with /n/
--- referring to the size of the priority queue.  These bounds hold even
--- in a persistent (shared) setting.
---
--- /Note/: Many of these operations have the same names as similar
--- operations on lists in the "Prelude".  The ambiguity may be resolved
--- using either qualification or the @hiding@ clause.
---
------------------------------------------------------------------------------
-
-module HaskellWorks.Data.PriorityQueue.FingerTree (
-    PQueue,
-    -- * Construction
-    empty,
-    singleton,
-    union,
-    insert,
-    add,
-    fromList,
-    -- * Deconstruction
-    null,
-    minView,
-    minViewWithKey
-    ) where
-
-import qualified HaskellWorks.Data.FingerTree as FT
-import HaskellWorks.Data.FingerTree (FingerTree, (<|), (|>), (><), ViewL(..), Measured(..))
-
-import Control.Arrow ((***))
-import Data.Foldable (Foldable(foldMap))
-import Data.Monoid
-import Prelude hiding (null)
-
-data Entry k v = Entry k v
-
-instance Functor (Entry k) where
-    fmap f (Entry k v) = Entry k (f v)
-
-instance Foldable (Entry k) where
-    foldMap f (Entry _ v) = f v
-
-data Prio k v = NoPrio | Prio k v
-
-instance Ord k => Monoid (Prio k v) where
-    mempty                  = NoPrio
-    x `mappend` NoPrio      = x
-    NoPrio `mappend` y      = y
-    x@(Prio kx _) `mappend` y@(Prio ky _)
-      | kx <= ky            = x
-      | otherwise           = y
-
-instance Ord k => Measured (Prio k v) (Entry k v) where
-    measure (Entry k v) = Prio k v
-
--- | Priority queues.
-newtype PQueue k v = PQueue (FingerTree (Prio k v) (Entry k v))
-
-instance Ord k => Functor (PQueue k) where
-    fmap f (PQueue xs) = PQueue (FT.fmap' (fmap f) xs)
-
-instance Ord k => Foldable (PQueue k) where
-    foldMap f q = case minView q of
-        Nothing -> mempty
-        Just (v, q') -> f v `mappend` foldMap f q'
-
-instance Ord k => Monoid (PQueue k v) where
-    mempty = empty
-    mappend = union
-
--- | /O(1)/. The empty priority queue.
-empty :: Ord k => PQueue k v
-empty = PQueue FT.empty
-
--- | /O(1)/. A singleton priority queue.
-singleton :: Ord k => k -> v -> PQueue k v
-singleton k v = PQueue (FT.singleton (Entry k v))
-
--- | /O(log n)/. Add a (priority, value) pair to the front of a priority queue.
---
--- * @'insert' k v q = 'union' ('singleton' k v) q@
---
--- If @q@ contains entries with the same priority @k@, 'minView' of
--- @'insert' k v q@ will return them after this one.
-insert :: Ord k => k -> v -> PQueue k v -> PQueue k v
-insert k v (PQueue q) = PQueue (Entry k v <| q)
-
--- | /O(log n)/. Add a (priority, value) pair to the back of a priority queue.
---
--- * @'add' k v q = 'union' q ('singleton' k v)@
---
--- If @q@ contains entries with the same priority @k@, 'minView' of
--- @'add' k v q@ will return them before this one.
-add :: Ord k => k -> v -> PQueue k v -> PQueue k v
-add k v (PQueue q) = PQueue (q |> Entry k v)
-
--- | /O(log(min(n1,n2)))/. Concatenate two priority queues.
--- 'union' is associative, with identity 'empty'.
---
--- If there are entries with the same priority in both arguments, 'minView'
--- of @'union' xs ys@ will return those from @xs@ before those from @ys@.
-union :: Ord k => PQueue k v -> PQueue k v -> PQueue k v
-union (PQueue xs) (PQueue ys) = PQueue (xs >< ys)
-
--- | /O(n)/. Create a priority queue from a finite list of priorities
--- and values.
-fromList :: Ord k => [(k, v)] -> PQueue k v
-fromList = foldr (uncurry insert) empty
-
--- | /O(1)/. Is this the empty priority queue?
-null :: Ord k => PQueue k v -> Bool
-null (PQueue q) = FT.null q
-
--- | /O(1)/ for the element, /O(log(n))/ for the reduced queue.
--- Returns 'Nothing' for an empty map, or the value associated with the
--- minimal priority together with the rest of the priority queue.
---
---  * @'minView' 'empty' = 'Nothing'@
---
---  * @'minView' ('singleton' k v) = 'Just' (v, 'empty')@
---
-minView :: Ord k => PQueue k v -> Maybe (v, PQueue k v)
-minView q = fmap (snd *** id) (minViewWithKey q)
-
--- | /O(1)/ for the element, /O(log(n))/ for the reduced queue.
--- Returns 'Nothing' for an empty map, or the minimal (priority, value)
--- pair together with the rest of the priority queue.
---
---  * @'minViewWithKey' 'empty' = 'Nothing'@
---
---  * @'minViewWithKey' ('singleton' k v) = 'Just' ((k, v), 'empty')@
---
---  * If @'minViewWithKey' qi = 'Just' ((ki, vi), qi')@ and @k1 <= k2@,
---    then @'minViewWithKey' ('union' q1 q2) = 'Just' ((k1, v1), 'union' q1' q2)@
---
---  * If @'minViewWithKey' qi = 'Just' ((ki, vi), qi')@ and @k2 < k1@,
---    then @'minViewWithKey' ('union' q1 q2) = 'Just' ((k2, v2), 'union' q1 q2')@
---
-minViewWithKey :: Ord k => PQueue k v -> Maybe ((k, v), PQueue k v)
-minViewWithKey (PQueue q)
-  | FT.null q = Nothing
-  | otherwise = Just ((k, v), case FT.viewl r of
-    _ :< r' -> PQueue (l >< r')
-    _ -> error "can't happen")
-  where
-    Prio k v = measure q
-    (l, r) = FT.split (below k) q
-
-below :: Ord k => k -> Prio k v -> Bool
-below _ NoPrio = False
-below k (Prio k' _) = k' <= k
diff --git a/hw-fingertree.cabal b/hw-fingertree.cabal
--- a/hw-fingertree.cabal
+++ b/hw-fingertree.cabal
@@ -1,54 +1,79 @@
-Name:           hw-fingertree
-Version:        0.1.0.0
-Cabal-Version:  >= 1.8
-Copyright:      (c) 2006 Ross Paterson, Ralf Hinze
-License:        BSD3
-License-File:   LICENSE
-Maintainer:     Ross Paterson <R.Paterson@city.ac.uk>
-bug-reports:    http://hub.darcs.net/ross/fingertree/issues
-Category:       Data Structures
-Synopsis:       Generic finger-tree structure, with example instances
-Description:
-                A general sequence representation with arbitrary
+-- This file has been generated from package.yaml by hpack version 0.20.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 8cd50b9741a1c8a2bcc9297a6ee8ba24104ddc058fb32364d45037c5f0958bf1
+
+name:           hw-fingertree
+version:        0.1.0.1
+synopsis:       Generic finger-tree structure, with example instances
+description:    A general sequence representation with arbitrary
                 annotations, for use as a base for implementations of
                 various collection types, with examples, 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://staff.city.ac.uk/~ross/papers/FingerTree.html>
+                * Ralf Hinze and Ross Paterson,
+                \"Finger trees: a simple general-purpose data structure\",
+                /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
+                <http://staff.city.ac.uk/~ross/papers/FingerTree.html>
                 .
                 For a tuned sequence type, see @Data.Sequence@ in the
                 @containers@ package, which is a specialization of
                 this structure.
-Build-Type:     Simple
+category:       Data Structures
+homepage:       https://github.com/haskell-works/hw-fingertree#readme
+bug-reports:    https://github.com/haskell-works/hw-fingertree/issues
+maintainer:     John Ky <newhoggy@gmail.com>
+copyright:      (c) 2006 Ross Paterson,
+                Ralf Hinze,
+                (c) 2017-2018 John Ky
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+cabal-version:  >= 1.10
 
-Source-Repository head
-  Type: git
-  Location: https://github.com/haskell-works/hw-fingertree
+source-repository head
+  type: git
+  location: https://github.com/haskell-works/hw-fingertree
 
-Library
-  Build-Depends:  base < 6
-                , deepseq
-  Extensions:   MultiParamTypeClasses
-                FunctionalDependencies
-                FlexibleInstances
-                UndecidableInstances
-  Exposed-Modules:
-                HaskellWorks.Data.FingerTree
-                HaskellWorks.Data.IntervalMap.FingerTree
-                HaskellWorks.Data.PriorityQueue.FingerTree
+library
+  hs-source-dirs:
+      src
+  build-depends:
+      base <6
+    , deepseq
+  exposed-modules:
+      HaskellWorks.Data.FingerTree
+      HaskellWorks.Data.IntervalMap.FingerTree
+      HaskellWorks.Data.PriorityQueue.FingerTree
+  other-modules:
+      Paths_hw_fingertree
+  default-language: Haskell2010
 
-Test-suite ft-properties
+test-suite hw-fingertree-tests
   type: exitcode-stdio-1.0
-  main-is: tests/ft-properties.hs
+  main-is: Spec.hs
+  hs-source-dirs:
+      tests
+      src
   cpp-options: -DTESTING
   build-depends:
-                base >= 4.2 && < 6,
-                deepseq,
-                HUnit,
-                QuickCheck,
-                test-framework,
-                test-framework-hunit,
-                test-framework-quickcheck2
+      HUnit
+    , QuickCheck
+    , base >=4.2 && <6
+    , deepseq
+    , hedgehog
+    , hspec
+    , hw-fingertree
+    , hw-hspec-hedgehog
+    , test-framework
+    , test-framework-hunit
+    , test-framework-quickcheck2
+  other-modules:
+      HaskellWorks.Data.FingerTree.Gen
+      HaskellWorks.Data.FingerTreeSpec
+      HaskellWorks.Data.FingerTree
+      HaskellWorks.Data.IntervalMap.FingerTree
+      HaskellWorks.Data.PriorityQueue.FingerTree
+      Paths_hw_fingertree
+  default-language: Haskell2010
diff --git a/src/HaskellWorks/Data/FingerTree.hs b/src/HaskellWorks/Data/FingerTree.hs
new file mode 100644
--- /dev/null
+++ b/src/HaskellWorks/Data/FingerTree.hs
@@ -0,0 +1,878 @@
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE DeriveAnyClass         #-}
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE UndecidableInstances   #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe                   #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable     #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.FingerTree
+-- Copyright   :  (c) Ross Paterson, Ralf Hinze 2006
+-- License     :  BSD-style
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- 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://staff.city.ac.uk/~ross/papers/FingerTree.html>
+--
+-- For a directly usable sequence type, see @Data.Sequence@, which is
+-- a specialization of this 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.
+--
+-- /Note/: Many of these operations have the same names as similar
+-- operations on lists in the "Prelude".  The ambiguity may be resolved
+-- using either qualification or the @hiding@ clause.
+--
+-----------------------------------------------------------------------------
+
+module HaskellWorks.Data.FingerTree (
+#if TESTING
+    FingerTree(..), Digit(..), Node(..), deep, node2, node3,
+#else
+    FingerTree,
+#endif
+    Measured(..),
+    -- * Construction
+    empty, singleton,
+    (<|), (|>), (><),
+    fromList,
+    -- * Deconstruction
+    null,
+    ViewL(..), ViewR(..), viewl, viewr,
+    split, takeUntil, dropUntil,
+    -- * Transformation
+    reverse,
+    fmap', fmapWithPos, unsafeFmap,
+    traverse', traverseWithPos, unsafeTraverse
+    -- * Example
+    -- $example
+    ) where
+
+import Prelude hiding (null, reverse)
+
+import Control.Applicative (Applicative (pure, (<*>)), (<$>))
+import Control.DeepSeq
+import Data.Foldable       (Foldable (foldMap), toList)
+import Data.Monoid
+import GHC.Generics        (Generic)
+
+import qualified Data.Semigroup as S
+
+infixr 5 ><
+infixr 5 <|, :<
+infixl 5 |>, :>
+
+-- | View of the left end of a sequence.
+data ViewL s a
+    = EmptyL        -- ^ empty sequence
+    | a :< s a      -- ^ leftmost element and the rest of the sequence
+    deriving (Eq, Ord, Show, Read, Generic, NFData)
+
+-- | View of the right end of a sequence.
+data ViewR s a
+    = EmptyR        -- ^ empty sequence
+    | s a :> a      -- ^ the sequence minus the rightmost element,
+                    -- and the rightmost element
+    deriving (Eq, Ord, Show, Read, Generic, NFData)
+
+instance Functor s => Functor (ViewL s) where
+    fmap _ EmptyL    = EmptyL
+    fmap f (x :< xs) = f x :< fmap f xs
+
+instance Functor s => Functor (ViewR s) where
+    fmap _ EmptyR    = EmptyR
+    fmap f (xs :> x) = fmap f xs :> f x
+
+instance Measured v a => S.Semigroup (FingerTree v a) where
+  (<>) = (><)
+  {-# INLINE (<>) #-}
+
+-- | 'empty' and '><'.
+instance Measured v a => Monoid (FingerTree v a) where
+  mempty = empty
+  {-# INLINE mempty #-}
+  mappend = (><)
+  {-# INLINE mappend #-}
+
+-- Explicit Digit type (Exercise 1)
+
+data Digit a
+    = One a
+    | Two a a
+    | Three a a a
+    | Four a a a a
+    deriving (Show, Generic, NFData)
+
+instance Foldable Digit where
+    foldMap f (One a)        = f a
+    foldMap f (Two a b)      = f a `mappend` f b
+    foldMap f (Three a b c)  = f a `mappend` f b `mappend` f c
+    foldMap f (Four a b c d) = f a `mappend` f b `mappend` f c `mappend` f d
+
+-------------------
+-- 4.1 Measurements
+-------------------
+
+-- | Things that can be measured.
+class (Monoid v) => Measured v a | a -> v where
+    measure :: a -> v
+
+instance (Measured v a) => Measured v (Digit a) where
+    measure = foldMap measure
+
+---------------------------
+-- 4.2 Caching measurements
+---------------------------
+
+data Node v a = Node2 !v a a | Node3 !v a a a
+    deriving (Show, Generic, NFData)
+
+instance Foldable (Node v) where
+    foldMap f (Node2 _ a b)   = f a `mappend` f b
+    foldMap f (Node3 _ a b c) = f a `mappend` f b `mappend` f c
+
+node2        ::  (Measured v a) => a -> a -> Node v a
+node2 a b    =   Node2 (measure a `mappend` measure b) a b
+
+node3        ::  (Measured v a) => a -> a -> a -> Node v a
+node3 a b c  =   Node3 (measure a `mappend` measure b `mappend` measure c) a b c
+
+instance (Monoid v) => Measured v (Node v a) where
+    measure (Node2 v _ _)   =  v
+    measure (Node3 v _ _ _) =  v
+
+nodeToDigit :: Node v a -> Digit a
+nodeToDigit (Node2 _ a b)   = Two a b
+nodeToDigit (Node3 _ a b c) = Three a b c
+
+-- | A representation of a sequence of values of type @a@, allowing
+-- access to the ends in constant time, and append and split in time
+-- logarithmic in the size of the smaller piece.
+--
+-- The collection is also parameterized by a measure type @v@, which
+-- is used to specify a position in the sequence for the 'split' operation.
+-- The types of the operations enforce the constraint @'Measured' v a@,
+-- which also implies that the type @v@ is determined by @a@.
+--
+-- A variety of abstract data types can be implemented by using different
+-- element types and measurements.
+data FingerTree v a
+    = Empty
+    | Single a
+    | Deep !v !(Digit a) (FingerTree v (Node v a)) !(Digit a)
+    deriving (
+#if TESTING
+    Show,
+#endif
+    Generic, NFData)
+
+deep ::  (Measured v a) =>
+     Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
+deep pr m sf = Deep ((measure pr `mappendVal` m) `mappend` measure sf) pr m sf
+
+-- | /O(1)/. The cached measure of a tree.
+instance (Measured v a) => Measured v (FingerTree v a) where
+    measure Empty          =  mempty
+    measure (Single x)     =  measure x
+    measure (Deep v _ _ _) =  v
+
+instance Foldable (FingerTree v) where
+    foldMap _ Empty = mempty
+    foldMap f (Single x) = f x
+    foldMap f (Deep _ pr m sf) =
+        foldMap f pr `mappend` foldMap (foldMap f) m `mappend` foldMap f sf
+
+instance Eq a => Eq (FingerTree v a) where
+    xs == ys = toList xs == toList ys
+
+instance Ord a => Ord (FingerTree v a) where
+    compare xs ys = compare (toList xs) (toList ys)
+
+#if !TESTING
+instance Show a => Show (FingerTree v a) where
+    showsPrec p xs = showParen (p > 10) $
+        showString "fromList " . shows (toList xs)
+#endif
+
+-- | Like 'fmap', but with a more constrained type.
+fmap' :: (Measured v1 a1, Measured v2 a2) =>
+    (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
+fmap' = mapTree
+
+mapTree :: (Measured v2 a2) =>
+    (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
+mapTree _ Empty = Empty
+mapTree f (Single x) = Single (f x)
+mapTree f (Deep _ pr m sf) =
+    deep (mapDigit f pr) (mapTree (mapNode f) m) (mapDigit f sf)
+
+mapNode :: (Measured v2 a2) =>
+    (a1 -> a2) -> Node v1 a1 -> Node v2 a2
+mapNode f (Node2 _ a b)   = node2 (f a) (f b)
+mapNode f (Node3 _ a b c) = node3 (f a) (f b) (f c)
+
+mapDigit :: (a -> b) -> Digit a -> Digit b
+mapDigit f (One a)        = One (f a)
+mapDigit f (Two a b)      = Two (f a) (f b)
+mapDigit f (Three a b c)  = Three (f a) (f b) (f c)
+mapDigit f (Four a b c d) = Four (f a) (f b) (f c) (f d)
+
+-- | Map all elements of the tree with a function that also takes the
+-- measure of the prefix of the tree to the left of the element.
+fmapWithPos :: (Measured v1 a1, Measured v2 a2) =>
+    (v1 -> a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
+fmapWithPos f = mapWPTree f mempty
+
+mapWPTree :: (Measured v1 a1, Measured v2 a2) =>
+    (v1 -> a1 -> a2) -> v1 -> FingerTree v1 a1 -> FingerTree v2 a2
+mapWPTree _ _ Empty = Empty
+mapWPTree f v (Single x) = Single (f v x)
+mapWPTree f v (Deep _ pr m sf) =
+    deep (mapWPDigit f v pr)
+         (mapWPTree (mapWPNode f) vpr m)
+         (mapWPDigit f vm sf)
+  where
+    vpr     =  v    `mappend`  measure pr
+    vm      =  vpr  `mappendVal` m
+
+mapWPNode :: (Measured v1 a1, Measured v2 a2) =>
+    (v1 -> a1 -> a2) -> v1 -> Node v1 a1 -> Node v2 a2
+mapWPNode f v (Node2 _ a b) = node2 (f v a) (f va b)
+  where
+    va      = v `mappend` measure a
+mapWPNode f v (Node3 _ a b c) = node3 (f v a) (f va b) (f vab c)
+  where
+    va      = v `mappend` measure a
+    vab     = va `mappend` measure b
+
+mapWPDigit :: (Measured v a) => (v -> a -> b) -> v -> Digit a -> Digit b
+mapWPDigit f v (One a) = One (f v a)
+mapWPDigit f v (Two a b) = Two (f v a) (f va b)
+  where
+    va      = v `mappend` measure a
+mapWPDigit f v (Three a b c) = Three (f v a) (f va b) (f vab c)
+  where
+    va      = v `mappend` measure a
+    vab     = va `mappend` measure b
+mapWPDigit f v (Four a b c d) = Four (f v a) (f va b) (f vab c) (f vabc d)
+  where
+    va      = v `mappend` measure a
+    vab     = va `mappend` measure b
+    vabc    = vab `mappend` measure c
+
+-- | Like 'fmap', but safe only if the function preserves the measure.
+unsafeFmap :: (a -> b) -> FingerTree v a -> FingerTree v b
+unsafeFmap _ Empty = Empty
+unsafeFmap f (Single x) = Single (f x)
+unsafeFmap f (Deep v pr m sf) =
+    Deep v (mapDigit f pr) (unsafeFmap (unsafeFmapNode f) m) (mapDigit f sf)
+
+unsafeFmapNode :: (a -> b) -> Node v a -> Node v b
+unsafeFmapNode f (Node2 v a b)   = Node2 v (f a) (f b)
+unsafeFmapNode f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
+
+-- | 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
+
+-- | Traverse the tree with a function that also takes the
+-- measure of the prefix of the tree to the left of the element.
+traverseWithPos :: (Measured v1 a1, Measured v2 a2, Applicative f) =>
+    (v1 -> a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
+traverseWithPos f = traverseWPTree f mempty
+
+traverseWPTree :: (Measured v1 a1, Measured v2 a2, Applicative f) =>
+    (v1 -> a1 -> f a2) -> v1 -> FingerTree v1 a1 -> f (FingerTree v2 a2)
+traverseWPTree _ _ Empty = pure Empty
+traverseWPTree f v (Single x) = Single <$> f v x
+traverseWPTree f v (Deep _ pr m sf) =
+    deep <$> traverseWPDigit f v pr <*> traverseWPTree (traverseWPNode f) vpr m <*> traverseWPDigit f vm sf
+  where
+    vpr     =  v    `mappend`  measure pr
+    vm      =  vpr  `mappendVal` m
+
+traverseWPNode :: (Measured v1 a1, Measured v2 a2, Applicative f) =>
+    (v1 -> a1 -> f a2) -> v1 -> Node v1 a1 -> f (Node v2 a2)
+traverseWPNode f v (Node2 _ a b) = node2 <$> f v a <*> f va b
+  where
+    va      = v `mappend` measure a
+traverseWPNode f v (Node3 _ a b c) = node3 <$> f v a <*> f va b <*> f vab c
+  where
+    va      = v `mappend` measure a
+    vab     = va `mappend` measure b
+
+traverseWPDigit :: (Measured v a, Applicative f) =>
+    (v -> a -> f b) -> v -> Digit a -> f (Digit b)
+traverseWPDigit f v (One a) = One <$> f v a
+traverseWPDigit f v (Two a b) = Two <$> f v a <*> f va b
+  where
+    va      = v `mappend` measure a
+traverseWPDigit f v (Three a b c) = Three <$> f v a <*> f va b <*> f vab c
+  where
+    va      = v `mappend` measure a
+    vab     = va `mappend` measure b
+traverseWPDigit f v (Four a b c d) = Four <$> f v a <*> f va b <*> f vab c <*> f vabc d
+  where
+    va      = v `mappend` measure a
+    vab     = va `mappend` measure b
+    vabc    = vab `mappend` measure c
+
+-- | Like 'traverse', but safe only if the function preserves the measure.
+unsafeTraverse :: (Applicative f) =>
+    (a -> f b) -> FingerTree v a -> f (FingerTree v b)
+unsafeTraverse _ Empty = pure Empty
+unsafeTraverse f (Single x) = Single <$> f x
+unsafeTraverse f (Deep v pr m sf) =
+    Deep v <$> traverseDigit f pr <*> unsafeTraverse (unsafeTraverseNode f) m <*> traverseDigit f sf
+
+unsafeTraverseNode :: (Applicative f) =>
+    (a -> f b) -> Node v a -> f (Node v b)
+unsafeTraverseNode f (Node2 v a b)   = Node2 v <$> f a <*> f b
+unsafeTraverseNode f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
+
+-----------------------------------------------------
+-- 4.3 Construction, deconstruction and concatenation
+-----------------------------------------------------
+
+-- | /O(1)/. The empty sequence.
+empty :: Measured v a => FingerTree v a
+empty = Empty
+
+-- | /O(1)/. A singleton sequence.
+singleton :: Measured v a => a -> FingerTree v a
+singleton = Single
+
+-- | /O(n)/. Create a sequence from a finite list of elements.
+fromList :: (Measured v a) => [a] -> FingerTree v a
+fromList = foldr (<|) Empty
+
+-- | /O(1)/. Add an element to the left end of a sequence.
+-- Mnemonic: a triangle with the single element at the pointy end.
+(<|) :: (Measured v a) => a -> FingerTree v a -> FingerTree v a
+a <| Empty              =  Single a
+a <| Single b           =  deep (One a) Empty (One b)
+a <| Deep v (Four b c d e) m sf = m `seq`
+    Deep (measure a `mappend` v) (Two a b) (node3 c d e <| m) sf
+a <| Deep v pr m sf     =
+    Deep (measure a `mappend` v) (consDigit a pr) m sf
+
+consDigit :: a -> Digit a -> Digit a
+consDigit a (One b)        = Two a b
+consDigit a (Two b c)      = Three a b c
+consDigit a (Three b c d)  = Four a b c d
+consDigit _ (Four _ _ _ _) = illegal_argument "consDigit"
+
+-- | /O(1)/. Add an element to the right end of a sequence.
+-- Mnemonic: a triangle with the single element at the pointy end.
+(|>) :: (Measured v a) => FingerTree v a -> a -> FingerTree v a
+Empty |> a              =  Single a
+Single a |> b           =  deep (One a) Empty (One b)
+Deep v pr m (Four a b c d) |> e = m `seq`
+    Deep (v `mappend` measure e) pr (m |> node3 a b c) (Two d e)
+Deep v pr m sf |> x     =
+    Deep (v `mappend` measure x) pr m (snocDigit sf x)
+
+snocDigit :: Digit a -> a -> Digit a
+snocDigit (One a) b        = Two a b
+snocDigit (Two a b) c      = Three a b c
+snocDigit (Three a b c) d  = Four a b c d
+snocDigit (Four _ _ _ _) _ = illegal_argument "snocDigit"
+
+-- | /O(1)/. Is this the empty sequence?
+null :: (Measured v a) => FingerTree v a -> Bool
+null Empty = True
+null _     = False
+
+-- | /O(1)/. Analyse the left end of a sequence.
+viewl :: (Measured v a) => FingerTree v a -> ViewL (FingerTree v) a
+viewl Empty                 =  EmptyL
+viewl (Single x)            =  x :< Empty
+viewl (Deep _ (One x) m sf) =  x :< rotL m sf
+viewl (Deep _ pr m sf)      =  lheadDigit pr :< deep (ltailDigit pr) m sf
+
+rotL :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> FingerTree v a
+rotL m sf      =   case viewl m of
+    EmptyL  ->  digitToTree sf
+    a :< m' ->  Deep (measure m `mappend` measure sf) (nodeToDigit a) m' sf
+
+lheadDigit :: Digit a -> a
+lheadDigit (One a)        = a
+lheadDigit (Two a _)      = a
+lheadDigit (Three a _ _)  = a
+lheadDigit (Four a _ _ _) = a
+
+ltailDigit :: Digit a -> Digit a
+ltailDigit (One _)        = illegal_argument "ltailDigit"
+ltailDigit (Two _ b)      = One b
+ltailDigit (Three _ b c)  = Two b c
+ltailDigit (Four _ b c d) = Three b c d
+
+-- | /O(1)/. Analyse the right end of a sequence.
+viewr :: (Measured v a) => FingerTree v a -> ViewR (FingerTree v) a
+viewr Empty                 =  EmptyR
+viewr (Single x)            =  Empty :> x
+viewr (Deep _ pr m (One x)) =  rotR pr m :> x
+viewr (Deep _ pr m sf)      =  deep pr m (rtailDigit sf) :> rheadDigit sf
+
+rotR :: (Measured v a) => Digit a -> FingerTree v (Node v a) -> FingerTree v a
+rotR pr m = case viewr m of
+    EmptyR  ->  digitToTree pr
+    m' :> a ->  Deep (measure pr `mappendVal` m) pr m' (nodeToDigit a)
+
+rheadDigit :: Digit a -> a
+rheadDigit (One a)        = a
+rheadDigit (Two _ b)      = b
+rheadDigit (Three _ _ c)  = c
+rheadDigit (Four _ _ _ d) = d
+
+rtailDigit :: Digit a -> Digit a
+rtailDigit (One _)        = illegal_argument "rtailDigit"
+rtailDigit (Two a _)      = One a
+rtailDigit (Three a b _)  = Two a b
+rtailDigit (Four a b c _) = Three a b c
+
+digitToTree :: (Measured v a) => Digit a -> FingerTree v a
+digitToTree (One a)        = Single a
+digitToTree (Two a b)      = deep (One a) Empty (One b)
+digitToTree (Three a b c)  = deep (Two a b) Empty (One c)
+digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
+
+----------------
+-- Concatenation
+----------------
+
+-- | /O(log(min(n1,n2)))/. Concatenate two sequences.
+(><) :: (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 Empty xs =
+    xs
+appendTree0 xs Empty =
+    xs
+appendTree0 (Single x) xs =
+    x <| xs
+appendTree0 xs (Single x) =
+    xs |> x
+appendTree0 (Deep _ pr1 m1 sf1) (Deep _ pr2 m2 sf2) =
+    deep pr1 (addDigits0 m1 sf1 pr2 m2) 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 m1 (One a) (One b) m2 =
+    appendTree1 m1 (node2 a b) m2
+addDigits0 m1 (One a) (Two b c) m2 =
+    appendTree1 m1 (node3 a b c) m2
+addDigits0 m1 (One a) (Three b c d) m2 =
+    appendTree2 m1 (node2 a b) (node2 c d) m2
+addDigits0 m1 (One a) (Four b c d e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits0 m1 (Two a b) (One c) m2 =
+    appendTree1 m1 (node3 a b c) m2
+addDigits0 m1 (Two a b) (Two c d) m2 =
+    appendTree2 m1 (node2 a b) (node2 c d) m2
+addDigits0 m1 (Two a b) (Three c d e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits0 m1 (Two a b) (Four c d e f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits0 m1 (Three a b c) (One d) m2 =
+    appendTree2 m1 (node2 a b) (node2 c d) m2
+addDigits0 m1 (Three a b c) (Two d e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits0 m1 (Three a b c) (Three d e f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits0 m1 (Three a b c) (Four d e f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits0 m1 (Four a b c d) (One e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits0 m1 (Four a b c d) (Two e f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits0 m1 (Four a b c d) (Three e f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+
+appendTree1 :: (Measured v a) => FingerTree v a -> a -> FingerTree v a -> FingerTree v a
+appendTree1 Empty a xs =
+    a <| xs
+appendTree1 xs a Empty =
+    xs |> a
+appendTree1 (Single x) a xs =
+    x <| a <| xs
+appendTree1 xs a (Single x) =
+    xs |> a |> x
+appendTree1 (Deep _ pr1 m1 sf1) a (Deep _ pr2 m2 sf2) =
+    deep pr1 (addDigits1 m1 sf1 a pr2 m2) 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 m1 (One a) b (One c) m2 =
+    appendTree1 m1 (node3 a b c) m2
+addDigits1 m1 (One a) b (Two c d) m2 =
+    appendTree2 m1 (node2 a b) (node2 c d) m2
+addDigits1 m1 (One a) b (Three c d e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits1 m1 (One a) b (Four c d e f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits1 m1 (Two a b) c (One d) m2 =
+    appendTree2 m1 (node2 a b) (node2 c d) m2
+addDigits1 m1 (Two a b) c (Two d e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits1 m1 (Two a b) c (Three d e f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits1 m1 (Two a b) c (Four d e f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits1 m1 (Three a b c) d (One e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits1 m1 (Three a b c) d (Two e f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits1 m1 (Three a b c) d (Three e f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits1 m1 (Four a b c d) e (One f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits1 m1 (Four a b c d) e (Two f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+
+appendTree2 :: (Measured v a) => FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a
+appendTree2 Empty a b xs =
+    a <| b <| xs
+appendTree2 xs a b Empty =
+    xs |> a |> b
+appendTree2 (Single x) a b xs =
+    x <| a <| b <| xs
+appendTree2 xs a b (Single x) =
+    xs |> a |> b |> x
+appendTree2 (Deep _ pr1 m1 sf1) a b (Deep _ pr2 m2 sf2) =
+    deep pr1 (addDigits2 m1 sf1 a b pr2 m2) 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 m1 (One a) b c (One d) m2 =
+    appendTree2 m1 (node2 a b) (node2 c d) m2
+addDigits2 m1 (One a) b c (Two d e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits2 m1 (One a) b c (Three d e f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits2 m1 (One a) b c (Four d e f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits2 m1 (Two a b) c d (One e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits2 m1 (Two a b) c d (Two e f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits2 m1 (Two a b) c d (Three e f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits2 m1 (Three a b c) d e (One f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits2 m1 (Three a b c) d e (Two f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+addDigits2 m1 (Four a b c d) e f (One g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
+
+appendTree3 :: (Measured v a) => FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a
+appendTree3 Empty a b c xs =
+    a <| b <| c <| xs
+appendTree3 xs a b c Empty =
+    xs |> a |> b |> c
+appendTree3 (Single x) a b c xs =
+    x <| a <| b <| c <| xs
+appendTree3 xs a b c (Single x) =
+    xs |> a |> b |> c |> x
+appendTree3 (Deep _ pr1 m1 sf1) a b c (Deep _ pr2 m2 sf2) =
+    deep pr1 (addDigits3 m1 sf1 a b c pr2 m2) 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 m1 (One a) b c d (One e) m2 =
+    appendTree2 m1 (node3 a b c) (node2 d e) m2
+addDigits3 m1 (One a) b c d (Two e f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits3 m1 (One a) b c d (Three e f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits3 m1 (One a) b c d (Four e f g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits3 m1 (Two a b) c d e (One f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits3 m1 (Two a b) c d e (Two f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+addDigits3 m1 (Three a b c) d e f (One g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
+addDigits3 m1 (Four a b c d) e f g (One h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
+addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
+
+appendTree4 :: (Measured v a) => FingerTree v a -> a -> a -> a -> a -> FingerTree v a -> FingerTree v a
+appendTree4 Empty a b c d xs =
+    a <| b <| c <| d <| xs
+appendTree4 xs a b c d Empty =
+    xs |> a |> b |> c |> d
+appendTree4 (Single x) a b c d xs =
+    x <| a <| b <| c <| d <| xs
+appendTree4 xs a b c d (Single x) =
+    xs |> a |> b |> c |> d |> x
+appendTree4 (Deep _ pr1 m1 sf1) a b c d (Deep _ pr2 m2 sf2) =
+    deep pr1 (addDigits4 m1 sf1 a b c d pr2 m2) 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 m1 (One a) b c d e (One f) m2 =
+    appendTree2 m1 (node3 a b c) (node3 d e f) m2
+addDigits4 m1 (One a) b c d e (Two f g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits4 m1 (One a) b c d e (Three f g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+addDigits4 m1 (Two a b) c d e f (One g) m2 =
+    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
+addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
+addDigits4 m1 (Three a b c) d e f g (One h) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
+addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
+addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
+addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
+    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
+addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
+addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
+addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
+    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
+
+----------------
+-- 4.4 Splitting
+----------------
+
+-- | /O(log(min(i,n-i)))/. Split a sequence at a point where the predicate
+-- on the accumulated measure changes from 'False' to 'True'.
+--
+-- For predictable results, one should ensure that there is only one such
+-- point, i.e. that the predicate is /monotonic/.
+split ::  (Measured v a) =>
+      (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
+split _ Empty  =  (Empty, Empty)
+split p xs
+  | p (measure xs) =  (l, x <| r)
+  | otherwise   =  (xs, Empty)
+  where
+    Split l x r = splitTree p mempty xs
+
+-- | /O(log(min(i,n-i)))/.
+-- Given a monotonic predicate @p@, @'takeUntil' p t@ is the largest
+-- prefix of @t@ whose measure does not satisfy @p@.
+--
+-- *  @'takeUntil' p t = 'fst' ('split' p t)@
+takeUntil :: (Measured v a) => (v -> Bool) -> FingerTree v a -> FingerTree v a
+takeUntil p  =  fst . split p
+
+-- | /O(log(min(i,n-i)))/.
+-- Given a monotonic predicate @p@, @'dropUntil' p t@ is the rest of @t@
+-- after removing the largest prefix whose measure does not satisfy @p@.
+--
+-- * @'dropUntil' p t = 'snd' ('split' p t)@
+dropUntil :: (Measured v a) => (v -> Bool) -> FingerTree v a -> FingerTree v a
+dropUntil p  =  snd . split 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 _ _ Empty = illegal_argument "splitTree"
+splitTree _ _ (Single x) = Split Empty x Empty
+splitTree p i (Deep _ pr m sf)
+  | p vpr       =  let  Split l x r     =  splitDigit p i pr
+                   in   Split (maybe Empty digitToTree l) x (deepL r m sf)
+  | p vm        =  let  Split ml xs mr  =  splitTree p vpr m
+                        Split l x r     =  splitNode p (vpr `mappendVal` ml) xs
+                   in   Split (deepR pr  ml l) x (deepL r mr sf)
+  | otherwise   =  let  Split l x r     =  splitDigit p vm sf
+                   in   Split (deepR pr  m  l) x (maybe Empty digitToTree r)
+  where
+    vpr     =  i    `mappend`  measure pr
+    vm      =  vpr  `mappendVal` m
+
+-- Avoid relying on right identity (cf Exercise 7)
+mappendVal :: (Measured v a) => v -> FingerTree v a -> v
+mappendVal v Empty = v
+mappendVal v t     = v `mappend` measure t
+
+deepL :: (Measured v a) =>
+    Maybe (Digit a) -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
+deepL Nothing m sf   =   rotL m sf
+deepL (Just pr) m sf =   deep pr m sf
+
+deepR :: (Measured v a) =>
+    Digit a -> FingerTree v (Node v a) -> Maybe (Digit a) -> FingerTree v a
+deepR pr m Nothing   =   rotR pr m
+deepR pr m (Just sf) =   deep pr m sf
+
+splitNode :: (Measured v a) => (v -> Bool) -> v -> Node v a ->
+    Split (Maybe (Digit a)) a
+splitNode p i (Node2 _ a b)
+  | p va        = Split Nothing a (Just (One b))
+  | otherwise   = Split (Just (One a)) b Nothing
+  where
+    va      = i `mappend` measure a
+splitNode p i (Node3 _ a b c)
+  | p va        = Split Nothing a (Just (Two b c))
+  | p vab       = Split (Just (One a)) b (Just (One c))
+  | otherwise   = Split (Just (Two a b)) c Nothing
+  where
+    va      = i `mappend` measure a
+    vab     = va `mappend` measure b
+
+splitDigit :: (Measured v a) => (v -> Bool) -> v -> Digit a ->
+    Split (Maybe (Digit a)) a
+splitDigit _ i (One a) = i `seq` Split Nothing a Nothing
+splitDigit p i (Two a b)
+  | p va        = Split Nothing a (Just (One b))
+  | otherwise   = Split (Just (One a)) b Nothing
+  where
+    va      = i `mappend` measure a
+splitDigit p i (Three a b c)
+  | p va        = Split Nothing a (Just (Two b c))
+  | p vab       = Split (Just (One a)) b (Just (One c))
+  | otherwise   = Split (Just (Two a b)) c Nothing
+  where
+    va      = i `mappend` measure a
+    vab     = va `mappend` measure b
+splitDigit p i (Four a b c d)
+  | p va        = Split Nothing a (Just (Three b c d))
+  | p vab       = Split (Just (One a)) b (Just (Two c d))
+  | p vabc      = Split (Just (Two a b)) c (Just (One d))
+  | otherwise   = Split (Just (Three a b c)) d Nothing
+  where
+    va      = i `mappend` measure a
+    vab     = va `mappend` measure b
+    vabc    = vab `mappend` measure c
+
+------------------
+-- Transformations
+------------------
+
+-- | /O(n)/. The reverse of a sequence.
+reverse :: (Measured v a) => FingerTree v a -> FingerTree v a
+reverse = reverseTree id
+
+reverseTree :: (Measured v2 a2) => (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
+reverseTree _ Empty = Empty
+reverseTree f (Single x) = Single (f x)
+reverseTree f (Deep _ pr m sf) =
+    deep (reverseDigit f sf) (reverseTree (reverseNode f) m) (reverseDigit f pr)
+
+reverseNode :: (Measured v2 a2) => (a1 -> a2) -> Node v1 a1 -> Node v2 a2
+reverseNode f (Node2 _ a b)   = node2 (f b) (f a)
+reverseNode f (Node3 _ a b c) = node3 (f c) (f b) (f a)
+
+reverseDigit :: (a -> b) -> Digit a -> Digit b
+reverseDigit f (One a)        = One (f a)
+reverseDigit f (Two a b)      = Two (f b) (f a)
+reverseDigit f (Three a b c)  = Three (f c) (f b) (f a)
+reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
+
+illegal_argument :: String -> a
+illegal_argument name =
+    error $ "Logic error: " ++ name ++ " called with illegal argument"
+
+{- $example
+
+Particular abstract data types may be implemented by defining
+element types with suitable 'Measured' instances.
+
+(from section 4.5 of the paper)
+Simple sequences can be implemented using a 'Sum' monoid as a measure:
+
+> newtype Elem a = Elem { getElem :: a }
+>
+> instance Measured (Sum Int) (Elem a) where
+>     measure (Elem _) = Sum 1
+>
+> newtype Seq a = Seq (FingerTree (Sum Int) (Elem a))
+
+Then the measure of a subsequence is simply its length.
+This representation supports log-time extraction of subsequences:
+
+> take :: Int -> Seq a -> Seq a
+> take k (Seq xs) = Seq (takeUntil (> Sum k) xs)
+>
+> drop :: Int -> Seq a -> Seq a
+> drop k (Seq xs) = Seq (dropUntil (> Sum k) xs)
+
+The module @Data.Sequence@ is an optimized instantiation of this type.
+
+For further examples, see "Data.IntervalMap.FingerTree" and
+"Data.PriorityQueue.FingerTree".
+
+-}
diff --git a/src/HaskellWorks/Data/IntervalMap/FingerTree.hs b/src/HaskellWorks/Data/IntervalMap/FingerTree.hs
new file mode 100644
--- /dev/null
+++ b/src/HaskellWorks/Data/IntervalMap/FingerTree.hs
@@ -0,0 +1,235 @@
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DeriveAnyClass        #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe                  #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable    #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.PriorityQueue.FingerTree
+-- Copyright   :  (c) Ross Paterson 2008
+-- License     :  BSD-style
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  non-portable (MPTCs and functional dependencies)
+--
+-- Interval maps implemented using the 'FingerTree' type, following
+-- section 4.8 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://staff.city.ac.uk/~ross/papers/FingerTree.html>
+--
+-- An amortized running time is given for each operation, with /n/
+-- referring to the size of the priority queue.  These bounds hold even
+-- in a persistent (shared) setting.
+--
+-- /Note/: Many of these operations have the same names as similar
+-- operations on lists in the "Prelude".  The ambiguity may be resolved
+-- using either qualification or the @hiding@ clause.
+--
+-----------------------------------------------------------------------------
+
+module HaskellWorks.Data.IntervalMap.FingerTree (
+    -- * Intervals
+    Interval(..), point,
+    -- * Interval maps
+    IntervalMap(..), empty, singleton, insert, union,
+    -- * Searching
+    search, intersections, dominators
+    ) where
+
+import Control.Applicative          ((<$>))
+import Control.DeepSeq
+import Data.Foldable                (Foldable (foldMap))
+import Data.Monoid
+import Data.Traversable             (Traversable (traverse))
+import GHC.Generics
+import HaskellWorks.Data.FingerTree (FingerTree, Measured (..), ViewL (..), (<|), (><))
+
+import qualified Data.Semigroup               as S
+import qualified HaskellWorks.Data.FingerTree as FT
+
+----------------------------------
+-- 4.8 Application: interval trees
+----------------------------------
+
+-- | A closed interval.  The lower bound should be less than or equal
+-- to the higher bound.
+data Interval v = Interval { low :: v, high :: v }
+    deriving (Eq, Ord, Show, Generic, NFData)
+
+-- | An interval in which the lower and upper bounds are equal.
+point :: v -> Interval v
+point v = Interval v v
+
+data Node v a = Node (Interval v) a deriving (Generic, NFData)
+
+instance Functor (Node v) where
+    fmap f (Node i x) = Node i (f x)
+
+instance Foldable (Node v) where
+    foldMap f (Node _ x) = f x
+
+instance Traversable (Node v) where
+    traverse f (Node i x) = Node i <$> f x
+
+-- rightmost interval (including largest lower bound) and largest upper bound.
+data IntInterval v = NoInterval | IntInterval (Interval v) v deriving (Generic, NFData)
+
+appendInterval :: Ord v => IntInterval v -> IntInterval v -> IntInterval v
+appendInterval (NoInterval       ) (i                   ) = i
+appendInterval (i                ) (NoInterval          ) = i
+appendInterval (IntInterval _ hi1) (IntInterval int2 hi2) = IntInterval int2 (max hi1 hi2)
+{-# INLINE appendInterval #-}
+
+instance Ord v => S.Semigroup (IntInterval v) where
+  (<>) = appendInterval
+  {-# INLINE (<>) #-}
+
+instance Ord v => Monoid (IntInterval v) where
+  mempty = NoInterval
+  {-# INLINE mempty #-}
+  mappend = appendInterval
+  {-# INLINE mappend #-}
+
+instance (Ord v) => Measured (IntInterval v) (Node v a) where
+    measure (Node i _) = IntInterval i (high i)
+
+-- | Map of closed intervals, possibly with duplicates.
+-- The 'Foldable' and 'Traversable' instances process the intervals in
+-- lexicographical order.
+newtype IntervalMap v a =
+    IntervalMap (FingerTree (IntInterval v) (Node v a))
+    deriving (Generic, NFData)
+-- ordered lexicographically by interval
+
+instance Functor (IntervalMap v) where
+    fmap f (IntervalMap t) = IntervalMap (FT.unsafeFmap (fmap f) t)
+
+instance Foldable (IntervalMap v) where
+    foldMap f (IntervalMap t) = foldMap (foldMap f) t
+
+instance Traversable (IntervalMap v) where
+    traverse f (IntervalMap t) =
+        IntervalMap <$> FT.unsafeTraverse (traverse f) t
+
+instance (Ord v) => S.Semigroup (IntervalMap v a) where
+  (<>) = union
+  {-# INLINE (<>) #-}
+
+-- | 'empty' and 'union'.
+instance (Ord v) => Monoid (IntervalMap v a) where
+    mempty = empty
+    {-# INLINE mempty #-}
+    mappend = union
+    {-# INLINE mappend #-}
+
+-- | /O(1)/.  The empty interval map.
+empty :: (Ord v) => IntervalMap v a
+empty = IntervalMap FT.empty
+
+-- | /O(1)/.  Interval map with a single entry.
+singleton :: (Ord v) => Interval v -> a -> IntervalMap v a
+singleton i x = IntervalMap (FT.singleton (Node i x))
+
+-- | /O(log n)/.  Insert an interval into a map.
+-- The map may contain duplicate intervals; the new entry will be inserted
+-- before any existing entries for the same interval.
+insert :: (Ord v) => Interval v -> a -> IntervalMap v a -> IntervalMap v a
+insert (Interval lo hi) _ m | lo > hi = m
+insert i x (IntervalMap t) = IntervalMap (l >< Node i x <| r)
+  where
+    (l, r) = FT.split larger t
+    larger (IntInterval k _) = k >= i
+    larger NoInterval        = error "larger NoInterval"
+
+-- | /O(m log (n/\//m))/.  Merge two interval maps.
+-- The map may contain duplicate intervals; entries with equal intervals
+-- are kept in the original order.
+union  ::  (Ord v) => IntervalMap v a -> IntervalMap v a -> IntervalMap v a
+union (IntervalMap xs) (IntervalMap ys) = IntervalMap (merge1 xs ys)
+  where
+    merge1 as bs = case FT.viewl as of
+        EmptyL                  -> bs
+        a@(Node i _) :< as'     -> l >< a <| merge2 as' r
+          where
+            (l, r) = FT.split larger bs
+            larger (IntInterval k _) = k >= i
+            larger NoInterval        = error "larger NoInterval"
+    merge2 as bs = case FT.viewl bs of
+        EmptyL                  -> as
+        b@(Node i _) :< bs'     -> l >< b <| merge1 r bs'
+          where
+            (l, r) = FT.split larger as
+            larger (IntInterval k _) = k > i
+            larger NoInterval        = error "larger NoInterval"
+
+-- | /O(k log (n/\//k))/.  All intervals that intersect with the given
+-- interval, in lexicographical order.
+intersections :: (Ord v) => Interval v -> IntervalMap v a -> [(Interval v, a)]
+intersections i = inRange (low i) (high i)
+
+-- | /O(k log (n/\//k))/.  All intervals that contain the given interval,
+-- in lexicographical order.
+dominators :: (Ord v) => Interval v -> IntervalMap v a -> [(Interval v, a)]
+dominators i = inRange (high i) (low i)
+
+-- | /O(k log (n/\//k))/.  All intervals that contain the given point,
+-- in lexicographical order.
+search :: (Ord v) => v -> IntervalMap v a -> [(Interval v, a)]
+search p = inRange p p
+
+-- | /O(k log (n/\//k))/.  All intervals that intersect with the given
+-- interval, in lexicographical order.
+inRange :: (Ord v) => v -> v -> IntervalMap v a -> [(Interval v, a)]
+inRange lo hi (IntervalMap t) = matches (FT.takeUntil (greater hi) t)
+  where
+    matches xs  =  case FT.viewl (FT.dropUntil (atleast lo) xs) of
+        EmptyL          ->  []
+        Node i x :< xs' ->  (i, x) : matches xs'
+
+atleast :: (Ord v) => v -> IntInterval v -> Bool
+atleast k (IntInterval _ hi) = k <= hi
+atleast _ NoInterval         = error "atleast NoInterval"
+
+greater :: (Ord v) => v -> IntInterval v -> Bool
+greater k (IntInterval i _) = low i > k
+greater _ NoInterval        = error "greater NoInterval"
+
+{-
+-- Examples
+
+mkMap :: (Ord v) => [(v, v, a)] -> IntervalMap v a
+mkMap = foldr ins empty
+  where
+    ins (lo, hi, n) = insert (Interval lo hi) n
+
+composers :: IntervalMap Int String
+composers = mkMap [
+    (1685, 1750, "Bach"),
+    (1685, 1759, "Handel"),
+    (1732, 1809, "Haydn"),
+    (1756, 1791, "Mozart"),
+    (1770, 1827, "Beethoven"),
+    (1782, 1840, "Paganini"),
+    (1797, 1828, "Schubert"),
+    (1803, 1869, "Berlioz"),
+    (1810, 1849, "Chopin"),
+    (1833, 1897, "Brahms"),
+    (1838, 1875, "Bizet")]
+
+mathematicians :: IntervalMap Int String
+mathematicians = mkMap [
+    (1642, 1727, "Newton"),
+    (1646, 1716, "Leibniz"),
+    (1707, 1783, "Euler"),
+    (1736, 1813, "Lagrange"),
+    (1777, 1855, "Gauss"),
+    (1811, 1831, "Galois")]
+-}
diff --git a/src/HaskellWorks/Data/PriorityQueue/FingerTree.hs b/src/HaskellWorks/Data/PriorityQueue/FingerTree.hs
new file mode 100644
--- /dev/null
+++ b/src/HaskellWorks/Data/PriorityQueue/FingerTree.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe                  #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE AutoDeriveTypeable    #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.PriorityQueue.FingerTree
+-- Copyright   :  (c) Ross Paterson 2008
+-- License     :  BSD-style
+-- Maintainer  :  R.Paterson@city.ac.uk
+-- Stability   :  experimental
+-- Portability :  non-portable (MPTCs and functional dependencies)
+--
+-- Min-priority queues implemented using the 'FingerTree' type,
+-- following section 4.6 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://staff.city.ac.uk/~ross/papers/FingerTree.html>
+--
+-- These have the same big-O complexity as skew heap implementations,
+-- but are approximately an order of magnitude slower.
+-- On the other hand, they are stable, so they can be used for fair
+-- queueing.  They are also shallower, so that 'fmap' consumes less
+-- space.
+--
+-- An amortized running time is given for each operation, with /n/
+-- referring to the size of the priority queue.  These bounds hold even
+-- in a persistent (shared) setting.
+--
+-- /Note/: Many of these operations have the same names as similar
+-- operations on lists in the "Prelude".  The ambiguity may be resolved
+-- using either qualification or the @hiding@ clause.
+--
+-----------------------------------------------------------------------------
+
+module HaskellWorks.Data.PriorityQueue.FingerTree (
+    PQueue,
+    -- * Construction
+    empty,
+    singleton,
+    union,
+    insert,
+    add,
+    fromList,
+    -- * Deconstruction
+    null,
+    minView,
+    minViewWithKey
+    ) where
+
+import Control.Arrow                ((***))
+import Data.Foldable                (Foldable (foldMap))
+import Data.Monoid
+import HaskellWorks.Data.FingerTree (FingerTree, Measured (..), ViewL (..), (<|), (><), (|>))
+import Prelude                      hiding (null)
+
+import qualified Data.Semigroup               as S
+import qualified HaskellWorks.Data.FingerTree as FT
+
+data Entry k v = Entry k v
+
+instance Functor (Entry k) where
+    fmap f (Entry k v) = Entry k (f v)
+
+instance Foldable (Entry k) where
+    foldMap f (Entry _ v) = f v
+
+data Prio k v = NoPrio | Prio k v
+
+appendPrio :: Ord k => Prio k v -> Prio k v -> Prio k v
+appendPrio x             NoPrio        = x
+appendPrio NoPrio        y             = y
+appendPrio x@(Prio kx _) y@(Prio ky _) = if kx <= ky then x else y
+{-# INLINE appendPrio #-}
+
+instance Ord k => S.Semigroup (Prio k v) where
+  (<>) = appendPrio
+  {-# INLINE (<>) #-}
+
+instance Ord k => Monoid (Prio k v) where
+    mempty  = NoPrio
+    {-# INLINE mempty #-}
+    mappend = appendPrio
+    {-# INLINE mappend #-}
+
+instance Ord k => Measured (Prio k v) (Entry k v) where
+    measure (Entry k v) = Prio k v
+
+-- | Priority queues.
+newtype PQueue k v = PQueue (FingerTree (Prio k v) (Entry k v))
+
+instance Ord k => Functor (PQueue k) where
+    fmap f (PQueue xs) = PQueue (FT.fmap' (fmap f) xs)
+
+instance Ord k => Foldable (PQueue k) where
+    foldMap f q = case minView q of
+        Nothing      -> mempty
+        Just (v, q') -> f v `mappend` foldMap f q'
+
+instance Ord k => S.Semigroup (PQueue k v) where
+  (<>) = union
+  {-# INLINE (<>) #-}
+
+instance Ord k => Monoid (PQueue k v) where
+  mempty = empty
+  {-# INLINE mempty #-}
+  mappend = union
+  {-# INLINE mappend #-}
+
+-- | /O(1)/. The empty priority queue.
+empty :: Ord k => PQueue k v
+empty = PQueue FT.empty
+
+-- | /O(1)/. A singleton priority queue.
+singleton :: Ord k => k -> v -> PQueue k v
+singleton k v = PQueue (FT.singleton (Entry k v))
+
+-- | /O(log n)/. Add a (priority, value) pair to the front of a priority queue.
+--
+-- * @'insert' k v q = 'union' ('singleton' k v) q@
+--
+-- If @q@ contains entries with the same priority @k@, 'minView' of
+-- @'insert' k v q@ will return them after this one.
+insert :: Ord k => k -> v -> PQueue k v -> PQueue k v
+insert k v (PQueue q) = PQueue (Entry k v <| q)
+
+-- | /O(log n)/. Add a (priority, value) pair to the back of a priority queue.
+--
+-- * @'add' k v q = 'union' q ('singleton' k v)@
+--
+-- If @q@ contains entries with the same priority @k@, 'minView' of
+-- @'add' k v q@ will return them before this one.
+add :: Ord k => k -> v -> PQueue k v -> PQueue k v
+add k v (PQueue q) = PQueue (q |> Entry k v)
+
+-- | /O(log(min(n1,n2)))/. Concatenate two priority queues.
+-- 'union' is associative, with identity 'empty'.
+--
+-- If there are entries with the same priority in both arguments, 'minView'
+-- of @'union' xs ys@ will return those from @xs@ before those from @ys@.
+union :: Ord k => PQueue k v -> PQueue k v -> PQueue k v
+union (PQueue xs) (PQueue ys) = PQueue (xs >< ys)
+
+-- | /O(n)/. Create a priority queue from a finite list of priorities
+-- and values.
+fromList :: Ord k => [(k, v)] -> PQueue k v
+fromList = foldr (uncurry insert) empty
+
+-- | /O(1)/. Is this the empty priority queue?
+null :: Ord k => PQueue k v -> Bool
+null (PQueue q) = FT.null q
+
+-- | /O(1)/ for the element, /O(log(n))/ for the reduced queue.
+-- Returns 'Nothing' for an empty map, or the value associated with the
+-- minimal priority together with the rest of the priority queue.
+--
+--  * @'minView' 'empty' = 'Nothing'@
+--
+--  * @'minView' ('singleton' k v) = 'Just' (v, 'empty')@
+--
+minView :: Ord k => PQueue k v -> Maybe (v, PQueue k v)
+minView q = fmap (snd *** id) (minViewWithKey q)
+
+-- | /O(1)/ for the element, /O(log(n))/ for the reduced queue.
+-- Returns 'Nothing' for an empty map, or the minimal (priority, value)
+-- pair together with the rest of the priority queue.
+--
+--  * @'minViewWithKey' 'empty' = 'Nothing'@
+--
+--  * @'minViewWithKey' ('singleton' k v) = 'Just' ((k, v), 'empty')@
+--
+--  * If @'minViewWithKey' qi = 'Just' ((ki, vi), qi')@ and @k1 <= k2@,
+--    then @'minViewWithKey' ('union' q1 q2) = 'Just' ((k1, v1), 'union' q1' q2)@
+--
+--  * If @'minViewWithKey' qi = 'Just' ((ki, vi), qi')@ and @k2 < k1@,
+--    then @'minViewWithKey' ('union' q1 q2) = 'Just' ((k2, v2), 'union' q1 q2')@
+--
+minViewWithKey :: Ord k => PQueue k v -> Maybe ((k, v), PQueue k v)
+minViewWithKey (PQueue q)
+  | FT.null q = Nothing
+  | otherwise = Just ((k, v), case FT.viewl r of
+    _ :< r' -> PQueue (l >< r')
+    _       -> error "can't happen")
+  where
+    Prio k v = measure q
+    (l, r) = FT.split (below k) q
+
+below :: Ord k => k -> Prio k v -> Bool
+below _ NoPrio      = False
+below k (Prio k' _) = k' <= k
diff --git a/tests/HaskellWorks/Data/FingerTree/Gen.hs b/tests/HaskellWorks/Data/FingerTree/Gen.hs
new file mode 100644
--- /dev/null
+++ b/tests/HaskellWorks/Data/FingerTree/Gen.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module HaskellWorks.Data.FingerTree.Gen where
+
+import Control.Monad
+import HaskellWorks.Data.FingerTree
+import Hedgehog
+
+import qualified Hedgehog.Gen             as G
+import qualified Hedgehog.Internal.Gen    as G
+import qualified Hedgehog.Internal.Shrink as S
+import qualified Hedgehog.Range           as R
+
+genList :: MonadGen m => Range Int -> m a -> m [a]
+genList range gen =
+  G.sized $ \size ->
+    (traverse snd =<<) .
+    G.ensure (G.atLeast $ R.lowerBound size range) .
+    G.shrink S.list $ do
+      k <- G.integral_ range
+      replicateM k (G.freeze gen)
+
+shrinkFingerTree :: Measured v a => FingerTree v a -> [FingerTree v a]
+shrinkFingerTree (Deep _ (One a) Empty (One b)) = [Single a, Single b]
+shrinkFingerTree (Deep _ pr m sf) =
+    [deep pr' m  sf  | pr' <- shrinkDigit      pr] ++
+    [deep pr  m' sf  | m'  <- shrinkFingerTree m ] ++
+    [deep pr  m  sf' | sf' <- shrinkDigit      sf]
+shrinkFingerTree (Single x) = []
+shrinkFingerTree Empty = []
+
+fingerTree :: (MonadGen m, Measured v a) => m a -> m (FingerTree v a)
+fingerTree gen = G.sized $ \size -> genSizedFingerTree size gen
+
+genSizedFingerTree :: (MonadGen m, Measured v a) => Size -> m a -> m (FingerTree v a)
+genSizedFingerTree n gen = G.shrink shrinkFingerTree $ case n of
+    0 -> return Empty
+    1 -> Single <$> gen
+    n -> deep <$> (One <$> gen) <*> genSizedFingerTree (n `div` 2) (genSizedNode (n `div` 2) gen) <*> (One <$> gen)
+
+shrinkNode :: Measured v a => Node v a -> [Node v a]
+shrinkNode (Node2 _ a b) = []
+shrinkNode (Node3 _ a b c) = [node2 a  b, node2 a c, node2 b c]
+
+genSizedNode :: (MonadGen m, Measured v a) => Size -> m a -> m (Node v a)
+genSizedNode n gen = G.shrink shrinkNode $ G.choice
+    [ node2 <$> gen <*> gen
+    , node3 <$> gen <*> gen <*> gen
+    ]
+
+shrinkDigit :: Digit a -> [Digit a]
+shrinkDigit (One a)         = []
+shrinkDigit (Two a b)       = [One a, One b]
+shrinkDigit (Three a b c)   = [Two a b, Two a c, Two b c]
+shrinkDigit (Four a b c d)  = [Three a b c, Three a b d, Three a c d, Three b c d]
diff --git a/tests/HaskellWorks/Data/FingerTreeSpec.hs b/tests/HaskellWorks/Data/FingerTreeSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/HaskellWorks/Data/FingerTreeSpec.hs
@@ -0,0 +1,211 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module HaskellWorks.Data.FingerTreeSpec (spec) where
+
+import Control.Applicative          (Applicative (..))
+import Control.Monad                (ap)
+import Data.Foldable                (Foldable (foldMap, foldl, foldr), all, toList)
+import Data.Functor                 ((<$>))
+import Data.List                    (inits)
+import Data.Monoid                  (Monoid (..))
+import Data.Traversable             (traverse)
+import HaskellWorks.Data.FingerTree
+import HaskellWorks.Hspec.Hedgehog
+import Hedgehog                     hiding (evalM)
+import Prelude                      hiding (null, reverse)
+import Test.Hspec
+
+import qualified HaskellWorks.Data.FingerTree.Gen as G
+import qualified Hedgehog.Gen                     as G
+import qualified Hedgehog.Range                   as R
+import qualified Prelude                          as P
+
+{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}
+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}
+{-# ANN module ("HLint: redundant bracket"          :: String) #-}
+
+spec :: Spec
+spec = do
+  it "foldr" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    foldr (:) [] xs === P.foldr (:) [] (toList xs)
+  it "foldl" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    foldl (flip (:)) [] xs === P.foldl (flip (:)) [] (toList xs)
+  it "(==)" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    ys <- forAll (G.fingerTree (G.int R.constantBounded))
+    (xs == ys) === (toList xs == toList ys)
+  it "compare" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    ys <- forAll (G.fingerTree (G.int R.constantBounded))
+    compare xs ys === compare (toList xs) (toList ys)
+  it "mappend" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    ys <- forAll (G.fingerTree (G.int R.constantBounded))
+    toList' (mappend xs ys) ~== toList xs ++ toList ys
+  it "empty" $ require $ property $ do
+    toList' (empty :: Seq Int) === Just []
+  it "singletone" $ require $ property $ do
+    x <- forAll (G.int R.constantBounded)
+    toList' (singleton x) ~== [x]
+  it "(<|)" $ require $ property $ do
+    x  <- forAll (G.int R.constantBounded)
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    toList' (x <| xs) ~== x : toList xs
+  it "(|>)" $ require $ property $ do
+    x  <- forAll (G.int R.constantBounded)
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    toList' (xs |> x) ~== toList xs ++ [x]
+  it "(><)" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    ys <- forAll (G.fingerTree (G.int R.constantBounded))
+    toList' (xs >< ys) ~== toList xs ++ toList ys
+  it "fromList" $ require $ property $ do
+    xs <- forAll (G.list (R.linear 0 100) (G.int R.constantBounded))
+    toList' (fromList xs) ~== xs
+  it "null" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    null xs === P.null (toList xs)
+  it "viewl" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    case viewl xs of
+      EmptyL    -> P.null (toList xs) === True
+      x :< xs'  -> do
+        valid xs' === True
+        toList xs === x : toList xs'
+  it "viewr" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    case viewr xs of
+      EmptyR    -> P.null (toList xs) === True
+      xs' :> x  -> do
+        valid xs' === True
+        toList xs === toList xs' ++ [x]
+  it "split" $ require $ property $ do
+    n <- forAll (G.int R.constantBounded)
+    let p ys = P.length ys > n
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    toListPair' (split p xs) ~== P.splitAt n (toList xs)
+  it "takeUntil" $ require $ property $ do
+    n <- forAll (G.int R.constantBounded)
+    let p ys = P.length ys > n
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    toList' (takeUntil p xs) ~== P.take n (toList xs)
+  it "dropUntil" $ require $ property $ do
+    n <- forAll (G.int R.constantBounded)
+    let p ys = P.length ys > n
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    toList' (dropUntil p xs) ~== P.drop n (toList xs)
+  it "reverse" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    toList' (reverse xs) ~== P.reverse (toList xs)
+  it "fmap" $ require $ property $ do
+    let f = Just
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    toList' (fmap' f xs) ~== map f (toList xs)
+  it "fmapWithPos" $ require $ property $ do
+    let f = (,)
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    let xs_list = toList xs
+    toList' (fmapWithPos f xs) ~== zipWith f (inits xs_list) xs_list
+  it "traverse" $ require $ property $ do
+    let f x = do
+          n <- step
+          return (n, x)
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    toList' (evalM (traverse' f xs)) ~== evalM (traverse f (toList xs))
+  it "traverseWithPos" $ require $ property $ do
+    xs <- forAll (G.fingerTree (G.int R.constantBounded))
+    let f xs y = do
+          n <- step
+          return (xs, n, y)
+    let xs_list = toList xs
+    toList' (evalM (traverseWithPos f xs)) ~== evalM (traverse (uncurry f) (zip (inits xs_list) xs_list))
+
+infix 4 ~==
+
+(~==) :: (Show a, Eq a) => Maybe a -> a -> PropertyT IO ()
+(~==) = maybe (const failure) (===)
+
+newtype M a = M (Int -> (Int, a))
+
+runM :: M a -> Int -> (Int, a)
+runM (M m) = m
+
+evalM :: M a -> a
+evalM m = snd (runM m 0)
+
+instance Monad M where
+    return x = M $ \ n -> (n, x)
+    M u >>= f = M $ \ m -> let (n, x) = u m in runM (f x) n
+
+instance Functor M where
+    fmap f (M u) = M $ \ m -> let (n, x) = u m in (n, f x)
+
+instance Applicative M where
+    pure = return
+    (<*>) = ap
+
+step :: M Int
+step = M $ \ n -> (n+1, n)
+
+toListPair' ::
+    (Eq a, Measured [a] a, Valid a, Eq b, Measured [b] b, Valid b) =>
+        (Seq a, Seq b) -> Maybe ([a], [b])
+toListPair' (xs, ys) = (,) <$> toList' xs <*> toList' ys
+
+toList' :: (Eq a, Measured [a] a, Valid a) => Seq a -> Maybe [a]
+toList' xs
+  | valid xs = Just (toList xs)
+  | otherwise = Nothing
+
+class Valid a where
+  valid :: a -> Bool
+
+instance (Measured v a, Eq v, Valid a) => Valid (FingerTree v a) where
+    valid Empty = True
+    valid (Single x) = valid x
+    valid (Deep s pr m sf) =
+        s == measure pr `mappend` measure m `mappend` measure sf &&
+        valid pr && valid m && valid sf
+
+instance (Measured v a, Eq v, Valid a) => Valid (Node v a) where
+    valid node = measure node == foldMap measure node && all valid node
+
+instance Valid a => Valid (Digit a) where
+    valid = all valid
+
+instance Valid Int where
+    valid = const True
+
+instance Valid (a,b) where
+    valid = const True
+
+instance Valid (a,b,c) where
+    valid = const True
+
+instance Valid (Maybe a) where
+    valid = const True
+
+instance Valid [a] where
+    valid = const True
+
+------------------------------------------------------------------------
+-- Use list of elements as the measure
+------------------------------------------------------------------------
+
+type Seq a = FingerTree [a] a
+
+instance Measured [Int] Int where
+    measure x = [x]
+
+instance Measured [Maybe a] (Maybe a) where
+    measure x = [x]
+
+instance Measured [(a, b)] (a, b) where
+    measure x = [x]
+
+instance Measured [(a, b, c)] (a, b, c) where
+    measure x = [x]
diff --git a/tests/Spec.hs b/tests/Spec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/tests/ft-properties.hs b/tests/ft-properties.hs
deleted file mode 100644
--- a/tests/ft-properties.hs
+++ /dev/null
@@ -1,337 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
--- QuickCheck properties for Data.FingerTree
-
-module Main where
-
-import HaskellWorks.Data.FingerTree    -- needs to be compiled with -DTESTING for use here
-
-import Test.Framework
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
-import Test.HUnit (Assertion, (@?=))
-import Test.QuickCheck hiding ((><))
-import Test.QuickCheck.Poly
-
-import Prelude hiding (null, reverse, foldl, foldl1, foldr, foldr1, all)
-import qualified Prelude
-
-import Control.Applicative (Applicative(..))
-import Control.Monad (ap)
-import Data.Foldable (Foldable(foldMap, foldl, foldr), toList, all)
-import Data.Functor ((<$>))
-import Data.Traversable (traverse)
-import Data.List (inits)
-import Data.Monoid (Monoid(..))
-
-main :: IO ()
-main = defaultMainWithOpts
-    [ testProperty "foldr" prop_foldr
-    , testProperty "foldl" prop_foldl
-    , testProperty "(==)" prop_equals
-    , testProperty "compare" prop_compare
-    , testProperty "mappend" prop_mappend
-    , testCase "empty" test_empty
-    , testProperty "singleton" prop_singleton
-    , testProperty "(<|)" prop_cons
-    , testProperty "(|>)" prop_snoc
-    , testProperty "(><)" prop_append
-    , testProperty "fromList" prop_fromList
-    , testProperty "null" prop_null
-    , testProperty "viewl" prop_viewl
-    , testProperty "viewr" prop_viewr
-    , testProperty "split" prop_split
-    , testProperty "takeUntil" prop_takeUntil
-    , testProperty "dropUntil" prop_dropUntil
-    , testProperty "reverse" prop_reverse
-    , testProperty "fmap'" prop_fmap'
-    -- , testProperty "fmapWithPos" prop_fmapWithPos -- (slow)
-    , testProperty "traverse'" prop_traverse'
-    -- , testProperty "traverseWithPos" prop_traverseWithPos -- (slow)
-    ] runner_opts
-  where
-    runner_opts = mempty { ropt_test_options = Just test_opts }
-    test_opts = mempty {
-          topt_maximum_generated_tests = Just 500
-        , topt_maximum_unsuitable_generated_tests = Just 500
-        }
-
-{--------------------------------------------------------------------
-  The general plan is to compare each function with a list equivalent.
-  Each operation should produce a valid tree representing the same
-  sequence as produced by its list counterpart on corresponding inputs.
-  (The list versions are often lazier, but these properties ignore
-  strictness.)
---------------------------------------------------------------------}
-
--- utilities for partial conversions
-
-infix 4 ~=
-
-(~=) :: Eq a => Maybe a -> a -> Bool
-(~=) = maybe (const False) (==)
-
--- Partial conversion of an output sequence to a list.
-toList' :: (Eq a, Measured [a] a, Valid a) => Seq a -> Maybe [a]
-toList' xs
-  | valid xs = Just (toList xs)
-  | otherwise = Nothing
-
-toListPair' ::
-    (Eq a, Measured [a] a, Valid a, Eq b, Measured [b] b, Valid b) =>
-        (Seq a, Seq b) -> Maybe ([a], [b])
-toListPair' (xs, ys) = (,) <$> toList' xs <*> toList' ys
-
--- instances
-
-prop_foldr :: Seq A -> Bool
-prop_foldr xs =
-    foldr f z xs == Prelude.foldr f z (toList xs)
-  where
-    f = (:)
-    z = []
-
-prop_foldl :: Seq A -> Bool
-prop_foldl xs =
-    foldl f z xs == Prelude.foldl f z (toList xs)
-  where
-    f = flip (:)
-    z = []
-
-prop_equals :: Seq OrdA -> Seq OrdA -> Bool
-prop_equals xs ys =
-    (xs == ys) == (toList xs == toList ys)
-
-prop_compare :: Seq OrdA -> Seq OrdA -> Bool
-prop_compare xs ys =
-    compare xs ys == compare (toList xs) (toList ys)
-
-prop_mappend :: Seq A -> Seq A -> Bool
-prop_mappend xs ys =
-    toList' (mappend xs ys) ~= toList xs ++ toList ys
-
--- * Construction
-
-test_empty :: Assertion
-test_empty =
-    toList' (empty :: Seq A) @?= Just []
-
-prop_singleton :: A -> Bool
-prop_singleton x =
-    toList' (singleton x) ~= [x]
-
-prop_cons :: A -> Seq A -> Bool
-prop_cons x xs =
-    toList' (x <| xs) ~= x : toList xs
-
-prop_snoc :: Seq A -> A -> Bool
-prop_snoc xs x =
-    toList' (xs |> x) ~= toList xs ++ [x]
-
-prop_append :: Seq A -> Seq A -> Bool
-prop_append xs ys =
-    toList' (xs >< ys) ~= toList xs ++ toList ys
-
-prop_fromList :: [A] -> Bool
-prop_fromList xs =
-    toList' (fromList xs) ~= xs
-
--- * Deconstruction
-
-prop_null :: Seq A -> Bool
-prop_null xs =
-    null xs == Prelude.null (toList xs)
-
-prop_viewl :: Seq A -> Bool
-prop_viewl xs =
-    case viewl xs of
-    EmptyL ->   Prelude.null (toList xs)
-    x :< xs' -> valid xs' && toList xs == x : toList xs'
-
-prop_viewr :: Seq A -> Bool
-prop_viewr xs =
-    case viewr xs of
-    EmptyR ->   Prelude.null (toList xs)
-    xs' :> x -> valid xs' && toList xs == toList xs' ++ [x]
-
-prop_split :: Int -> Seq A -> Bool
-prop_split n xs =
-    toListPair' (split p xs) ~= Prelude.splitAt n (toList xs)
-  where p ys = Prelude.length ys > n
-
-prop_takeUntil :: Int -> Seq A -> Bool
-prop_takeUntil n xs =
-    toList' (takeUntil p xs) ~= Prelude.take n (toList xs)
-  where p ys = Prelude.length ys > n
-
-prop_dropUntil :: Int -> Seq A -> Bool
-prop_dropUntil n xs =
-    toList' (dropUntil p xs) ~= Prelude.drop n (toList xs)
-  where p ys = Prelude.length ys > n
-
--- * Transformation
-
-prop_reverse :: Seq A -> Bool
-prop_reverse xs =
-    toList' (reverse xs) ~= Prelude.reverse (toList xs)
-
-prop_fmap' :: Seq A -> Bool
-prop_fmap' xs =
-    toList' (fmap' f xs) ~= map f (toList xs)
-  where f = Just
-
-prop_fmapWithPos :: Seq A -> Bool
-prop_fmapWithPos xs =
-    toList' (fmapWithPos f xs) ~= zipWith f (inits xs_list) xs_list
-  where
-    f = (,)
-    xs_list = toList xs
-
-prop_traverse' :: Seq A -> Bool
-prop_traverse' xs =
-    toList' (evalM (traverse' f xs)) ~= evalM (traverse f (toList xs))
-  where
-    f x = do
-        n <- step
-        return (n, x)
-
-prop_traverseWithPos :: Seq A -> Bool
-prop_traverseWithPos xs =
-    toList' (evalM (traverseWithPos f xs)) ~= evalM (traverse (uncurry f) (zip (inits xs_list) xs_list))
-  where
-    f xs y = do
-        n <- step
-        return (xs, n, y)
-    xs_list = toList xs
-
-{- untested:
-traverseWithPos
--}
-
-------------------------------------------------------------------------
--- QuickCheck
-------------------------------------------------------------------------
-
-instance (Arbitrary a, Measured v a) => Arbitrary (FingerTree v a) where
-    arbitrary = sized arb
-      where
-        arb :: (Arbitrary a, Measured v a) => Int -> Gen (FingerTree v a)
-        arb 0 = return Empty
-        arb 1 = Single <$> arbitrary
-        arb n = deep <$> arbitrary <*> arb (n `div` 2) <*> arbitrary
-
-    shrink (Deep _ (One a) Empty (One b)) = [Single a, Single b]
-    shrink (Deep _ pr m sf) =
-        [deep pr' m sf | pr' <- shrink pr] ++
-        [deep pr m' sf | m' <- shrink m] ++
-        [deep pr m sf' | sf' <- shrink sf]
-    shrink (Single x) = map Single (shrink x)
-    shrink Empty = []
-
-instance (Arbitrary a, Measured v a) => Arbitrary (Node v a) where
-    arbitrary = oneof [
-        node2 <$> arbitrary <*> arbitrary,
-        node3 <$> arbitrary <*> arbitrary <*> arbitrary]
-
-    shrink (Node2 _ a b) =
-        [node2 a' b | a' <- shrink a] ++
-        [node2 a b' | b' <- shrink b]
-    shrink (Node3 _ a b c) =
-        [node2 a b, node2 a c, node2 b c] ++
-        [node3 a' b c | a' <- shrink a] ++
-        [node3 a b' c | b' <- shrink b] ++
-        [node3 a b c' | c' <- shrink c]
-
-instance Arbitrary a => Arbitrary (Digit a) where
-    arbitrary = oneof [
-        One <$> arbitrary,
-        Two <$> arbitrary <*> arbitrary,
-        Three <$> arbitrary <*> arbitrary <*> arbitrary,
-        Four <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary]
-
-    shrink (One a) = map One (shrink a)
-    shrink (Two a b) = [One a, One b]
-    shrink (Three a b c) = [Two a b, Two a c, Two b c]
-    shrink (Four a b c d) = [Three a b c, Three a b d, Three a c d, Three b c d]
-
-------------------------------------------------------------------------
--- Valid trees
-------------------------------------------------------------------------
-
-class Valid a where
-    valid :: a -> Bool
-
-instance (Measured v a, Eq v, Valid a) => Valid (FingerTree v a) where
-    valid Empty = True
-    valid (Single x) = valid x
-    valid (Deep s pr m sf) =
-        s == measure pr `mappend` measure m `mappend` measure sf &&
-        valid pr && valid m && valid sf
-
-instance (Measured v a, Eq v, Valid a) => Valid (Node v a) where
-    valid node = measure node == foldMap measure node && all valid node
-
-instance Valid a => Valid (Digit a) where
-    valid = all valid
-
-instance Valid A where
-    valid = const True
-
-instance Valid (a,b) where
-    valid = const True
-
-instance Valid (a,b,c) where
-    valid = const True
-
-instance Valid (Maybe a) where
-    valid = const True
-
-instance Valid [a] where
-    valid = const True
-
-------------------------------------------------------------------------
--- Use list of elements as the measure
-------------------------------------------------------------------------
-
-type Seq a = FingerTree [a] a
-
-instance Measured [A] A where
-    measure x = [x]
-
-instance Measured [OrdA] OrdA where
-    measure x = [x]
-
-instance Measured [Maybe a] (Maybe a) where
-    measure x = [x]
-
-instance Measured [(a, b)] (a, b) where
-    measure x = [x]
-
-instance Measured [(a, b, c)] (a, b, c) where
-    measure x = [x]
-
-------------------------------------------------------------------------
--- Simple counting monad
-------------------------------------------------------------------------
-
-newtype M a = M (Int -> (Int, a))
-
-runM :: M a -> Int -> (Int, a)
-runM (M m) = m
-
-evalM :: M a -> a
-evalM m = snd (runM m 0)
-
-instance Monad M where
-    return x = M $ \ n -> (n, x)
-    M u >>= f = M $ \ m -> let (n, x) = u m in runM (f x) n
-
-instance Functor M where
-    fmap f (M u) = M $ \ m -> let (n, x) = u m in (n, f x)
-
-instance Applicative M where
-    pure = return
-    (<*>) = ap
-
-step :: M Int
-step = M $ \ n -> (n+1, n)