diff --git a/Data/BKTree.hs b/Data/BKTree.hs
new file mode 100644
--- /dev/null
+++ b/Data/BKTree.hs
@@ -0,0 +1,69 @@
+-- | Implementation of a BK-tree: <https://en.wikipedia.org/wiki/Bk-tree>
+module Data.BKTree
+    ( -- * Types
+      Distance
+    , BKTree
+      -- * Operations
+    , empty
+    , insert
+    , query
+    ) where
+
+import           Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+
+type Distance s = s -> s -> Int
+
+data BKTree s =
+    BKTree !(BK s) (Distance s)
+
+data BK s
+    = EmptyBK
+    | BK !s !(IntMap (BK s))
+
+narrow :: Int -> Int -> IntMap a -> IntMap a
+narrow n m im | n == m    = IntMap.fromList (maybe [] (\v -> [(n, v)]) (IntMap.lookup n im))
+narrow n m im | otherwise = insMaybe m res pr
+  where
+    (_, pl, res0)  = IntMap.splitLookup n im
+    (res, pr, _)   = IntMap.splitLookup m (insMaybe n res0 pl)
+    insMaybe k im' = maybe im' (\v -> IntMap.insert k v im')
+
+empty :: Distance s -- ^ The distance function \"d\" must be a metric on \"s\"
+                    --   (<https://en.wikipedia.org/wiki/Metric_space#Definition>):
+                    --
+                    --   * d x y >= 0
+                    --
+                    --   * d x y == 0 iff x == y
+                    --
+                    --   * d x y == d y x
+                    --
+                    --   * d x z <= d x y + d y z
+      -> BKTree s
+empty = BKTree EmptyBK
+
+insert :: s -> BKTree s -> BKTree s
+insert s (BKTree bk f) = BKTree (insert' s f bk) f
+
+insert' :: s -> Distance s -> BK s -> BK s
+insert' s _ EmptyBK = BK s IntMap.empty
+insert' s f bk@(BK s' bks)
+    | dist == 0 = bk
+    | otherwise = BK s' $ flip (IntMap.insert dist) bks $
+                  maybe (insert' s f EmptyBK) (insert' s f) (IntMap.lookup dist bks)
+  where dist = f s s'
+
+query :: Int                    -- ^ The maximum distance to search for.
+      -> s -> BKTree s
+      -> [(s, Int)]             -- ^ All the words with a distance less than the
+                                -- one specified, and their respective
+                                -- distances.
+query maxd s (BKTree bk f) = query' maxd s f bk
+
+query' :: Int -> s -> Distance s -> BK s -> [(s, Int)]
+query' _    _ _  EmptyBK    = []
+query' maxd s f (BK s' bks) = match ++ concatMap (query' maxd s f) children
+  where
+    dist     = f s s'
+    match    = if (dist <= maxd) then [(s', dist)] else []
+    children = IntMap.elems $ narrow (max (dist - maxd) 0) (dist + maxd) bks
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/bk-tree.cabal b/bk-tree.cabal
new file mode 100644
--- /dev/null
+++ b/bk-tree.cabal
@@ -0,0 +1,27 @@
+Cabal-Version:      >= 1.8
+Name:               bk-tree
+Version:            0.1
+Author:             Francesco Mazzoli (f@mazzo.li)
+Maintainer:         Francesco Mazzoli (f@mazzo.li)
+Build-Type:         Simple
+License:            PublicDomain
+Build-Type:         Simple
+Category:           Data Structures
+Synopsis:           BK-tree implementation
+Tested-With:        GHC==7.4.1
+Homepage:           https://github.com/bitonic/language-spelling
+Bug-Reports:        https://github.com/bitonic/language-spelling/issues
+Description:
+    BK-tree implementation.
+
+source-repository head
+    type:     git
+    location: git://github.com/bitonic/language-spelling.git
+
+Library
+    Build-Depends:    base >= 3 && < 5,
+                      containers
+
+    GHC-Options:      -Werror -O2
+
+    Exposed-Modules:  Data.BKTree