diff --git a/Setup.hs b/Setup.hs
deleted file mode 100644
--- a/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/pred-trie.cabal b/pred-trie.cabal
--- a/pred-trie.cabal
+++ b/pred-trie.cabal
@@ -1,5 +1,5 @@
 Name:                   pred-trie
-Version:                0.2.0
+Version:                0.2.1
 Author:                 Athan Clark <athan.clark@gmail.com>
 Maintainer:             Athan Clark <athan.clark@gmail.com>
 License:                BSD3
@@ -20,6 +20,9 @@
                         Data.Trie.Pred.Disjoint.Tail
   Build-Depends:        base >= 4.6 && < 5
                       , semigroups
+                      , mtl
+                      , composition-extra >= 1.2
+                      , QuickCheck
 
 Test-Suite spec
   Type:                 exitcode-stdio-1.0
@@ -29,9 +32,14 @@
   Ghc-Options:          -Wall
   Main-Is:              Spec.hs
   Build-Depends:        base
-                      , hspec
+                      , tasty
+                      , tasty-quickcheck
+                      , tasty-hunit
                       , QuickCheck
                       , quickcheck-instances
+                      , semigroups
+                      , mtl
+                      , composition-extra
 
 Benchmark simplevshort
     Type:               exitcode-stdio-1.0
diff --git a/src/Data/Trie/Pred/Unified.hs b/src/Data/Trie/Pred/Unified.hs
--- a/src/Data/Trie/Pred/Unified.hs
+++ b/src/Data/Trie/Pred/Unified.hs
@@ -3,42 +3,49 @@
   , assignLit
   , showTrie
   , merge
+  , elem
   , lookup
   , lookupWithL
   , lookupNearestParent
+  , lookupThrough
   , litSingleton
   , litExtrude
-  , module Data.Trie.Pred.Unified.Tail
   ) where
 
-import Prelude hiding (lookup)
-import Data.Trie.Pred.Unified.Tail hiding (lookup, lookupWithL, lookupNearestParent, merge, assignLit)
+import Prelude hiding (lookup, map, elem)
+import           Data.Trie.Pred.Unified.Tail (UPTrie (..), showTail)
 import qualified Data.Trie.Pred.Unified.Tail as NU
-import Data.Monoid
-import Data.Maybe (fromMaybe)
 import qualified Data.List.NonEmpty as NE
+import Data.Monoid
+import Data.Maybe
+import Data.Functor.Syntax
 
+import Test.QuickCheck
 
+
 data RUPTrie t x = Rooted { root :: Maybe x
                           , children :: [UPTrie t x] }
+  deriving (Eq)
 
+instance Functor (RUPTrie t) where
+  fmap = map
+
+map :: (a -> b) -> RUPTrie t a -> RUPTrie t b
+map f (Rooted mx xs) = Rooted (f <$> mx) $ f <$$> xs
+
+instance Foldable (RUPTrie t) where
+  foldMap f (Rooted mx xs) = fromMaybe (foldMap (foldMap f) xs) $ f <$> mx
+
 showTrie :: Show t => RUPTrie t x -> String
-showTrie (Rooted mx xs) = case mx of
-  Nothing -> "(NoRoot) [" ++ concatMap showTail xs ++ "] "
-  Just x  -> "(Root) [" ++ concatMap showTail xs ++ "] "
+showTrie (Rooted mx xs) =
+  if isNothing mx
+  then "(NoRoot) [" ++ concatMap showTail xs ++ "] "
+  else "(Root) [" ++ concatMap showTail xs ++ "] "
 
 instance (Eq t) => Monoid (RUPTrie t x) where
   mempty = Rooted Nothing []
   mappend = Data.Trie.Pred.Unified.merge
 
-instance (Show t) => Show (RUPTrie t x) where
-  show = showTrie
-
-assignLit :: Eq t => [t] -> Maybe x -> RUPTrie t x -> RUPTrie t x
-assignLit [] mx (Rooted my ys) = Rooted mx ys
-assignLit ts mx (Rooted my ys) = Rooted my $
-  map (NU.assignLit (NE.fromList ts) mx) ys
-
 merge :: (Eq t) => RUPTrie t x -> RUPTrie t x -> RUPTrie t x
 merge (Rooted mx xs) (Rooted my ys) =
   Rooted (getLast $ Last mx <> Last my) $ NU.sort $ foldr go [] $ xs ++ ys
@@ -48,23 +55,43 @@
     go a (b:bs) | NU.areDisjoint a b =        a : b : bs
                 | otherwise          = NU.merge a b : bs
 
+instance (Show t) => Show (RUPTrie t x) where
+  show = showTrie
+
+instance (Arbitrary t, Arbitrary x) => Arbitrary (RUPTrie t x) where
+  arbitrary = do
+    mx <- arbitrary
+    xs <- arbitrary `suchThat` (\x -> length x < 10)
+    return $ Rooted mx xs
+
+
+assignLit :: Eq t => [t] -> Maybe x -> RUPTrie t x -> RUPTrie t x
+assignLit [] mx (Rooted _ ys) = Rooted mx ys
+assignLit ts mx (Rooted my ys) = Rooted my $
+  NU.assignLit (NE.fromList ts) mx <$> ys
+
+elem :: (Eq t) => [t] -> RUPTrie t x -> Bool
+elem ts = isJust . lookup ts
+
 lookup :: (Eq t) => [t] -> RUPTrie t x -> Maybe x
 lookup [] (Rooted mx _) = mx
-lookup ts (Rooted _ xs) = firstJust $ map (NU.lookup $ NE.fromList ts) xs
+lookup ts (Rooted _ xs) = firstJust $ NU.lookup (NE.fromList ts) <$> xs
 
+-- | Applies @f@ to the last chunk.
 lookupWithL :: (Eq t) => (t -> t) -> [t] -> RUPTrie t x -> Maybe x
 lookupWithL _ [] (Rooted mx _) = mx
-lookupWithL f ts (Rooted _ xs) = firstJust $ map (NU.lookupWithL f $ NE.fromList ts) xs
+lookupWithL f ts (Rooted _ xs) = firstJust $ NU.lookupWithL f (NE.fromList ts) <$> xs
 
 lookupNearestParent :: (Eq t) => [t] -> RUPTrie t x -> Maybe x
 lookupNearestParent [] (Rooted mx _) = mx
 lookupNearestParent ts (Rooted mx xs) =
-  getFirst $ (First $ firstJust $ map (NU.lookupNearestParent $ NE.fromList ts) xs) <> First mx
+  firstJust $ (NU.lookupNearestParent (NE.fromList ts) <$> xs) ++ [mx]
 
-firstJust :: [Maybe a] -> Maybe a
-firstJust [] = Nothing
-firstJust (Nothing:xs) = firstJust xs
-firstJust (Just x :xs) = Just x
+-- | Append contents up-to lookup path.
+lookupThrough :: (Eq t, Monoid x) => [t] -> RUPTrie t x -> [x]
+lookupThrough [] (Rooted mx _) = maybeToList mx
+lookupThrough ts (Rooted mx xs) =
+  maybeToList mx ++ NU.firstNonEmpty (NU.lookupThrough (NE.fromList ts) <$> xs)
 
 litSingleton :: [t] -> x -> RUPTrie t x
 litSingleton [] x = Rooted (Just x) []
@@ -77,3 +104,8 @@
 litExtrude ts (Rooted mx xs) = Rooted Nothing [NU.litExtrudeTail (init ts) $
                                                  UMore (last ts) mx xs
                                               ]
+
+-- * Utilities
+
+firstJust :: [Maybe a] -> Maybe a
+firstJust = getFirst . foldMap First
diff --git a/src/Data/Trie/Pred/Unified/Tail.hs b/src/Data/Trie/Pred/Unified/Tail.hs
--- a/src/Data/Trie/Pred/Unified/Tail.hs
+++ b/src/Data/Trie/Pred/Unified/Tail.hs
@@ -1,14 +1,22 @@
 {-# LANGUAGE
-  GADTs
+    GADTs
   #-}
 
 module Data.Trie.Pred.Unified.Tail
   ( UPTrie (..)
+  , suppliment
+  , tagUPTrie
+  , measureDepthRelative
+  , minDepth
+  , maxDepth
   , showTail
   , assignLit
+  , elem
   , lookup
   , lookupWithL
   , lookupNearestParent
+  , lookupThrough
+  , firstNonEmpty
   , merge
   , areDisjoint
   , litSingletonTail
@@ -16,12 +24,19 @@
   , sort
   ) where
 
-import Prelude hiding (lookup)
-import Data.List.NonEmpty as NE hiding (map, sort)
+import Prelude hiding (lookup, elem, map)
+import Data.List.NonEmpty as NE hiding (map, sort, length)
+import Data.Semigroup hiding (First (..), Last (..))
+import Data.Monoid hiding ((<>))
+import Data.Maybe
+import Data.Functor.Syntax
 import Control.Applicative
+import Control.Monad
 
+import Test.QuickCheck
 
 
+
 data UPTrie t x where
   UMore :: t
         -> Maybe x
@@ -33,100 +48,186 @@
         -> [UPTrie t (r -> x)]
         -> UPTrie t x
 
-showTail :: (Show t) => UPTrie t x -> String
-showTail (UMore t mx xs) = "(UMore " ++ show t ++ ") [" ++ concatMap showTail xs ++ "] "
-showTail (UPred t p mx xs) = "(UPred " ++ show t ++ ") [" ++ concatMap showTail xs ++ "] "
 
--- | Ignores contents
-instance (Show t) => Show (UPTrie t x) where
-  show = showTail
+-- | Given a parser and a chunk, take a trie expecting a result, and
+-- possibly return a reduced trie without the expectation.
+suppliment :: (t -> Maybe r) -> t -> UPTrie t (r -> x) -> Maybe (UPTrie t x)
+suppliment p t xrs = (xrs <~$>) <$> p t
 
--- | Assigns a value to literal constructors
-assignLit :: (Eq t) => NonEmpty t -> Maybe x -> UPTrie t x -> UPTrie t x
-assignLit (t:|ts) mx yy@(UMore p my ys)
-  | t == p = case ts of
-               [] -> UMore p mx ys
-               _  -> UMore p my $ map (assignLit (NE.fromList ts) mx) ys
-  | otherwise = yy
-assignLit _ _ yy@(UPred _ _ _ _) = yy
+-- | Acts as a default tag value for the node
+tagUPTrie :: UPTrie t x -> t
+tagUPTrie (UMore t _ _) = t
+tagUPTrie (UPred t _ _ _) = t
 
+-- | Measure the depth of a trie, based on the relation of other adjacent depths
+measureDepthRelative :: ([Int] -> Int) -> UPTrie t x -> Int
+measureDepthRelative f = go 0
+  where
+    go :: Int -> UPTrie t x -> Int
+    go n (UMore _ _ xs) =
+      f $ go (n+1) <$> xs
+    go n (UPred t p _ xrs) =
+      f $ go (n+1) <$> mapMaybe (suppliment p t) xrs
+
+maxDepth :: UPTrie t x -> Int
+maxDepth = measureDepthRelative maximum'
+  where
+    maximum' [] = 1
+    maximum' xs = maximum xs
+
+minDepth :: UPTrie t x -> Int
+minDepth = measureDepthRelative minimum'
+  where
+    minimum' [] = 1
+    minimum' xs = minimum xs
+
+instance Functor (UPTrie t) where
+  fmap = map
+
+map :: (a -> b) -> UPTrie t a -> UPTrie t b
+map f (UMore t mx xs) = UMore t (f <$> mx) $ f <$$> xs
+map f (UPred t p mrx xrs) = UPred t p (f <.$> mrx) $ f <.$$> xrs
+
+instance Foldable (UPTrie t) where
+  foldMap f xs = fromMaybe mempty $ unwrapMonoid $ go $ f <$> xs
+    where
+      go (UMore _ mx xs') = WrapMonoid mx <> WrapMonoid (foldMap (unwrapMonoid . go) xs')
+      go (UPred t p mrx xrs) = WrapMonoid (mrx <*> p t) <> WrapMonoid (mconcat
+        (mapMaybe (\z -> (\r -> unwrapMonoid $ go $ z <~$> r) <$> p t) xrs))
+
+instance (Eq t, Eq x) => Eq (UPTrie t x) where
+  (UMore s mx xs) == (UMore t my ys) = t == s && mx == my && xs == ys
+  (UPred s p mx xs) == (UPred t q my ys) = s == t
+                                        && (mx <*> p s) == (my <*> q t)
+                                        && (suppliment p s <$> xs) -- same children
+                                        == (suppliment q t <$> ys)
+  (UMore s mx xs) == (UPred t q my ys) = s == t
+                                      && mx == (my <*> q t)
+                                      && (Just <$> xs) == (suppliment q t <$> ys)
+  (UPred s p mx xs) == (UMore t my ys) = s == t
+                                      && (mx <*> p s) == my
+                                      && (suppliment p s <$> xs) == (Just <$> ys)
+
+instance Eq t => Semigroup (UPTrie t x) where
+  (<>) = merge
+
 -- | Overwrites when similar, leaves untouched when not
 merge :: (Eq t) => UPTrie t x -> UPTrie t x -> UPTrie t x
-merge xx@(UMore t mx xs) yy@(UMore p my ys)
-  | t == p = UMore p my $ sort $ xs ++ ys
+merge xx@(UMore t mx xs) (UMore p my ys)
+  | t == p = UMore p (getLast $ Last mx <> Last my) $ sort $ xs ++ ys
   | otherwise = xx
-merge xx@(UPred t q mrx xrs) yy@(UPred p w mry yrs)
+merge xx@(UPred t _ _ _) yy@(UPred p _ _ _)
   | t == p = yy -- predicate children are incompatible
   | otherwise = xx
-merge xx@(UMore t mx xs) yy@(UPred p w mrx xrs)
+merge xx@(UMore t _ _) yy@(UPred p _ _ _)
   | t == p = yy -- rightward bias
   | otherwise = xx
-merge xx@(UPred t q mrx xrs) yy@(UMore p my ys)
+merge xx@(UPred t _ _ _) yy@(UMore p _ _)
   | t == p = yy -- rightward bias
   | otherwise = xx
 
+-- | Can only generate literal examples
+instance (Arbitrary t, Arbitrary x) => Arbitrary (UPTrie t x) where
+  arbitrary = sized go
+    where
+      go s = do
+        t <- arbitrary
+        mx <- arbitrary
+        xs <- if s <= 1 then return []
+                        else scale (subtract 1) arbitrary `suchThat` (\x -> length x < 10)
+        return $ UMore t mx xs
 
+showTail :: (Show t) => UPTrie t x -> String
+showTail (UMore t _ xs) = "(UMore " ++ show t ++ ") [" ++ concatMap showTail xs ++ "] "
+showTail (UPred t _ _ xs) = "(UPred " ++ show t ++ ") [" ++ concatMap showTail xs ++ "] "
+
+-- | Ignores contents
+instance (Show t) => Show (UPTrie t x) where
+  show = showTail
+
+
+
+type Path t = NonEmpty t
+
+-- | Assigns a value to literal constructors
+assignLit :: (Eq t) => Path t -> Maybe x -> UPTrie t x -> UPTrie t x
+assignLit (t:|ts) mx yy@(UMore p my ys)
+  | t == p = if null ts
+             then UMore p mx ys
+             else UMore p my $ fmap (assignLit (NE.fromList ts) mx) ys
+  | otherwise = yy
+assignLit _ _ yy = yy
+
+
 areDisjoint :: (Eq t) => UPTrie t x -> UPTrie t x -> Bool
 areDisjoint (UMore t _ _)    (UMore p _ _)    = t /= p
 areDisjoint (UPred t _ _ _)  (UPred p _ _ _)  = t /= p
 areDisjoint (UPred t _ _ _)  (UMore p _ _)    = t /= p
 areDisjoint (UMore t _ _)    (UPred p _ _ _)  = t /= p
 
+elem :: Eq t => Path t -> UPTrie t x -> Bool
+elem ts = isJust . lookup ts
 
-lookup :: Eq t => NonEmpty t -> UPTrie t x -> Maybe x
-lookup (t:|ts) (UMore t' mx xs)
-  | t == t' = case ts of
-    [] -> mx
-    _  -> firstJust $ map (lookup $ NE.fromList ts) xs
-  | otherwise = Nothing
-lookup (t:|ts) (UPred _ p mrx xrs) =
-  p t >>=
-    \r -> case ts of
-      [] -> ($ r) <$> mrx
-      _  -> ($ r) <$> firstJust (map (lookup $ NE.fromList ts) xrs)
+lookup :: Eq t => Path t -> UPTrie t x -> Maybe x
+lookup (t:|ts) (UMore t' mx xs) = do
+  guard (t == t')
+  if null ts then mx
+             else firstJust $ fmap (lookup $ NE.fromList ts) xs
+lookup (t:|ts) (UPred _ p mrx xrs) = do
+  r <- p t
+  if null ts then mrx <~$> r
+             else firstJust (fmap (lookup $ NE.fromList ts) xrs) <~$> r
 
-lookupWithL :: Eq t => (t -> t) -> NonEmpty t -> UPTrie t x -> Maybe x
+-- | Apply a transform @f@ to the final path chunk, when matching a literal
+-- cell - used for eliminating file extensions in nested-routes.
+lookupWithL :: Eq t => (t -> t) -> Path t -> UPTrie t x -> Maybe x
 lookupWithL f (t:|ts) (UMore t' mx xs)
-  | null ts = if f t == t'
-              then mx
-              else Nothing
-  | otherwise = if t == t'
-                then firstJust $ map (lookupWithL f $ NE.fromList ts) xs
-                else Nothing
-lookupWithL f (t:|ts) (UPred _ p mrx xrs) =
-  p t >>=
-    \r -> case ts of
-      [] -> ($ r) <$> mrx
-      _  -> ($ r) <$> firstJust (map (lookupWithL f $ NE.fromList ts) xrs)
-
-lookupNearestParent :: Eq t => NonEmpty t -> UPTrie t x -> Maybe x
-lookupNearestParent tss@(t:|ts) trie@(UMore t' mx xs) = case lookup tss trie of
-  Nothing -> if t == t'
-    then case ts of
-           [] -> mx -- redundant; should have successful lookup
-           _  -> case firstJust $ map (lookupNearestParent $ NE.fromList ts) xs of
-                   Nothing -> mx
-                   justr   -> justr
-    else Nothing
-  justr -> justr
-lookupNearestParent tss@(t:|ts) trie@(UPred t' p mrx xrs) = case lookup tss trie of
-  Nothing -> p t >>=
-    \r -> case ts of
-            [] -> ($ r) <$> mrx -- redundant; should have successful lookup
-            _  -> case firstJust $ map (lookupNearestParent $ NE.fromList ts) xrs of
-                    Nothing -> ($ r) <$> mrx
-                    justr   -> ($ r) <$> justr
-  justr -> justr
+  | null ts = do guard (f t == t')
+                 mx
+  | otherwise = do guard (t == t')
+                   firstJust $ fmap (lookupWithL f $ NE.fromList ts) xs
+lookupWithL f (t:|ts) (UPred _ p mrx xrs) = do
+  r <- p t
+  if null ts then mrx <~$> r
+             else firstJust (fmap (lookupWithL f $ NE.fromList ts) xrs) <~$> r
 
+lookupNearestParent :: Eq t => Path t -> UPTrie t x -> Maybe x
+lookupNearestParent tss@(t:|ts) trie@(UMore t' mx xs) = firstJust
+  [ lookup tss trie
+  , do guard (t == t')
+       firstJust $ fmap (lookupNearestParent $ NE.fromList ts) xs ++ [mx]
+  ]
+lookupNearestParent tss@(t:|ts) trie@(UPred _ p mrx xrs) = firstJust
+  [ lookup tss trie
+  , do r <- p t
+       firstJust (fmap (lookupNearestParent $ NE.fromList ts) xrs ++ [mrx]) <~$> r
+  ]
 
+-- | Return all nodes passed during a lookup
+lookupThrough :: Eq t => Path t -> UPTrie t x -> [x]
+lookupThrough (t:|ts) (UMore t' mx xs)
+  | null ts = maybeToList $ do guard (t == t')
+                               mx
+  | otherwise = maybeToList mx
+             ++ (do guard (t == t')
+                    firstNonEmpty $ lookupThrough (NE.fromList ts) <$> xs)
+lookupThrough (t:|ts) (UPred _ p mrx xrs) =
+  let (l,r) = fromMaybe (Nothing,[]) $ do
+                r <- p t
+                return $ if null ts
+                         then ( mrx <~$> r, [])
+                         else ( mrx <~$> r
+                              , firstNonEmpty (fmap (lookupThrough $ NE.fromList ts) xrs) <~$> r
+                              )
+  in maybeToList l ++ r
 
-firstJust :: [Maybe a] -> Maybe a
-firstJust [] = Nothing
-firstJust (Nothing:xs) = firstJust xs
-firstJust (Just x :xs) = Just x
+firstNonEmpty :: [[a]] -> [a]
+firstNonEmpty [] = []
+firstNonEmpty (x:xs) | null x = firstNonEmpty xs
+                     | otherwise = x
 
 -- | Create a singleton trie out of literal constructors
-litSingletonTail :: NonEmpty t -> x -> UPTrie t x
+litSingletonTail :: Path t -> x -> UPTrie t x
 litSingletonTail (t:|[]) x = UMore t (Just x) []
 litSingletonTail (t:|ts) x = UMore t Nothing  [litSingletonTail (NE.fromList ts) x]
 
@@ -136,21 +237,27 @@
 litExtrudeTail (t:ts) r = UMore t Nothing [litExtrudeTail ts r]
 
 
--- also does a non-deterministic merge - make sure your nodes are disjoint & clean
+-- | also does a non-deterministic merge - make sure your nodes are disjoint & clean
 sort :: (Eq t) => [UPTrie t x] -> [UPTrie t x]
-sort = foldr insert []
+sort = foldr insert' []
   where
-    insert :: (Eq t) => UPTrie t x -> [UPTrie t x] -> [UPTrie t x]
-    insert r [] = [r]
-    insert x@(UMore t _ _) (y@(UMore p _ _):rs)
+    insert' :: (Eq t) => UPTrie t x -> [UPTrie t x] -> [UPTrie t x]
+    insert' r [] = [r]
+    insert' x@(UMore t _ _) (y@(UMore p _ _):rs)
       | t == p = x : rs
       | otherwise = x : y : rs
-    insert x@(UMore t _ _) (y@(UPred p _ _ _):rs)
+    insert' x@(UMore t _ _) (y@(UPred p _ _ _):rs)
       | t == p = x : rs
       | otherwise = x : y : rs
-    insert x@(UPred t _ _ _) (y@(UPred p _ _ _):rs)
-      | t == p = x : rs -- basis
+    insert' x@(UPred t _ _ _) (y@(UPred p _ _ _):rs)
+      | t == p = x : rs
       | otherwise = x : y : rs
-    insert x@(UPred t _ _ _) (y@(UMore p _ _):rs)
-      | t == p = insert x rs
-      | otherwise = y : insert x rs
+    insert' x@(UPred t _ _ _) (y@(UMore p _ _):rs)
+      | t == p = insert' x rs -- Puts @UPred@ at the bottom
+      | otherwise = y : insert' x rs
+
+
+-- * Utilities
+
+firstJust :: [Maybe a] -> Maybe a
+firstJust = getFirst . foldMap First
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,1 +1,13 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+module Main where
+
+import Data.Trie.Pred.UnifiedSpec
+
+import Test.Tasty
+
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Testing..."
+  [unifiedSpec]