diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,11 @@
+# Changelog for `nspace`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Sandy Maguire (c) 2023
+
+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 Sandy Maguire 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/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,23 @@
+# nspace
+
+[![Hackage](https://img.shields.io/hackage/v/nspace.svg?logo=haskell&label=nspace)](https://hackage.haskell.org/package/nspace)
+
+
+## Dedication
+
+> The eternal silence of these infinite spaces frightens me.
+>
+> -- Blaise Pascal
+
+
+## Overview
+
+Haskelly `QuadTree`s and `OctTree`s at last!
+
+`nspace` provides infinite-precision 2D and 3D spatial data structures with
+support for efficient spatial queries.
+
+Check the
+[Haddock](https://hackage.haskell.org/package/nspace/docs/Data-OctTree.html) for
+more information on how to get started!
+
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/nspace.cabal b/nspace.cabal
new file mode 100644
--- /dev/null
+++ b/nspace.cabal
@@ -0,0 +1,109 @@
+cabal-version: 2.2
+
+-- This file has been generated from package.yaml by hpack version 0.35.1.
+--
+-- see: https://github.com/sol/hpack
+
+name:           nspace
+version:        0.1.0.0
+synopsis:       Efficient, infinite-precision 2D and 3D spatial containers.
+description:    Please see the README on GitHub at <https://github.com/isovector/nspace#readme>
+category:       Data Structures
+homepage:       https://github.com/isovector/nspace#readme
+bug-reports:    https://github.com/isovector/nspace/issues
+author:         Sandy Maguire
+maintainer:     sandy@sandymaguire.me
+copyright:      2023 Sandy Maguire
+license:        BSD-3-Clause
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/isovector/nspace
+
+library
+  exposed-modules:
+      Data.OctTree
+      Data.OctTree.Internal
+      Data.QuadTree
+      Data.QuadTree.Internal
+      Data.Semilattice
+  other-modules:
+      Paths_nspace
+  autogen-modules:
+      Paths_nspace
+  hs-source-dirs:
+      src
+  default-extensions:
+      BangPatterns
+      DeriveDataTypeable
+      DeriveFoldable
+      DeriveFunctor
+      DeriveGeneric
+      DeriveLift
+      DeriveTraversable
+      DerivingStrategies
+      DerivingVia
+      GeneralisedNewtypeDeriving
+      ImplicitPrelude
+      LambdaCase
+      MonomorphismRestriction
+      RankNTypes
+      ScopedTypeVariables
+      StandaloneDeriving
+      StarIsType
+      TypeApplications
+      ViewPatterns
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , containers
+    , hashable
+    , linear
+    , monoidal-containers
+  default-language: Haskell2010
+
+test-suite nspace-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_nspace
+  autogen-modules:
+      Paths_nspace
+  hs-source-dirs:
+      test
+  default-extensions:
+      BangPatterns
+      DeriveDataTypeable
+      DeriveFoldable
+      DeriveFunctor
+      DeriveGeneric
+      DeriveLift
+      DeriveTraversable
+      DerivingStrategies
+      DerivingVia
+      GeneralisedNewtypeDeriving
+      ImplicitPrelude
+      LambdaCase
+      MonomorphismRestriction
+      RankNTypes
+      ScopedTypeVariables
+      StandaloneDeriving
+      StarIsType
+      TypeApplications
+      ViewPatterns
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      QuickCheck
+    , base >=4.7 && <5
+    , checkers
+    , containers
+    , hashable
+    , linear
+    , monoidal-containers
+    , nspace
+  default-language: Haskell2010
diff --git a/src/Data/OctTree.hs b/src/Data/OctTree.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/OctTree.hs
@@ -0,0 +1,298 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE StrictData      #-}
+
+module Data.OctTree
+  ( OctTree (..)
+
+    -- * Constructing 'OctTree's
+  , cube
+  , fill
+  , combineAla
+
+    -- * Spatially Querying 'OctTree's
+  , lookup
+  , query
+
+    -- * Eliminating 'OctTree's
+  , fuse
+  , elements
+  , toCubes
+  , boundingCube
+  , defaultValue
+
+    -- * Constructing 'Cube's
+  , Cube (..)
+  , mkCubeByPow
+
+    -- * Eliminating 'Cube's
+  , midpoint
+  , subdivide
+  , Raw.cubeCorners
+
+    -- * Indexing Types
+  , V3 (..)
+  , Oct (..)
+  ) where
+
+import           Data.Coerce
+import           Data.Foldable
+import           Data.Maybe (fromMaybe)
+import           Data.Monoid (Ap(..))
+import           Data.OctTree.Internal (Free(..), Oct(..), Cube(..), pattern Oct8, unwrap, intersects, cubeContainsCube, getIntersect, cubeContainsPoint, normalize, cubeSize)
+import qualified Data.OctTree.Internal as Raw
+import           Data.Semilattice
+import           Data.Set (Set)
+import qualified Data.Set as S
+import           GHC.Base (liftA2)
+import           Linear.V3
+import           Prelude hiding (lookup)
+
+
+------------------------------------------------------------------------------
+-- | Compute the center of a 'Cube'.
+midpoint :: (Fractional a) => Cube a -> V3 a
+midpoint (Cube pos sz) = pos + sz / 2
+
+
+------------------------------------------------------------------------------
+-- | Subdivide a 'Cube' into eight 'Cube's which fill up the same volume.
+subdivide :: Fractional a => Cube a -> Oct (Cube a)
+subdivide (Cube (V3 x y z) (V3 w h d)) =
+  let halfw = w / 2
+      halfh = h / 2
+      halfd = d / 2
+   in Oct8
+        (Cube (V3 x y z) (V3 halfw halfh halfd))
+        (Cube (V3 (x + halfw) y z) $ V3 (w - halfw) halfh halfd)
+        (Cube (V3 x (y + halfh) z) $ V3 halfw (h - halfh) halfd)
+        (Cube (V3 (x + halfw) (y + halfh) z) $ V3 (w - halfw) (h - halfh) halfd)
+        (Cube (V3 x y (z + halfd)) $ V3 halfw halfh (d - halfd))
+        (Cube (V3 (x + halfw) y (z + halfd)) $ V3 (w - halfw) halfh (d - halfd))
+        (Cube (V3 x (y + halfh) (z + halfd)) $ V3 halfw (h - halfh) (d - halfd))
+        (Cube (V3 (x + halfw) (y + halfh) (z + halfd)) $ V3 (w - halfw) (h - halfh) (d - halfd))
+
+
+------------------------------------------------------------------------------
+-- | A type mapping values at (infinitely precise) locations in 3D
+-- space. That is, you can consider an 'OctTree' to be a function @'V3'
+-- 'Rational' -> a@, equipped with efficient means of querying the space.
+--
+-- 'OctTree's should usually be constructed using their 'Monoid'al or
+-- 'Applicative' interfaces, as well as by way of the 'cube' and 'fill'
+-- functions.
+data OctTree a = OctTree
+  { ot_default  :: a
+  , ot_root_pow :: Integer
+  , ot_tree     :: Free a
+  }
+  deriving stock (Show, Functor)
+  deriving (Num, Semigroup, Monoid) via (Ap OctTree a)
+
+instance Semilattice a => Semilattice (OctTree a)
+
+
+------------------------------------------------------------------------------
+-- | Get the value used to fill the infinity of space in an 'OctTree'.
+defaultValue :: OctTree a -> a
+defaultValue = ot_default
+
+instance Eq a => Eq (OctTree a) where
+  q1@(OctTree a m tr) == q2@(OctTree a' n tr') =
+    case compare m n of
+      LT -> realloc q1 == q2
+      EQ -> a == a' && tr == tr'
+      GT -> q1 == realloc q2
+
+
+instance Applicative OctTree where
+  pure a = OctTree a 0 $ pure a
+  liftA2 fabc q1@(OctTree a m ota) q2@(OctTree b n otb) =
+    case compare m n of
+      LT -> liftA2 fabc (realloc q1) q2
+      EQ -> OctTree (fabc a b) m $ liftA2 fabc ota otb
+      GT -> liftA2 fabc q1 (realloc q2)
+
+
+------------------------------------------------------------------------------
+-- | Get a 'Cube' guaranteed to bound all of the non-defaulted values in the
+-- 'OctTree'.
+boundingCube :: OctTree a -> Cube Rational
+boundingCube = mkCubeByPow . ot_root_pow
+
+
+------------------------------------------------------------------------------
+-- | Construct a 'Cube' centered around $(0, 0, 0)$, with side length $2n$.
+mkCubeByPow :: Integer -> Cube Rational
+mkCubeByPow n =
+  let side = 2 ^ n
+   in Cube (pure (-side)) $ pure $ side * 2
+
+
+------------------------------------------------------------------------------
+-- | Build a larger 'Free' 'Oct' by doubling each side length, keeping the
+-- contents in the center.
+doubleGo :: a -> Oct (Free a) -> Free a
+doubleGo def (Oct8 tl0 tr0 bl0 br0 tl1 tr1 bl1 br1) = Split $
+  Oct8
+    (Split (Oct8 a a a a a a
+                 a tl0)) (Split (Oct8 a a a a a  a
+                                     tr0 a))
+    (Split (Oct8 a a a a a bl0
+                 a a)) (Split (Oct8 a a a a br0 a
+                                    a  a))
+    (Split (Oct8 a a
+                 a tl1 a a a a)) (Split (Oct8 a  a
+                                     tr1 a a a a a))
+    (Split (Oct8 a bl1
+                 a a a a a a)) (Split (Oct8 br1 a
+                                    a  a a a a a))
+  where
+    a = Fill def
+
+
+------------------------------------------------------------------------------
+-- | Reallocate the bounds of the 'OctTree' so each side length is twice the
+-- size.
+realloc :: OctTree a -> OctTree a
+realloc (OctTree a n q) = OctTree a (n + 1) $ doubleGo a $ unwrap q
+
+
+------------------------------------------------------------------------------
+-- | Get the smallest integer which will contain the 'Cube' when given as an
+-- argument to 'mkCubeByPow'.
+--
+-- @
+-- 'cubeContainsCube' ('mkCubeByPow' ('cubeBoundingLog' c)) c == True
+-- @
+cubeBoundingLog :: Cube Rational -> Integer
+cubeBoundingLog (Cube (V3 x y z) (V3 w h d)) =
+  maximum $ (0 :) $ fmap (ceiling @Double . logBase 2 . fromRational)
+    [ abs x
+    , abs $ x + w
+    , abs y
+    , abs $ y + h
+    , abs z
+    , abs $ z + d
+    ]
+
+
+fillSel :: (Fractional r, Ord r) => a -> a -> Maybe (Cube r) -> Cube r -> Free a
+fillSel def _ Nothing _ = pure def
+fillSel def v (Just r) qu = fillImpl def v r qu
+
+
+fillImpl :: (Fractional r, Ord r) => a -> a -> Cube r -> Cube r -> Free a
+fillImpl def v area r
+  | cubeContainsCube area r = pure v
+  | intersects area r = do
+      let subr = subdivide r
+          subarea = getIntersect area <$> subr
+      Split $ fillSel def v <$> subarea <*> subr
+  | otherwise = pure def
+
+
+------------------------------------------------------------------------------
+-- | @'cube' def val c@ constructs a new 'OctTree', which has value @val@
+-- everywhere in the cube @c@, and @def@ everywhere else.
+cube :: a -> a -> Cube Rational -> OctTree a
+cube def v (normalize -> r)
+  | cubeSize r == 0  = OctTree def (cubeBoundingLog r) $ pure def
+  | otherwise = OctTree def (cubeBoundingLog r) $ fillImpl def v r $ mkCubeByPow (cubeBoundingLog r)
+
+
+------------------------------------------------------------------------------
+-- | Fill a 'Cube' with the given value in an 'OctTree'
+fill :: forall a. Cube Rational -> a -> OctTree a -> OctTree a
+fill (normalize -> r) a q = liftA2 fromMaybe q (cube Nothing (Just a) r)
+
+
+lookupImpl :: V3 Rational -> Cube Rational -> Free a -> Maybe a
+lookupImpl p r ot
+  | cubeContainsPoint r p = case ot of
+      Fill a -> Just a
+      Split qu -> asum $ lookupImpl p <$> subdivide r <*> qu
+  | otherwise = Nothing
+
+
+------------------------------------------------------------------------------
+-- | Get the value at the given position in the 'OctTree'.
+lookup :: V3 Rational -> OctTree a -> a
+lookup v2 (OctTree a n q) = fromMaybe a $ lookupImpl v2 (mkCubeByPow n) q
+
+
+------------------------------------------------------------------------------
+-- | Query a region of space in an 'OctTree'. This method is a special case of
+-- 'foldMap', specialized to finite regions.
+--
+-- For example, if you'd like to check if everything in the 'Cube' has
+-- a specific value, use 'Data.Monoid.All' as your choice of 'Semilattice'. If
+-- you'd like to check whether anything in the space has a value, instead use
+-- 'Data.Monoid.Any'.
+query :: Semilattice s => (a -> s) -> Cube Rational -> OctTree a -> s
+query f (normalize -> area) (OctTree a n q)
+  | cubeContainsCube r area = queryImpl f area r q
+  | intersects r area = queryImpl f area r q /\ f a
+  | otherwise = f a
+  where
+    r = mkCubeByPow n
+
+
+queryImpl :: Semilattice s => (a -> s) -> Cube Rational -> Cube Rational -> Free a -> s
+queryImpl f area r (Fill a)
+  | intersects area r = f a
+  | otherwise = mempty
+queryImpl f area r (Split qu)
+  | intersects area r = do
+      let subr = subdivide r
+          subarea = getIntersect area <$> subr
+      fold $ querySel f <$> subarea <*> subr <*> qu
+  | otherwise = mempty
+
+
+querySel :: Semilattice s => (a -> s) -> Maybe (Cube Rational) -> Cube Rational -> Free a -> s
+querySel _ Nothing _ _ = mempty
+querySel f (Just area) r q = queryImpl f area r q
+
+
+------------------------------------------------------------------------------
+-- | Partition the 'OctTree' into contiguous, singular-valued 'Cube's.
+-- Satsifies the law
+--
+-- @
+-- 'foldMap' (uncurry $ 'cube' ('defaultValue' ot)) ('toCubes' ot) == ot
+-- @
+toCubes :: OctTree a -> [(Cube Rational, a)]
+toCubes (OctTree _ n q) = toCubesImpl (mkCubeByPow n) q
+
+toCubesImpl :: Cube Rational -> Free a -> [(Cube Rational, a)]
+toCubesImpl r (Fill a) = pure (r, a)
+toCubesImpl r (Split qu) = do
+  let subr = subdivide r
+  fold $ toCubesImpl <$> subr <*> qu
+
+
+------------------------------------------------------------------------------
+-- | Get the unique elements contained in the 'OctTree'.
+elements :: Ord a => OctTree a -> Set a
+elements ot = S.insert (ot_default ot) $ query S.singleton (boundingCube ot) ot
+
+
+------------------------------------------------------------------------------
+-- | Fuse together all adjacent regions of space which contain the same value.
+-- This will speed up subsequent queries, but requires traversing the entire
+-- tree.
+fuse :: Eq a => OctTree a -> OctTree a
+fuse (OctTree a n ot) = OctTree a n $ Raw.fuse ot
+
+
+------------------------------------------------------------------------------
+-- | Combine two 'OctTree's using a different semigroup than usual. For
+-- example, in order to replace any values in @ot1@ with those covered by
+-- @ot2@, we can use:
+--
+-- @
+-- 'combineAla' 'Data.Semigroup.Last' ot1 ot2
+-- @
+combineAla :: forall n a. (Coercible a n, Semigroup n)  => (a -> n) -> OctTree a -> OctTree a -> OctTree a
+combineAla _ x y = coerce $ (coerce x :: OctTree n) <> coerce y
+
diff --git a/src/Data/OctTree/Internal.hs b/src/Data/OctTree/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/OctTree/Internal.hs
@@ -0,0 +1,187 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+module Data.OctTree.Internal where
+
+import Control.Applicative (liftA2)
+import Data.Maybe (isJust)
+import Data.Monoid (Ap(..))
+import GHC.Generics (Generic)
+import Linear.V3
+import Linear.V4
+
+
+------------------------------------------------------------------------------
+-- | An axis-aligned bounding box in 3-space.
+data Cube a = Cube
+  { r_pos  :: !(V3 a)
+  , r_size :: !(V3 a)
+  }
+  deriving stock (Show, Read, Eq, Generic, Ord, Functor)
+
+
+------------------------------------------------------------------------------
+r_x, r_y, r_z, r_w, r_h, r_d :: Cube a -> a
+r_x (Cube (V3 x _ _) (V3 _ _ _)) = x
+r_y (Cube (V3 _ y _) (V3 _ _ _)) = y
+r_z (Cube (V3 _ _ z) (V3 _ _ _)) = z
+r_w (Cube (V3 _ _ _) (V3 w _ _)) = w
+r_h (Cube (V3 _ _ _) (V3 _ h _)) = h
+r_d (Cube (V3 _ _ _) (V3 _ _ d)) = d
+
+
+------------------------------------------------------------------------------
+-- | @'containsCube' c1 c2@ is true when @c2@ is inside or equal to @c1@.
+cubeContainsCube :: (Num a, Ord a) => Cube a -> Cube a -> Bool
+cubeContainsCube r1@(Cube (V3 bx by bz) (V3 bw bh bd)) r2@(Cube (V3 sx sy sz) (V3 sw sh sd)) =
+  r1 == r2 ||
+  and
+    [ bx <= sx
+    , by <= sy
+    , bz <= sz
+    , sx + sw <= bx + bw
+    , sy + sh <= by + bh
+    , sz + sd <= bz + bd
+    ]
+
+
+------------------------------------------------------------------------------
+-- | Does the cube contain a given point?
+cubeContainsPoint :: (Ord a, Num a) => Cube a -> V3 a -> Bool
+cubeContainsPoint (Cube _ (V3 w h d)) _
+  | w <= 0 || h <= 0 || d <= 0
+  = False
+cubeContainsPoint (Cube (V3 x y z) (V3 w h d)) (V3 tx ty tz) =
+  and
+    [ x <= tx
+    , y <= ty
+    , z <= tz
+    , tx < x + w
+    , ty < y + h
+    , tz < z + d
+    ]
+
+------------------------------------------------------------------------------
+-- | Get the co-ordinates of the corners of a 'Cube'.
+cubeCorners :: Num a => Cube a -> Oct (V3 a)
+cubeCorners (Cube (V3 x y z) (V3 w h d)) =
+  let p = V3 x y z
+      dx = V3 w 0 0
+      dy = V3 0 h 0
+      dz = V3 0 0 d
+   in fmap (p +) $ Oct8 0   dx         dy       (dx + dy)
+                       dz (dx + dz) (dy + dz) (dx + dy + dz)
+
+
+------------------------------------------------------------------------------
+-- | 'Control.Monad.Free.Free', but with better instances.
+data Free a
+  = Fill a
+  | Split (Oct (Free a))
+  deriving (Functor, Foldable, Traversable, Generic)
+
+deriving via Ap Free a instance (Semigroup a) => Semigroup (Free a)
+deriving via Ap Free a instance (Monoid    a) => Monoid    (Free a)
+
+deriving stock instance (Show a) => Show (Free a)
+
+instance (Eq a) => Eq (Free a) where
+  Fill a   == Fill b    = a             == b
+  Split qu == Split qu' = qu            == qu'
+  Fill a   == Split qu  = pure (pure a) == qu
+  Split qu == Fill a    = pure (pure a) == qu
+
+instance Applicative Free where
+  pure = Fill
+  liftA2 fabc (Fill a) (Fill b) = Fill $ fabc a b
+  liftA2 fabc (Fill a) (Split qu) = Split $ fmap (fmap (fabc a)) qu
+  liftA2 fabc (Split qu) (Fill b) = Split $ fmap (fmap (flip  fabc b)) qu
+  liftA2 fabc (Split qu) (Split qu') = Split $ liftA2 (liftA2 fabc) qu qu'
+
+instance Monad Free where
+  Fill a >>= f = f a
+  Split qu >>= f = Split $ fmap (>>= f) qu
+
+
+------------------------------------------------------------------------------
+-- | An 8-tuple of values.
+data Oct a = Oct !(V4 a) !(V4 a)
+  deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable, Generic)
+  deriving (Semigroup, Monoid) via Ap Oct a
+
+pattern Oct8 :: a -> a -> a -> a -> a -> a -> a -> a -> Oct a
+pattern Oct8 a b c d e f g h = Oct (V4 a b c d) (V4 e f g h)
+{-# COMPLETE Oct8 #-}
+
+instance Applicative Oct where
+  pure a = Oct (pure a) (pure a)
+  liftA2 fabc (Oct a1 a2) (Oct b1 b2)
+    = Oct (liftA2 fabc a1 b1) (liftA2 fabc a2 b2)
+
+
+------------------------------------------------------------------------------
+-- | Normalize a 'Cube' so it has a positive 'r_size'.
+normalize :: (Num a, Ord a) => Cube a -> Cube a
+normalize q@(Cube (V3 x y z) (V3 w h d))
+  | w < 0 = let w' = abs w in normalize $ Cube (V3 (x - w') y z) $ V3 w' h d
+  | h < 0 = let h' = abs h in normalize $ Cube (V3 x (y - h') z) $ V3 w h' d
+  | d < 0 = let d' = abs d in normalize $ Cube (V3 x y (z - d')) $ V3 w h d'
+  | otherwise = q
+
+
+------------------------------------------------------------------------------
+-- | Do two 'Cube's intersect?
+intersects :: (Ord a, Num a) => Cube a -> Cube a -> Bool
+intersects r1 r2 = isJust $ getIntersect r1 r2
+
+
+------------------------------------------------------------------------------
+-- | Get the volume of a 'Cube'.
+cubeSize :: Num a => Cube a -> a
+cubeSize (Cube _ (V3 w h d)) = abs w * abs h * abs d
+
+
+------------------------------------------------------------------------------
+-- | Compute the intersection of two 'Cube's.
+getIntersect :: (Ord a, Num a) => Cube a -> Cube a -> Maybe (Cube a)
+getIntersect (normalize -> r1) (normalize -> r2)
+ | cubeSize r1 == 0 = Just r1
+ | cubeSize r2 == 0 = Just r2
+ | otherwise =
+  let x0 = max (r_x r1) (r_x r2)
+      y0 = max (r_y r1) (r_y r2)
+      z0 = max (r_z r1) (r_z r2)
+      x1 = min (r_x r1 + r_w r1) (r_x r2 + r_w r2)
+      y1 = min (r_y r1 + r_h r1) (r_y r2 + r_h r2)
+      z1 = min (r_z r1 + r_d r1) (r_z r2 + r_d r2)
+      w = x1 - x0
+      h = y1 - y0
+      d = z1 - z0
+   in case 0 < w && 0 < h && 0 < d of
+        True -> Just $ Cube (V3 x0 y0 z0) (V3 w h d)
+        False -> Nothing
+
+
+unwrap :: Free a -> Oct (Free a)
+unwrap (Fill a) = pure $ pure a
+unwrap (Split qu) = qu
+
+
+------------------------------------------------------------------------------
+-- | Join together 'Split' constructors which all contain the same value.
+fuse :: Eq a => Free a -> Free a
+fuse (Fill a) = Fill a
+fuse (Split q) = doFuse $ fmap fuse q
+
+
+doFuse :: Eq a => Oct (Free a) -> Free a
+doFuse (Oct8 (Fill a) (Fill b) (Fill c) (Fill d) (Fill e) (Fill f) (Fill g) (Fill h))
+  | a == b
+  , b == c
+  , c == d
+  , d == e
+  , e == f
+  , f == g
+  , g == h
+  = Fill a
+doFuse q = Split q
+
diff --git a/src/Data/QuadTree.hs b/src/Data/QuadTree.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/QuadTree.hs
@@ -0,0 +1,287 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE StrictData      #-}
+
+module Data.QuadTree
+  ( QuadTree (..)
+
+    -- * Constructing 'QuadTree's
+  , rect
+  , fill
+  , combineAla
+
+    -- * Spatially Querying 'QuadTree's
+  , lookup
+  , query
+
+    -- * Eliminating 'QuadTree's
+  , fuse
+  , elements
+  , toRects
+  , boundingRect
+  , defaultValue
+
+    -- * Constructing 'Rect's
+  , Rect (..)
+  , mkRectByPow
+
+    -- * Eliminating 'Rect's
+  , midpoint
+  , subdivide
+  , Raw.rectCorners
+
+    -- * Indexing Types
+  , V2 (..)
+  , V4 (..)
+  ) where
+
+import           Data.Coerce
+import           Data.Foldable
+import           Data.Maybe (fromMaybe)
+import           Data.Monoid (Ap(..))
+import           Data.QuadTree.Internal (Free(..), Rect(..), unwrap, intersects, rectContainsRect, getIntersect, rectContainsPoint, normalize, rectSize)
+import qualified Data.QuadTree.Internal as Raw
+import           Data.Semilattice
+import           Data.Set (Set)
+import qualified Data.Set as S
+import           GHC.Base (liftA2)
+import           Linear.V2
+import           Linear.V4
+import           Prelude hiding (lookup)
+
+
+------------------------------------------------------------------------------
+-- | Compute the center of a 'Rect'.
+midpoint :: (Fractional a) => Rect a -> V2 a
+midpoint (Rect pos sz) = pos + sz / 2
+
+
+------------------------------------------------------------------------------
+-- | Subdivide a 'Rect' into four 'Rect's which fill up the same volume.
+subdivide :: Fractional a => Rect a -> V4 (Rect a)
+subdivide (Rect (V2 x y) (V2 w h)) =
+  let halfw = w / 2
+      halfh = h / 2
+   in V4
+        (Rect (V2 x y) (V2 halfw halfh))
+        (Rect (V2 (x + halfw) y) $ V2 (w - halfw) halfh)
+        (Rect (V2 x (y + halfh)) $ V2 halfw (h - halfh))
+        (Rect (V2 (x + halfw) (y + halfh)) $ V2 (w - halfw) (h - halfh))
+
+
+------------------------------------------------------------------------------
+-- | A type mapping values at (infinitely precise) locations in 2D
+-- space. That is, you can consider an 'QuadTree' to be a function @'V2'
+-- 'Rational' -> a@, equipped with efficient means of querying the space.
+--
+-- 'QuadTree's should usually be constructed using their 'Monoid'al or
+-- 'Applicative' interfaces, as well as by way of the 'rect' and 'fill'
+-- functions.
+data QuadTree a = QuadTree
+  { ot_default  :: a
+  , ot_root_pow :: Integer
+  , ot_tree     :: Free a
+  }
+  deriving stock (Show, Functor)
+  deriving (Num, Semigroup, Monoid) via (Ap QuadTree a)
+
+instance Semilattice a => Semilattice (QuadTree a)
+
+
+------------------------------------------------------------------------------
+-- | Get the value used to fill the infinity of space in an 'QuadTree'.
+defaultValue :: QuadTree a -> a
+defaultValue = ot_default
+
+instance Eq a => Eq (QuadTree a) where
+  q1@(QuadTree a m tr) == q2@(QuadTree a' n tr') =
+    case compare m n of
+      LT -> realloc q1 == q2
+      EQ -> a == a' && tr == tr'
+      GT -> q1 == realloc q2
+
+
+instance Applicative QuadTree where
+  pure a = QuadTree a 0 $ pure a
+  liftA2 fabc q1@(QuadTree a m ota) q2@(QuadTree b n otb) =
+    case compare m n of
+      LT -> liftA2 fabc (realloc q1) q2
+      EQ -> QuadTree (fabc a b) m $ liftA2 fabc ota otb
+      GT -> liftA2 fabc q1 (realloc q2)
+
+
+------------------------------------------------------------------------------
+-- | Get a 'Rect' guaranteed to bound all of the non-defaulted values in the
+-- 'QuadTree'.
+boundingRect :: QuadTree a -> Rect Rational
+boundingRect = mkRectByPow . ot_root_pow
+
+
+------------------------------------------------------------------------------
+-- | Construct a 'Rect' centered around $(0, 0, 0)$, with side length $2n$.
+mkRectByPow :: Integer -> Rect Rational
+mkRectByPow n =
+  let side = 2 ^ n
+   in Rect (pure (-side)) $ pure $ side * 2
+
+
+------------------------------------------------------------------------------
+-- | Build a larger 'Free' 'Quad' by doubling each side length, keeping the
+-- contents in the center.
+doubleGo :: a -> V4 (Free a) -> Free a
+doubleGo def (V4 tl tr bl br) = Split $
+  V4
+    (Split (V4 a a
+               a tl)) (Split (V4 a  a
+                                tr a))
+    (Split (V4 a bl
+               a a)) (Split (V4 br a
+                                a  a))
+  where
+    a = Fill def
+
+
+------------------------------------------------------------------------------
+-- | Reallocate the bounds of the 'QuadTree' so each side length is twice the
+-- size.
+realloc :: QuadTree a -> QuadTree a
+realloc (QuadTree a n q) = QuadTree a (n + 1) $ doubleGo a $ unwrap q
+
+
+------------------------------------------------------------------------------
+-- | Get the smallest integer which will contain the 'Rect' when given as an
+-- argument to 'mkRectByPow'.
+--
+-- @
+-- 'rectContainsRect' ('mkRectByPow' ('rectBoundingLog' c)) c == True
+-- @
+rectBoundingLog :: Rect Rational -> Integer
+rectBoundingLog (Rect (V2 x y) (V2 w h)) =
+  maximum $ (0 :) $ fmap (ceiling @Double . logBase 2 . fromRational)
+    [ abs x
+    , abs $ x + w
+    , abs y
+    , abs $ y + h
+    ]
+
+
+fillSel :: (Fractional r, Ord r) => a -> a -> Maybe (Rect r) -> Rect r -> Free a
+fillSel def _ Nothing _ = pure def
+fillSel def v (Just r) qu = fillImpl def v r qu
+
+
+fillImpl :: (Fractional r, Ord r) => a -> a -> Rect r -> Rect r -> Free a
+fillImpl def v area r
+  | rectContainsRect area r = pure v
+  | intersects area r = do
+      let subr = subdivide r
+          subarea = getIntersect area <$> subr
+      Split $ fillSel def v <$> subarea <*> subr
+  | otherwise = pure def
+
+
+------------------------------------------------------------------------------
+-- | @'rect' def val c@ constructs a new 'QuadTree', which has value @val@
+-- everywhere in the rect @c@, and @def@ everywhere else.
+rect :: a -> a -> Rect Rational -> QuadTree a
+rect def v (normalize -> r)
+  | rectSize r == 0  = QuadTree def (rectBoundingLog r) $ pure def
+  | otherwise = QuadTree def (rectBoundingLog r) $ fillImpl def v r $ mkRectByPow (rectBoundingLog r)
+
+
+------------------------------------------------------------------------------
+-- | Fill a 'Rect' with the given value in an 'QuadTree'
+fill :: forall a. Rect Rational -> a -> QuadTree a -> QuadTree a
+fill (normalize -> r) a q = liftA2 fromMaybe q (rect Nothing (Just a) r)
+
+
+lookupImpl :: V2 Rational -> Rect Rational -> Free a -> Maybe a
+lookupImpl p r ot
+  | rectContainsPoint r p = case ot of
+      Fill a -> Just a
+      Split qu -> asum $ lookupImpl p <$> subdivide r <*> qu
+  | otherwise = Nothing
+
+
+------------------------------------------------------------------------------
+-- | Get the value at the given position in the 'QuadTree'.
+lookup :: V2 Rational -> QuadTree a -> a
+lookup v2 (QuadTree a n q) = fromMaybe a $ lookupImpl v2 (mkRectByPow n) q
+
+
+------------------------------------------------------------------------------
+-- | Query a region of space in an 'QuadTree'. This method is a special case of
+-- 'foldMap', specialized to finite regions.
+--
+-- For example, if you'd like to check if everything in the 'Rect' has
+-- a specific value, use 'Data.Monoid.All' as your choice of 'Semilattice'. If
+-- you'd like to check whether anything in the space has a value, instead use
+-- 'Data.Monoid.Any'.
+query :: Semilattice s => (a -> s) -> Rect Rational -> QuadTree a -> s
+query f (normalize -> area) (QuadTree a n q)
+  | rectContainsRect r area = queryImpl f area r q
+  | intersects r area = queryImpl f area r q /\ f a
+  | otherwise = f a
+  where
+    r = mkRectByPow n
+
+
+queryImpl :: Semilattice s => (a -> s) -> Rect Rational -> Rect Rational -> Free a -> s
+queryImpl f area r (Fill a)
+  | intersects area r = f a
+  | otherwise = mempty
+queryImpl f area r (Split qu)
+  | intersects area r = do
+      let subr = subdivide r
+          subarea = getIntersect area <$> subr
+      fold $ querySel f <$> subarea <*> subr <*> qu
+  | otherwise = mempty
+
+
+querySel :: Semilattice s => (a -> s) -> Maybe (Rect Rational) -> Rect Rational -> Free a -> s
+querySel _ Nothing _ _ = mempty
+querySel f (Just area) r q = queryImpl f area r q
+
+
+------------------------------------------------------------------------------
+-- | Partition the 'QuadTree' into contiguous, singular-valued 'Rect's.
+-- Satsifies the law
+--
+-- @
+-- 'foldMap' (uncurry $ 'rect' ('defaultValue' ot)) ('toRects' ot) == ot
+-- @
+toRects :: QuadTree a -> [(Rect Rational, a)]
+toRects (QuadTree _ n q) = toRectsImpl (mkRectByPow n) q
+
+toRectsImpl :: Rect Rational -> Free a -> [(Rect Rational, a)]
+toRectsImpl r (Fill a) = pure (r, a)
+toRectsImpl r (Split qu) = do
+  let subr = subdivide r
+  fold $ toRectsImpl <$> subr <*> qu
+
+
+------------------------------------------------------------------------------
+-- | Get the unique elements contained in the 'QuadTree'.
+elements :: Ord a => QuadTree a -> Set a
+elements ot = S.insert (ot_default ot) $ query S.singleton (boundingRect ot) ot
+
+
+------------------------------------------------------------------------------
+-- | Fuse together all adjacent regions of space which contain the same value.
+-- This will speed up subsequent queries, but requires traversing the entire
+-- tree.
+fuse :: Eq a => QuadTree a -> QuadTree a
+fuse (QuadTree a n ot) = QuadTree a n $ Raw.fuse ot
+
+
+------------------------------------------------------------------------------
+-- | Combine two 'QuadTree's using a different semigroup than usual. For
+-- example, in order to replace any values in @qt1@ with those covered by
+-- @qt2@, we can use:
+--
+-- @
+-- 'combineAla' 'Data.Semigroup.Last' qt1 qt2
+-- @
+combineAla :: forall n a. (Coercible a n, Semigroup n)  => (a -> n) -> QuadTree a -> QuadTree a -> QuadTree a
+combineAla _ x y = coerce $ (coerce x :: QuadTree n) <> coerce y
+
+
diff --git a/src/Data/QuadTree/Internal.hs b/src/Data/QuadTree/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/QuadTree/Internal.hs
@@ -0,0 +1,157 @@
+{-# LANGUAGE PatternSynonyms      #-}
+{-# LANGUAGE RoleAnnotations      #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Data.QuadTree.Internal where
+
+import Control.Applicative (liftA2)
+import Data.Maybe (isJust)
+import Data.Monoid (Ap(..))
+import GHC.Generics (Generic)
+import Linear.V2
+import Linear.V4
+
+
+------------------------------------------------------------------------------
+-- | An axis-aligned bounding box in 3-space.
+data Rect a = Rect
+  { r_pos  :: !(V2 a)
+  , r_size :: !(V2 a)
+  }
+  deriving stock (Show, Read, Eq, Generic, Ord, Functor)
+
+
+------------------------------------------------------------------------------
+r_x, r_y, r_w, r_h :: Rect a -> a
+r_x (Rect (V2 x _) (V2 _ _)) = x
+r_y (Rect (V2 _ y) (V2 _ _)) = y
+r_w (Rect (V2 _ _) (V2 w _)) = w
+r_h (Rect (V2 _ _) (V2 _ h)) = h
+
+
+------------------------------------------------------------------------------
+-- | @'containsRect' c1 c2@ is true when @c2@ is inside or equal to @c1@.
+rectContainsRect :: (Num a, Ord a) => Rect a -> Rect a -> Bool
+rectContainsRect r1@(Rect (V2 bx by) (V2 bw bh)) r2@(Rect (V2 sx sy) (V2 sw sh)) =
+  r1 == r2 ||
+  and
+    [ bx <= sx
+    , by <= sy
+    , sx + sw <= bx + bw
+    , sy + sh <= by + bh
+    ]
+
+
+------------------------------------------------------------------------------
+-- | Does the rect contain a given point?
+rectContainsPoint :: (Ord a, Num a) => Rect a -> V2 a -> Bool
+rectContainsPoint (Rect _ (V2 w h)) _
+  | w <= 0 || h <= 0
+  = False
+rectContainsPoint (Rect (V2 x y) (V2 w h)) (V2 tx ty) =
+  and
+    [ x <= tx
+    , y <= ty
+    , tx < x + w
+    , ty < y + h
+    ]
+
+------------------------------------------------------------------------------
+-- | Get the co-ordinates of the corners of a 'Rect'.
+rectCorners :: Num a => Rect a -> V4 (V2 a)
+rectCorners (Rect (V2 x y) (V2 w h)) =
+  let p = V2 x y
+      dx = V2 w 0
+      dy = V2 0 h
+   in fmap (p +) $ V4 0   dx         dy       (dx + dy)
+
+
+------------------------------------------------------------------------------
+-- | 'Control.Monad.Free.Free', but with better instances.
+data Free a
+  = Fill a
+  | Split (V4 (Free a))
+  deriving (Functor, Foldable, Traversable, Generic)
+
+deriving via Ap Free a instance (Semigroup a) => Semigroup (Free a)
+deriving via Ap Free a instance (Monoid    a) => Monoid    (Free a)
+
+deriving stock instance (Show a) => Show (Free a)
+
+instance (Eq a) => Eq (Free a) where
+  Fill a   == Fill b    = a             == b
+  Split qu == Split qu' = qu            == qu'
+  Fill a   == Split qu  = pure (pure a) == qu
+  Split qu == Fill a    = pure (pure a) == qu
+
+instance Applicative Free where
+  pure = Fill
+  liftA2 fabc (Fill a) (Fill b) = Fill $ fabc a b
+  liftA2 fabc (Fill a) (Split qu) = Split $ fmap (fmap (fabc a)) qu
+  liftA2 fabc (Split qu) (Fill b) = Split $ fmap (fmap (flip  fabc b)) qu
+  liftA2 fabc (Split qu) (Split qu') = Split $ liftA2 (liftA2 fabc) qu qu'
+
+instance Monad Free where
+  Fill a >>= f = f a
+  Split qu >>= f = Split $ fmap (>>= f) qu
+
+
+------------------------------------------------------------------------------
+-- | Normalize a 'Rect' so it has a positive 'r_size'.
+normalize :: (Num a, Ord a) => Rect a -> Rect a
+normalize q@(Rect (V2 x y) (V2 w h))
+  | w < 0 = let w' = abs w in normalize $ Rect (V2 (x - w') y) $ V2 w' h
+  | h < 0 = let h' = abs h in normalize $ Rect (V2 x (y - h')) $ V2 w h'
+  | otherwise = q
+
+
+------------------------------------------------------------------------------
+-- | Do two 'Rect's intersect?
+intersects :: (Ord a, Num a) => Rect a -> Rect a -> Bool
+intersects r1 r2 = isJust $ getIntersect r1 r2
+
+
+------------------------------------------------------------------------------
+-- | Get the area of a 'Rect'.
+rectSize :: Num a => Rect a -> a
+rectSize (Rect _ (V2 w h)) = w * h
+
+
+------------------------------------------------------------------------------
+-- | Compute the intersection of two 'Rect's.
+getIntersect :: (Ord a, Num a) => Rect a -> Rect a -> Maybe (Rect a)
+getIntersect (normalize -> r1) (normalize -> r2)
+ | rectSize r1 == 0 = Just r1
+ | rectSize r2 == 0 = Just r2
+ | otherwise =
+  let x0 = max (r_x r1) (r_x r2)
+      y0 = max (r_y r1) (r_y r2)
+      x1 = min (r_x r1 + r_w r1) (r_x r2 + r_w r2)
+      y1 = min (r_y r1 + r_h r1) (r_y r2 + r_h r2)
+      w = x1 - x0
+      h = y1 - y0
+   in case 0 < w && 0 < h of
+        True -> Just $ Rect (V2 x0 y0) (V2 w h)
+        False -> Nothing
+
+
+unwrap :: Free a -> V4 (Free a)
+unwrap (Fill a) = pure $ pure a
+unwrap (Split qu) = qu
+
+
+------------------------------------------------------------------------------
+-- | Join together 'Split' constructors which all contain the same value.
+fuse :: Eq a => Free a -> Free a
+fuse (Fill a) = Fill a
+fuse (Split q) = doFuse $ fmap fuse q
+
+
+doFuse :: Eq a => V4 (Free a) -> Free a
+doFuse (V4 (Fill a) (Fill b) (Fill c) (Fill d))
+  | a == b
+  , b == c
+  , c == d
+  = Fill a
+doFuse q = Split q
+
diff --git a/src/Data/Semilattice.hs b/src/Data/Semilattice.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Semilattice.hs
@@ -0,0 +1,62 @@
+module Data.Semilattice where
+
+import           Data.Functor.Compose
+import           Data.Functor.Const
+import           Data.Functor.Product
+import qualified Data.HashMap.Monoidal as HashMap
+import           Data.Hashable (Hashable)
+import qualified Data.IntMap.Monoidal as LazyIntMap
+import qualified Data.IntMap.Monoidal.Strict as StrictIntMap
+import qualified Data.Map.Monoidal as LazyMap
+import qualified Data.Map.Monoidal.Strict as StrictMap
+import           Data.Monoid hiding (Product)
+import           Data.Semigroup hiding (Product)
+import           Data.Set (Set)
+import           GHC.Generics
+
+------------------------------------------------------------------------------
+-- | A 'Semilattice' is a 'Monoid' with the additional property that its
+-- @'(/\)' = '(<>)'@ operation is commutative and idempotent.  That is:
+--
+-- @
+-- a '/\' b = b '/\' a
+-- @
+--
+-- and
+--
+-- @
+-- a '/\' a = a
+-- @
+--
+-- These two properties ensure the internal representations of
+-- 'Data.QuadTree.QuadTree' and 'Data.OctTree.OctTree' can't leak out when
+-- performing spatial queries.
+class Monoid a => Semilattice a where
+  (/\) :: a -> a -> a
+  (/\) = (<>)
+
+instance Semilattice ()
+instance Semilattice Any
+instance Semilattice All
+instance (Ord a, Bounded a) => Semilattice (Max a)
+instance (Ord a, Bounded a) => Semilattice (Min a)
+instance Ord a => Semilattice (Set a)
+instance (Ord k, Semilattice a) => Semilattice (LazyMap.MonoidalMap k a)
+instance (Ord k, Semilattice a) => Semilattice (StrictMap.MonoidalMap k a)
+instance Semilattice a => Semilattice (LazyIntMap.MonoidalIntMap a)
+instance Semilattice a => Semilattice (StrictIntMap.MonoidalIntMap a)
+instance (Hashable k, Eq k, Semilattice a) => Semilattice (HashMap.MonoidalHashMap k a)
+instance Semilattice b => Semilattice (a -> b)
+instance Semilattice a => Semilattice (Maybe a)
+instance Semilattice a => Semilattice (Const a b)
+instance Semilattice a => Semilattice (K1 i a b)
+instance Semilattice (f a) => Semilattice (M1 i c f a)
+instance (Semilattice (f a), Semilattice (g a)) => Semilattice (Product f g a)
+instance (Semilattice (f (g a))) => Semilattice (Compose f g a)
+instance (Semilattice (f (g a))) => Semilattice ((:.:) f g a)
+instance (Semilattice (f a), Semilattice (g a)) => Semilattice ((:*:) f g a)
+instance (Semilattice a, Semilattice b) => Semilattice (a, b)
+instance (Semilattice a, Semilattice b, Semilattice c) => Semilattice (a, b, c)
+instance (Semilattice a, Semilattice b, Semilattice c, Semilattice d) => Semilattice (a, b, c, d)
+instance (Semilattice a, Semilattice b, Semilattice c, Semilattice d, Semilattice e) => Semilattice (a, b, c, d, e)
+
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"