diff --git a/bench/Bench.hs b/bench/Bench.hs
new file mode 100644
--- /dev/null
+++ b/bench/Bench.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE
+    OverloadedStrings
+  #-}
+
+module Main where
+
+
+import Prelude hiding (lookup)
+import           Data.Trie.Pred
+import           Data.Trie.Pred.Step (PredStep (..), PredSteps (..))
+import           Data.Trie.Class
+import           Data.Trie.Map (MapStep (..))
+import qualified Data.Map as Map
+import           Data.List.NonEmpty
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Text as T
+import           Data.Attoparsec.Text
+import           Criterion.Main
+import           Data.Set.Class as Sets
+
+
+doubleLit :: RootedPredTrie T.Text Double
+doubleLit = RootedPredTrie Nothing $ PredTrie
+              (MapStep $ unUnion $ foldMap (Union . genStep) [1..100])
+              (PredSteps [])
+  where genStep n = Map.singleton (T.pack $ show n) (Just n, Nothing)
+
+doubleAtto :: RootedPredTrie T.Text Double
+doubleAtto = RootedPredTrie Nothing $ PredTrie mempty $ PredSteps
+  [PredStep "d" (eitherToMaybe . parseOnly double) (Just id) mempty]
+  where
+    eitherToMaybe (Left _) = Nothing
+    eitherToMaybe (Right a) = Just a
+
+
+main = defaultMain
+  [ bgroup "Lit vs. Pred"
+    [ bgroup "Lit"
+      [ bench "1" $ whnf (lookup ["1"]) doubleLit
+      , bench "2" $ whnf (lookup ["21"]) doubleLit
+      , bench "3" $ whnf (lookup ["41"]) doubleLit
+      , bench "4" $ whnf (lookup ["61"]) doubleLit
+      , bench "4" $ whnf (lookup ["81"]) doubleLit
+      ]
+    , bgroup "Pred"
+      [ bench "1" $ whnf (lookup ["1"]) doubleAtto
+      , bench "2" $ whnf (lookup ["21"]) doubleAtto
+      , bench "3" $ whnf (lookup ["41"]) doubleAtto
+      , bench "4" $ whnf (lookup ["61"]) doubleAtto
+      , bench "4" $ whnf (lookup ["81"]) doubleAtto
+      ]
+    ]
+  ]
diff --git a/bench/SimpleVShort.hs b/bench/SimpleVShort.hs
deleted file mode 100644
--- a/bench/SimpleVShort.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-module Main where
-
-
-import           Data.Trie.Pred.FastUnified
-import qualified Data.Trie.Pred.FastUnified as FU
-import           Data.Trie.Pred.NormUnified
-import qualified Data.Trie.Pred.NormUnified as NU
-import Criterion.Main
-import           Data.List.NonEmpty
-import qualified Data.List.NonEmpty as NE
-
-
-tdFU = FUMore "foo" Nothing $ NE.fromList
-         [ FURest ("bar":|["baz","qux"]) 1
-         , FUMore "tro" (Just 2) $ NE.fromList
-             [ FUMore "zja" (Just 3) $ NE.fromList
-                 [ FURest ("hda":|["jes","kuq"]) 4 ]
-             , FURest ("end":|["orp","vag"]) 5
-             ]
-         , FURest ("dic":|["but","gea"]) 6
-         ]
-
-tdNU = NUMore "foo" Nothing
-         [ NUMore "bar" Nothing
-             [ NUMore "baz" Nothing
-                 [ NUMore "qux" (Just 1) []
-                 ]
-             ]
-         , NUMore "tro" (Just 2)
-             [ NUMore "zja" (Just 3)
-                 [ NUMore "hda" Nothing
-                     [ NUMore "jes" Nothing
-                         [ NUMore "kuq" (Just 4) []
-                         ]
-                     ]
-                 ]
-             , NUMore "end" Nothing
-                 [ NUMore "orp" Nothing
-                     [ NUMore "vag" (Just 5) []
-                     ]
-                 ]
-             ]
-         , NUMore "dic" Nothing
-             [ NUMore "but" Nothing
-                 [ NUMore "gea" (Just 6) []
-                 ]
-             ]
-         ]
-
-
-
-main = defaultMain
-  [ bgroup "Fast" [ bench "foobarbaz"       $ whnf (FU.lookup $ "foo":|["bar","baz"]) tdFU
-                  , bench "footrozjahdajes" $ whnf (FU.lookup $ "foo":|["tro","zja","hda","jes"]) tdFU
-                  , bench "footroendorpvag" $ whnf (FU.lookup $ "foo":|["tro","end","orp","vag"]) tdFU
-                  , bench "foodicbutgea"    $ whnf (FU.lookup $ "foo":|["dic","but","gea"]) tdFU
-                  ]
-
-  , bgroup "Norm" [ bench "foobarbaz"       $ whnf (NU.lookup $ "foo":|["bar","baz"]) tdNU
-                  , bench "footrozjahdajes" $ whnf (NU.lookup $ "foo":|["tro","zja","hda","jes"]) tdNU
-                  , bench "footroendorpvag" $ whnf (NU.lookup $ "foo":|["tro","end","orp","vag"]) tdNU
-                  , bench "foodicbutgea"    $ whnf (NU.lookup $ "foo":|["dic","but","gea"]) tdNU
-                  ]
-  ]
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.4
+Version:                0.3.0
 Author:                 Athan Clark <athan.clark@gmail.com>
 Maintainer:             Athan Clark <athan.clark@gmail.com>
 License:                BSD3
@@ -14,41 +14,52 @@
   Default-Language:     Haskell2010
   HS-Source-Dirs:       src
   GHC-Options:          -Wall
-  Exposed-Modules:      Data.Trie.Pred.Unified
-                        Data.Trie.Pred.Unified.Tail
-                        Data.Trie.Pred.Disjoint
-                        Data.Trie.Pred.Disjoint.Tail
+  Exposed-Modules:      Data.Trie.Pred
+                        Data.Trie.Pred.Step
   Build-Depends:        base >= 4.6 && < 5
                       , semigroups
                       , mtl
-                      , composition-extra >= 1.2
+                      , containers
+                      , composition-extra >= 2.0.0
+                      , tries >= 0.0.2
                       , QuickCheck
 
-Test-Suite spec
+-- Test-Suite spec
+--   Type:                 exitcode-stdio-1.0
+--   Default-Language:     Haskell2010
+--   Hs-Source-Dirs:       src
+--                       , test
+--   Ghc-Options:          -Wall -threaded
+--   Main-Is:              Spec.hs
+--   Other-Modules:        Data.Trie.PredSpec
+--   Build-Depends:        base
+--                       , tasty
+--                       , tasty-quickcheck
+--                       , tasty-hunit
+--                       , QuickCheck
+--                       , quickcheck-instances
+--                       , semigroups
+--                       , mtl
+--                       , composition-extra
+
+Benchmark bench
   Type:                 exitcode-stdio-1.0
   Default-Language:     Haskell2010
-  Hs-Source-Dirs:       src
-                      , test
-  Ghc-Options:          -Wall
-  Main-Is:              Spec.hs
-  Build-Depends:        base
-                      , tasty
-                      , tasty-quickcheck
-                      , tasty-hunit
-                      , QuickCheck
-                      , quickcheck-instances
-                      , semigroups
-                      , mtl
-                      , composition-extra
-
-Benchmark simplevshort
-    Type:               exitcode-stdio-1.0
-    Main-Is:            SimpleVShort.hs
-    HS-Source-Dirs:     bench
+  Main-Is:              Bench.hs
+  HS-Source-Dirs:       bench
                       , src
-    Build-Depends:      base
+  Ghc-Options:          -Wall -threaded
+  Build-Depends:        base
+                      , pred-trie
+                      , tries
+                      , containers
                       , criterion
                       , semigroups
+                      , attoparsec
+                      , text
+                      , composition-extra
+                      , QuickCheck
+                      , sets
 
 Source-Repository head
   Type:                 git
diff --git a/src/Data/Trie/Pred.hs b/src/Data/Trie/Pred.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Pred.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE
+    ExistentialQuantification
+  , FlexibleContexts
+  , FlexibleInstances
+  , MultiParamTypeClasses
+  , DeriveFunctor
+  #-}
+
+module Data.Trie.Pred where
+
+import Prelude hiding (lookup)
+import Data.Trie.Pred.Step
+import Data.Trie.Class
+import qualified Data.Trie.Map as MT
+import qualified Data.Map as Map
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
+
+import Data.Functor.Syntax
+import Data.Monoid
+import Data.Maybe (fromMaybe)
+
+
+
+-- * Predicated Trie
+
+data PredTrie s a = PredTrie
+  { predLits  :: MT.MapStep PredTrie s a
+  , predPreds :: PredSteps PredTrie s a
+  } deriving (Functor)
+
+instance Ord s => Trie NonEmpty s PredTrie where
+  lookup ts (PredTrie ls ps) =
+    getFirst $ First (lookup ts ls) <> First (lookup ts ps)
+  delete ts (PredTrie ls ps) = PredTrie (delete ts ls) (delete ts ps)
+  insert ts x (PredTrie ls ps) = PredTrie (insert ts x ls) ps -- can only insert literals
+
+instance Ord s => Monoid (PredTrie s a) where
+  mempty = PredTrie mempty mempty
+  mappend (PredTrie ls1 ps1) (PredTrie ls2 ps2) =
+    PredTrie (ls1 <> ls2) (ps1 <> ps2)
+
+emptyPT :: PredTrie s a
+emptyPT = PredTrie MT.empty (PredSteps [])
+
+
+
+-- subtrie :: Ord s => NonEmpty s -> PredTrie s a -> PredTrie s a
+-- subtrie (t:|ts) (PredTrie (MapTrie (MapStep ls)) ps)
+--   | null ts = getFirst $ First (lookup ts ls)
+
+-- | Find the nearest parent node of the requested query, while returning
+-- the split of the string that was matched, and what wasn't.
+matchPT :: Ord s => NonEmpty s -> PredTrie s a -> Maybe (NonEmpty s, a, [s])
+matchPT (t:|ts) (PredTrie ls (PredSteps ps)) = getFirst $
+  First (goLit ls) <> foldMap (First . goPred) ps
+  where
+    goLit (MT.MapStep xs) = do
+      (mx,mxs) <- Map.lookup t xs
+      let mFoundHere = do x <- mx
+                          return (t:|[], x, [])
+      if null ts then mFoundHere
+      else getFirst $ First (do (pre,y,suff) <- matchPT (NE.fromList ts) =<< mxs
+                                return (t:|NE.toList pre, y, suff))
+                   <> First mFoundHere
+
+    goPred (PredStep _ p mx xs) = do
+      r <- p t
+      let mFoundHere = do x <- mx <$~> r
+                          return (t:|[], x, [])
+      if null ts then mFoundHere
+      else getFirst $ First (do (pre,y,suff) <- matchPT (NE.fromList ts) xs
+                                return (t:|NE.toList pre, y r, suff))
+                   <> First mFoundHere
+
+
+matchesPT :: Ord s => NonEmpty s -> PredTrie s a -> [(NonEmpty s, a, [s])]
+matchesPT (t:|ts) (PredTrie ls (PredSteps ps)) =
+  fromMaybe [] $ getFirst $ First (goLit ls) <> foldMap (First . goPred) ps
+  where
+    goLit (MT.MapStep xs) = do
+      (mx,mxs) <- Map.lookup t xs
+      let mFoundHere = do x <- mx
+                          return [(t:|[],x,ts)]
+          prependAncestry (pre,x,suff) = (t:| NE.toList pre,x,suff)
+      if null ts then mFoundHere
+      else do foundHere <- mFoundHere
+              let rs = fromMaybe [] $ matchesPT (NE.fromList ts) <$> mxs
+              return $ foundHere ++ (prependAncestry <$> rs)
+
+    goPred (PredStep _ p mx xs) = do
+      r <- p t
+      let mFoundHere = do x <- mx <$~> r
+                          return [(t:|[],x,ts)]
+          prependAncestryAndApply (pre,x,suff) = (t:| NE.toList pre,x r,suff)
+      if null ts then mFoundHere
+      else do foundHere <- mFoundHere
+              let rs = matchesPT (NE.fromList ts) xs
+              return $ foundHere ++ (prependAncestryAndApply <$> rs)
+
+-- * Rooted Predicated Trie
+
+data RootedPredTrie s a = RootedPredTrie
+  { rootedBase :: Maybe a
+  , rootedSub  :: PredTrie s a
+  } deriving (Functor)
+
+instance Ord s => Trie [] s RootedPredTrie where
+  lookup [] (RootedPredTrie mx _) = mx
+  lookup ts (RootedPredTrie _ xs) = lookup (NE.fromList ts) xs
+
+  delete [] (RootedPredTrie _ xs) = RootedPredTrie Nothing xs
+  delete ts (RootedPredTrie mx xs) = RootedPredTrie mx $ delete (NE.fromList ts) xs
+
+  insert [] x (RootedPredTrie _ xs) = RootedPredTrie (Just x) xs
+  insert ts x (RootedPredTrie mx xs) = RootedPredTrie mx $ insert (NE.fromList ts) x xs
+
+instance Ord s => Monoid (RootedPredTrie s a) where
+  mempty = emptyRPT
+  mappend (RootedPredTrie mx xs) (RootedPredTrie my ys) = RootedPredTrie
+    (getLast $ Last mx <> Last my) $ xs <> ys
+
+
+emptyRPT :: RootedPredTrie s a
+emptyRPT = RootedPredTrie Nothing emptyPT
+
+matchRPT :: Ord s => [s] -> RootedPredTrie s a -> Maybe ([s], a, [s])
+matchRPT [] (RootedPredTrie mx _) = do x <- mx
+                                       return ([],x,[])
+matchRPT ts (RootedPredTrie mx xs) = getFirst $
+  First mFoundThere <> First (do x <- mx
+                                 return ([],x,[]))
+  where mFoundThere = do (pre,x,suff) <- matchPT (NE.fromList ts) xs
+                         return (NE.toList pre,x,suff)
+
+matchesRPT :: Ord s => [s] -> RootedPredTrie s a -> [([s], a, [s])]
+matchesRPT [] (RootedPredTrie mx _) = fromMaybe [] $ do x <- mx
+                                                        return [([],x,[])]
+matchesRPT ts (RootedPredTrie mx xs) =
+  foundHere ++ fmap allowRoot (matchesPT (NE.fromList ts) xs)
+  where foundHere = fromMaybe [] $ do x <- mx
+                                      return [([],x,[])]
+        allowRoot (pre,x,suff) = (NE.toList pre,x,suff)
diff --git a/src/Data/Trie/Pred/Disjoint.hs b/src/Data/Trie/Pred/Disjoint.hs
deleted file mode 100644
--- a/src/Data/Trie/Pred/Disjoint.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-module Data.Trie.Pred.Disjoint
-  ( RDPTrie (..)
-  , merge
-  , lookup
-  , lookupWithL
-  , lookupNearestParent
-  , litSingleton
-  , litExtrude
-  , module Data.Trie.Pred.Disjoint.Tail
-  ) where
-
-import Prelude hiding (lookup)
-import Data.Trie.Pred.Disjoint.Tail hiding (lookup, lookupWithL, lookupNearestParent, merge)
-import qualified Data.Trie.Pred.Disjoint.Tail as ND
-import Data.Monoid
-import qualified Data.List.NonEmpty as NE
-
-
--- | A Rooted, predicate, disjointly indexed trie
-data RDPTrie p t x = Rooted (Maybe x) [DPTrie p t x]
-
-instance (Eq p, Eq t) => Monoid (RDPTrie p t x) where
-  mempty = Rooted Nothing []
-  mappend = Data.Trie.Pred.Disjoint.merge
-
-merge :: (Eq p, Eq t) => RDPTrie p t x -> RDPTrie p t x -> RDPTrie p t x
-merge (Rooted mx xs) (Rooted my ys) =
-  Rooted my $ foldr go [] $ xs ++ ys
-  where
-    go :: (Eq p, Eq t) => DPTrie p t x -> [DPTrie p t x] -> [DPTrie p t x]
-    go a [] = [a]
-    go a (b:bs) | ND.areDisjoint a b =        a : b : bs
-                | otherwise          = ND.merge a b : bs
-
-lookup :: (Eq t) => [t] -> RDPTrie p t x -> Maybe x
-lookup [] (Rooted mx _) = mx
-lookup ts (Rooted _ xs) = firstJust $ map (ND.lookup $ NE.fromList ts) xs
-
-lookupWithL :: (Eq t) => (t -> t) -> [t] -> RDPTrie p t x -> Maybe x
-lookupWithL _ [] (Rooted mx _) = mx
-lookupWithL f ts (Rooted _ xs) = firstJust $ map (ND.lookupWithL f $ NE.fromList ts) xs
-
-lookupNearestParent :: (Eq t) => [t] -> RDPTrie p t x -> Maybe x
-lookupNearestParent [] (Rooted mx _) = mx
-lookupNearestParent ts (Rooted mx xs) =
-  getFirst $ (First $ firstJust $ map (ND.lookupNearestParent $ NE.fromList ts) xs) <> First mx
-
-firstJust :: [Maybe a] -> Maybe a
-firstJust [] = Nothing
-firstJust (Nothing:xs) = firstJust xs
-firstJust (Just x :xs) = Just x
-
-
-litSingleton :: [t] -> x -> RDPTrie p t x
-litSingleton [] x = Rooted (Just x) []
-litSingleton ts x = Rooted Nothing [ND.litSingletonTail (NE.fromList ts) x]
-
-
-litExtrude :: [t] -> RDPTrie p t x -> RDPTrie p t x
-litExtrude [] r = r
-litExtrude [t] (Rooted mx xs) = Rooted Nothing [DMore t mx xs]
-litExtrude ts (Rooted mx xs) = Rooted Nothing [ND.litExtrudeTail (init ts) $
-                                                 DMore (last ts) mx xs
-                                              ]
diff --git a/src/Data/Trie/Pred/Disjoint/Tail.hs b/src/Data/Trie/Pred/Disjoint/Tail.hs
deleted file mode 100644
--- a/src/Data/Trie/Pred/Disjoint/Tail.hs
+++ /dev/null
@@ -1,134 +0,0 @@
-{-# LANGUAGE
-  GADTs
-  #-}
-
-module Data.Trie.Pred.Disjoint.Tail
-  ( DPTrie (..)
-  , lookup
-  , lookupWithL
-  , lookupNearestParent
-  , merge
-  , areDisjoint
-  , litSingletonTail
-  , litExtrudeTail
-  , sort
-  ) where
-
-import Prelude hiding (lookup)
-import Data.List.NonEmpty as NE hiding (map, sort)
-import Control.Applicative
-
-
-
-data DPTrie p t x where
-  DMore :: t
-        -> Maybe x
-        -> [DPTrie p t x]
-        -> DPTrie p t x
-  DPred :: p
-        -> (t -> Maybe r)
-        -> Maybe (r -> x)
-        -> [DPTrie p t (r -> x)]
-        -> DPTrie p t x
-
-
--- | Overwrites when similar, leaves untouched when not
-merge :: (Eq p, Eq t) => DPTrie p t x -> DPTrie p t x -> DPTrie p t x
-merge xx@(DMore t mx xs) yy@(DMore p my ys)
-  | t == p = DMore p my $ foldr go [] $ xs ++ ys
-  | otherwise = xx
-  where
-    go :: (Eq p, Eq t) => DPTrie p t x -> [DPTrie p t x] -> [DPTrie p t x]
-    go a [] = [a]
-    go a (b:bs) | areDisjoint a b =     a : b : bs
-                | otherwise       = merge a b : bs
-merge xx@(DPred t q mrx xrs) yy@(DPred p w mry yrs)
-  | t == p = yy
-  | otherwise = xx
-merge xx@(DMore t mx xs) yy@(DPred p w mrx xrs) = yy
-merge xx@(DPred t q mrx xrs) yy@(DMore p my ys) = yy
-
-
-areDisjoint :: (Eq p, Eq t) => DPTrie p t x -> DPTrie p t x -> Bool
-areDisjoint (DMore t _ _)    (DMore p _ _)    = t == p
-areDisjoint (DPred t _ _ _)  (DPred p _ _ _)  = t == p
-areDisjoint _ _ = True
-
-
-lookup :: Eq t => NonEmpty t -> DPTrie p t x -> Maybe x
-lookup (t:|ts) (DMore t' mx xs)
-  | t == t' = case ts of
-    [] -> mx
-    _  -> firstJust $ map (lookup $ NE.fromList ts) xs
-  | otherwise = Nothing
-lookup (t:|ts) (DPred _ p mrx xrs) =
-  p t >>=
-    \r -> case ts of
-      [] -> ($ r) <$> mrx
-      _  -> ($ r) <$> firstJust (map (lookup $ NE.fromList ts) xrs)
-
-lookupWithL :: Eq t => (t -> t) -> NonEmpty t -> DPTrie p t x -> Maybe x
-lookupWithL f (t:|ts) (DMore 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) (DPred _ 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 -> DPTrie p t x -> Maybe x
-lookupNearestParent tss@(t:|ts) trie@(DMore 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@(DPred 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
-
-
-firstJust :: [Maybe a] -> Maybe a
-firstJust [] = Nothing
-firstJust (Nothing:xs) = firstJust xs
-firstJust (Just x :xs) = Just x
-
-
-litSingletonTail :: NonEmpty t -> x -> DPTrie p t x
-litSingletonTail (t:|[]) x = DMore t (Just x) []
-litSingletonTail (t:|ts) x = DMore t Nothing  [litSingletonTail (NE.fromList ts) x]
-
-
-litExtrudeTail :: [t] -> DPTrie p t x -> DPTrie p t x
-litExtrudeTail [] r = r
-litExtrudeTail (t:ts) r = DMore t Nothing [litExtrudeTail ts r]
-
-
-sort :: (Eq p, Eq t) => [DPTrie p t x] -> [DPTrie p t x]
-sort = foldr insert []
-  where
-    insert :: (Eq p, Eq t) => DPTrie p t x -> [DPTrie p t x] -> [DPTrie p t x]
-    insert r [] = [r]
-    insert x@(DMore t _ _) (y@(DMore p _ _):rs)
-      | t == p = x : rs
-      | otherwise = x : y : rs
-    insert x@(DMore t _ _) (y@(DPred p _ _ _):rs) =
-        x : y : rs
-    insert x@(DPred t _ _ _) (y@(DPred p _ _ _):rs)
-      | t == p = x : rs -- basis
-      | otherwise = x : y : rs
-    insert x@(DPred t _ _ _) (y@(DMore p _ _):rs) =
-        y : insert x rs
diff --git a/src/Data/Trie/Pred/Step.hs b/src/Data/Trie/Pred/Step.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Pred/Step.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE
+    ExistentialQuantification
+  , FlexibleContexts
+  , FlexibleInstances
+  , MultiParamTypeClasses
+  , DeriveFunctor
+  #-}
+
+module Data.Trie.Pred.Step where
+
+import Prelude hiding (lookup)
+import Data.Trie.Class
+import qualified Data.Trie.Map as MT
+import qualified Data.Map as Map
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
+
+import Data.Functor.Syntax
+import Data.Monoid
+import Data.Maybe (fromMaybe)
+
+
+-- * Single Predicated Step
+
+data PredStep c s a = forall r. PredStep
+  { predTag  :: s -- ^ Unique identifier for the predicate - used for combination
+  , predPred :: s -> Maybe r
+  , predData :: Maybe (r -> a)
+  , predSub  :: c s (r -> a)
+  }
+
+instance Functor (c s) => Functor (PredStep c s) where
+  fmap f (PredStep i p mx xs) = PredStep i p (f <.$> mx) $ f <.$> xs
+
+-- | Lookup and delete only - can't arbitrarilly construct a predicated trie.
+instance Trie NonEmpty s c => Trie NonEmpty s (PredStep c) where
+  lookup (t:|ts) (PredStep _ p mx xs) = do
+    r <- p t
+    if null ts then mx <$~> r
+               else lookup (NE.fromList ts) xs <$~> r
+  delete (t:|ts) xss@(PredStep i p mx xs) =
+    maybe xss
+      (const $ if null ts
+               then PredStep i p Nothing xs
+               else PredStep i p mx $ delete (NE.fromList ts) xs)
+      (p t)
+
+singletonPred :: Monoid (c s (r -> a)) => s -> (s -> Maybe r) -> (r -> a) -> PredStep c s a
+singletonPred i p x = PredStep i p (Just x) mempty
+
+
+-- * Adjacent Predicated Steps
+
+newtype PredSteps c s a = PredSteps
+  { unPredSteps :: [PredStep c s a] }
+  deriving (Functor)
+
+-- | Lookup and delete only - can't arbitrarilly construct a predicated trie.
+instance Trie NonEmpty s c => Trie NonEmpty s (PredSteps c) where
+  lookup ts (PredSteps ps) = getFirst $ foldMap (First . lookup ts) ps
+  delete ts (PredSteps ps) = PredSteps $ fmap (delete ts) ps
+
+instance Eq s => Monoid (PredSteps c s a) where
+  mempty = PredSteps []
+  mappend = unionPred
+
+-- | @Last@-style instance
+unionPred :: Eq s => PredSteps c s a -> PredSteps c s a -> PredSteps c s a
+unionPred (PredSteps (xss@(PredStep i p mx xs):pxs)) (PredSteps (yss@(PredStep j q my ys):pys))
+  | i == j = PredSteps $ yss : unPredSteps (unionPred (PredSteps pxs) (PredSteps pys))
+  | otherwise = PredSteps $ xss : yss : unPredSteps (unionPred (PredSteps pxs) (PredSteps pys))
+unionPred x (PredSteps []) = x
+unionPred (PredSteps []) y = y
diff --git a/src/Data/Trie/Pred/Unified.hs b/src/Data/Trie/Pred/Unified.hs
deleted file mode 100644
--- a/src/Data/Trie/Pred/Unified.hs
+++ /dev/null
@@ -1,112 +0,0 @@
-module Data.Trie.Pred.Unified
-  ( RUPTrie (..)
-  , UPTrie (..)
-  , assignLit
-  , showTrie
-  , merge
-  , elem
-  , lookup
-  , lookupWithL
-  , lookupNearestParent
-  , lookupThrough
-  , litSingleton
-  , litExtrude
-  ) where
-
-import Prelude hiding (lookup, map, elem)
-import           Data.Trie.Pred.Unified.Tail (UPTrie (..), showTail)
-import qualified Data.Trie.Pred.Unified.Tail as NU
-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) =
-  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
-
-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
-  where
-    go :: (Eq t) => UPTrie t x -> [UPTrie t x] -> [UPTrie t x]
-    go a [] = [a]
-    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 $ 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 $ 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) =
-  firstJust $ (NU.lookupNearestParent (NE.fromList ts) <$> xs) ++ [mx]
-
--- | Append contents up-to lookup path.
-lookupThrough :: (Eq t) => [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) []
-litSingleton ts x = Rooted Nothing [NU.litSingletonTail (NE.fromList ts) x]
-
-
-litExtrude :: [t] -> RUPTrie t x -> RUPTrie t x
-litExtrude [] r = r
-litExtrude [t] (Rooted mx xs) = Rooted Nothing [UMore t mx xs]
-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
deleted file mode 100644
--- a/src/Data/Trie/Pred/Unified/Tail.hs
+++ /dev/null
@@ -1,261 +0,0 @@
-{-# LANGUAGE
-    GADTs
-  #-}
-
-module Data.Trie.Pred.Unified.Tail
-  ( UPTrie (..)
-  , suppliment
-  , tagUPTrie
-  , measureDepthRelative
-  , minDepth
-  , maxDepth
-  , showTail
-  , assignLit
-  , elem
-  , lookup
-  , lookupWithL
-  , lookupNearestParent
-  , lookupThrough
-  , firstNonEmpty
-  , merge
-  , areDisjoint
-  , litSingletonTail
-  , litExtrudeTail
-  , sort
-  ) where
-
-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
-        -> [UPTrie t x]
-        -> UPTrie t x
-  UPred :: t
-        -> (t -> Maybe r)
-        -> Maybe (r -> x)
-        -> [UPTrie t (r -> x)]
-        -> UPTrie t x
-
-
--- | 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
-
--- | 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) (UMore p my ys)
-  | t == p = UMore p (getLast $ Last mx <> Last my) $ sort $ xs ++ ys
-  | otherwise = xx
-merge xx@(UPred t _ _ _) yy@(UPred p _ _ _)
-  | t == p = yy -- predicate children are incompatible
-  | otherwise = xx
-merge xx@(UMore t _ _) yy@(UPred p _ _ _)
-  | t == p = yy -- rightward bias
-  | otherwise = xx
-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 => 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
-
--- | 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 = 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) = do
-  guard $ t == t'
-  maybeToList mx ++ (do guard $ null ts
-                        firstNonEmpty $ fmap (lookupThrough $ NE.fromList ts) xs)
-lookupThrough (t:|ts) (UPred _ p mrx xrs) =
-  let (left,right) = 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 left ++ right
-
-firstNonEmpty :: [[a]] -> [a]
-firstNonEmpty [] = []
-firstNonEmpty (x:xs) | null x = firstNonEmpty xs
-                     | otherwise = x
-
--- | Create a singleton trie out of literal constructors
-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]
-
--- | Push a trie down with literal constructors
-litExtrudeTail :: [t] -> UPTrie t x -> UPTrie t x
-litExtrudeTail [] r = r
-litExtrudeTail (t:ts) r = UMore t Nothing [litExtrudeTail ts r]
-
-
--- | 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' []
-  where
-    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)
-      | t == p = x : rs
-      | otherwise = x : y : rs
-    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 -- 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
deleted file mode 100644
--- a/test/Spec.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Main where
-
-import Data.Trie.Pred.UnifiedSpec
-
-import Test.Tasty
-
-
-main :: IO ()
-main = defaultMain tests
-
-tests :: TestTree
-tests = testGroup "Testing..."
-  [unifiedSpec]