diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2015, Athan Clark
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Athan Clark nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/bench/Bench.hs b/bench/Bench.hs
new file mode 100644
--- /dev/null
+++ b/bench/Bench.hs
@@ -0,0 +1,59 @@
+module Main where
+
+import           Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
+import Data.Tree (Tree (..))
+import Data.Trie.List as L
+import Data.Trie.Map as M
+import Data.Trie.Class as TC
+import qualified Data.Map as Map
+import Criterion.Main
+import Control.Monad.State
+
+
+genListTrie :: Int -> ListTrie Int Int
+genListTrie n = ListTrie $ Node (0, Just 0) $ genTree n
+  where
+    genTree :: Int -> [Tree (Int, Maybe Int)]
+    genTree n = evalState (replicateM n $ do
+      i <- getSucc
+      return $ Node (i, Just i) $ genTree (n-1)) 1
+
+
+getSucc :: State Int Int
+getSucc = get <* modify (+1)
+
+
+genMapTrie :: Int -> MapTrie Int Int
+genMapTrie n = MapTrie $ MapStep $ Map.singleton 0
+  (Just 0, Just $ MapTrie $ MapStep $ genMapTree n)
+  where
+    genMapTree :: Int -> Map.Map Int (Maybe Int, Maybe (MapTrie Int Int))
+    genMapTree n = Map.unions $ evalState (replicateM n $ do
+      i <- getSucc
+      return $ Map.singleton i ( Just i
+                               , if n <= 1 then Nothing
+                                 else Just $ MapTrie $ MapStep $ genMapTree (n-1))) 1
+
+
+
+main = defaultMain
+  [ bgroup "lookup"
+    [ bgroup "ListTrie"
+      [ bench "1" $ whnf (L.lookup $ 0 :| [100])         (genListTrie 100)
+      , bench "2" $ whnf (L.lookup $ 0 :| [100,99..81])  (genListTrie 100)
+      , bench "3" $ whnf (L.lookup $ 0 :| [100,99..61])  (genListTrie 100)
+      , bench "4" $ whnf (L.lookup $ 0 :| [100,99..41])  (genListTrie 100)
+      , bench "5" $ whnf (L.lookup $ 0 :| [100,99..21])  (genListTrie 100)
+      , bench "6" $ whnf (L.lookup $ 0 :| [100,99..1])   (genListTrie 100)
+      ]
+    , bgroup "MapTrie"
+      [ bench "1" $ whnf (TC.lookup $ 0 :| [100])         (genMapTrie 100)
+      , bench "2" $ whnf (TC.lookup $ 0 :| [100,99..81])  (genMapTrie 100)
+      , bench "3" $ whnf (TC.lookup $ 0 :| [100,99..61])  (genMapTrie 100)
+      , bench "4" $ whnf (TC.lookup $ 0 :| [100,99..41])  (genMapTrie 100)
+      , bench "5" $ whnf (TC.lookup $ 0 :| [100,99..21])  (genMapTrie 100)
+      , bench "6" $ whnf (TC.lookup $ 0 :| [100,99..1])   (genMapTrie 100)
+      ]
+    ]
+  ]
diff --git a/src/Data/Trie/Class.hs b/src/Data/Trie/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Class.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE
+    MultiParamTypeClasses
+  , FunctionalDependencies
+  #-}
+
+module Data.Trie.Class where
+
+import Prelude hiding (lookup)
+import qualified Data.Trie as BT
+import qualified Data.ByteString as BS
+
+import Data.Function.Syntax
+import Data.Maybe (isJust, fromMaybe)
+import Data.Monoid
+import Data.Foldable as F
+import Data.Functor.Identity (Identity (..))
+
+
+-- | Class representing tries with single-threaded insertion, deletion, and lookup.
+-- @forall ts ps a. isJust $ lookupPath ps (insertPath ps a ts)@
+-- @forall ts ps. isNothing $ lookupPath ps (deletePath ps ts)@
+class Trie p s t | t -> p where
+  lookup :: p s -> t s a -> Maybe a
+  insert :: p s -> a -> t s a -> t s a
+  delete :: p s -> t s a -> t s a
+
+lookupWithDefault :: Trie p s t => a -> p s -> t s a -> a
+lookupWithDefault x = fromMaybe x .* lookup
+
+
+
+member :: Trie p s t => p s -> t s a -> Bool
+member = isJust .* lookup
+
+notMember :: Trie p s t => p s -> t s a -> Bool
+notMember = not .* member
+
+-- * Conversion
+
+fromFoldable :: (Foldable f, Monoid (t s a), Trie p s t) => f (p s, a) -> t s a
+fromFoldable = F.foldr (uncurry insert) mempty
+
+
+-- * ByteString-Trie
+
+-- | Embeds an empty ByteString passed around for type inference.
+newtype BSTrie q a = BSTrie {unBSTrie :: (q, BT.Trie a)}
+
+makeBSTrie :: BT.Trie a -> BSTrie BS.ByteString a
+makeBSTrie x = BSTrie (mempty,x)
+
+getBSTrie :: BSTrie BS.ByteString a -> BT.Trie a
+getBSTrie (BSTrie (_,x)) = x
+
+instance Trie Identity BS.ByteString BSTrie where
+  lookup = (BT.lookup *. snd . unBSTrie) . runIdentity
+  insert (Identity ps) x (BSTrie (q,xs)) = BSTrie (q, BT.insert ps x xs)
+  delete (Identity ps) (BSTrie (q,xs)) = BSTrie (q, BT.delete ps xs)
diff --git a/src/Data/Trie/Knuth.hs b/src/Data/Trie/Knuth.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Knuth.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE
+    DeriveFunctor
+  , DeriveFoldable
+  , DeriveTraversable
+  , GeneralizedNewtypeDeriving
+  , FlexibleInstances
+  , MultiParamTypeClasses
+  #-}
+
+module Data.Trie.Knuth where
+
+import Prelude hiding (lookup)
+import           Data.Tree.Knuth.Forest (KnuthForest (..))
+import           Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
+
+import Data.Trie.Class
+
+
+newtype KnuthTrie s x = KnuthTrie
+  {unKnuthTrie :: KnuthForest (s, Maybe x)}
+  deriving (Show, Eq, Functor, Foldable, Traversable)
+
+instance Eq s => Trie NonEmpty s KnuthTrie where
+  lookup _ (KnuthTrie Nil) = Nothing
+  lookup tss@(t:|ts) (KnuthTrie (Fork (t',mx) cs ss))
+    | t == t' = if null ts then mx
+                else lookup (NE.fromList ts) $ KnuthTrie cs
+    | otherwise = lookup tss $ KnuthTrie ss
+
+  insert (t:|ts) x (KnuthTrie Nil)
+    | null ts = KnuthTrie $ Fork (t,Just x) Nil Nil
+    | otherwise = let cs' = unKnuthTrie $ insert (NE.fromList ts) x $ KnuthTrie Nil
+                  in KnuthTrie $ Fork (t,Nothing) cs' Nil
+  insert tss@(t:|ts) x (KnuthTrie (Fork s@(t',mx) cs ss))
+    | t == t' = if null ts
+                then KnuthTrie $ Fork (t',Just x) cs ss
+                else let cs' = unKnuthTrie $ insert (NE.fromList ts) x $ KnuthTrie cs
+                     in KnuthTrie $ Fork s cs' ss
+    | otherwise = KnuthTrie $ Fork s cs $ unKnuthTrie $ insert tss x $ KnuthTrie ss
+
+  delete _ xs@(KnuthTrie Nil) = xs
+  delete tss@(t:|ts) (KnuthTrie (Fork s@(t',mx) cs ss))
+    | t == t' = if null ts
+                then KnuthTrie $ Fork (t',Nothing) cs ss
+                else let cs' = unKnuthTrie $ delete (NE.fromList ts) $ KnuthTrie cs
+                     in KnuthTrie $ Fork s cs' ss
+    | otherwise = KnuthTrie $ Fork s cs $ unKnuthTrie $ delete tss $ KnuthTrie ss
diff --git a/src/Data/Trie/List.hs b/src/Data/Trie/List.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/List.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE
+    TypeFamilies
+  , DeriveFunctor
+  , DeriveFoldable
+  , DeriveTraversable
+  , GeneralizedNewtypeDeriving
+  #-}
+
+module Data.Trie.List where
+
+import Prelude hiding (lookup)
+import           Data.Tree (Tree (..))
+import           Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
+
+import Data.Key hiding (lookup)
+import Data.Monoid
+import Control.Monad
+
+
+newtype ListTrie t x = ListTrie
+  { unListTrie :: Tree (t, Maybe x)
+  } deriving (Show, Eq, Functor, Foldable, Traversable)
+
+type instance Key (ListTrie t) = NonEmpty t
+-- TODO: Trie instance
+
+
+
+lookup :: Eq t => NonEmpty t -> ListTrie t x -> Maybe x
+lookup (t:|ts) (ListTrie (Node (t',mx) xs)) = do
+  guard $ t == t'
+  if null ts then mx
+             else getFirst $ foldMap (First . lookup (NE.fromList ts) . ListTrie) xs
diff --git a/src/Data/Trie/Map.hs b/src/Data/Trie/Map.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Map.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE
+    DeriveFunctor
+  , DeriveFoldable
+  , DeriveTraversable
+  , GeneralizedNewtypeDeriving
+  , TupleSections
+  , TypeFamilies
+  , FlexibleInstances
+  , FlexibleContexts
+  , MultiParamTypeClasses
+  #-}
+
+module Data.Trie.Map where
+
+import Data.Trie.Class
+
+import Prelude hiding (lookup, null)
+import qualified Data.Map as Map
+import           Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
+
+import qualified Data.Set.Class as S
+import qualified Data.Key as K
+import qualified Data.Foldable as F
+import Data.Maybe
+import Data.Monoid
+
+
+-- * One Step
+
+newtype MapStep c p a = MapStep
+  { unMapStep :: Map.Map p (Maybe a, Maybe (c p a)) }
+  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
+
+
+instance (Ord p, Trie NonEmpty p c) => Trie NonEmpty p (MapStep c) where
+  lookup (p:|ps) (MapStep xs)
+    | F.null ps = do (mx,_) <- Map.lookup p xs
+                     mx
+    | otherwise = do (_,mxs) <- Map.lookup p xs
+                     lookup (NE.fromList ps) =<< mxs
+  insert (p:|ps) x (MapStep xs)
+    | F.null ps = let mxs = snd =<< Map.lookup p xs
+                  in  MapStep $ Map.insert p (Just x,mxs) xs
+    | otherwise = let (mx,mxs) = fromMaybe (Nothing,Nothing) $ Map.lookup p xs
+                  in  MapStep $ Map.insert p (mx, insert (NE.fromList ps) x <$> mxs) xs
+  delete (p:|ps) (MapStep xs)
+    | F.null ps = let mxs = snd =<< Map.lookup p xs
+                  in  MapStep $ Map.insert p (Nothing,mxs) xs
+    | otherwise = let (mx,mxs) = fromMaybe (Nothing,Nothing) $ Map.lookup p xs
+                  in  MapStep $ Map.insert p (mx, delete (NE.fromList ps) <$> mxs) xs
+
+
+instance (Ord s, Monoid (c s a)) => Monoid (MapStep c s a) where
+  mempty = empty
+  mappend (MapStep xs) (MapStep ys) = MapStep $ Map.unionWith go xs ys
+    where go (mx,mxs) (my,mys) = (getLast $ Last mx <> Last my, mxs <> mys)
+
+empty :: MapStep c s a
+empty = MapStep Map.empty
+
+singleton :: s -> a -> MapStep c s a
+singleton p x = MapStep $ Map.singleton p (Just x, Nothing)
+
+
+-- * Fixpoint of Steps
+
+newtype MapTrie s a = MapTrie
+  { unMapTrie :: MapStep MapTrie s a }
+  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Monoid, Trie NonEmpty s)
+
+type instance K.Key (MapTrie s) = NonEmpty s
+
+-- instance K.Keyed (MapTrie t) where
+  -- mapWithKey
+
+instance Ord s => K.Lookup (MapTrie s) where
+  lookup = lookup
+
+-- * Conversion
+
+keys :: Ord s => MapTrie s a -> [NonEmpty s]
+keys (MapTrie (MapStep xs)) = let ks = Map.keys xs
+                              in F.concatMap go ks
+  where go k = let (_,mxs) = fromJust $ Map.lookup k xs
+               in fmap (k :|) $ fromMaybe [] $ do xs' <- mxs
+                                                  return $ NE.toList <$> keys xs'
+
+elems :: MapTrie s a -> [a]
+elems = F.toList
+
+-- * Query
+
+subtrie :: Ord s => NonEmpty s -> MapTrie s a -> Maybe (MapTrie s a)
+subtrie (p:|ps) (MapTrie (MapStep xs))
+  | F.null ps = do (_,mxs) <- Map.lookup p xs
+                   mxs
+  | otherwise = do (_,mxs) <- Map.lookup p xs
+                   subtrie (NE.fromList ps) =<< mxs
+
+-- lookupNearest ~ match
+match :: Ord s => NonEmpty s -> MapTrie s a -> Maybe (NonEmpty s, a, [s])
+match (p:|ps) (MapTrie (MapStep xs)) = do
+  (mx,mxs) <- Map.lookup p xs
+  let mFoundHere = do x <- mx
+                      return (p:|[], x, ps)
+  if F.null ps then mFoundHere
+               else getFirst $ First (do (pre,y,suff) <- match (NE.fromList ps) =<< mxs
+                                         return (p:|NE.toList pre, y, suff))
+                            <> First mFoundHere
+
+-- | Returns a list of all the nodes along the path to the furthest point in the
+-- query, in order of the path walked from the root to the furthest point.
+matches :: Ord s => NonEmpty s -> MapTrie s a -> [(NonEmpty s, a, [s])]
+matches (p:|ps) (MapTrie (MapStep xs)) =
+  let (mx,mxs) = fromMaybe (Nothing,Nothing) $ Map.lookup p xs
+      foundHere = fromMaybe [] $ do x <- mx
+                                    return [(p:|[],x,ps)]
+  in if F.null ps then foundHere
+                  else let rs = fromMaybe [] $ matches (NE.fromList ps) <$> mxs
+                       in foundHere ++ (prependAncestry <$> rs)
+  where prependAncestry (pre,x,suff) = (p:| NE.toList pre,x,suff)
+
+
+--
+-- lookupVia :: Ord t => (t -> Map.Map t (Maybe x, Maybe (MapTrie t x)) -> Maybe (t, (Maybe x, Maybe (MapTrie t x))))
+--                    -> NonEmpty t -> MapTrie t x -> Maybe (NonEmpty t, x)
+-- lookupVia f (t:|ts) (MapTrie xs) = case ts of
+--   [] -> do (_,(mx,_)) <- f t xs
+--            x <- mx
+--            return (t:|[],x)
+--   _  -> do (_,(_,mxs)) <- Map.lookupLT t xs
+--            lookupVia f (NE.fromList ts) =<< mxs
+--
diff --git a/src/Data/Trie/Pseudo.hs b/src/Data/Trie/Pseudo.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Pseudo.hs
@@ -0,0 +1,225 @@
+{-# LANGUAGE
+    DeriveFunctor
+  , DeriveFoldable
+  , DeriveTraversable
+  , FlexibleInstances
+  , ScopedTypeVariables
+  #-}
+
+module Data.Trie.Pseudo where
+
+import Prelude hiding (foldl, foldr, foldr1, lookup, map)
+import           Data.Foldable             hiding (all)
+import           Data.List                 (intercalate)
+import           Data.List.NonEmpty        (NonEmpty (..), fromList, toList)
+import qualified Data.List.NonEmpty        as NE
+import           Data.Maybe                (fromMaybe)
+import           Data.Monoid
+import qualified Data.Semigroup            as S
+
+import           Control.Applicative
+import           Control.Monad             (replicateM)
+import           Control.Arrow             (second)
+
+
+-- TODO: difference
+-- | Tagged rose tree with explicit emptyness
+data PseudoTrie t a = More t (Maybe a) (NonEmpty (PseudoTrie t a))
+                    | Rest (NonEmpty t) a
+                    | Nil
+  deriving (Show, Eq, Functor, Foldable, Traversable)
+
+-- | Overwriting instance
+instance (Eq t) => Monoid (PseudoTrie t a) where
+  mempty = Nil
+  mappend = merge
+
+beginsWith :: (Eq t) => PseudoTrie t a -> t -> Bool
+beginsWith Nil _ = False
+beginsWith (Rest (t:|_) _) p = t == p
+beginsWith (More t _ _) p    = t == p
+
+-- | Provides a form of deletion by setting a path to @Nothing@, but doesn't
+-- cleanup like @prune@
+assign :: (Eq t) => NonEmpty t -> Maybe a -> PseudoTrie t a -> PseudoTrie t a
+assign ts (Just x) Nil = Rest ts x
+assign _  Nothing  Nil = Nil
+assign tss@(t:|ts) mx ys@(Rest pss@(p:|ps) y)
+  | tss == pss = case mx of
+                   (Just x) -> Rest pss x
+                   Nothing  -> Nil
+  | t == p = case (ts,ps) of
+               ([],  p':_) -> More t mx $ Rest (NE.fromList ps) y :| []
+               (t':_,  []) -> case mx of
+                                Just x  -> More p (Just y) $ Rest (NE.fromList ts) x :| []
+                                Nothing -> ys
+               (t':_,p':_) -> if t' == p'
+                                then More t Nothing $
+                                       assign (NE.fromList ts) mx (Rest (NE.fromList ps) y) :| []
+                                else case mx of -- disjoint
+                                       Nothing  -> ys
+                                       Just x   -> More t Nothing $ NE.fromList $
+                                                     [ Rest (NE.fromList ps) y
+                                                     , Rest (NE.fromList ts) x
+                                                     ]
+  | otherwise = ys
+assign (t:|ts) mx y@(More p my ys)
+  | t == p = case ts of
+               [] -> More p mx ys
+               _  -> More p my $ fmap (assign (NE.fromList ts) mx) ys
+  | otherwise = y
+
+-- | Overwrite the LHS point-wise with the RHS's contents
+merge :: (Eq t) => PseudoTrie t a -> PseudoTrie t a -> PseudoTrie t a
+merge Nil y = y
+merge x Nil = x
+merge xx@(Rest tss@(t:|ts) x) (Rest pss@(p:|ps) y)
+  | tss == pss = Rest pss y
+  | t == p = case (ts,ps) of
+               ([],p':ps') -> More t (Just x) $ Rest (NE.fromList ps) y :| []
+               (t':ts',[]) -> More t (Just y) $ Rest (NE.fromList ts) x :| []
+               (_,_)       -> More t Nothing $
+                                merge (Rest (NE.fromList ts) x)
+                                      (Rest (NE.fromList ps) y) :| []
+  | otherwise = xx
+merge xx@(More t mx xs) (More p my ys)
+  | t == p = More p my $ NE.fromList $
+               foldr go [] $ NE.toList xs ++ NE.toList ys
+  | otherwise = xx
+  where
+    go q [] = [q]
+    go q (z:zs) | areDisjoint q z = q : z : zs
+                | otherwise = merge q z : zs
+merge xx@(More t mx xs) (Rest pss@(p:|ps) y)
+  | t == p = case ps of
+               [] -> More t (Just y) xs
+               _  -> More t mx $
+                       fmap (flip merge $ Rest (NE.fromList ps) y) xs
+  | otherwise = xx
+merge xx@(Rest tss@(t:|ts) x) (More p my ys)
+  | t == p = case ts of
+               [] -> More p (Just x) ys
+               _  -> More p my $
+                       fmap (merge $ Rest (NE.fromList ts) x) ys
+  | otherwise = xx
+
+
+add :: (Eq t) => NonEmpty t -> PseudoTrie t a -> PseudoTrie t a -> PseudoTrie t a
+add ts input container =
+  let ts' = NE.toList ts in
+  merge container $ mkMores ts' input
+  where
+    mkMores :: (Eq t) => [t] -> PseudoTrie t a -> PseudoTrie t a
+    mkMores [] trie = trie
+    mkMores (t:ts) trie = More t Nothing $
+      mkMores ts trie :| []
+
+
+toAssocs :: PseudoTrie t a -> [(NonEmpty t, a)]
+toAssocs = go [] []
+  where
+    go :: [t] -> [(NonEmpty t, a)] -> PseudoTrie t a -> [(NonEmpty t, a)]
+    go depth acc Nil = acc
+    go depth acc (Rest ts x) = (NE.fromList $ depth ++ NE.toList ts, x) : acc
+    go depth acc (More t Nothing xs) =
+      foldr (flip $ go $ depth ++ [t]) acc $ NE.toList xs
+    go depth acc (More t (Just x) xs) =
+      (NE.fromList $ depth ++ [t], x) :
+        (foldr $ flip $ go $ depth ++ [t]) acc (NE.toList xs)
+
+fromAssocs :: (Eq t) => [(NonEmpty t, a)] -> PseudoTrie t a
+fromAssocs = foldr (uncurry assign) Nil . fmap (second Just)
+
+lookup :: (Eq t) => NonEmpty t -> PseudoTrie t a -> Maybe a
+lookup _   Nil = Nothing
+lookup tss (Rest pss a)
+  | tss == pss = Just a
+  | otherwise = Nothing
+lookup tss@(t:|ts) (More p mx xs)
+  | t == p = case ts of
+               [] -> mx
+               (t':ts') -> find (hasNextTag t') xs >>= lookup (fromList ts)
+  | otherwise = Nothing
+
+  where
+    hasNextTag :: (Eq t) => t -> PseudoTrie t a -> Bool
+    hasNextTag t Nil = False
+    hasNextTag t (More p _ _) = t == p
+    hasNextTag t (Rest (p:|_) _) = t == p
+
+-- | Simple test on the heads of two tries
+areDisjoint :: (Eq t) => PseudoTrie t a -> PseudoTrie t a -> Bool
+areDisjoint (More t _ _) (More p _ _)
+  | t == p = False
+  | otherwise = True
+areDisjoint (Rest (t:|_) _) (Rest (p:|_) _)
+  | t == p = False
+  | otherwise = True
+areDisjoint _ _ = True
+
+-- | The meet of two @PseudoTrie@s
+intersectionWith :: (Eq t) =>
+                    (a -> b -> c)
+                 -> PseudoTrie t a
+                 -> PseudoTrie t b
+                 -> PseudoTrie t c
+intersectionWith _ _ Nil = Nil
+intersectionWith _ Nil _ = Nil
+intersectionWith f (Rest tss@(t:|ts) x) (Rest pss@(p:|ps) y)
+  | tss == pss = Rest pss $ f x y
+  | otherwise = Nil
+intersectionWith f (More t mx xs) (More p my ys)
+  | t == p = case [intersectionWith f x' y' | x' <- NE.toList xs, y' <- NE.toList ys] of
+               [] -> case f <$> mx <*> my of
+                       Nothing -> Nil
+                       Just c  -> Rest (p :| []) c
+               zs -> More p (f <$> mx <*> my) $ NE.fromList zs
+  -- implicit root
+  | otherwise = Nil
+intersectionWith f (More t mx xs) (Rest pss@(p:|ps) y)
+  | t == p = case ps of
+               [] -> case f <$> mx <*> Just y of
+                     Nothing -> Nil
+                     Just c  -> Rest (p :| []) c
+               _  -> More p Nothing $ fmap (flip (intersectionWith f) $ Rest (fromList ps) y) xs
+  | otherwise = Nil
+intersectionWith f (Rest tss@(t:|ts) x) (More p my ys)
+  | t == p = case ts of
+               [] -> case f <$> Just x <*> my of
+                     Nothing -> Nil
+                     Just c  -> Rest (t :| []) c
+               _  -> More t Nothing $ fmap (intersectionWith f $ Rest (fromList ts) x) ys
+  | otherwise = Nil
+
+-- difference :: Eq t =>
+--               PseudoTrie t a
+--            -> PseudoTrie t a
+--            -> PseudoTrie t a
+
+
+-- | Needless intermediary elements are turned into shortcuts, @Nil@'s in
+-- subtrees are also removed.
+prune :: PseudoTrie t a -> PseudoTrie t a
+prune = go
+  where
+    go Nil = Nil
+    go xx@(Rest ts x) = xx
+    go (More t Nothing xs) =
+      case cleaned xs of
+        [Nil]       -> Nil
+        [Rest ts x] -> Rest (t:|NE.toList ts) x
+        xs'         -> More t Nothing $ NE.fromList xs'
+    go (More t (Just x) xs) =
+      case cleaned xs of
+        [Nil] -> Rest (t:|[]) x
+        xs'   -> More t (Just x) $ NE.fromList xs'
+
+    cleaned xs = removeNils (NE.toList $ fmap go xs)
+
+    removeNils xs = case removeNils' xs of
+                      [] -> [Nil]
+                      ys -> ys
+      where
+        removeNils' []       =     []
+        removeNils' (Nil:xs) =     removeNils' xs
+        removeNils' (x:xs)   = x : removeNils' xs
diff --git a/tries.cabal b/tries.cabal
new file mode 100644
--- /dev/null
+++ b/tries.cabal
@@ -0,0 +1,58 @@
+Name:                   tries
+Version:                0.0.1
+Author:                 Athan Clark <athan.clark@gmail.com>
+Maintainer:             Athan Clark <athan.clark@gmail.com>
+License:                BSD3
+License-File:           LICENSE
+Synopsis:               Various trie implementations in Haskell
+-- Description:
+Cabal-Version:          >= 1.10
+Build-Type:             Simple
+Category:               Data, Tree
+
+Library
+  Default-Language:     Haskell2010
+  HS-Source-Dirs:       src
+  GHC-Options:          -Wall
+  Exposed-Modules:      Data.Trie.Class
+                        Data.Trie.Knuth
+                        Data.Trie.List
+                        Data.Trie.Map
+                        Data.Trie.Pseudo
+  Build-Depends:        base >= 4.6 && < 5
+                      , containers
+                      , bytestring
+                      , bytestring-trie
+                      , semigroups
+                      , rose-trees >= 0.0.2
+                      , composition
+                      , composition-extra >= 2.0.0
+                      , keys
+                      , sets >= 0.0.5
+                      , mtl
+                      , criterion
+
+Benchmark bench
+  Type:                 exitcode-stdio-1.0
+  Default-Language:     Haskell2010
+  Hs-Source-Dirs:       src
+                      , bench
+  Ghc-Options:          -Wall
+  Main-Is:              Bench.hs
+  Build-Depends:        base
+                      , tries
+                      , criterion
+                      , containers
+                      , bytestring
+                      , bytestring-trie
+                      , semigroups
+                      , rose-trees
+                      , composition
+                      , composition-extra
+                      , keys
+                      , sets
+                      , mtl
+
+Source-Repository head
+  Type:                 git
+  Location:             https://github.com/athanclark/tries.git