diff --git a/hw-fingertree-strict.cabal b/hw-fingertree-strict.cabal
--- a/hw-fingertree-strict.cabal
+++ b/hw-fingertree-strict.cabal
@@ -2,10 +2,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: cf96e753aa89a6ce71fe493132b754969cc657812d4d88482f673fee7fe3a96c
+-- hash: f1b862b22d5d83cf314a1c9f6c15e9533377a9225218e6b3bd7693aa5a50f50b
 
 name:           hw-fingertree-strict
-version:        0.1.0.2
+version:        0.1.0.3
 synopsis:       Generic strict finger-tree structure
 description:    A general sequence representation with arbitrary
                 annotations, for use as a base for implementations of
@@ -44,6 +44,7 @@
       src
   build-depends:
       base >=4.7 && <5
+    , deepseq
   if !(impl(ghc >=8.0))
     build-depends:
         semigroups ==0.18.*
@@ -78,8 +79,10 @@
     , test-framework-hunit
     , test-framework-quickcheck2
   other-modules:
+      HaskellWorks.Data.FingerTree.Gen
       HaskellWorks.Data.FingerTree.Strict.Gen
       HaskellWorks.Data.FingerTree.StrictSpec
+      HaskellWorks.Data.FingerTreeSpec
       HaskellWorks.Data.Gen
       HaskellWorks.Data.SegmentMap.StrictSpec
       HaskellWorks.Data.SegmentSet.Naive
diff --git a/src/HaskellWorks/Data/FingerTree/Strict.hs b/src/HaskellWorks/Data/FingerTree/Strict.hs
--- a/src/HaskellWorks/Data/FingerTree/Strict.hs
+++ b/src/HaskellWorks/Data/FingerTree/Strict.hs
@@ -65,8 +65,10 @@
 import Prelude hiding (null, reverse)
 
 import Control.Applicative (Applicative (pure, (<*>)), (<$>))
+import Control.DeepSeq     (NFData)
 import Data.Foldable       (Foldable (foldMap), foldr', toList)
 import Data.Monoid
+import GHC.Generics        (Generic)
 
 import qualified Data.Semigroup as S
 
@@ -78,14 +80,14 @@
 data ViewL s a
     = EmptyL        -- ^ empty sequence
     | !a :< !(s a)  -- ^ leftmost element and the rest of the sequence
-    deriving (Eq, Ord, Show, Read)
+    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)
+    deriving (Eq, Ord, Show, Read, Generic, NFData)
 
 instance Functor s => Functor (ViewL s) where
     fmap _ EmptyL    = EmptyL
@@ -114,7 +116,7 @@
     | Two !a !a
     | Three !a !a !a
     | Four !a !a !a !a
-    deriving Show
+    deriving (Eq, Show, Generic, NFData)
 
 instance Foldable Digit where
     foldMap f (One a)        = f a
@@ -138,7 +140,7 @@
 ---------------------------
 
 data Node v a = Node2 !v !a !a | Node3 !v !a !a !a
-    deriving Show
+    deriving (Show, Generic, NFData)
 
 instance Foldable (Node v) where
     foldMap f (Node2 _ a b)   = f a `mappend` f b
@@ -173,7 +175,7 @@
     = Empty
     | Single !a
     | Deep !v !(Digit a) !(FingerTree v (Node v a)) !(Digit a)
-    deriving (Show)
+    deriving (Show, Generic, NFData)
 
 deep ::  (Measured v a) =>
      Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a
@@ -737,7 +739,7 @@
 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
+data Split t a = Split !t !a !t deriving (Eq, Show, Generic, NFData)
 
 splitTree :: (Measured v a) =>
     (v -> Bool) -> v -> FingerTree v a -> Split (FingerTree v a) a
diff --git a/src/HaskellWorks/Data/IntervalMap/Strict.hs b/src/HaskellWorks/Data/IntervalMap/Strict.hs
--- a/src/HaskellWorks/Data/IntervalMap/Strict.hs
+++ b/src/HaskellWorks/Data/IntervalMap/Strict.hs
@@ -45,9 +45,11 @@
     ) where
 
 import Control.Applicative                 ((<$>))
+import Control.DeepSeq                     (NFData)
 import Data.Foldable                       (Foldable (foldMap))
 import Data.Monoid
 import Data.Traversable                    (Traversable (traverse))
+import GHC.Generics                        (Generic)
 import HaskellWorks.Data.FingerTree.Strict (FingerTree, Measured (..), ViewL (..), (<|), (><))
 
 import qualified Data.Semigroup                      as S
@@ -60,13 +62,14 @@
 -- | 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)
+  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 (Eq, Show, Generic, NFData)
 
 instance Functor (Node v) where
     fmap f (Node i x) = Node i (f x)
@@ -79,6 +82,7 @@
 
 -- rightmost interval (including largest lower bound) and largest upper bound.
 data IntInterval v = NoInterval | IntInterval !(Interval v) !v
+  deriving (Eq, Show, Generic, NFData)
 
 appendInterval :: Ord v => IntInterval v -> IntInterval v -> IntInterval v
 appendInterval (NoInterval       ) (i                   ) = i
@@ -104,6 +108,8 @@
 -- lexicographical order.
 newtype IntervalMap v a =
     IntervalMap (FingerTree (IntInterval v) (Node v a))
+  deriving (Eq, Show, Generic, NFData)
+
 -- ordered lexicographically by interval
 
 instance Functor (IntervalMap v) where
diff --git a/src/HaskellWorks/Data/Item/Strict.hs b/src/HaskellWorks/Data/Item/Strict.hs
--- a/src/HaskellWorks/Data/Item/Strict.hs
+++ b/src/HaskellWorks/Data/Item/Strict.hs
@@ -1,11 +1,15 @@
+{-# LANGUAGE DeriveAnyClass        #-}
+{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module HaskellWorks.Data.Item.Strict where
 
+import Control.DeepSeq                     (NFData)
+import GHC.Generics                        (Generic)
 import HaskellWorks.Data.FingerTree.Strict
 
-data Item k a = Item !k !a deriving (Eq, Show)
+data Item k a = Item !k !a deriving (Eq, Show, Generic, NFData)
 
 instance Functor (Item k) where
     fmap f (Item i t) = Item i (f t)
diff --git a/src/HaskellWorks/Data/PriorityQueue/Strict.hs b/src/HaskellWorks/Data/PriorityQueue/Strict.hs
--- a/src/HaskellWorks/Data/PriorityQueue/Strict.hs
+++ b/src/HaskellWorks/Data/PriorityQueue/Strict.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 #if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Safe                  #-}
@@ -55,8 +56,10 @@
     ) where
 
 import Control.Arrow                       ((***))
+import Control.DeepSeq                     (NFData)
 import Data.Foldable                       (Foldable (foldMap))
 import Data.Monoid
+import GHC.Generics                        (Generic)
 import HaskellWorks.Data.FingerTree.Strict (FingerTree, Measured (..), ViewL (..), (<|), (><), (|>))
 import Prelude                             hiding (null)
 
diff --git a/src/HaskellWorks/Data/Segment/Strict.hs b/src/HaskellWorks/Data/Segment/Strict.hs
--- a/src/HaskellWorks/Data/Segment/Strict.hs
+++ b/src/HaskellWorks/Data/Segment/Strict.hs
@@ -1,14 +1,18 @@
+{-# LANGUAGE DeriveAnyClass        #-}
+{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module HaskellWorks.Data.Segment.Strict where
 
+import Control.DeepSeq                     (NFData)
+import GHC.Generics                        (Generic)
 import HaskellWorks.Data.FingerTree.Strict
 
 -- | A closed segment.  The lower bound should be less than or equal
 -- to the higher bound.
 data Segment k = Segment { low :: !k, high :: !k }
-    deriving (Eq, Ord, Show)
+    deriving (Eq, Ord, Show, Generic, NFData)
 
 -- | A segment in which the lower and upper bounds are equal.
 point :: k -> Segment k
diff --git a/src/HaskellWorks/Data/SegmentMap/Strict.hs b/src/HaskellWorks/Data/SegmentMap/Strict.hs
--- a/src/HaskellWorks/Data/SegmentMap/Strict.hs
+++ b/src/HaskellWorks/Data/SegmentMap/Strict.hs
@@ -1,6 +1,7 @@
 -- {-# LANGUAGE BangPatterns          #-}
 {-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DeriveAnyClass        #-}
+{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
@@ -56,17 +57,18 @@
     cappedM
     ) where
 
+import Control.Applicative                 ((<$>))
+import Control.DeepSeq                     (NFData)
+import Data.Foldable                       (Foldable (foldMap), foldl', toList)
+import Data.Semigroup
+import Data.Traversable                    (Traversable (traverse))
+import GHC.Generics                        (Generic)
 import HaskellWorks.Data.FingerTree.Strict (FingerTree, ViewL (..), ViewR (..), viewl, viewr, (<|), (><))
 import HaskellWorks.Data.Item.Strict
 import HaskellWorks.Data.Segment.Strict
 
 import qualified HaskellWorks.Data.FingerTree.Strict as FT
 
-import Control.Applicative ((<$>))
-import Data.Foldable       (Foldable (foldMap), foldl', toList)
-import Data.Semigroup
-import Data.Traversable    (Traversable (traverse))
-
 infixr 5 >*<
 
 ----------------------------------
@@ -77,9 +79,9 @@
 -- The 'Foldable' and 'Traversable' instances process the segments in
 -- lexicographical order.
 
-newtype OrderedMap k a = OrderedMap (FingerTree k (Item k a)) deriving Show
+newtype OrderedMap k a = OrderedMap (FingerTree k (Item k a)) deriving (Show, Generic, NFData)
 
-newtype SegmentMap k a = SegmentMap (OrderedMap (Max k) (Segment k, a)) deriving Show
+newtype SegmentMap k a = SegmentMap (OrderedMap (Max k) (Segment k, a)) deriving (Show, Generic, NFData)
 
 -- ordered lexicographically by segment start
 
diff --git a/src/HaskellWorks/Data/SegmentSet/Strict.hs b/src/HaskellWorks/Data/SegmentSet/Strict.hs
--- a/src/HaskellWorks/Data/SegmentSet/Strict.hs
+++ b/src/HaskellWorks/Data/SegmentSet/Strict.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DeriveAnyClass        #-}
+{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
@@ -59,17 +60,18 @@
     cappedM
     ) where
 
+import Control.Applicative                 ((<$>))
+import Control.DeepSeq                     (NFData)
+import Data.Foldable                       (Foldable (foldMap), foldl', toList)
+import Data.Semigroup
+import Data.Traversable                    (Traversable (traverse))
+import GHC.Generics                        (Generic)
 import HaskellWorks.Data.FingerTree.Strict (FingerTree, Measured (..), ViewL (..), ViewR (..), viewl, viewr, (<|), (><))
 import HaskellWorks.Data.Item.Strict
 import HaskellWorks.Data.Segment.Strict
 
 import qualified HaskellWorks.Data.FingerTree.Strict as FT
 
-import Control.Applicative ((<$>))
-import Data.Foldable       (Foldable (foldMap), foldl', toList)
-import Data.Semigroup
-import Data.Traversable    (Traversable (traverse))
-
 {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}
 
 infixr 5 >*<
@@ -82,9 +84,9 @@
 -- The 'Foldable' and 'Traversable' instances process the segments in
 -- lexicographical order.
 
-newtype OrderedMap k a = OrderedMap (FingerTree k (Item k a)) deriving Show
+newtype OrderedMap k a = OrderedMap (FingerTree k (Item k a)) deriving (Show, Generic, NFData)
 
-newtype SegmentSet k = SegmentSet (OrderedMap (Max k) (Segment k)) deriving Show
+newtype SegmentSet k = SegmentSet (OrderedMap (Max k) (Segment k)) deriving (Show, Generic, NFData)
 
 -- ordered lexicographically by segment start
 
diff --git a/test/HaskellWorks/Data/FingerTree/Gen.hs b/test/HaskellWorks/Data/FingerTree/Gen.hs
new file mode 100644
--- /dev/null
+++ b/test/HaskellWorks/Data/FingerTree/Gen.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module HaskellWorks.Data.FingerTree.Gen where
+
+import Control.Monad
+import HaskellWorks.Data.FingerTree.Strict
+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/test/HaskellWorks/Data/FingerTreeSpec.hs b/test/HaskellWorks/Data/FingerTreeSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/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.Strict
+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]