diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for binary-tree
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2018 Donnacha Oisín Kidney
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,3 @@
+[![Build Status](https://travis-ci.org/oisdk/binary-tree.svg?branch=master)](https://travis-ci.org/oisdk/binary-tree)
+
+# binary-tree
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bench/bench.hs b/bench/bench.hs
new file mode 100644
--- /dev/null
+++ b/bench/bench.hs
@@ -0,0 +1,13 @@
+module Main (main) where
+
+import Criterion.Main
+import System.Random
+import Data.Tree.Binary.Preorder
+
+int :: IO Int
+int = randomIO
+
+showAtSize n = env (replicateA n int) $ \xs -> bench (show n) $ nf drawTree xs
+
+main :: IO ()
+main = defaultMain (map showAtSize [10000, 100000])
diff --git a/binary-tree.cabal b/binary-tree.cabal
new file mode 100644
--- /dev/null
+++ b/binary-tree.cabal
@@ -0,0 +1,102 @@
+-- This file has been generated from package.yaml by hpack version 0.20.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: a3b5e36c787d0bbc68253ec588dc76870165b6a14b277df261519294744cb379
+
+name:           binary-tree
+version:        0.1.0.0
+description:    Please see the README on Github at <https://github.com/oisdk/binary-tree#readme>
+homepage:       https://github.com/oisdk/binary-tree#readme
+bug-reports:    https://github.com/oisdk/binary-tree/issues
+author:         Donnacha Oisín Kidney
+maintainer:     mail@doisinkidney.com
+copyright:      2018 Donnacha Oisín Kidney
+license:        MIT
+license-file:   LICENSE
+build-type:     Simple
+cabal-version:  >= 1.10
+
+extra-source-files:
+    ChangeLog.md
+    README.md
+
+source-repository head
+  type: git
+  location: https://github.com/oisdk/binary-tree
+
+library
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -fwarn-incomplete-record-updates -fwarn-incomplete-uni-patterns
+  build-depends:
+      base >=4.0 && <5
+    , deepseq
+  if impl(ghc >= 8.0)
+    ghc-options: -fwarn-redundant-constraints -Wcompat
+  if impl(ghc)
+    build-depends:
+        ghc-prim
+  exposed-modules:
+      Data.Tree.Binary.Inorder
+      Data.Tree.Binary.Internal
+      Data.Tree.Binary.Leafy
+      Data.Tree.Binary.Preorder
+  other-modules:
+      Paths_binary_tree
+  default-language: Haskell2010
+
+test-suite binary-tree-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  hs-source-dirs:
+      test
+  ghc-options: -Wall -fwarn-incomplete-record-updates -fwarn-incomplete-uni-patterns -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      ChasingBottoms >=1.2.2
+    , HUnit >=1.1
+    , QuickCheck >=1.0
+    , base >=4.0 && <5
+    , binary-tree
+    , checkers >=0.1
+    , test-framework >=0.1
+    , test-framework-quickcheck2 >=0.2.1
+  if impl(ghc >= 8.0)
+    ghc-options: -fwarn-redundant-constraints -Wcompat
+  other-modules:
+      Paths_binary_tree
+  default-language: Haskell2010
+
+test-suite doctests
+  type: exitcode-stdio-1.0
+  main-is: doctests.hs
+  hs-source-dirs:
+      doctest
+  ghc-options: -Wall -fwarn-incomplete-record-updates -fwarn-incomplete-uni-patterns -threaded
+  build-depends:
+      QuickCheck >=1.0
+    , base >=4.0 && <5
+    , binary-tree
+    , doctest >=0.3.0
+  if impl(ghc >= 8.0)
+    ghc-options: -fwarn-redundant-constraints -Wcompat
+  other-modules:
+      Paths_binary_tree
+  default-language: Haskell2010
+
+benchmark bench
+  type: exitcode-stdio-1.0
+  main-is: bench.hs
+  hs-source-dirs:
+      bench
+  ghc-options: -Wall -fwarn-incomplete-record-updates -fwarn-incomplete-uni-patterns -threaded -rtsopts -with-rtsopts=-N -O2
+  build-depends:
+      base >=4.0 && <5
+    , binary-tree
+    , criterion >=0.1
+    , random >=1.0.0.0
+  if impl(ghc >= 8.0)
+    ghc-options: -fwarn-redundant-constraints -Wcompat
+  other-modules:
+      Paths_binary_tree
+  default-language: Haskell2010
diff --git a/doctest/doctests.hs b/doctest/doctests.hs
new file mode 100644
--- /dev/null
+++ b/doctest/doctests.hs
@@ -0,0 +1,4 @@
+import Test.DocTest
+
+main :: IO ()
+main = doctest ["-isrc", "src/"]
diff --git a/src/Data/Tree/Binary/Inorder.hs b/src/Data/Tree/Binary/Inorder.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Tree/Binary/Inorder.hs
@@ -0,0 +1,479 @@
+{-# LANGUAGE CPP #-}
+
+{-# LANGUAGE BangPatterns #-}
+#if __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 703
+{-# LANGUAGE Safe #-}
+#endif
+
+-- | 
+-- Module      : Data.Tree.Binary.Inorder
+-- Description : A simple, generic, inorder binary tree.
+-- Copyright   : (c) Donnacha Oisín Kidney, 2018
+-- License     : MIT
+-- Maintainer  : mail@doisinkidney.com
+-- Stability   : experimental
+-- Portability : portable
+--
+-- This module provides a simple inorder binary tree, as is needed
+-- in several applications. Instances, if sensible, are defined,
+-- and generally effort is made to keep the implementation as
+-- generic as possible.
+
+module Data.Tree.Binary.Inorder
+  ( -- * The tree type
+   Tree(..)
+   -- * Construction
+  , unfoldTree
+  , replicate
+  , replicateA
+  , singleton
+  , empty
+  , fromList
+   -- * Consumption
+  , foldTree
+   -- * Querying
+  , depth
+   -- * Display
+  , drawTree
+  , drawTreeWith
+  , printTree
+  ) where
+
+import Prelude hiding
+  ( replicate
+#if MIN_VERSION_base(4,8,0)
+  ,Functor(..),Foldable(..),Applicative, (<$>), foldMap, Monoid
+#else
+  ,foldr,foldl
+#endif
+  )
+
+import Data.List (length)
+
+import Control.Applicative (Applicative(..), Alternative, liftA2, liftA3)
+import qualified Control.Applicative as Alternative (empty, (<|>)) 
+
+import Control.DeepSeq (NFData(rnf))
+
+import Data.Monoid (Monoid(mappend, mempty))
+import Data.Functor (Functor(fmap, (<$)))
+
+#if MIN_VERSION_base(4,6,0)
+import Data.Foldable (Foldable(foldl, foldr, foldMap, foldl', foldr'))
+#else
+import Data.Foldable (Foldable(foldl, foldr, foldMap))
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes
+import qualified Data.Semigroup as Semigroup
+#endif
+
+import Data.Traversable (Traversable(traverse))
+
+import Data.Typeable (Typeable)
+
+#if __GLASGOW_HASKELL__ >= 706
+import GHC.Generics (Generic, Generic1)
+#elif __GLASGOW_HASKELL__ >= 702
+import GHC.Generics (Generic)
+#endif
+
+import Text.Read
+
+#if __GLASGOW_HASKELL__
+import Data.Data (Data)
+#if MIN_VERSION_base(4,10,0)
+import Text.Read.Lex (expect)
+#endif
+#endif
+
+import qualified Data.Tree.Binary.Internal as Internal
+import Data.Tree.Binary.Internal (State(..), evalState, Identity(..))
+
+-- | An inorder binary tree.
+data Tree a
+  = Leaf
+  | Node (Tree a)
+         a
+         (Tree a)
+  deriving (Show, Read, Eq, Ord
+#if __GLASGOW_HASKELL__ >= 706
+  , Typeable, Data, Generic, Generic1
+#elif __GLASGOW_HASKEL__ >= 702
+  , Typeable, Data, Generic
+#elif __GLASGOW_HASKELL__
+  , Typeable, Data
+#endif
+  )
+
+instance Functor Tree where
+  fmap _ Leaf = Leaf
+  fmap f (Node l x r) = Node (fmap f l) (f x) (fmap f r)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE fmap #-}
+#endif
+  x <$ xs = go xs where
+    go Leaf = Leaf
+    go (Node l _ r) = Node (go l) x (go r)
+  {-# INLINE (<$) #-}
+
+instance Applicative Tree where
+  pure x = y where y = Node y x y
+  Leaf <*> _ = Leaf
+  Node _ _ _ <*> Leaf = Leaf
+  Node fl f fr <*> Node xl x xr = Node (fl <*> xl) (f x) (fr <*> xr)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE pure #-}
+  {-# INLINABLE (<*>) #-}
+#endif
+#if MIN_VERSION_base(4,10,0)
+  liftA2 f = go where
+    go Leaf _ = Leaf
+    go (Node _ _ _) Leaf = Leaf
+    go (Node xl x xr) (Node yl y yr) = Node (go xl yl) (f x y) (go xr yr)
+  {-# INLINE liftA2 #-}
+#endif
+#if MIN_VERSION_base(4,2,0)
+  Leaf *> _ = Leaf
+  Node _ _ _ *> Leaf = Leaf
+  Node xl _ xr *> Node yl y yr = Node (xl *> yl) y (xr *> yr)
+  Leaf <* _ = Leaf
+  Node _ _ _ <* Leaf = Leaf
+  Node xl x xr <* Node yl _ yr = Node (xl <* yl) x (xr <* yr)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE (*>) #-}
+  {-# INLINABLE (<*) #-}
+#endif
+#endif
+
+instance Alternative Tree where
+  empty = Leaf
+  {-# INLINE empty #-}
+#if MIN_VERSION_base(4,9,0)
+  (<|>) = (Semigroup.<>)
+#else
+  (<|>) = mappend
+#endif
+  {-# INLINE (<|>) #-}
+
+instance Foldable Tree where
+  foldr _ b Leaf = b
+  foldr f b (Node l x r) = foldr f (f x (foldr f b r)) l
+
+  foldl _ b Leaf = b
+  foldl f b (Node l x r) = foldl f (f (foldl f b l) x) r
+
+  foldMap _ Leaf = mempty
+  foldMap f (Node l x r) = foldMap f l `mappend` f x `mappend` foldMap f r
+
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE foldMap #-}
+  {-# INLINABLE foldr #-}
+  {-# INLINABLE foldl #-}
+#endif
+
+
+#if MIN_VERSION_base(4,6,0)
+  foldr' _ !b Leaf = b
+  foldr' f !b (Node l x r) = case foldr' f b r of
+    !b' -> case f x b' of
+      !b'' -> foldr' f b'' l
+
+  foldl' _ !b Leaf = b
+  foldl' f !b (Node l x r) = case foldl' f b l of
+    !b' -> case f b' x of
+      !b'' -> foldl' f b'' r
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE foldr' #-}
+  {-# INLINABLE foldl' #-}
+#endif
+#endif
+
+instance Traversable Tree where
+  traverse _ Leaf = pure Leaf
+  traverse f (Node l x r) = liftA3 Node (traverse f l) (f x) (traverse f r)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE traverse #-}
+#endif
+
+-- | A binary tree with one element.
+singleton :: a -> Tree a
+singleton x = Node Leaf x Leaf
+
+{-# INLINE singleton #-}
+-- | A binary tree with no elements.
+empty :: Tree a
+empty = Leaf
+
+{-# INLINE empty #-}
+instance NFData a => NFData (Tree a) where
+  rnf Leaf = ()
+  rnf (Node l x r) = rnf l `seq` rnf x `seq` rnf r
+
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 Tree where
+  liftEq _ Leaf Leaf = True
+  liftEq eq (Node xl x xr) (Node yl y yr) =
+    liftEq eq xl yl && eq x y && liftEq eq xr yr
+  liftEq _ _ _ = False
+
+instance Ord1 Tree where
+  liftCompare _ Leaf Leaf = EQ
+  liftCompare cmp (Node xl x xr) (Node yl y yr) =
+    liftCompare cmp xl yl `mappend` cmp x y `mappend` liftCompare cmp xr yr
+  liftCompare _ Leaf _ = LT
+  liftCompare _ _ Leaf = GT
+
+instance Show1 Tree where
+  liftShowsPrec s _ = go
+    where
+      go _ Leaf = showString "Leaf"
+      go d (Node l x r) =
+        showParen (d >= 11) $
+        showString "Node " .
+        go 11 l . showChar ' ' . s 11 x . showChar ' ' . go 11 r
+
+instance Read1 Tree where
+#if MIN_VERSION_base(4,10,0) && __GLASGOW_HASKELL__
+  liftReadPrec rp _ = go
+    where
+      go =
+        parens $
+        (Leaf <$ expect' (Ident "Leaf")) +++
+        prec
+          10
+          (expect' (Ident "Node") *> liftA3 Node (step go) (step rp) (step go))
+      expect' = lift . expect
+  liftReadListPrec = liftReadListPrecDefault
+#else
+  liftReadsPrec rp _ = go
+    where
+      go p st =
+        [(Leaf, xs) | ("Leaf", xs) <- lex st] ++
+        readParen
+          (p > 10)
+          (\vs ->
+             [ (Node l x r, zs)
+             | ("Node", ws) <- lex vs
+             , (l, xs) <- go 11 ws
+             , (x, ys) <- rp 11 xs
+             , (r, zs) <- go 11 ys
+             ])
+          st
+#endif
+#endif
+
+-- | Fold over a tree.
+--
+-- prop> foldTree Leaf Node xs === xs
+foldTree :: b -> (b -> a -> b -> b) -> Tree a -> b
+foldTree b f = go
+  where
+    go Leaf = b
+    go (Node l x r) = f (go l) x (go r)
+{-# INLINE foldTree #-}
+
+-- | The depth of the tree.
+-- 
+-- >>> depth empty
+-- 0
+--
+-- >>> depth (singleton ())
+-- 1
+depth :: Tree a -> Int
+depth = foldTree 0 (\l _ r -> succ (max l r))
+
+-- | Unfold a tree from a seed.
+unfoldTree :: (b -> Maybe (b, a, b)) -> b -> Tree a
+unfoldTree f = go
+  where
+    go = maybe Leaf (\(l, x, r) -> Node (go l) x (go r)) . f
+
+-- | @'replicate' n a@ creates a tree of size @n@ filled @a@.
+--
+-- >>> putStr (drawTree (replicate 4 ()))
+--      ┌()
+--   ┌()┘
+-- ()┤
+--   └()
+--
+-- prop> \(NonNegative n) -> length (replicate n ()) === n
+replicate :: Int -> a -> Tree a
+replicate n x = runIdentity (replicateA n (Identity x))
+
+-- | @'replicateA' n a@ replicates the action @a@ @n@ times, trying
+-- to balance the result as much as possible. The actions are executed
+-- in a preorder traversal (same as the 'Foldable' instance.)
+--
+-- >>> toList (evalState (replicateA 10 (State (\s -> (s, s + 1)))) 1)
+-- [1,2,3,4,5,6,7,8,9,10]
+replicateA :: Applicative f => Int -> f a -> f (Tree a)
+replicateA n x = go n
+  where
+    go m
+      | m <= 0 = pure Leaf
+      | even m = liftA3 Node r x (go (d - 1))
+      | otherwise = liftA3 Node r x r
+      where
+        d = m `div` 2
+        r = go d
+
+{-# SPECIALISE replicateA :: Int -> Identity a -> Identity (Tree a) #-}
+{-# SPECIALISE replicateA :: Int -> State s a -> State s (Tree a) #-}
+
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup.Semigroup (Tree a) where
+  Leaf <> y = y
+  Node x l r <> y = Node x l (r Semigroup.<> y)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE (<>) #-}
+#endif
+#endif
+
+-- | This instance is necessarily inefficient, to obey the monoid laws.
+--
+-- >>> printTree (fromList [1..6])
+--    ┌1
+--  ┌2┤
+--  │ └3
+-- 4┤
+--  │ ┌5
+--  └6┘
+--
+-- >>> printTree (fromList [1..6] `mappend` singleton 7)
+--    ┌1
+--  ┌2┤
+--  │ └3
+-- 4┤
+--  │ ┌5
+--  └6┤
+--    └7
+--
+-- 'mappend' distributes over 'toList':
+--
+-- prop> toList (mappend xs (ys :: Tree Int)) === mappend (toList xs) (toList ys)
+instance Monoid (Tree a) where
+#if MIN_VERSION_base(4,9,0)
+  mappend = (Semigroup.<>)
+  {-# INLINE mappend #-}
+#else
+  mappend Leaf y = y
+  mappend (Node l x r) y = Node l x (mappend r y)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE mappend #-}
+#endif
+#endif
+  mempty = Leaf
+
+-- | Construct a tree from a list, in an inorder fashion.
+--
+-- prop> toList (fromList xs) === xs
+fromList :: [a] -> Tree a
+fromList xs = evalState (replicateA n u) xs
+  where
+    n = length xs
+    u =
+      State
+        (\ys ->
+           case ys of
+             [] -> 
+#if __GLASGOW_HASKELL__ >= 800
+               errorWithoutStackTrace
+#else
+               error
+#endif
+               "Data.Tree.Binary.Inorder.fromList: bug!"
+             z:zs -> (z, zs))
+
+-- | Convert a tree to a human-readable structural representation.
+--
+-- >>> putStr (drawTree (fromList [1..7]))
+--    ┌1
+--  ┌2┤
+--  │ └3
+-- 4┤
+--  │ ┌5
+--  └6┤
+--    └7
+--
+drawTree :: Show a => Tree a -> String
+drawTree t = drawTreeWith show t ""
+
+-- | Pretty-print a tree with a custom show function.
+--
+-- >>> putStr (drawTreeWith (const "─") (fromList [1..7]) "")
+--    ┌─
+--  ┌─┤
+--  │ └─
+-- ─┤
+--  │ ┌─
+--  └─┤
+--    └─
+--
+-- >>> putStr (drawTreeWith id (singleton "abc") "")
+-- abc
+--
+-- >>> putStr (drawTreeWith id (Node (singleton "d") "abc" Leaf) "")
+--    ┌d
+-- abc┘
+--
+-- >>> putStr (drawTreeWith id (fromList ["abc", "d", "ef", "ghij"]) "")
+--     ┌abc
+--   ┌d┘
+-- ef┤
+--   └ghij
+drawTreeWith :: (a -> String) -> Tree a -> ShowS
+drawTreeWith sf = Internal.drawTree sf uncons'
+  where
+    uncons' Leaf = Nothing
+    uncons' (Node l x r) = Just (x, l, r)
+    
+
+-- | Pretty-print a tree.
+--
+-- >>> printTree (fromList [1..7])
+--    ┌1
+--  ┌2┤
+--  │ └3
+-- 4┤
+--  │ ┌5
+--  └6┤
+--    └7
+--
+-- >>> printTree (singleton 1)
+-- 1
+--
+-- >>> printTree (singleton 1 `mappend` singleton 2)
+-- 1┐
+--  └2
+printTree :: Show a => Tree a -> IO ()
+printTree = putStr . drawTree
+
+-- $setup
+-- >>> import Test.QuickCheck
+-- >>> import Data.Foldable (toList)
+-- >>> import Prelude (Num(..), putStr)
+-- >>> :{
+-- instance Arbitrary a =>
+--          Arbitrary (Tree a) where
+--     arbitrary = sized go
+--       where
+--         go 0 = pure Leaf
+--         go n
+--           | n <= 0 = pure Leaf
+--           | otherwise = oneof [pure Leaf, liftA3 Node sub arbitrary sub]
+--           where
+--             sub = go (n `div` 2)
+--     shrink Leaf = []
+--     shrink (Node l x r) =
+--         Leaf : l : r :
+--         [ Node l' x' r'
+--         | (l',x',r') <- shrink (l, x, r) ]
+-- :}
diff --git a/src/Data/Tree/Binary/Internal.hs b/src/Data/Tree/Binary/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Tree/Binary/Internal.hs
@@ -0,0 +1,200 @@
+{-# LANGUAGE CPP  #-}
+
+#if __GLASGOW_HASKELL__ >= 703
+{-# LANGUAGE Safe #-}
+#endif
+
+-- |
+-- Module      : Data.Tree.Binary.Internal
+-- Description : Common utility functions for the binary-tree package.
+-- Copyright   : (c) Donnacha Oisín Kidney 2018
+-- License     : MIT
+-- Maintainer  : mail@doisinkidney.com
+-- Portability : portable
+--
+-- = WARNING
+--
+-- This module is considered __internal__.
+--
+-- The Package Versioning Policy __does not apply__.
+--
+-- This contents of this module may change __in any way whatsoever__
+-- and __without any warning__ between minor versions of this package.
+--
+-- Authors importing this module are expected to track development
+-- closely.
+--
+-- = Description
+--
+-- This module exports some utility functions common to both tree modules.
+module Data.Tree.Binary.Internal
+  ( -- * Drawing Trees
+    Drawing(..)
+  , toDrawing
+  , runDrawing
+  , drawTree
+    -- * State
+  , State(..)
+  , evalState
+    -- * Reimplementations for older GHCs
+  , Identity(..)
+  ) where
+import Prelude hiding (
+#if MIN_VERSION_base(4,8,0)
+  Functor(..),Applicative, (<$>), foldMap, Monoid
+#endif
+  )
+
+#if MIN_VERSION_base(4,8,0)
+import           Data.Functor.Identity (Identity (..))
+#endif
+
+import           Control.Applicative   (Applicative (pure, (<*>)))
+import           Data.Functor          (Functor (fmap))
+
+bool :: a -> a -> Bool -> a
+bool f _ False = f
+bool _ t True  = t
+{-# INLINE bool #-}
+
+--------------------------------------------------------------------------------
+-- Drawing Trees
+--------------------------------------------------------------------------------
+
+-- | An abstract representation of a textual drawing of a tree.
+data Drawing
+  = Nil
+  | NewLine     !Drawing
+  | BottomLeft  !Drawing
+  | BottomRight !Drawing
+  | TopLeft     !Drawing
+  | TopRight    !Drawing
+  | Vert        !Drawing
+  | Split       !Drawing
+  | Item !String Drawing
+  | Padding {-# UNPACK #-} !Int !Drawing
+
+-- | A function to convert a drawing to a string.
+runDrawing :: Drawing -> ShowS
+runDrawing Nil = showString "╼\n"
+runDrawing ys = go ys
+  where
+    go Nil st              = st
+    go (NewLine     xs) st = '\n' : go xs st
+    go (BottomLeft  xs) st = '└' : go xs st
+    go (BottomRight xs) st = '┘' : go xs st
+    go (TopLeft     xs) st = '┌' : go xs st
+    go (TopRight    xs) st = '┐' : go xs st
+    go (Vert        xs) st = '│' : go xs st
+    go (Split       xs) st = '┤' : go xs st
+    go (Item x      xs) st = x ++ go xs st
+    go (Padding i   xs) st = pad i (go xs st)
+    pad 0 = id
+    pad n = showChar ' ' . pad (n-1)
+{-# INLINE runDrawing #-}
+
+
+-- | Given an uncons function for a binary tree, draw the tree in a structured,
+-- human-readable way.
+drawTree :: (a -> String) -> (t -> Maybe (a, t, t)) -> t -> ShowS
+drawTree sf project = runDrawing . toDrawing sf project
+{-# INLINE drawTree #-}
+
+-- | Convert a tree to the Drawing type. This function is exposed so that users
+-- may replace the call to 'runDrawing' in 'drawTree' with a more efficient
+-- implementation that could use (for example) 'Text'.
+toDrawing :: (a -> String) -> (t -> Maybe (a, t, t)) -> t -> Drawing
+toDrawing sf project = maybe Nil root . project
+  where
+    go dir k len (x, l, r) = node dir len x (project l) (project r) k
+
+    -- Root special case (no incoming direction)
+    root (x, l, r) =
+      maybeAp (go True id xlen) ls $
+      Item xshw $ endc ls rs $ NewLine $ maybeAp (go False id xlen) rs Nil
+      where
+        xshw = sf x
+        xlen = length xshw
+        ls = project l
+        rs = project r
+
+    node up i x ls rs k b =
+      maybeAp (branch True) ls $
+      k $
+      pad i $
+      bool BottomLeft TopLeft up $
+      Item xshw $ endc ls rs $ NewLine $ maybeAp (branch False) rs b
+      where
+        xshw = sf x
+        xlen = length xshw
+        branch d
+          | d == up = go d (k . pad i) (xlen + 1)
+          | otherwise = go d (k . pad i . Vert) xlen
+        {-# INLINE branch #-}
+    {-# INLINE node #-}
+
+    endc Nothing  Nothing  b = b
+    endc (Just _) Nothing  b = BottomRight b
+    endc Nothing  (Just _) b = TopRight b
+    endc (Just _) (Just _) b = Split b
+    {-# INLINE endc #-}
+
+    pad i (Padding j xs) = Padding (i+j) xs
+    pad i xs             = Padding i xs
+    {-# INLINE pad #-}
+
+    maybeAp _ Nothing y  = y
+    maybeAp f (Just x) y = f x y
+    {-# INLINE maybeAp #-}
+{-# INLINE toDrawing #-}
+
+--------------------------------------------------------------------------------
+-- State
+--------------------------------------------------------------------------------
+
+-- | A clone of Control.Monad.State.Strict, reimplemented here to avoid the
+-- dependency.
+newtype State s a = State
+  { runState :: s -> (a, s)
+  }
+
+instance Functor (State s) where
+  fmap f xs =
+    State
+      (\s ->
+         case runState xs s of
+           (x, s') -> (f x, s'))
+  {-# INLINE fmap #-}
+
+instance Applicative (State s) where
+  pure x = State (\s -> (x, s))
+  {-# INLINE pure #-}
+  fs <*> xs =
+    State
+      (\s ->
+         case runState fs s of
+           (f, s') ->
+             case runState xs s' of
+               (x, s'') -> (f x, s''))
+  {-# INLINE (<*>) #-}
+
+-- | Evaluate a stateful action.
+evalState :: State s a -> s -> a
+evalState xs s = fst (runState xs s)
+{-# INLINE evalState #-}
+
+--------------------------------------------------------------------------------
+-- Identity
+--------------------------------------------------------------------------------
+#if !MIN_VERSION_base(4,8,0)
+-- | A clone of Data.Functor.Identity, reimplemented here when it's not yet
+-- included in base.
+newtype Identity a = Identity {runIdentity :: a}
+
+instance Functor Identity where
+  fmap f (Identity x) = Identity (f x)
+
+instance Applicative Identity where
+  pure = Identity
+  Identity f <*> Identity x = Identity (f x)
+#endif
diff --git a/src/Data/Tree/Binary/Leafy.hs b/src/Data/Tree/Binary/Leafy.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Tree/Binary/Leafy.hs
@@ -0,0 +1,475 @@
+{-# LANGUAGE CPP #-}
+
+{-# LANGUAGE BangPatterns #-}
+#if __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 703
+{-# LANGUAGE Safe #-}
+#endif
+
+
+-- |
+-- Module      : Data.Tree.Binary.Leafy
+-- Description : A simple, generic, leafy binary tree.
+-- Copyright   : (c) Donnacha Oisín Kidney, 2018
+-- License     : MIT
+-- Maintainer  : mail@doisinkidney.com
+-- Stability   : experimental
+-- Portability : portable
+--
+-- This module provides a simple leafy binary tree, as is needed
+-- in several applications. Instances, if sensible, are defined,
+-- and generally effort is made to keep the implementation as
+-- generic as possible.
+
+module Data.Tree.Binary.Leafy
+  ( -- * The tree type
+   Tree(..)
+   -- * Construction
+  , unfoldTree
+  , replicate
+  , replicateA
+  , singleton
+  , fromList
+   -- * Consumption
+  , foldTree
+   -- * Querying
+  , depth
+   -- * Display
+  , drawTree
+  , drawTreeWith
+  , printTree
+  ) where
+
+import Prelude hiding
+  ( replicate
+#if MIN_VERSION_base(4,8,0)
+  ,Functor(..),Foldable(..),Applicative, (<$>), foldMap, Monoid
+#else
+  ,foldr,foldl
+#endif
+  )
+
+import Control.Applicative (Applicative(..), liftA2, (*>))
+
+import Control.DeepSeq (NFData(rnf))
+
+import Data.Monoid (Monoid(mappend))
+import Data.Functor (Functor(fmap, (<$)))
+
+#if MIN_VERSION_base(4,8,0)
+import Data.Foldable (Foldable(foldl, foldr, foldMap, foldl', foldr', null))
+#elif MIN_VERSION_base(4,6,0)
+import Data.Foldable (Foldable(foldl, foldr, foldMap, foldl', foldr'))
+#else
+import Data.Foldable (Foldable(foldl, foldr, foldMap))
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes
+import qualified Data.Semigroup as Semigroup
+#endif
+
+import Data.Traversable (Traversable(traverse))
+
+import Data.Typeable (Typeable)
+
+#if __GLASGOW_HASKELL__ >= 706
+import GHC.Generics (Generic, Generic1)
+#elif __GLASGOW_HASKELL__ >= 702
+import GHC.Generics (Generic)
+#endif
+
+import Text.Read
+
+#if __GLASGOW_HASKELL__
+import Data.Data (Data)
+#if MIN_VERSION_base(4,10,0)
+import Text.Read.Lex (expect)
+#endif
+#endif
+
+import Control.Monad.Fix (MonadFix(mfix), fix)
+
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip (..))
+#endif
+
+import qualified Data.Tree.Binary.Internal as Internal
+import Data.Tree.Binary.Internal (Identity(..), State)
+
+#if __GLASGOW_HASKELL__ >= 800
+import GHC.Stack (HasCallStack)
+#endif
+
+-- | A leafy binary tree.
+infixl 5 :*:
+data Tree a
+  = Leaf a
+  | Tree a :*: Tree a
+  deriving (Show, Read, Eq, Ord
+#if __GLASGOW_HASKELL__ >= 706
+  , Typeable, Data, Generic, Generic1
+#elif __GLASGOW_HASKEL__ >= 702
+  , Typeable, Data, Generic
+#elif __GLASGOW_HASKELL__
+  , Typeable, Data
+#endif
+  )
+
+instance Functor Tree where
+  fmap f (Leaf x) = Leaf (f x)
+  fmap f (xs :*: ys) = fmap f xs :*: fmap f ys
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE fmap #-}
+#endif
+  x <$ xs = go xs where
+    go (Leaf _) = Leaf x
+    go (ls :*: rs) = go ls :*: go rs
+  {-# INLINE (<$) #-}
+
+instance Applicative Tree where
+  pure = Leaf
+  {-# INLINE pure #-}
+  Leaf f <*> xs = fmap f xs
+  (fs :*: gs) <*> xs = (fs <*> xs) :*: (gs <*> xs)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE (<*>) #-}
+#endif
+#if MIN_VERSION_base(4,10,0)
+  liftA2 f = go where
+    go (Leaf x) ys = fmap (f x) ys
+    go (xl :*: xr) ys = go xl ys :*: go xr ys
+  {-# INLINE liftA2 #-}
+#endif
+#if MIN_VERSION_base(4,2,0)
+  Leaf _ *> ys = ys
+  (xl :*: xr) *> ys = (xl *> ys) :*: (xr *> ys)
+  Leaf x <* ys = x <$ ys
+  (xl :*: xr) <* ys = (xl <* ys) :*: (xr <* ys)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE (*>) #-}
+  {-# INLINABLE (<*) #-}
+#endif
+#endif
+
+instance Monad Tree where
+#if !MIN_VERSION_base(4,8,0)
+  return = pure
+  {-# INLINE return #-}
+  (>>) = (*>)
+  {-# INLINE (>>) #-}
+#endif
+  Leaf x >>= f = f x
+  (xl :*: xr) >>= f = (xl >>= f) :*: (xr >>= f)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE (>>=) #-}
+#endif
+
+-- |
+-- <http://leventerkok.github.io/papers/erkok-thesis.pdf Erkok, Levent. “Value Recursion in Monadic Computations.” PhD Thesis, Oregon Health & Science University, 2002.>
+instance MonadFix Tree where
+  mfix f =
+    case fix (f . unLeaf) of
+      Leaf x -> Leaf x
+      _ :*: _ -> mfix (lc . f) :*: mfix (rc . f)
+      where
+        unLeaf (Leaf x) = x
+        unLeaf _ =
+#if __GLASGOW_HASKELL__ >= 800
+          errorWithoutStackTrace
+#else
+          error
+#endif
+          "Data.Tree.Binary.Leafy.mfix: :*: encountered, expected Leaf"
+        lc (x :*: _) = x
+        lc _ =
+#if __GLASGOW_HASKELL__ >= 800
+          errorWithoutStackTrace
+#else
+          error
+#endif
+          "Data.Tree.Binary.Leafy.mfix: Leaf encountered, expected :*:"
+        rc (_ :*: y) = y
+        rc _ =
+#if __GLASGOW_HASKELL__ >= 800
+          errorWithoutStackTrace
+#else
+          error
+#endif
+          "Data.Tree.Binary.Leafy.mfix: Leaf encountered, expected :*:"
+
+#if MIN_VERSION_base(4,4,0)
+instance MonadZip Tree where
+  mzipWith f = go
+    where
+      go (Leaf x) (Leaf y) = Leaf (f x y)
+      go (xl :*: xr) (yl :*: yr) = go xl yl :*: go xr yr
+      go (Leaf x) (yl :*: yr) = fmap (f x) yl :*: fmap (f x) yr
+      go (xl :*: xr) (Leaf y) = fmap (flip f y) xl :*: fmap (flip f y) xr
+  munzip (Leaf (x, y)) = (Leaf x, Leaf y)
+  munzip (xs :*: ys) = (xl :*: yl, xr :*: yr)
+    where
+      (xl, xr) = munzip xs
+      (yl, yr) = munzip ys
+#endif
+
+
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup.Semigroup (Tree a) where
+  xs@(Leaf _) <> ys = xs :*: ys
+  (xl :*: xr) <> ys = xl :*: (xr Semigroup.<> ys)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE (<>) #-}
+#endif
+#endif
+
+instance Foldable Tree where
+  foldr f b (Leaf x) = f x b
+  foldr f b (xs :*: ys) = foldr f (foldr f b ys) xs
+
+  foldl f b (Leaf x) = f b x
+  foldl f b (xs :*: ys) = foldl f (foldl f b xs) ys
+
+  foldMap f (Leaf x) = f x
+  foldMap f (xs :*: ys) = foldMap f xs `mappend` foldMap f ys
+
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE foldr #-}
+  {-# INLINABLE foldl #-}
+  {-# INLINABLE foldMap #-}
+#endif
+
+#if MIN_VERSION_base(4,6,0)
+  foldr' f !b (Leaf x) = f x b
+  foldr' f !b (xs :*: ys) = case foldr' f b ys of
+    !b' -> foldr' f b' xs
+
+  foldl' f !b (Leaf x) = f b x
+  foldl' f !b (xs :*: ys) = case foldl' f b xs of
+    !b' -> foldl' f b' ys
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE foldr' #-}
+  {-# INLINABLE foldl' #-}
+#endif
+#endif
+
+#if MIN_VERSION_base(4,8,0)
+  null _ = False
+  {-# INLINE null #-}
+#endif
+
+instance Traversable Tree where
+  traverse f (Leaf x) = fmap Leaf (f x)
+  traverse f (xs :*: ys) = liftA2 (:*:) (traverse f xs) (traverse f ys)
+#if __GLASGOW_HASKELL
+  {-# INLINABLE traverse #-}
+#endif
+
+-- | A binary tree with one element.
+singleton :: a -> Tree a
+singleton = Leaf
+{-# INLINE singleton #-}
+
+instance NFData a => NFData (Tree a) where
+  rnf (Leaf x) = rnf x
+  rnf (xs :*: ys) = rnf xs `seq` rnf ys
+
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 Tree where
+  liftEq eq (Leaf x) (Leaf y) = eq x y
+  liftEq eq (xl :*: xr) (yl :*: yr) = liftEq eq xl yl && liftEq eq xr yr
+  liftEq _ _ _ = False
+
+instance Ord1 Tree where
+  liftCompare cmp (Leaf x) (Leaf y) = cmp x y
+  liftCompare cmp (xl :*: xr) (yl :*: yr) =
+    liftCompare cmp xl yl `mappend` liftCompare cmp xr yr
+  liftCompare _ (Leaf _) (_ :*: _) = LT
+  liftCompare _ (_ :*: _) (Leaf _) = GT
+
+instance Show1 Tree where
+  liftShowsPrec s _ = go
+    where
+      go d (Leaf x) = showParen (d >= 11) $ showString "Leaf " . s 11 x
+      go d (xs :*: ys) =
+        showParen (d > 5) $ go 6 xs . showString " :*: " . go 6 ys
+
+instance Read1 Tree where
+#if MIN_VERSION_base(4,10,0) && __GLASGOW_HASKELL__
+  liftReadPrec rp _ = go
+    where
+      go =
+        parens $
+        prec 10 (expect' (Ident "Leaf") *> fmap Leaf (step rp)) +++
+        prec 5 (liftA2 (:*:) (step go) (expect' (Symbol ":*:") *> step go))
+      expect' = lift . expect
+  liftReadListPrec = liftReadListPrecDefault
+#else
+  liftReadsPrec rp _ = go
+    where
+      go p st =
+        readParen
+          (p > 10)
+          (\xs -> [(Leaf x, zs) | ("Leaf", ys) <- lex xs, (x, zs) <- rp 11 ys])
+          st ++
+        readParen
+          (p > 5)
+          (\ws ->
+             [ (x :*: y, zs)
+             | (x, xs) <- go 6 ws
+             , (":*:", ys) <- lex xs
+             , (y, zs) <- go 6 ys
+             ])
+          st
+#endif
+#endif
+
+-- | Fold over a tree.
+--
+-- prop> foldTree Leaf (:*:) xs === xs
+foldTree :: (a -> b) -> (b -> b -> b) -> Tree a -> b
+foldTree b f = go
+  where
+    go (Leaf x) = b x
+    go (xs :*: ys) = go xs `f` go ys
+{-# INLINE foldTree #-}
+
+-- | The depth of the tree.
+--
+-- >>> depth (singleton ())
+-- 1
+depth :: Tree a -> Int
+depth = foldTree (const 1) (\x y -> succ (max x y))
+
+-- | Unfold a tree from a seed.
+unfoldTree :: (b -> Either a (b, b)) -> b -> Tree a
+unfoldTree f = go
+  where
+    go = either Leaf (\(l,r) -> go l :*: go r) . f
+
+-- | @'replicate' n a@ creates a tree of size @n@ filled with @a@.
+--
+-- >>> printTree (replicate 4 ())
+--  ┌()
+-- ┌┤
+-- │└()
+-- ┤
+-- │┌()
+-- └┤
+--  └()
+--
+--  prop> \(Positive n) -> length (replicate n ()) === n
+replicate :: Int -> a -> Tree a
+replicate n x = runIdentity (replicateA n (Identity x))
+
+-- | @'replicateA' n a@ replicates the action @a@ @n@ times, trying
+-- to balance the result as much as possible. The actions are executed
+-- in the same order as the 'Foldable' instance.
+--
+-- >>> toList (evalState (replicateA 10 (State (\s -> (s, s + 1)))) 1)
+-- [1,2,3,4,5,6,7,8,9,10]
+replicateA :: Applicative f => Int -> f a -> f (Tree a)
+replicateA n x = go n
+  where
+    go m
+      | m <= 1 = fmap Leaf x
+      | even m = liftA2 (:*:) r r
+      | otherwise = liftA2 (:*:) r (go (d+1))
+      where
+        d = m `div` 2
+        r = go d
+{-# SPECIALISE replicateA :: Int -> Identity a -> Identity (Tree a) #-}
+{-# SPECIALISE replicateA :: Int -> State s a -> State s (Tree a) #-}
+
+-- | Construct a tree from a list.
+--
+-- The constructed tree is somewhat, but not totally, balanced.
+--
+-- >>> printTree (fromList [1,2,3,4])
+--  ┌1
+-- ┌┤
+-- │└2
+-- ┤
+-- │┌3
+-- └┤
+--  └4
+--
+-- >>> printTree (fromList [1,2,3,4,5,6])
+--   ┌1
+--  ┌┤
+--  │└2
+-- ┌┤
+-- ││┌3
+-- │└┤
+-- │ └4
+-- ┤
+-- │┌5
+-- └┤
+--  └6
+
+#if __GLASGOW_HASKELL__ >= 800
+fromList :: HasCallStack => [a] -> Tree a
+#else
+fromList :: [a] -> Tree a
+#endif
+fromList [] = error "Data.Tree.Binary.Leafy.fromList: empty list!"
+fromList (x':xs') = go x' xs'
+  where
+    go x [] = Leaf x
+    go a (b:l) = go' (Leaf a :*: Leaf b) (pairMap l)
+    pairMap (x:y:rest) = (Leaf x :*: Leaf y) : pairMap rest
+    pairMap [] = []
+    pairMap [x] = [Leaf x]
+    go' x [] = x
+    go' a (b:l) = go' (a :*: b) (pairs l)
+    pairs (x:y:rest) = (x :*: y) : pairs rest
+    pairs xs = xs
+
+-- | Convert a tree to a human-readable structural representation.
+--
+-- >>> putStr (drawTree (Leaf 1 :*: Leaf 2 :*: Leaf 3))
+--  ┌1
+-- ┌┤
+-- │└2
+-- ┤
+-- └3
+drawTree :: Show a => Tree a -> String
+drawTree t = drawTreeWith show t ""
+
+-- | Pretty-print a tree with a custom show function.
+drawTreeWith :: (a -> String) -> Tree a -> ShowS
+drawTreeWith sf = Internal.drawTree (maybe "" sf) (fmap uncons') . Just
+  where
+    uncons' (xl :*: xr) = (Nothing, Just xl, Just xr)
+    uncons' (Leaf x) = (Just x, Nothing, Nothing)
+
+-- | Pretty-print a tree
+printTree :: Show a => Tree a -> IO ()
+printTree = putStr . drawTree
+
+-- $setup
+-- >>> import Test.QuickCheck
+-- >>> import Data.Foldable (toList, length)
+-- >>> import Prelude (Num(..), putStr)
+-- >>> import Data.Tree.Binary.Internal (evalState, State(..))
+-- >>> :{
+-- instance Arbitrary a =>
+--          Arbitrary (Tree a) where
+--     arbitrary = sized go
+--       where
+--         go n
+--           | n <= 0 = fmap Leaf arbitrary
+--           | otherwise = oneof [fmap Leaf arbitrary, liftA2 (:*:) sub sub]
+--           where
+--             sub = go (n `div` 2)
+--     shrink (Leaf x) = fmap Leaf (shrink x)
+--     shrink (l :*: r) =
+--         l : r :
+--         [ l' :*: r'
+--         | (l',r') <- shrink (l, r) ]
+-- :}
diff --git a/src/Data/Tree/Binary/Preorder.hs b/src/Data/Tree/Binary/Preorder.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Tree/Binary/Preorder.hs
@@ -0,0 +1,477 @@
+{-# LANGUAGE CPP                #-}
+
+{-# LANGUAGE BangPatterns       #-}
+#if __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric      #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 703
+{-# LANGUAGE Safe               #-}
+#endif
+
+
+-- |
+-- Module      : Data.Tree.Binary.Preorder
+-- Description : A simple, generic, preorder binary tree.
+-- Copyright   : (c) Donnacha Oisín Kidney, 2018
+-- License     : MIT
+-- Maintainer  : mail@doisinkidney.com
+-- Stability   : experimental
+-- Portability : portable
+--
+-- This module provides a simple preorder binary tree, as is needed
+-- in several applications. Instances, if sensible, are defined,
+-- and generally effort is made to keep the implementation as
+-- generic as possible.
+
+module Data.Tree.Binary.Preorder
+  ( -- * The tree type
+   Tree(..)
+   -- * Construction
+  , unfoldTree
+  , replicate
+  , replicateA
+  , singleton
+  , empty
+  , fromList
+   -- * Consumption
+  , foldTree
+   -- * Querying
+  , depth
+   -- * Display
+  , drawTree
+  , drawTreeWith
+  , printTree
+  ) where
+
+import Prelude hiding
+  ( replicate
+#if MIN_VERSION_base(4,8,0)
+  ,Functor(..),Foldable(..),Applicative(..), (<$>), foldMap, Monoid
+#else
+  ,foldr,foldl
+#endif
+  )
+
+import           Data.List                 (length)
+
+import           Control.Applicative       (Alternative, Applicative (..),
+                                            liftA2, liftA3)
+import qualified Control.Applicative       as Alternative (empty, (<|>))
+
+import           Control.DeepSeq           (NFData (rnf))
+
+import           Data.Functor              (Functor (fmap, (<$)))
+import           Data.Monoid               (Monoid (mappend, mempty))
+
+#if MIN_VERSION_base(4,6,0)
+import           Data.Foldable             (Foldable (foldMap, foldl, foldl', foldr, foldr'))
+#else
+import           Data.Foldable             (Foldable (foldMap, foldl, foldr))
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+import           Data.Functor.Classes
+import qualified Data.Semigroup            as Semigroup
+#endif
+
+import           Data.Traversable          (Traversable (traverse))
+
+import           Data.Typeable             (Typeable)
+
+#if __GLASGOW_HASKELL__ >= 706
+import           GHC.Generics              (Generic, Generic1)
+#elif __GLASGOW_HASKELL__ >= 702
+import           GHC.Generics              (Generic)
+#endif
+
+import           Text.Read
+
+#if __GLASGOW_HASKELL__
+import           Data.Data                 (Data)
+#if MIN_VERSION_base(4,10,0)
+import           Text.Read.Lex             (expect)
+#endif
+#endif
+
+import           Data.Tree.Binary.Internal (Identity (..), State (..),
+                                            evalState)
+import qualified Data.Tree.Binary.Internal as Internal
+
+-- | A preorder binary tree.
+data Tree a
+  = Leaf
+  | Node a
+         (Tree a)
+         (Tree a)
+  deriving (Show, Read, Eq, Ord
+#if __GLASGOW_HASKELL__ >= 706
+  , Typeable, Data, Generic, Generic1
+#elif __GLASGOW_HASKEL__ >= 702
+  , Typeable, Data, Generic
+#elif __GLASGOW_HASKELL__
+  , Typeable, Data
+#endif
+  )
+
+instance Functor Tree where
+  fmap _ Leaf         = Leaf
+  fmap f (Node x l r) = Node (f x) (fmap f l) (fmap f r)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE fmap #-}
+#endif
+  x <$ xs = go xs where
+    go Leaf         = Leaf
+    go (Node _ l r) = Node x (go l) (go r)
+  {-# INLINE (<$) #-}
+
+instance Applicative Tree where
+  pure x = y where y = Node x y y
+  Leaf <*> _ = Leaf
+  Node _ _ _ <*> Leaf = Leaf
+  Node f fl fr <*> Node x xl xr = Node (f x) (fl <*> xl) (fr <*> xr)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE pure #-}
+  {-# INLINABLE (<*>) #-}
+#endif
+#if MIN_VERSION_base(4,10,0)
+  liftA2 f = go where
+    go Leaf _                        = Leaf
+    go (Node _ _ _) Leaf             = Leaf
+    go (Node x xl xr) (Node y yl yr) = Node (f x y) (go xl yl) (go xr yr)
+  {-# INLINE liftA2 #-}
+#endif
+#if MIN_VERSION_base(4,2,0)
+  Leaf *> _ = Leaf
+  Node _ _ _ *> Leaf = Leaf
+  Node _ xl xr *> Node y yl yr = Node y (xl *> yl) (xr *> yr)
+  Leaf <* _ = Leaf
+  Node _ _ _ <* Leaf = Leaf
+  Node x xl xr <* Node _ yl yr = Node x (xl <* yl) (xr <* yr)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE (*>) #-}
+  {-# INLINABLE (<*) #-}
+#endif
+#endif
+
+instance Alternative Tree where
+  empty = Leaf
+  {-# INLINE empty #-}
+#if MIN_VERSION_base(4,9,0)
+  (<|>) = (Semigroup.<>)
+#else
+  (<|>) = mappend
+#endif
+  {-# INLINE (<|>) #-}
+
+instance Foldable Tree where
+  foldr _ b Leaf         = b
+  foldr f b (Node x l r) = f x (foldr f (foldr f b r) l)
+
+  foldl _ b Leaf         = b
+  foldl f b (Node x l r) = foldl f (foldl f (f b x) l) r
+
+  foldMap _ Leaf         = mempty
+  foldMap f (Node x l r) = f x `mappend` foldMap f l `mappend` foldMap f r
+
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE foldMap #-}
+  {-# INLINABLE foldr #-}
+  {-# INLINABLE foldl #-}
+#endif
+
+
+#if MIN_VERSION_base(4,6,0)
+  foldr' _ !b Leaf = b
+  foldr' f !b (Node x l r) = case foldr' f b r of
+    !b' -> case foldr' f b' l of
+      !b'' -> f x b''
+
+  foldl' _ !b Leaf = b
+  foldl' f !b (Node x l r) = case f b x of
+    !b' -> case foldl' f b' l of
+      !b'' -> foldl' f b'' r
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE foldr' #-}
+  {-# INLINABLE foldl' #-}
+#endif
+#endif
+
+instance Traversable Tree where
+  traverse _ Leaf         = pure Leaf
+  traverse f (Node x l r) = liftA3 Node (f x) (traverse f l) (traverse f r)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE traverse #-}
+#endif
+
+-- | A binary tree with one element.
+singleton :: a -> Tree a
+singleton x = Node x Leaf Leaf
+
+{-# INLINE singleton #-}
+-- | A binary tree with no elements.
+empty :: Tree a
+empty = Leaf
+
+{-# INLINE empty #-}
+instance NFData a => NFData (Tree a) where
+  rnf Leaf         = ()
+  rnf (Node x l r) = rnf x `seq` rnf l `seq` rnf r
+
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 Tree where
+  liftEq _ Leaf Leaf = True
+  liftEq eq (Node x xl xr) (Node y yl yr) =
+    eq x y && liftEq eq xl yl && liftEq eq xr yr
+  liftEq _ _ _ = False
+
+instance Ord1 Tree where
+  liftCompare _ Leaf Leaf = EQ
+  liftCompare cmp (Node x xl xr) (Node y yl yr) =
+    cmp x y `mappend` liftCompare cmp xl yl `mappend` liftCompare cmp xr yr
+  liftCompare _ Leaf _ = LT
+  liftCompare _ _ Leaf = GT
+
+instance Show1 Tree where
+  liftShowsPrec s _ = go
+    where
+      go _ Leaf = showString "Leaf"
+      go d (Node x l r) =
+        showParen (d >= 11) $
+        showString "Node " .
+        s 11 x . showChar ' ' . go 11 l . showChar ' ' . go 11 r
+
+instance Read1 Tree where
+#if MIN_VERSION_base(4,10,0) && __GLASGOW_HASKELL__
+  liftReadPrec rp _ = go
+    where
+      go =
+        parens $
+        (Leaf <$ expect' (Ident "Leaf")) +++
+        prec
+          10
+          (expect' (Ident "Node") *> liftA3 Node (step rp) (step go) (step go))
+      expect' = lift . expect
+  liftReadListPrec = liftReadListPrecDefault
+#else
+  liftReadsPrec rp _ = go
+    where
+      go p st =
+        [(Leaf, xs) | ("Leaf", xs) <- lex st] ++
+        readParen
+          (p > 10)
+          (\vs ->
+             [ (Node x l r, zs)
+             | ("Node", ws) <- lex vs
+             , (x, xs) <- rp 11 ws
+             , (l, ys) <- go 11 xs
+             , (r, zs) <- go 11 ys
+             ])
+          st
+#endif
+#endif
+
+-- | Fold over a tree.
+--
+-- prop> foldTree Leaf Node xs === xs
+foldTree :: b -> (a -> b -> b -> b) -> Tree a -> b
+foldTree b f = go
+  where
+    go Leaf         = b
+    go (Node x l r) = f x (go l) (go r)
+{-# INLINE foldTree #-}
+
+-- | The depth of the tree.
+--
+-- >>> depth empty
+-- 0
+--
+-- >>> depth (singleton ())
+-- 1
+depth :: Tree a -> Int
+depth = foldTree 0 (\_ l r -> succ (max l r))
+
+-- | Unfold a tree from a seed.
+unfoldTree :: (b -> Maybe (a, b, b)) -> b -> Tree a
+unfoldTree f = go
+  where
+    go = maybe Leaf (\(x, l, r) -> Node x (go l) (go r)) . f
+
+-- | @'replicate' n a@ creates a tree of size @n@ filled @a@.
+--
+-- >>> putStr (drawTree (replicate 4 ()))
+--      ┌()
+--   ┌()┘
+-- ()┤
+--   └()
+--
+-- prop> \(NonNegative n) -> length (replicate n ()) === n
+replicate :: Int -> a -> Tree a
+replicate n x = runIdentity (replicateA n (Identity x))
+
+-- | @'replicateA' n a@ replicates the action @a@ @n@ times, trying
+-- to balance the result as much as possible. The actions are executed
+-- in a preorder traversal (same as the 'Foldable' instance.)
+--
+-- >>> toList (evalState (replicateA 10 (State (\s -> (s, s + 1)))) 1)
+-- [1,2,3,4,5,6,7,8,9,10]
+replicateA :: Applicative f => Int -> f a -> f (Tree a)
+replicateA n x = go n
+  where
+    go m
+      | m <= 0 = pure Leaf
+      | even m = liftA3 Node x r (go (d - 1))
+      | otherwise = liftA3 Node x r r
+      where
+        d = m `div` 2
+        r = go d
+
+{-# SPECIALISE replicateA :: Int -> Identity a -> Identity (Tree a) #-}
+{-# SPECIALISE replicateA :: Int -> State s a -> State s (Tree a) #-}
+
+#if MIN_VERSION_base(4,9,0)
+instance Semigroup.Semigroup (Tree a) where
+  Leaf <> y = y
+  Node x l r <> y = Node x l (r Semigroup.<> y)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE (<>) #-}
+#endif
+#endif
+
+-- | This instance is necessarily inefficient, to obey the monoid laws.
+--
+-- >>> printTree (fromList [1..6])
+--    ┌3
+--  ┌2┤
+--  │ └4
+-- 1┤
+--  │ ┌6
+--  └5┘
+--
+-- >>> printTree (fromList [1..6] `mappend` singleton 7)
+--    ┌3
+--  ┌2┤
+--  │ └4
+-- 1┤
+--  │ ┌6
+--  └5┤
+--    └7
+--
+-- 'mappend' distributes over 'toList':
+--
+-- prop> toList (mappend xs (ys :: Tree Int)) === mappend (toList xs) (toList ys)
+instance Monoid (Tree a) where
+#if MIN_VERSION_base(4,9,0)
+  mappend = (Semigroup.<>)
+  {-# INLINE mappend #-}
+#else
+  mappend Leaf y         = y
+  mappend (Node x l r) y = Node x l (mappend r y)
+#if __GLASGOW_HASKELL__
+  {-# INLINABLE mappend #-}
+#endif
+#endif
+  mempty = Leaf
+
+-- | Construct a tree from a list, in an preorder fashion.
+--
+-- prop> toList (fromList xs) === xs
+fromList :: [a] -> Tree a
+fromList xs = evalState (replicateA n u) xs
+  where
+    n = length xs
+    u =
+      State
+        (\ys ->
+           case ys of
+             [] ->
+#if __GLASGOW_HASKELL__ >= 800
+               errorWithoutStackTrace
+#else
+               error
+#endif
+               "Data.Tree.Binary.Preorder.fromList: bug!"
+             z:zs -> (z, zs))
+
+-- | Convert a tree to a human-readable structural representation.
+--
+-- >>> putStr (drawTree (fromList [1..7]))
+--    ┌3
+--  ┌2┤
+--  │ └4
+-- 1┤
+--  │ ┌6
+--  └5┤
+--    └7
+drawTree :: Show a => Tree a -> String
+drawTree t = drawTreeWith show t ""
+
+-- | Pretty-print a tree with a custom show function.
+--
+-- >>> putStr (drawTreeWith (const "─") (fromList [1..7]) "")
+--    ┌─
+--  ┌─┤
+--  │ └─
+-- ─┤
+--  │ ┌─
+--  └─┤
+--    └─
+--
+-- >>> putStr (drawTreeWith id (singleton "abc") "")
+-- abc
+--
+-- >>> putStr (drawTreeWith id (Node "abc" (singleton  "d") Leaf) "")
+--    ┌d
+-- abc┘
+--
+-- >>> putStr (drawTreeWith id (fromList ["abc", "d", "ef", "ghij"]) "")
+--      ┌ef
+--    ┌d┘
+-- abc┤
+--    └ghij
+drawTreeWith :: (a -> String) -> Tree a -> ShowS
+drawTreeWith sf = Internal.drawTree sf uncons'
+  where
+    uncons' Leaf         = Nothing
+    uncons' (Node x l r) = Just (x, l, r)
+
+-- | Pretty-print a tree.
+--
+-- >>> printTree (fromList [1..7])
+--    ┌3
+--  ┌2┤
+--  │ └4
+-- 1┤
+--  │ ┌6
+--  └5┤
+--    └7
+--
+-- >>> printTree (singleton 1 `mappend` singleton 2)
+-- 1┐
+--  └2
+printTree :: Show a => Tree a -> IO ()
+printTree = putStr . drawTree
+
+-- $setup
+-- >>> import Test.QuickCheck
+-- >>> import Data.Foldable (toList)
+-- >>> import Prelude (Num(..), putStr)
+-- >>> :{
+-- instance Arbitrary a =>
+--          Arbitrary (Tree a) where
+--     arbitrary = sized go
+--       where
+--         go 0 = pure Leaf
+--         go n
+--           | n <= 0 = pure Leaf
+--           | otherwise = oneof [pure Leaf, liftA3 Node arbitrary sub sub]
+--           where
+--             sub = go (n `div` 2)
+--     shrink Leaf = []
+--     shrink (Node x l r) =
+--         Leaf : l : r :
+--         [ Node x' l' r'
+--         | (x',l',r') <- shrink (x, l, r) ]
+-- :}
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,398 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+import Test.QuickCheck
+import Test.QuickCheck.Poly
+import Test.QuickCheck.Checkers
+import Test.QuickCheck.Classes
+import Test.ChasingBottoms
+import Test.Framework as Framework
+import Test.Framework.Providers.QuickCheck2
+
+import qualified Data.Tree.Binary.Preorder as Preorder
+import qualified Data.Tree.Binary.Leafy as Leafy
+import qualified Data.Tree.Binary.Inorder as Inorder
+
+import Control.Applicative
+import Data.Foldable
+import Data.Traversable
+
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes
+#endif
+
+import Prelude hiding
+  ( replicate
+#if MIN_VERSION_base(4,8,0)
+  ,Functor(..),Foldable(..),Applicative, (<$>), foldMap, Monoid
+#else
+  ,foldr,foldl
+#endif
+  )
+
+import Data.Functor (Functor(fmap))
+
+#if MIN_VERSION_base(4,6,0)
+import Data.Foldable (Foldable(foldl, foldr, foldMap, foldl', foldr'))
+#else
+import Data.Foldable (Foldable(foldl, foldr, foldMap))
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+import qualified Data.Semigroup as Semigroup
+#endif
+
+import Text.Read
+
+--------------------------------------------------------------------------------
+-- Lifted Properties
+--------------------------------------------------------------------------------
+#if MIN_VERSION_base(4,9,0)
+eq1Prop ::
+     (Eq (f OrdA), Eq1 f, Show (f OrdA), Arbitrary (f OrdA))
+  => f OrdA
+  -> Property
+eq1Prop p =
+  forAllShrink arbitrary shrink $ \xs ->
+    forAllShrink (oneof [pure xs, arbitrary]) shrink $ \ys ->
+      (Lifted xs == Lifted ys) === ((xs `asTypeOf` p) == ys)
+
+ord1Prop ::
+     (Ord (f OrdA), Ord1 f, Show (f OrdA), Arbitrary (f OrdA))
+  => f OrdA
+  -> Property
+ord1Prop p =
+  forAllShrink arbitrary shrink $ \xs ->
+    forAllShrink (oneof [pure xs, arbitrary]) shrink $ \ys ->
+      (Lifted xs `compare` Lifted ys) === ((xs `asTypeOf` p) `compare` ys)
+
+showProp :: (Show1 f, Show (f A)) => f () -> f A -> Property
+showProp _ xs = show xs === show (Lifted xs)
+
+readProp ::
+     (Read1 f, Show (f (f Int)), Read (f Int), EqProp (f (f Int)), Arbitrary (f (f Int)))
+  => f (f Int)
+  -> Property
+readProp p = inverseL reader show
+  where
+    reader str = runLifted (read str) `asTypeOf` p
+
+liftedProperties
+    :: (Ord (f OrdA)
+       ,Ord1 f
+       ,Show (f OrdA)
+       ,Arbitrary (f OrdA)
+       ,Show1 f
+       ,Arbitrary (f A)
+       ,Show (f A)
+       ,Read1 f
+       ,Show (f (f Int))
+       ,Read (f Int)
+       ,EqProp (f (f Int))
+       ,Arbitrary (f (f Int))
+       ,EqProp (f OrdA))
+    => (OrdA -> f OrdA) -> Framework.Test
+liftedProperties t =
+    testGroup
+        "Lifted Classes"
+        [ testBatch (ord (\x -> oneof [pure x, arbitrary `asTypeOf` conv3 t]))
+        , testProperty "eq1" (eq1Prop (t undefined))
+        , testProperty "ord1 consistency" (ord1Prop (t undefined))
+        , testProperty "show1" (showProp (conv t))
+        , testProperty "read1" (readProp (conv2 t))]
+  where
+    conv :: (OrdA -> f OrdA) -> f ()
+    conv = undefined
+    conv2 :: (OrdA -> f OrdA) -> f (f Int)
+    conv2 = undefined
+    conv3 :: (OrdA -> f OrdA) -> Gen (Lifted f OrdA)
+    conv3 = undefined
+#endif
+
+--------------------------------------------------------------------------------
+-- Folds
+--------------------------------------------------------------------------------
+
+foldlProp ::
+     (Foldable f)
+  => f ()
+  -> f A
+  -> Fun (B, A) B
+  -> B
+  -> Property
+foldlProp _ xs f b =
+  foldl (applyFun2 f) b (toList xs) === foldl (applyFun2 f) b xs
+
+foldrProp' ::
+     (Foldable f)
+  => f ()
+  -> f A
+  -> Fun (A, B) B
+  -> B
+  -> Property
+foldrProp' _ xs f b = foldr' (applyFun2 f) b xs === foldr (applyFun2 f) b xs
+
+foldlProp' ::
+     (Foldable f)
+  => f ()
+  -> f A
+  -> Fun (B, A) B
+  -> B
+  -> Property
+foldlProp' _ xs f b =
+  foldl' (applyFun2 f) b xs === foldl (applyFun2 f) b xs
+
+foldMapProp :: Foldable f => f () -> f A -> Fun A [B] -> Property
+foldMapProp _ xs f =
+  foldMap (applyFun f) (toList xs) === foldMap (applyFun f) xs
+
+indexed :: Traversable f => f a -> (Int, f Int)
+indexed = mapAccumL (\a _ -> (a+1, a)) 0
+
+foldrStrictProp :: (Show (f Int), Traversable f) => f () -> f () -> Property
+foldrStrictProp _ xs' =
+  conjoin
+    [ counterexample (unlines [show xs, show ys, show i]) $
+    isBottom (foldr' c b xs) === isBottom (foldr' c b ys)
+    | b
+    -- error "too strict",
+         <-
+        [0 :: Int]
+    , (i, c) <- zip [(-1 :: Int) ..] fns
+    ]
+  where
+    (n, xs) = indexed xs'
+    ys = [0 .. n - 1]
+    fns =
+      const :
+      [ \y _ ->
+        if x == y
+          then error "too strict"
+          else y
+      | x <- ys
+      ]
+
+foldlStrictProp :: (Show (f Int), Traversable f) => f () -> f () -> Property
+foldlStrictProp _ xs' =
+  conjoin
+    [ counterexample (unlines [show xs, show ys, show i]) $
+    isBottom (foldl' c b xs) == isBottom (foldl' c b ys)
+    | b <- [error "too strict", 0]
+    , (i, c) <- zip [(-1 :: Int) ..] fns
+    ]
+  where
+    (n, xs) = indexed xs'
+    ys = [(0 :: Int) .. n - 1]
+    fns =
+      const id :
+      [ \_ y ->
+        if x == y
+          then error "too strict"
+          else y
+      | x <- ys
+      ]
+
+foldProperties
+    :: (Arbitrary (f A)
+       ,Show (f A)
+       ,Show (f Int)
+       ,Arbitrary (f ())
+       ,Show (f ())
+       ,Traversable f)
+    => f () -> Framework.Test
+foldProperties p =
+    testGroup
+        "Folds"
+        [ testProperty "foldl" (foldlProp p)
+        , testProperty "foldr'" (foldrProp' p)
+        , testProperty "foldl'" (foldlProp' p)
+        , testProperty "foldMap" (foldMapProp p)
+        , testProperty "foldrStrict" (foldrStrictProp p)
+#if MIN_VERSION_base(4,8,0) || !MIN_VERSION_base(4,6,0)
+        , testProperty "foldlStrict" (foldlStrictProp p)
+#endif
+        ]
+
+
+
+--------------------------------------------------------------------------------
+-- Display
+--------------------------------------------------------------------------------
+
+endsInNewlineProp :: (a -> String) -> a -> Property
+endsInNewlineProp f x =
+    maybe (counterexample "shouldn't be empty" False) ('\n' ===) (last' (f x))
+  where
+    last' =
+        foldl'
+            (\_ e ->
+                  Just e)
+            Nothing
+
+--------------------------------------------------------------------------------
+-- Helper for Checker format
+--------------------------------------------------------------------------------
+
+testBatch :: TestBatch -> Framework.Test
+testBatch (name, tests) = testGroup name (map (uncurry testProperty) tests)
+
+main :: IO ()
+main =
+  defaultMain
+    [ testGroup
+        "Preorder"
+        [ testBatch (monoid (Preorder.Leaf :: Preorder.Tree A))
+        , testProperty "toList . fromList" (inverseL toList (Preorder.fromList :: [Int] -> Preorder.Tree Int))
+#if MIN_VERSION_base(4,9,0)
+        , liftedProperties (const Preorder.Leaf)
+#endif
+        , foldProperties Preorder.Leaf
+        , testBatch (functor (undefined :: Preorder.Tree (A, B, C)))
+        , testBatch
+            ( "applicative"
+            , [ (name, test)
+              | (name, test) <- snd $ applicative (undefined :: Preorder.Tree (A, B, C))
+              , name /= "homomorphism"
+              ])
+        , testBatch (traversable (undefined :: Preorder.Tree (A, B, [Int])))
+        , testBatch (alternative (undefined :: Preorder.Tree A))
+        , testProperty "drawTree ends in newline" (endsInNewlineProp (Preorder.drawTree :: Preorder.Tree A -> String))
+        ]
+    , testGroup
+        "Inorder"
+        [ testBatch (monoid (Inorder.Leaf :: Inorder.Tree A))
+        , testProperty "toList . fromList" (inverseL toList (Inorder.fromList :: [Int] -> Inorder.Tree Int))
+#if MIN_VERSION_base(4,9,0)
+        , liftedProperties (const Inorder.Leaf)
+#endif
+        , foldProperties Inorder.Leaf
+        , testBatch
+            ( "applicative"
+            , [ (name, test)
+              | (name, test) <- snd $ applicative (undefined :: Inorder.Tree (A, B, C))
+              , name /= "homomorphism"
+              ])
+        , testBatch (functor (undefined :: Inorder.Tree (A, B, C)))
+        , testBatch (traversable (undefined :: Inorder.Tree (A, B, [Int])))
+        , testBatch (alternative (undefined :: Inorder.Tree A))
+        , testProperty "drawTree ends in newline" (endsInNewlineProp (Inorder.drawTree :: Inorder.Tree A -> String))
+        ]
+    , testGroup
+        "Leafy"
+        [
+#if MIN_VERSION_base(4,9,0)
+        testProperty "semigroup" (isAssoc ((Semigroup.<>) :: Leafy.Tree Int -> Leafy.Tree Int -> Leafy.Tree Int) ) ,
+#endif
+         testProperty "toList . fromList" (inverseL (NonEmpty . toList) (Leafy.fromList . getNonEmpty :: NonEmptyList Int -> Leafy.Tree Int))
+#if MIN_VERSION_base(4,9,0)
+        , liftedProperties Leafy.Leaf
+#endif
+        , foldProperties (Leafy.Leaf undefined)
+        , testBatch (functor (undefined :: Leafy.Tree (A, B, C)))
+        , testBatch (applicative (undefined :: Leafy.Tree (A, B, C)))
+        , testBatch (monad (undefined :: Leafy.Tree (A, B, C)))
+        , testBatch (monadFunctor (undefined :: Leafy.Tree (A, B)))
+        , testBatch (monadApplicative (undefined :: Leafy.Tree (A, B)))
+        , testBatch (traversable (undefined :: Leafy.Tree (A, B, [Int])))
+        , testProperty "drawTree ends in newline" (endsInNewlineProp (Leafy.drawTree :: Leafy.Tree A -> String))
+        ]
+    ]
+
+--------------------------------------------------------------------------------
+-- Arbitrary Instances
+--------------------------------------------------------------------------------
+instance Arbitrary a => Arbitrary (Preorder.Tree a) where
+  arbitrary = sized go
+    where
+      go n
+        | n <= 0 = pure Preorder.Leaf
+        | otherwise =
+          oneof [pure Preorder.Leaf, liftA3 Preorder.Node arbitrary sub sub]
+        where
+          sub = go (n `div` 2)
+  shrink Preorder.Leaf = []
+  shrink (Preorder.Node x l r) =
+    Preorder.Leaf :
+    l : r : [Preorder.Node x' l' r' | (x', l', r') <- shrink (x, l, r)]
+
+instance Arbitrary a => Arbitrary (Inorder.Tree a) where
+  arbitrary = sized go
+    where
+      go n
+        | n <= 0 = pure Inorder.Leaf
+        | otherwise =
+          oneof [pure Inorder.Leaf, liftA3 Inorder.Node sub arbitrary sub]
+        where
+          sub = go (n `div` 2)
+  shrink Inorder.Leaf = []
+  shrink (Inorder.Node l x r) =
+    Inorder.Leaf :
+    l : r : [Inorder.Node l' x' r' | (l', x', r') <- shrink (l, x, r)]
+
+instance Arbitrary a => Arbitrary (Leafy.Tree a) where
+  arbitrary = sized go
+    where
+      go n
+        | n <= 0 = fmap Leafy.Leaf arbitrary
+        | otherwise =
+          oneof [fmap Leafy.Leaf arbitrary, liftA2 (Leafy.:*:) sub sub]
+        where
+          sub = go (n `div` 2)
+  shrink (Leafy.Leaf x) = fmap Leafy.Leaf (shrink x)
+  shrink (l Leafy.:*: r) =
+    l : r : [l' Leafy.:*: r' | (l', r') <- shrink (l, r)]
+
+--------------------------------------------------------------------------------
+-- EqProp Instances
+--------------------------------------------------------------------------------
+instance (Show a, Eq a) => EqProp (Preorder.Tree a) where
+  x =-= y =
+    whenFail
+      (putStrLn (Preorder.drawTree x ++ "\n/=\n" ++ Preorder.drawTree y))
+      (x == y)
+
+instance (Show a, Eq a) => EqProp (Inorder.Tree a) where
+  x =-= y =
+    whenFail
+      (putStrLn (Inorder.drawTree x ++ "\n/=\n" ++ Inorder.drawTree y))
+      (x == y)
+
+instance (Show a, Eq a) => EqProp (Leafy.Tree a) where
+  x =-= y =
+    whenFail
+      (putStrLn (Leafy.drawTree x ++ "\n/=\n" ++ Leafy.drawTree y))
+      (x == y)
+
+instance (Eq a, Show a) => EqProp (NonEmptyList a) where
+  (=-=) = (===)
+--------------------------------------------------------------------------------
+-- Lifted
+--------------------------------------------------------------------------------
+
+#if MIN_VERSION_base(4,9,0)
+newtype Lifted f a = Lifted { runLifted :: f a }
+
+instance (Eq1 f, Eq a) => Eq (Lifted f a) where
+  Lifted xs == Lifted ys = eq1 xs ys
+
+instance (Ord1 f, Ord a) => Ord (Lifted f a) where
+  compare (Lifted xs) (Lifted ys) = compare1 xs ys
+
+instance (Show1 f, Show a) => Show (Lifted f a) where
+  showsPrec n (Lifted xs) = showsPrec1 n xs
+  showList xs = liftShowList showsPrec showList [ x | Lifted x <- xs ]
+
+instance (Read1 f, Read a) => Read (Lifted f a) where
+#if MIN_VERSION_base(4,10,0)
+  readPrec = fmap Lifted readPrec1
+#else
+  readsPrec n xs = [ (Lifted x,ys) | (x, ys) <- readsPrec1 n xs ]
+#endif
+
+instance EqProp (f a) => EqProp (Lifted f a) where
+  Lifted x =-= Lifted y = x =-= y
+
+instance Arbitrary (f a) => Arbitrary (Lifted f a) where
+  arbitrary = fmap Lifted arbitrary
+  shrink (Lifted xs) = fmap Lifted (shrink xs)
+#endif