diff --git a/ChangeLog b/ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,20 @@
-0.9.8: Fixed bug.
+0.9.8.0:
+* Fixed incomplete pattern errors for `FastQueue` and `BSeq`.
+* Fixed fold order for `BSeq`.
+* Added a small test suite.
+* Added `Semigroup`, `Monoid`, `Eq`, `Ord`, `Show`, `Show1`,
+and `Read` instances for all the sequences.
+* Added a `fromList` method.
+* Made all method implementations reasonably efficient (to the
+extent possible for each structure). The defaults led to some
+operations being too slow to allow the test suite to complete.
+* Fixed a strictness bug in `viewl` for `FastQueue` that caused its
+amortized bounds to degrade under persistence.
+* Made folds and traversals for `FastQueue` respect the worst-case
+bounds for each element pulled.
+* Made `fmap` for `FastQueue` stop mapping over the schedule.
+* Arranged for GHC to be able to unpack `FastQueue`, though that
+will not immediately improve `FastCatQueue`.
 0.9.7: Added binary tree sequence datastructure
 0.9.6: Fixed bug in Functor for FastQueue which causes it be not O(1)
 0.9.5: Added traversable instances (thanks dolio!)
diff --git a/Data/Sequence/BSeq.hs b/Data/Sequence/BSeq.hs
--- a/Data/Sequence/BSeq.hs
+++ b/Data/Sequence/BSeq.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE Rank2Types,GADTs, DataKinds, TypeOperators #-}
-
-
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Sequence.BSeq
@@ -11,53 +7,14 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- A sequence, implemented as a binary tree, good performance when used ephemerally
+-- A catenable qeueue, implemented as a binary tree,
+-- with good amortized performance when used ephemerally.
 --
 --
 -----------------------------------------------------------------------------
-module Data.Sequence.BSeq(module Data.SequenceClass,BSeq)  where
-import Control.Applicative (pure, (<*>), (<$>))
-import Data.Foldable
-import Data.Monoid ((<>))
-import Data.Traversable
-import Prelude hiding (foldr,foldl)
+module Data.Sequence.BSeq
+  ( module Data.SequenceClass
+  , BSeq
+  ) where
+import Data.Sequence.BSeq.Internal
 import Data.SequenceClass
-
-data BSeq a = Empty | Leaf a | Node (BSeq a) (BSeq a)
-
-
-
-instance Functor BSeq where
-  fmap f = loop where
-    loop Empty = Empty
-    loop (Leaf x) = Leaf (f x)
-    loop (Node l r) = Node (loop l) (loop r)
-
-instance Foldable BSeq where
-  foldl f = loop where
-    loop i s = case viewl s of
-          EmptyL -> i
-          h :< t -> loop (f i h) t
-  foldr f i s = foldr f i (reverse $ toRevList s)
-    where toRevList s = case viewl s of
-           EmptyL -> []
-           h :< t -> h : toRevList t
-
-instance Traversable BSeq where
-  traverse f = loop where
-    loop Empty = pure Empty
-    loop (Leaf x) = Leaf <$> f x
-    loop (Node l r) = Node <$> loop l <*> loop r
-
-instance Sequence BSeq where
-  empty     = Empty
-  singleton = Leaf
-  (><)      = Node
-  viewl Empty               = EmptyL
-  viewl (Leaf x)            = x :< Empty
-  viewl (Node (Node l r) z) = viewl (Node l (Node r z))
-  viewl (Node Empty r)      = viewl r
-  viewl (Node (Leaf x) r)   = x :< r
-
-
-
diff --git a/Data/Sequence/BSeq/Internal.hs b/Data/Sequence/BSeq/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Sequence/BSeq/Internal.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Rank2Types,GADTs, DataKinds, TypeOperators #-}
+{-# LANGUAGE DeriveTraversable #-}
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+#endif
+
+
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Sequence.BSeq
+-- Copyright   :  (c) Atze van der Ploeg 2014
+-- License     :  BSD-style
+-- Maintainer  :  atzeus@gmail.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A catenable qeueue, implemented as a binary tree,
+-- with good amortized performance when used ephemerally.
+--
+--
+-----------------------------------------------------------------------------
+module Data.Sequence.BSeq.Internal (BSeq (..))  where
+import Control.Applicative hiding (empty)
+import Data.Foldable
+import Data.Monoid (Monoid (..), (<>))
+import Data.Traversable
+import qualified Text.Read as TR
+#if MIN_VERSION_base(4,9,0)
+import qualified Data.Semigroup as Semigroup
+import Data.Functor.Classes (Show1 (..))
+#endif
+import Data.Function (on)
+import Prelude hiding (foldr,foldl)
+import Data.SequenceClass
+
+-- | A catenable queue intended for ephemeral use.
+data BSeq a = Empty | Leaf a | Node (BSeq a) (BSeq a)
+-- Invariant: Neither child of a Node may be Empty.
+  deriving (Functor, Traversable)
+
+instance Foldable BSeq where
+  foldMap _ Empty = mempty
+  foldMap f (Leaf a) = f a
+  foldMap f (Node l r) = foldMap f l `mappend` foldMap f r
+
+  foldr _ n Empty = n
+  foldr c n (Leaf a) = c a n
+  foldr c n (Node l r) = foldr c (foldr c n r) l
+
+#if MIN_VERSION_base(4,8,0)
+  -- This implementation avoids digging into Nodes to see
+  -- that they're not empty.
+  null Empty = True
+  null _ = False
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup.Semigroup (BSeq a) where
+  (<>) = (><)
+#endif
+instance Monoid (BSeq a) where
+  mempty = empty
+#if MIN_VERSION_base(4,9,0)
+  mappend = (Semigroup.<>)
+#else
+  mappend = (><)
+#endif
+
+instance Show a => Show (BSeq a) where
+    showsPrec p xs = showParen (p > 10) $
+        showString "fromList " . shows (toList xs)
+
+#if MIN_VERSION_base(4,9,0)
+instance Show1 BSeq where
+  liftShowsPrec _shwsPrc shwList p xs = showParen (p > 10) $
+        showString "fromList " . shwList (toList xs)
+#endif
+
+instance Read a => Read (BSeq a) where
+    readPrec = TR.parens $ TR.prec 10 $ do
+        TR.Ident "fromList" <- TR.lexP
+        xs <- TR.readPrec
+        return (fromList xs)
+
+    readListPrec = TR.readListPrecDefault
+
+instance Eq a => Eq (BSeq a) where
+  (==) = (==) `on` toList
+
+instance Ord a => Ord (BSeq a) where
+  compare = compare `on` toList
+
+instance Sequence BSeq where
+  empty     = Empty
+  singleton = Leaf
+  Empty      >< r = r
+  l          >< Empty = l
+  Node l r   >< z = Node l (Node r z)
+  l@(Leaf _) >< z = Node l z
+  viewl Empty         = EmptyL
+  viewl (Leaf x)      = x :< Empty
+  viewl (Node l r)    = case viewl l of
+    EmptyL -> error "Invariant failure"
+    x :< l' -> (x :<) $! l' >< r
+  viewr Empty = EmptyR
+  viewr (Leaf x) = Empty :> x
+  viewr (Node l r) = case viewr r of
+    EmptyR -> error "Invariant failure"
+    r' :> x -> (:> x) $! l >< r'
+  fromList [] = Empty
+  fromList [x] = Leaf x
+  fromList (x : xs) = Node (Leaf x) (fromList xs)
diff --git a/Data/Sequence/FastCatQueue.hs b/Data/Sequence/FastCatQueue.hs
--- a/Data/Sequence/FastCatQueue.hs
+++ b/Data/Sequence/FastCatQueue.hs
@@ -9,7 +9,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- A sequence, a catanable queue, with worst case constant time: '><', '|>', '<|' and 'tviewl'.
+-- A sequence, a catenable queue, with worst case constant time: '><', '|>', '<|' and 'viewl'.
 --
 -----------------------------------------------------------------------------
 module Data.Sequence.FastCatQueue(module Data.SequenceClass, FastTCQueue) where
@@ -18,4 +18,5 @@
 import Data.Sequence.FastQueue
 import Data.Sequence.ToCatQueue
 
+-- | A catenable queue.
 type FastTCQueue =  ToCatQueue FastQueue
diff --git a/Data/Sequence/FastQueue.hs b/Data/Sequence/FastQueue.hs
--- a/Data/Sequence/FastQueue.hs
+++ b/Data/Sequence/FastQueue.hs
@@ -1,72 +1,24 @@
-{-# LANGUAGE GADTs, ViewPatterns, TypeOperators #-}
-
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Sequence.FastQueue
 -- Copyright   :  (c) Atze van der Ploeg 2014
+--                (c) David Feuer 2021
 -- License     :  BSD-style
 -- Maintainer  :  atzeus@gmail.org
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- A sequence, a queue, with worst case constant time: '|>', and 'tviewl'.
+-- A queue (actually an output-restricted deque), with worst case constant time:
+-- '|>', '<|', and 'viewl'. It has worst case linear time 'viewr' and '><'.
 --
 -- Based on: "Simple and Efficient Purely Functional Queues and Deques", Chris Okasaki,
 -- Journal of Functional Programming 1995
 --
 -----------------------------------------------------------------------------
 
-module Data.Sequence.FastQueue(module Data.SequenceClass, FastQueue) where
-import Control.Applicative (pure, (<$>), (<*>))
-import Control.Applicative.Backwards
+module Data.Sequence.FastQueue 
+  ( module Data.SequenceClass
+  , FastQueue
+  ) where
 import Data.SequenceClass
-import Data.Foldable
-import Data.Traversable
-import Prelude hiding (foldr,foldl)
-
-revAppend l r = rotate l r []
--- precondtion : |a| = |f| - (|r| - 1)
--- postcondition: |a| = |f| - |r|
-rotate :: [a] -> [a]-> [a] -> [a]
-rotate []  [y] r = y : r
-rotate (x : f) (y : r) a = x : rotate f r (y : a)
-rotate f        a     r  = error "Invariant |a| = |f| - (|r| - 1) broken"
-
-data FastQueue a where
-  RQ :: ![a] -> ![a] -> ![a] -> FastQueue a
-
-queue :: [a] -> [a] -> [a] -> FastQueue a
-queue f r [] = let f' = revAppend f r 
-                 in RQ f' [] f'
-queue f r (h : t) = RQ f r t
-
-instance Functor FastQueue where
-  fmap phi q = case viewl q of
-     EmptyL -> empty
-     h :< t -> phi h <| fmap phi t
-
-instance Foldable FastQueue where
-  foldl f = loop where
-    loop i s = case viewl s of
-          EmptyL -> i
-          h :< t -> loop (f i h) t
-  foldr f i s = foldr f i (reverse $ toRevList s)
-    where toRevList s = case viewl s of
-           EmptyL -> []
-           h :< t -> h : toRevList t
-
-instance Sequence FastQueue where
- empty = RQ [] [] []
- singleton x = let c = [x] in queue c [] c
- (RQ f r a) |> x = queue f (x : r) a
-
- viewl (RQ [] [] []) = EmptyL
- viewl (RQ (h : t) f a) = h :< queue t f a
-
-instance Traversable FastQueue where
-  sequenceA q = case viewl q of
-     EmptyL -> pure empty
-     h :< t  -> (<|) <$> h <*> sequenceA t
-   
-
+import Data.Sequence.FastQueue.Internal
diff --git a/Data/Sequence/FastQueue/Internal.hs b/Data/Sequence/FastQueue/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Sequence/FastQueue/Internal.hs
@@ -0,0 +1,186 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE BangPatterns #-}
+
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Sequence.FastQueue
+-- Copyright   :  (c) Atze van der Ploeg 2014
+--                (c) David Feuer 2021
+-- License     :  BSD-style
+-- Maintainer  :  atzeus@gmail.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A queue (actually an output-restricted deque), with worst case constant time:
+-- '|>', '<|', and 'viewl'. It has worst case linear time 'viewr'. '><' is linear
+-- in the length of its second argument.
+--
+-- Based on: "Simple and Efficient Purely Functional Queues and Deques", Chris Okasaki,
+-- Journal of Functional Programming 1995
+--
+-----------------------------------------------------------------------------
+
+module Data.Sequence.FastQueue.Internal
+  ( FastQueue (..)
+  , SL (..)
+  , appendSL
+  , queue
+  ) where
+import Data.SequenceClass hiding ((:>))
+import qualified Data.SequenceClass as SC
+import Data.Foldable
+import qualified Data.Traversable as T
+import Data.Sequence.FastQueue.Internal.Any
+import qualified Control.Applicative as A
+import Data.Function (on)
+import qualified Text.Read as TR
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes (Show1 (..))
+import qualified Data.Semigroup as Semigroup
+#endif
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Functor (Functor (..))
+import Data.Monoid (Monoid (..))
+#endif
+
+infixl 5 :>
+-- | A lazy-spined snoc-list. Why lazy-spined? Only because
+-- that's better for `fmap`. In theory, strict-spined should
+-- be a bit better for everything else, but in practice it
+-- makes no measurable difference.
+data SL a
+  = SNil
+  | SL a :> a
+  deriving Functor
+
+-- | Append a snoc list to a list.
+appendSL :: [a] -> SL a -> [a]
+appendSL l r = rotate l r []
+-- precondition : |a| = |f| - (|r| - 1)
+-- postcondition: |a| = |f| - |r|
+rotate :: [a] -> SL a -> [a] -> [a]
+rotate [] (SNil :> y) r = y : r
+rotate (x : f) (r :> y) a = x : rotate f r (y : a)
+rotate _f _a _r  = error "Invariant |a| = |f| - (|r| - 1) broken"
+
+-- | A scheduled Banker's FastQueue, as described by Okasaki.
+data FastQueue a = RQ ![a] !(SL a) ![Any]
+  deriving Functor
+  -- We use 'Any' rather than an existential to allow GHC to unpack
+  -- queues if it's so inclined.
+
+queue :: [a] -> SL a -> [Any] -> FastQueue a
+queue f r [] =
+  let
+    f' = appendSL f r
+    {-# NOINLINE f' #-}
+  in RQ f' SNil (toAnyList f')
+queue f r (_h : t) = RQ f r t
+
+instance Sequence FastQueue where
+  empty = RQ [] SNil []
+  singleton x =
+    let
+      c = [x]
+      {-# NOINLINE c #-}
+    in RQ c SNil (toAnyList c)
+  RQ f r a |> x = queue f (r :> x) a
+
+  -- We need to extend the schedule to maintain the
+  -- data structure invariant.
+  x <| RQ f r a = RQ (x : f) r (toAny () : a)
+
+  (><) = foldl' (|>)
+
+  viewl (RQ [] ~SNil ~[]) = EmptyL
+  viewl (RQ (h : t) f a) = h :< queue t f a
+
+  -- Sometimes we get lucky and we can snatch the last element
+  -- for free. Sometimes we don't, and it costs us O(n) time.
+  viewr (RQ f (rs :> r) a) = RQ f rs (toAny () : a) SC.:> r
+  viewr (RQ f SNil _) = case viewr f of
+    EmptyR -> EmptyR
+    f' SC.:> x -> fromList f' SC.:> x
+
+  fromList xs = RQ xs SNil (toAnyList xs)
+
+instance Show a => Show (FastQueue a) where
+    showsPrec p xs = showParen (p > 10) $
+        showString "fromList " . shows (toList xs)
+
+#if MIN_VERSION_base(4,9,0)
+instance Show1 FastQueue where
+  liftShowsPrec _shwsPrc shwList p xs = showParen (p > 10) $
+        showString "fromList " . shwList (toList xs)
+#endif
+
+instance Read a => Read (FastQueue a) where
+    readPrec = TR.parens $ TR.prec 10 $ do
+        TR.Ident "fromList" <- TR.lexP
+        xs <- TR.readPrec
+        return (fromList xs)
+
+    readListPrec = TR.readListPrecDefault
+
+instance Eq a => Eq (FastQueue a) where
+  (==) = (==) `on` toList
+
+instance Ord a => Ord (FastQueue a) where
+  compare = compare `on` toList
+
+-- -----------------
+-- Note: folding and traversing
+--
+-- We define the Foldable and Traversable instances for this type manually
+-- rather than deriving them. This is necessary to maintain the *worst case*
+-- performance bounds expected for this type. For example, suppose we convert a
+-- FastQueue to a list using toList. Then we expect to be able to consume each
+-- cons of the resulting list in O(1) time. If we used the derived instance,
+-- and had RQ f r a, then once f was exhausted we'd have to pause to reverse r.
+-- Note that `traverse` is inherently a bit weird from a performance
+-- standpoint, because it delays building the result structure until the end.
+-- There's nothing we can do about this; the Applicative constraint on traverse
+-- isn't sufficient to build as we go.
+
+instance Foldable FastQueue where
+  -- See note: folding and traversing
+  foldr c n = \q -> go q
+    where
+      go q = case viewl q of
+        EmptyL -> n
+        h :< t -> c h (go t)
+#if MIN_VERSION_base(4,6,0)
+  foldl' f b0 = \q -> go q b0
+    where
+      go q !b = case viewl q of
+        EmptyL -> b
+        h :< t -> go t (f b h)
+#endif
+
+#if MIN_VERSION_base(4,8,0)
+  null (RQ [] _ _) = True
+  null _ = False
+#endif
+
+instance T.Traversable FastQueue where
+  -- See note: folding and traversing
+  traverse f = fmap fromList . go
+    where
+      go q = case viewl q of
+        EmptyL -> A.pure empty
+        h :< t  -> A.liftA2 (:) (f h) (go t)
+
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup.Semigroup (FastQueue a) where
+  (<>) = (><)
+#endif
+instance Monoid (FastQueue a) where
+  mempty = empty
+#if MIN_VERSION_base(4,9,0)
+  mappend = (Semigroup.<>)
+#else
+  mappend = (><)
+#endif
diff --git a/Data/Sequence/FastQueue/Internal/Any.hs b/Data/Sequence/FastQueue/Internal/Any.hs
new file mode 100644
--- /dev/null
+++ b/Data/Sequence/FastQueue/Internal/Any.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE Trustworthy #-}
+#endif
+-- We suppress this warning because otherwise GHC complains
+-- about the newtype constructor not being used.
+#if __GLASGOW_HASKELL__ >= 800
+-- This warning doesn't seem to exist before 8.0, by any name.
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+#endif
+
+
+-- | It's safe to coerce /to/ 'Any' as long as you don't
+-- coerce back. We define our own 'Any' instead of using
+-- the one in "GHC.Exts" directly to ensure that this
+-- module doesn't clash with one making the opposite
+-- assumption. We use a newtype rather than a closed type
+-- family with no instances because the latter weren't supported
+-- until 8.0.
+module Data.Sequence.FastQueue.Internal.Any
+  ( Any
+  , toAny
+  , toAnyList
+  ) where
+
+import Unsafe.Coerce
+import qualified GHC.Exts as E
+
+newtype Any = Any E.Any
+
+-- | Convert anything to 'Any'.
+toAny :: a -> Any
+toAny = unsafeCoerce
+
+-- | Convert a list of anything to a list of 'Any'.
+toAnyList :: [a] -> [Any]
+toAnyList = unsafeCoerce
diff --git a/Data/Sequence/Queue.hs b/Data/Sequence/Queue.hs
--- a/Data/Sequence/Queue.hs
+++ b/Data/Sequence/Queue.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE Rank2Types,GADTs, DataKinds, TypeOperators #-}
-
-
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Sequence.Queue
@@ -11,7 +7,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- A sequence, a queue, with amortized constant time: '|>', and 'tviewl'.
+-- A sequence, a queue, with amortized constant time: '|>', and 'viewl'.
 --
 -- A simplified version of Okasaki's implicit recursive
 -- slowdown queues. 
@@ -20,91 +16,5 @@
 --
 -----------------------------------------------------------------------------
 module Data.Sequence.Queue(module Data.SequenceClass,Queue)  where
-import Control.Applicative (pure, (<*>), (<$>))
-import Data.Foldable
-import Data.Monoid ((<>))
-import Data.Traversable
-import Prelude hiding (foldr,foldl)
+import Data.Sequence.Queue.Internal
 import Data.SequenceClass
-
-data P a = a :* a 
-
-instance Functor P where
-  fmap f (a :* b) = f a :* f b
-
-instance Foldable P where
-  foldl f z (a :* b) = f (f z a) b
-  foldr f z (a :* b) = f a (f b z)
-  foldMap f (a :* b) = f a <> f b
-
-instance Traversable P where
-  traverse f (a :* b) = (:*) <$> f a <*> f b
-
-data B a where
-  B1 :: a    -> B a
-  B2 :: !(P a)  -> B a
-
-instance Functor B where
- fmap phi (B1 c) = B1 (phi c)
- fmap phi (B2 p) = B2 (fmap phi p)
-
-instance Foldable B where
-  foldl f z (B1 x) = f z x
-  foldl f z (B2 p) = foldl f z p
-  foldr f z (B1 x) = f x z
-  foldr f z (B2 p) = foldr f z p
-  foldMap f (B1 x) = f x
-  foldMap f (B2 p) = foldMap f p
-
-instance Traversable B where
-  traverse f (B1 x) = B1 <$> f x
-  traverse f (B2 p) = B2 <$> traverse f p
-
-data Queue a  where
-  Q0 :: Queue a 
-  Q1 :: a  -> Queue a
-  QN :: !(B a) -> Queue (P a) -> !(B a) -> Queue a
-
-instance Functor Queue where
-  fmap f Q0 = Q0
-  fmap f (Q1 x) = Q1 (f x)
-  fmap f (QN l m r) = QN (fmap f l) (fmap (fmap f) m) (fmap f r)
-
-instance Foldable Queue where
-  foldl f = loop where
-    loop i s = case viewl s of
-          EmptyL -> i
-          h :< t -> loop (f i h) t
-  foldr f i s = foldr f i (reverse $ toRevList s)
-    where toRevList s = case viewl s of
-           EmptyL -> []
-           h :< t -> h : toRevList t
-
-instance Traversable Queue where
-  traverse f Q0 = pure Q0
-  traverse f (Q1 x) = Q1 <$> f x
-  traverse f (QN b1 q b2) = QN <$> traverse f b1 <*> traverse (traverse f) q <*> traverse f b2
-
-instance Sequence Queue where
-  empty = Q0
-  singleton = Q1 
-  q |> b = case q of
-    Q0             -> Q1 b
-    Q1 a           -> QN (B1 a) Q0 (B1 b)
-    QN l m (B1 a)  -> QN l m (B2 (a :* b)) 
-    QN l m (B2 r)  -> QN l (m |> r) (B1 b)
-
-  viewl q = case q of
-    Q0                    -> EmptyL
-    Q1 a                  -> a :< Q0
-    QN (B2 (a :* b)) m r  -> a :< QN (B1 b) m r
-    QN (B1 a) m r         -> a :< shiftLeft m r
-    where  
-           shiftLeft q r = case viewl q of
-               EmptyL -> buf2queue r
-               l :< m -> QN (B2 l) m r
-           buf2queue (B1 a)        = Q1 a
-           buf2queue(B2 (a :* b))  = QN (B1 a) Q0 (B1 b)
-
-
-
diff --git a/Data/Sequence/Queue/Internal.hs b/Data/Sequence/Queue/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Sequence/Queue/Internal.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Rank2Types,GADTs, DataKinds, TypeOperators #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveTraversable #-}
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Sequence.Queue
+-- Copyright   :  (c) Atze van der Ploeg 2014
+-- License     :  BSD-style
+-- Maintainer  :  atzeus@gmail.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A sequence, a queue, with amortized constant time: '|>', and 'viewl'.
+-- It also supports '|>' and 'viewr' in amortized logarithmic time.
+--
+-- A simplified version of Okasaki's implicit recursive
+-- slowdown queues. 
+-- See purely functional data structures by Chris Okasaki 
+-- section 8.4: Queues based on implicit recursive slowdown
+--
+-----------------------------------------------------------------------------
+module Data.Sequence.Queue.Internal
+  ( Queue (..)
+  , P (..)
+  , B (..)
+  )  where
+import Control.Applicative (pure, (<*>), (<$>))
+import Data.Foldable
+import Data.Monoid (Monoid (..), (<>))
+import Data.Traversable
+import qualified Text.Read as TR
+import Data.Function (on)
+#if MIN_VERSION_base(4,9,0)
+import qualified Data.Semigroup as Semigroup
+import Data.Functor.Classes (Show1 (..))
+#endif
+
+import Prelude hiding (foldr,foldl)
+import Data.SequenceClass
+
+data P a = a :* a 
+  deriving (Functor, Foldable, Traversable)
+
+data B a where
+  B1 :: a    -> B a
+  B2 :: !(P a)  -> B a
+
+deriving instance Functor B
+deriving instance Foldable B
+deriving instance Traversable B
+
+-- | A queue.
+data Queue a  where
+  Q0 :: Queue a 
+  Q1 :: a  -> Queue a
+  QN :: !(B a) -> Queue (P a) -> !(B a) -> Queue a
+
+deriving instance Functor Queue
+-- The derived Foldable instance has an optimal null
+-- with a good unfolding. No need to fuss around with it.
+deriving instance Foldable Queue
+deriving instance Traversable Queue
+
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup.Semigroup (Queue a) where
+  (<>) = (><)
+#endif
+instance Monoid (Queue a) where
+  mempty = empty
+#if MIN_VERSION_base(4,9,0)
+  mappend = (Semigroup.<>)
+#else
+  mappend = (><)
+#endif
+
+instance Sequence Queue where
+  empty = Q0
+  singleton = Q1 
+  q |> b = case q of
+    Q0             -> Q1 b
+    Q1 a           -> QN (B1 a) Q0 (B1 b)
+    QN l m (B1 a)  -> QN l m (B2 (a :* b))
+    QN l m (B2 r)  -> QN l (m |> r) (B1 b)
+
+  a <| q = case q of
+    Q0 -> Q1 a
+    Q1 b -> QN (B1 a) Q0 (B1 b)
+    QN (B1 b) m r -> QN (B2 (a :* b)) m r
+    QN (B2 l) m r -> QN (B1 a) (l <| m) r
+
+  (><) = foldl' (|>)
+
+  viewl q0 = case q0 of
+    Q0                    -> EmptyL
+    Q1 a                  -> a :< Q0
+    QN (B2 (a :* b)) m r  -> a :< QN (B1 b) m r
+    QN (B1 a) m r         -> a :< shiftLeft m r
+    where  
+           shiftLeft q r = case viewl q of
+               EmptyL -> buf2queue r
+               l :< m -> QN (B2 l) m r
+
+  viewr q0 = case q0 of
+    Q0 -> EmptyR
+    Q1 a -> Q0 :> a
+    QN l m (B2 (a :* b)) -> QN l m (B1 a) :> b
+    QN l m (B1 a) -> shiftRight l m :> a
+    where
+      shiftRight l q = case viewr q of
+        EmptyR -> buf2queue l
+        m :> r -> QN l m (B2 r)
+
+buf2queue :: B a -> Queue a
+buf2queue (B1 a)        = Q1 a
+buf2queue (B2 (a :* b))  = QN (B1 a) Q0 (B1 b)
+{-# INLINE buf2queue #-}
+
+instance Show a => Show (Queue a) where
+    showsPrec p xs = showParen (p > 10) $
+        showString "fromList " . shows (toList xs)
+
+#if MIN_VERSION_base(4,9,0)
+instance Show1 Queue where
+  liftShowsPrec _shwsPrc shwList p xs = showParen (p > 10) $
+        showString "fromList " . shwList (toList xs)
+#endif
+
+instance Read a => Read (Queue a) where
+    readPrec = TR.parens $ TR.prec 10 $ do
+        TR.Ident "fromList" <- TR.lexP
+        xs <- TR.readPrec
+        return (fromList xs)
+
+    readListPrec = TR.readListPrecDefault
+
+instance Eq a => Eq (Queue a) where
+  (==) = (==) `on` toList
+
+instance Ord a => Ord (Queue a) where
+  compare = compare `on` toList
+
diff --git a/Data/Sequence/ToCatQueue.hs b/Data/Sequence/ToCatQueue.hs
--- a/Data/Sequence/ToCatQueue.hs
+++ b/Data/Sequence/ToCatQueue.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE GADTs #-}
-
-
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Sequence.ToCatQueue
@@ -19,46 +15,9 @@
 --
 -----------------------------------------------------------------------------
 
-module Data.Sequence.ToCatQueue(module Data.SequenceClass,ToCatQueue) where
-import Control.Applicative (pure, (<*>), (<$>))
-import Data.Foldable
-import Data.Traversable
-import Prelude hiding (foldr,foldl)
+module Data.Sequence.ToCatQueue
+  ( module Data.SequenceClass
+  , ToCatQueue
+  ) where
+import Data.Sequence.ToCatQueue.Internal
 import Data.SequenceClass
-
--- | The catenable queue type. The first type argument is the 
--- type of the queue we use (|>)
-data ToCatQueue q a where
-  C0 :: ToCatQueue q a
-  CN :: a -> !(q (ToCatQueue q a)) -> ToCatQueue q a
-
-instance Functor q => Functor (ToCatQueue q) where
-  fmap f C0 = C0
-  fmap f (CN l m) = CN (f l) (fmap (fmap f) m)
-
-instance Foldable q => Foldable (ToCatQueue q) where
-  foldl f z C0 = z
-  foldl f z (CN x qs) = foldl (foldl f) (f z x) qs
-  foldr f z C0 = z
-  foldr f z (CN x qs) = x `f` foldr (\q z -> foldr f z q) z qs
-
-instance Sequence q => Sequence (ToCatQueue q) where
- empty       = C0
- singleton a = CN a empty
- C0        >< ys  = ys
- xs        >< C0  = xs
- (CN x q)  >< ys  = CN x (q |> ys)
-
- viewl C0        = EmptyL
- viewl (CN h t)  = h :< linkAll t
-   where 
-    linkAll :: Sequence q =>  q (ToCatQueue q a)  -> ToCatQueue q a
-    linkAll v = case viewl v of
-     EmptyL     -> C0
-     CN x q :< t  -> CN x (q `snoc` linkAll t)
-    snoc q C0  = q
-    snoc q r   = q |> r
-
-instance Traversable q => Traversable (ToCatQueue q) where
-  traverse f C0 = pure C0
-  traverse f (CN x qs) = CN <$> f x <*> traverse (traverse f) qs
diff --git a/Data/Sequence/ToCatQueue/Internal.hs b/Data/Sequence/ToCatQueue/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Sequence/ToCatQueue/Internal.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+#endif
+
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Sequence.ToCatQueue.Internal
+-- Copyright   :  (c) Atze van der Ploeg 2013
+-- License     :  BSD-style
+-- Maintainer  :  atzeus@gmail.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A purely functional catenable queue representation with
+-- that turns takes a purely functional queue and turns in it into
+-- a catenable queue, i.e. with the same complexity for '><' as for '|>'
+-- Based on Purely functional data structures by Chris Okasaki 
+-- section 7.2: Catenable lists
+--
+-----------------------------------------------------------------------------
+
+module Data.Sequence.ToCatQueue.Internal
+  ( ToCatQueue (..)
+  ) where
+import Control.Applicative hiding (empty)
+import Data.Foldable
+import Data.Traversable
+import Data.Monoid (Monoid (..))
+import qualified Text.Read as TR
+#if MIN_VERSION_base(4,9,0)
+import qualified Data.Semigroup as Semigroup
+import Data.Functor.Classes (Show1 (..))
+#endif
+import Data.Function (on)
+import Prelude hiding (foldr,foldl)
+import Data.SequenceClass
+
+-- | The catenable queue type. The first type argument is the 
+-- type of the queue we use (|>)
+data ToCatQueue q a where
+  -- Invariant: no element of the queue of queues may
+  -- be empty.
+  C0 :: ToCatQueue q a
+  CN :: a -> !(q (ToCatQueue q a)) -> ToCatQueue q a
+
+deriving instance Functor q => Functor (ToCatQueue q)
+deriving instance Foldable q => Foldable (ToCatQueue q)
+deriving instance Traversable q => Traversable (ToCatQueue q)
+
+instance (Show a, Foldable q) => Show (ToCatQueue q a) where
+    showsPrec p xs = showParen (p > 10) $
+        showString "fromList " . shows (toList xs)
+
+#if MIN_VERSION_base(4,9,0)
+instance Foldable q => Show1 (ToCatQueue q) where
+  liftShowsPrec _shwsPrc shwList p xs = showParen (p > 10) $
+        showString "fromList " . shwList (toList xs)
+#endif
+
+instance (Sequence q, Read a) => Read (ToCatQueue q a) where
+    readPrec = TR.parens $ TR.prec 10 $ do
+        TR.Ident "fromList" <- TR.lexP
+        xs <- TR.readPrec
+        return (fromList xs)
+
+    readListPrec = TR.readListPrecDefault
+
+instance (Foldable q, Eq a) => Eq (ToCatQueue q a) where
+  (==) = (==) `on` toList
+
+instance (Foldable q, Ord a) => Ord (ToCatQueue q a) where
+  compare = compare `on` toList
+
+instance Sequence q => Sequence (ToCatQueue q) where
+ empty       = C0
+ singleton a = CN a empty
+ C0        >< ys  = ys
+ xs        >< C0  = xs
+ (CN x q)  >< ys  = CN x (q |> ys)
+
+ viewl C0        = EmptyL
+ viewl (CN x0 q0)  = x0 :< case viewl q0 of
+   EmptyL -> C0
+   t :< q'  -> linkAll t q'
+   where
+   linkAll :: ToCatQueue q a -> q (ToCatQueue q a) -> ToCatQueue q a
+   linkAll t@(CN x q) q' = case viewl q' of
+     EmptyL -> t
+     h :< t' -> CN x (q |> linkAll h t')
+   linkAll C0 _ = error "Invariant failure"
+
+ viewr = foldl' go EmptyR
+   where
+     go EmptyR y = empty :> y
+     go (xs :> x) y = xs' :> y
+       where
+         !xs' = xs |> x
+
+#if MIN_VERSION_base(4,9,0)
+instance Sequence q => Semigroup.Semigroup (ToCatQueue q a) where
+  (<>) = (><)
+#endif
+instance Sequence q => Monoid (ToCatQueue q a) where
+  mempty = empty
+#if MIN_VERSION_base(4,9,0)
+  mappend = (Semigroup.<>)
+#else
+  mappend = (><)
+#endif
diff --git a/Data/SequenceClass.hs b/Data/SequenceClass.hs
--- a/Data/SequenceClass.hs
+++ b/Data/SequenceClass.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE UndecidableInstances, GADTs,TypeSynonymInstances,FlexibleInstances,Rank2Types #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 
 
@@ -18,33 +20,71 @@
 module Data.SequenceClass(Sequence(..), ViewL(..), ViewR(..)) where
 
 import Data.Monoid
-import Data.Foldable
+import Data.Foldable (foldl')
+import qualified Data.Foldable as F
 import qualified Data.Sequence as S
 
 infixr 5 <|
 infixl 5 |>
 infix 5 ><
+infixl 9 :<
+infixr 9 :>
 {- | A type class for (finite) sequences
  
-Minimal complete defention: 'empty' and 'singleton' and ('viewl' or 'viewr') and ('><' or '|>' or '<|')
 
-Instances should satisfy the following laws:
+Instances should be /free monoids/
+(<http://comonad.com/reader/2015/free-monoids-in-haskell/ ignoring issues with infinite and partially defined structures>),
+just like lists, with @singleton@ as the canonical injection and @foldMap@
+factoring functions.  In particular, they should satisfy the following laws:
 
-Monoid laws:
+@Semigroup@ and @Monoid@ laws:
 
+> (><) == (Data.Semigroup.<>)
+> empty == mempty
+
+In particular, this requires that
+
 > empty >< x == x
 > x >< empty == x
 > (x >< y) >< z = x >< (y >< z)
 
+@FoldMap@/@singleton@ laws:
+
+For any 'Monoid' @m@ and any function @f :: c -> m@,
+
+1. @'foldMap' f@ is a monoid morphism:
+
+    * @'foldMap' f 'mempty' = 'mempty'@
+    * @'foldMap' f (m '<>' n) = 'foldMap' f m <> 'foldMap' f n@
+
+2. 'foldMap' undoes 'singleton':
+
+    @'foldMap' f . 'singleton' = f@
+
 Observation laws:
 
 > viewl (singleton e >< s) == e :< s
 > viewl empty == EmptyL
 
-The behaviour of '<|','|>', and 'viewr' is implied by the above laws and their default definitions.
+The behaviour of '<|','|>', and 'viewr' is implied by the above laws and their
+default definitions.
+
+Warning: the default definitions are typically awful. Check them carefully
+before relying on them. In particular, they may well work in @O(n^2)@ time (or
+worse?) when even definitions that convert to and from lists would work in
+@O(n)@ time. Exceptions: for sequences with constant time concatenation, the
+defaults for '<|' and '|>' are okay. For sequences with constant time '|>',
+the default for 'fromList' is okay.
 -}
-class (Functor s, Foldable s) => Sequence s where
+class (F.Foldable s, Functor s) => Sequence s where
 
+  {-# MINIMAL
+    empty,
+    singleton,
+    (viewl | viewr),
+    ((><) | (|>) | (<|))
+    #-}
+
   empty     :: s c 
   singleton :: c  -> s c 
   -- | Append two sequences
@@ -77,6 +117,13 @@
   --
   (<|)       :: c  -> s c -> s c
   
+  -- | Convert a list to a sequence
+  --
+  -- Default definition:
+  --
+  -- > fromList = foldl' (|>) empty
+  fromList :: [c] -> s c
+
   l |> r = l >< singleton r
   l <| r = singleton l >< r
   l >< r = case viewl l of
@@ -95,14 +142,22 @@
         EmptyR -> empty   :> h
         p :> l   -> (h <| p) :> l
 
+  fromList = foldl' (|>) empty
+
+-- | A view of the left end of a 'Sequence'.
 data ViewL s c where
    EmptyL  :: ViewL s c 
-   (:<)    :: c  -> s c  -> ViewL s c 
+   (:<)    :: c -> s c -> ViewL s c
 
-data ViewR s c  where
+deriving instance (Show c, Show (s c)) => Show (ViewL s c)
+
+-- | A view of the right end of a 'Sequence'.
+data ViewR s c where
    EmptyR  :: ViewR s c 
-   (:>)     :: s c -> c -> ViewR s c 
+   (:>)    :: s c -> c -> ViewR s c
 
+deriving instance (Show c, Show (s c)) => Show (ViewR s c)
+
  
 instance Sequence S.Seq where
  empty = S.empty
@@ -116,13 +171,25 @@
  viewr s = case S.viewr s of
    S.EmptyR -> EmptyR
    t S.:> h -> t :> h
+ fromList = S.fromList
 
 instance Sequence [] where
   empty = []
   singleton x = [x]
   (<|) = (:)
+  xs |> x = xs ++ [x]
+  (><) = (++)
   viewl [] = EmptyL
   viewl (h : t) = h :< t 
 
-
-
+  -- This definition is entirely strict. I'm not sure whether there's
+  -- a real benefit to making it lazy or not.
+  -- NOTE: if we *do* make it lazy, then the definition of viewr
+  -- for FastQueue will have to be adjusted to keep its bounds
+  -- worst case.
+  viewr [] = EmptyR
+  viewr (x : xs) = case go x xs of (start, end) -> start :> end
+    where
+      go y [] = ([], y)
+      go y (z : zs) = case go z zs of (start, end) -> (y : start, end)
+  fromList = id
diff --git a/fake-test/Test.hs b/fake-test/Test.hs
new file mode 100644
--- /dev/null
+++ b/fake-test/Test.hs
@@ -0,0 +1,5 @@
+-- This fake test module is just a workaround so that
+-- haskell-ci doesn't fail when the GHC version is too
+-- old to build the test suite.
+main :: IO ()
+main = return ()
diff --git a/sequence.cabal b/sequence.cabal
--- a/sequence.cabal
+++ b/sequence.cabal
@@ -1,21 +1,62 @@
 Name:                sequence
-Version:             0.9.8
-Synopsis:	         A type class for sequences and various sequence data structures.
-Description:         A type class for sequences and various sequence data structures.
+Version:             0.9.9.0
+Synopsis:	     A type class for sequences and various sequence data structures.
+Description:         A type class for finite sequences along with several data structures
+                     that implement it.
 License:             BSD3
 License-file:        LICENSE
 Author:              Atze van der Ploeg
 Maintainer:          atzeus@gmail.com
 Homepage:            https://github.com/atzeus/sequence
 Build-Type:          Simple
-Cabal-Version:       >=1.6
+Cabal-Version:       2.0
 Data-files:          ChangeLog
 Category:            Data, Data Structures
 Tested-With:         GHC==7.6.3
 Library
-  Build-Depends: base >= 2 && <= 6, containers, transformers
-  Exposed-modules: Data.SequenceClass,Data.Sequence.BSeq, Data.Sequence.Queue, Data.Sequence.FastQueue, Data.Sequence.FastCatQueue,  Data.Sequence.ToCatQueue
-  Extensions:	
+  default-language: Haskell2010
+  ghc-options: -Wall -fno-warn-unused-imports
+  build-depends: base >= 2 && <= 6, containers, transformers
+  exposed-modules:
+      Data.SequenceClass
+    , Data.Sequence.BSeq
+    , Data.Sequence.BSeq.Internal
+    , Data.Sequence.Queue
+    , Data.Sequence.Queue.Internal
+    , Data.Sequence.FastQueue
+    , Data.Sequence.FastQueue.Internal
+    , Data.Sequence.FastCatQueue
+    , Data.Sequence.ToCatQueue
+    , Data.Sequence.ToCatQueue.Internal
+    , Data.Sequence.FastQueue.Internal.Any
+
+test-suite sequence-test
+  if impl(ghc < 7.10)
+    buildable: False
+  ghc-options: -Wall -fno-warn-unused-imports
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  default-language: Haskell2010
+  main-is:          Test.hs
+  other-modules:    FastQueue
+                  , BSeq
+                  , Queue
+                  , ToCatQueue
+                  , Valid
+  build-depends:    base >=4.5 && < 5
+                  , sequence
+                  , tasty >= 1.4
+                  , QuickCheck
+                  , tasty-quickcheck
+
+test-suite do-nothing
+  if impl(ghc >= 7.10)
+    buildable: False
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   fake-test
+  default-language: Haskell2010
+  main-is:          Test.hs
+  build-depends:    base >=4.5 && < 5
 
 source-repository head
     type:     git
diff --git a/test/BSeq.hs b/test/BSeq.hs
new file mode 100644
--- /dev/null
+++ b/test/BSeq.hs
@@ -0,0 +1,32 @@
+{-# language BangPatterns #-}
+{-# options_ghc -fno-warn-orphans #-}
+module BSeq where
+import Data.Sequence.BSeq.Internal
+import Test.QuickCheck
+import Valid
+
+
+instance Valid BSeq where
+  valid Empty = property True
+  valid x = counterexample "Empty under Node" $ valid' x
+    where
+      valid' Empty = False
+      valid' (Leaf _) = True
+      valid' (Node l r) = valid' l && valid' r
+
+instance Arbitrary a => Arbitrary (BSeq a) where
+  arbitrary = liftArbitrary arbitrary
+
+instance Arbitrary1 BSeq where
+  liftArbitrary el = sized $ \s -> do
+    len <- chooseInt (0, s)
+    mkArb len el
+
+-- Generate an arbitrary sequence of exactly the given size.
+mkArb :: Int -> Gen a -> Gen (BSeq a)
+mkArb 0 _ = pure Empty
+mkArb 1 g = Leaf <$> g
+mkArb n g = do
+  fs <- chooseInt (1, n - 1)
+  let rs = n - fs
+  Node <$> mkArb fs g <*> mkArb rs g
diff --git a/test/FastQueue.hs b/test/FastQueue.hs
new file mode 100644
--- /dev/null
+++ b/test/FastQueue.hs
@@ -0,0 +1,34 @@
+{-# language BangPatterns #-}
+{-# options_ghc -fno-warn-orphans #-}
+
+module FastQueue where
+import Data.Sequence.FastQueue.Internal
+import Test.QuickCheck
+import Data.Sequence.FastQueue.Internal.Any
+import Data.List (replicate)
+import Valid
+
+instance Valid FastQueue where
+  valid (RQ front rear schedule) =
+    counterexample "fails |front| = |rear| + |sched|" $
+    length front === slen rear + length schedule
+
+instance Arbitrary a => Arbitrary (FastQueue a) where
+  arbitrary = liftArbitrary arbitrary
+
+instance Arbitrary1 FastQueue where
+  liftArbitrary el = do
+    NonNegative rear_len <- arbitrary
+    NonNegative schedule_len <- arbitrary
+    rear <- sworp <$> vectorOf rear_len el
+    front <- vectorOf (schedule_len + rear_len) el
+    pure $ RQ front rear (replicate schedule_len (toAny ()))
+    where
+      sworp [] = SNil
+      sworp (x : xs) = sworp xs :> x
+
+slen :: SL a -> Int
+slen = go 0
+  where
+    go !acc SNil = acc
+    go acc (xs :> _) = go (acc + 1) xs
diff --git a/test/Queue.hs b/test/Queue.hs
new file mode 100644
--- /dev/null
+++ b/test/Queue.hs
@@ -0,0 +1,61 @@
+{-# language BangPatterns #-}
+{-# options_ghc -fno-warn-orphans #-}
+
+module Queue where
+import Data.Sequence.Queue.Internal
+import Test.QuickCheck
+import Valid
+
+{-
+data P a = a :* a
+  deriving (Functor, Foldable, Traversable)
+
+data B a where
+  B1 :: a    -> B a
+  B2 :: !(P a)  -> B a
+
+data Queue a  where
+  Q0 :: Queue a
+  Q1 :: a  -> Queue a
+  QN :: !(B a) -> Queue (P a) -> !(B a) -> Queue a
+  -}
+
+
+instance Valid Queue where
+  -- Just force the structure to make sure it's finite
+  -- and fully defined.
+  valid = property . foldr (\_ r -> r) True
+
+instance Arbitrary a => Arbitrary (Queue a) where
+  arbitrary = liftArbitrary arbitrary
+
+instance Arbitrary1 Queue where
+  liftArbitrary el = sized $ \s -> do
+    len <- chooseInt (0, s)
+    mkArbQ len el
+
+-- Generate an arbitrary queue of exactly the given size.
+mkArbQ :: Int -> Gen a -> Gen (Queue a)
+mkArbQ 0 _ = pure Q0
+mkArbQ 1 g = Q1 <$> g
+mkArbQ 2 g = QN <$> mkArbB 1 g <*> pure Q0 <*> mkArbB 1 g
+mkArbQ 3 g = oneof
+  [ QN <$> mkArbB 1 g <*> pure Q0 <*> mkArbB 2 g
+  , QN <$> mkArbB 2 g <*> pure Q0 <*> mkArbB 1 g ]
+mkArbQ n g
+  | even n
+  = oneof
+      [ QN <$> mkArbB 2 g <*> mkArbQ ((n - 4) `quot` 2) (mkArbP g) <*> mkArbB 2 g
+      , QN <$> mkArbB 1 g <*> mkArbQ ((n - 2) `quot` 2) (mkArbP g) <*> mkArbB 1 g ]
+  | otherwise
+  = oneof
+      [ QN <$> mkArbB 2 g <*> mkArbQ ((n - 3) `quot` 2) (mkArbP g) <*> mkArbB 1 g
+      , QN <$> mkArbB 1 g <*> mkArbQ ((n - 3) `quot` 2) (mkArbP g) <*> mkArbB 2 g ]
+
+mkArbB :: Int -> Gen a -> Gen (B a)
+mkArbB 1 g = B1 <$> g
+mkArbB 2 g = B2 <$> mkArbP g
+mkArbB _ _ = error "mkArbB must be called with 1 or 2."
+
+mkArbP :: Gen a -> Gen (P a)
+mkArbP g = (:*) <$> g <*> g
diff --git a/test/Test.hs b/test/Test.hs
new file mode 100644
--- /dev/null
+++ b/test/Test.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ConstraintKinds #-}
+
+import Test.Tasty
+import Test.Tasty.QuickCheck as QC hiding ((><))
+import Data.SequenceClass
+import Valid
+import Data.Proxy
+import Data.Foldable
+
+import FastQueue ()
+import Data.Sequence.FastQueue
+import BSeq ()
+import Data.Sequence.BSeq
+import Queue ()
+import Data.Sequence.Queue
+import ToCatQueue ()
+import Data.Sequence.ToCatQueue
+
+type Usable s = (Arbitrary (s Int), Show (s Int), Eq (s Int), Valid s, Sequence s)
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Tests"
+  [ testsFor "FastQueue" (Proxy :: Proxy FastQueue)
+  , testsFor "BSeq" (Proxy :: Proxy BSeq)
+  , testsFor "Queue" (Proxy :: Proxy Queue)
+  , testsFor "ToCatQueue FastQueue" (Proxy :: Proxy (ToCatQueue FastQueue))
+  , testsFor "ToCatQueue Queue" (Proxy :: Proxy (ToCatQueue Queue))
+  ]
+
+testsFor :: Usable s => String -> Proxy s -> TestTree
+testsFor s p = testGroup (s ++ " Tests") [properties p]
+
+properties :: Usable s => Proxy s -> TestTree
+properties p = testGroup "Properties" [qcProps p]
+
+qcProps :: Usable s => Proxy s -> TestTree
+qcProps (_ :: Proxy s) = testGroup "(checked by QuickCheck)" $
+  [ QC.testProperty "generator valid" $
+     -- We avoid trying to show an invalid generated sequence
+     -- because doing so may raise an exception.
+     forAllBlind (arbitrary :: Gen (s Int)) valid
+  , QC.testProperty "viewl works" $
+      \(s :: s Int) -> case viewl s of
+        EmptyL -> null s .&&. s === empty
+        a :< as -> valid as .&&. toList s === a : toList as .&&. a <| as === s
+  , QC.testProperty "viewr works" $
+      \(s :: s Int) -> case viewr s of
+        EmptyR -> null s .&&. s === empty
+        as :> a -> valid as .&&. toList s === toList as ++ [a] .&&.
+                      as |> a === s
+  , QC.testProperty ">< works" $
+      \(s :: s Int) t -> let st = s >< t in
+        valid st .&&. toList st === toList s ++ toList t
+  , QC.testProperty ">< is associative" $
+      \(s :: s Int) t u -> (s >< t) >< u === s >< (t >< u)
+  , QC.testProperty "empty is identity" $
+      \(s :: s Int) -> s >< empty === s .&&. empty >< s === s
+  , QC.testProperty "foldMap/singleton" $
+      \(x :: Int) ->
+        let s = singleton x :: s Int
+        in valid s .&&. foldMap (:[]) s === [x]
+  , QC.testProperty "fromList works" $
+      \(l :: [Int]) -> let s = fromList l :: s Int in
+        valid s .&&. toList s === l .&&. s === foldl' (|>) empty l
+  ]
diff --git a/test/ToCatQueue.hs b/test/ToCatQueue.hs
new file mode 100644
--- /dev/null
+++ b/test/ToCatQueue.hs
@@ -0,0 +1,57 @@
+{-# language BangPatterns #-}
+{-# language LambdaCase #-}
+{-# options_ghc -fno-warn-orphans #-}
+
+module ToCatQueue where
+import Data.SequenceClass
+import Data.Sequence.ToCatQueue.Internal
+import Test.QuickCheck
+import Data.List (replicate)
+import Data.Foldable (all)
+import Valid
+
+{-
+data ToCatQueue q a where
+  C0 :: ToCatQueue q a
+  CN :: a -> !(q (ToCatQueue q a)) -> ToCatQueue q a
+  -}
+
+instance Sequence q => Valid (ToCatQueue q) where
+  valid C0 = property True
+  valid (CN _ q0) = counterexample "Empty queue in simple queue" $ valid' q0
+    where
+      valid' = all $ \case
+        C0 -> False
+        CN _ q -> valid' q
+
+instance (Sequence q, Arbitrary a) => Arbitrary (ToCatQueue q a) where
+  arbitrary = liftArbitrary arbitrary
+
+-- We are testing only ToCatQueue here, and assume the underlying
+-- queue works correctly. So we don't try to generate arbitrary
+-- shapes of the underlying queue; we just build those from lists.
+instance Sequence q => Arbitrary1 (ToCatQueue q) where
+  liftArbitrary el = sized $ \s -> do
+    n <- chooseInt (0, s)
+    mkArb el n
+    
+mkArb :: Sequence q => Gen a -> Int -> Gen (ToCatQueue q a)
+mkArb _ 0 = pure C0
+mkArb g n = do
+  x <- g  -- Pick the first element
+  sizes <- splat (n - 1) -- Decide how to arrange the remaining ones
+  xs <- fromList <$> traverse (mkArb g) sizes
+  pure (CN x xs)
+
+  --  rear <- sworp <$> vectorOf rear_len el
+
+-- Generate a partition of a non-negative integer into
+-- positive integers. This is not statistically fair; it
+-- might be nice to make it so.
+splat :: Int -> Gen [Int]
+splat n | n < 0 = error "Can't splat a negative number"
+splat 0 = pure []
+splat n = do
+  k <- chooseInt (1, n)
+  rest <- splat (n - k)
+  pure (k : rest)
diff --git a/test/Valid.hs b/test/Valid.hs
new file mode 100644
--- /dev/null
+++ b/test/Valid.hs
@@ -0,0 +1,7 @@
+module Valid (Valid (..)) where
+
+import Test.QuickCheck
+
+class Valid s where
+  -- Check the invariants of a sequence.
+  valid :: s a -> Property