diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2011, Scrive
+
+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 Scrive 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/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/happstack-static-routing.cabal b/happstack-static-routing.cabal
new file mode 100644
--- /dev/null
+++ b/happstack-static-routing.cabal
@@ -0,0 +1,43 @@
+Name:                happstack-static-routing
+Version:             0.1
+Synopsis: Support for static URL routing with overlap detection for Happstack.
+
+Description: If you have a large routing table in Happstack and want
+  to insert a new handler, you might run into overlap problems
+  (ambiguity).  The new handler might not fire because it matches
+  against a URL that is already handled earlier.  Or if you put your
+  new handler first, it might steal requests from existing handlers.
+
+  This Happstack support library allows you to detect overlap cases
+  and build unambiguous routing tables where the order of the handlers
+  is irrelevant.
+
+License:             BSD3
+License-file:        LICENSE
+Author:              Scrive
+Maintainer:          magnus@scrive.com
+Homepage:            https://github.com/carlssonia/happstack-static-routing
+Stability:           Development
+Category:            Web, Distributed Computing
+Build-type:          Simple
+Cabal-version:       >=1.6
+
+
+library
+  exposed-modules:
+     Happstack.StaticRouting
+
+  other-modules:
+     Happstack.StaticRouting.Internal
+
+  hs-source-dirs: src
+
+  build-depends: base >= 4 && <= 10
+  build-depends: happstack-server >= 6
+  build-depends: containers >= 0.3
+  build-depends: list-tries >= 0.4
+  build-depends: transformers >= 0.2
+
+source-repository head
+  type: git
+  location: git://github.com/carlssonia/happstack-static-routing.git
diff --git a/src/Happstack/StaticRouting.hs b/src/Happstack/StaticRouting.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/StaticRouting.hs
@@ -0,0 +1,32 @@
+{-# OPTIONS_HADDOCK prune #-}
+
+-- | Support for static routing tables in Happstack.  The routing
+-- tables are order independent as long as:
+--
+-- * if any two handlers overlap, one of them handles a more specific
+-- path than the other.  The more specific handler is then tried
+-- first.
+--
+-- Routing tables are constructed from 'dir', 'path', 'remainingPath',
+-- 'choice', and (for now) 'param'.
+--
+-- A routing table is compiled by using 'compile'.  The result is an
+-- overlap report, and a prefix tree that is used to efficiently
+-- dispatch requests by means of 'dispatch'.
+--
+-- See the file @src\/Happstack\/StaticRouting\/Test.hs@ in the distribution
+-- for examples.
+
+module Happstack.StaticRouting
+  ( Route
+  , compile
+  , choice
+  , dir
+  , path
+  , Path
+  , remainingPath
+  , param
+  , handler
+  ) where
+
+import Happstack.StaticRouting.Internal
diff --git a/src/Happstack/StaticRouting/Internal.hs b/src/Happstack/StaticRouting/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/StaticRouting/Internal.hs
@@ -0,0 +1,213 @@
+{-# LANGUAGE OverlappingInstances, FunctionalDependencies, ScopedTypeVariables,
+    MultiParamTypeClasses, FlexibleInstances, UndecidableInstances,
+    FlexibleContexts #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+module Happstack.StaticRouting.Internal where
+
+import Happstack.Server(askRq, rqPaths, rqMethod, localRq, ServerMonad,
+  HasRqData, methodM, look, FromReqURI)
+import qualified Happstack.Server as H
+import Control.Monad(msum, MonadPlus, mzero, mplus)
+import Control.Monad.IO.Class(MonadIO)
+import Control.Arrow(first, second)
+import qualified Data.ListTrie.Map as Trie
+import Data.Map(Map)
+import qualified Data.Map as Map
+import Data.List(intercalate)
+import Data.Maybe
+
+-- | Static routing tables consisting of handlers of type 'a'.
+data Route a =
+    Dir Segment (Route a)
+  | Handler EndSegment a
+  | Param String (Route a)
+  | Choice [Route a]
+
+-- For backwards compatibility with GHC 6.12
+handler :: EndSegment -> a -> Route a
+handler = Handler
+
+newtype Segment =
+    StringS String
+  deriving (Show, Eq, Ord)
+
+type EndSegment = (Maybe Int, H.Method)
+
+-- | Support for varying number of arguments to 'path' handlers.
+class Path m a b | a -> m b where
+  pathHandler :: (m b -> m c) -> a -> m c
+  arity :: a -> Int
+
+instance (FromReqURI d, ServerMonad m, MonadPlus m, Path m a b) => Path m (d -> a) b where
+  pathHandler w f = H.path (pathHandler w . f)
+  arity f = 1 + arity (f undefined)
+
+instance Path m (m b) b where
+  pathHandler w m = w m
+  arity _ = 0
+
+-- | Pop a path element if it matches the given string.
+dir :: String -> Route a -> Route a
+dir = Dir . StringS
+
+-- | Combine several route alternatives into one.
+choice :: [Route a] -> Route a
+choice = Choice
+
+-- | Expect the given method, and exactly 'n' more segments, where 'n' is the arity of the handler.
+path :: Path m h a => H.Method -> (m a -> m b) -> h -> Route (m b)
+path m w h = Handler (Just (arity h),m) (pathHandler w h)
+
+-- | Expect zero or more segments.
+remainingPath :: H.Method -> h -> Route h
+remainingPath m = Handler (Nothing,m)
+
+-- | DEPRECATED. Expect a specific parameter to be present.
+param :: String -> Route a -> Route a
+param = Param
+
+-- | Extract handler monad from a route.
+extract :: (ServerMonad m, MonadPlus m, HasRqData m, MonadIO m) => Route (m a) -> m a
+extract = f Nothing where
+  f p (Dir (StringS s) r) = H.dir s (f p r)
+  f (Just p) (Param p' _) = error $ "extract: cannot handle more than one param: "++ show(p,p')
+  f _ (Param p r) = f (Just p) r
+  f p (Handler (_,m) a) = doParam p >> methodM m >> a
+  f p (Choice rs) = msum (map (f p) rs)
+
+doParam :: (MonadIO m, HasRqData m, ServerMonad m, MonadPlus m) =>
+           Maybe String -> m ()
+doParam Nothing = return ()
+doParam (Just p) = H.getDataFn (look p) >>= either (const mzero) (const (return ()))
+
+type Param = Maybe String
+newtype RouteTree a =
+  R { unR :: Trie.TrieMap Map Segment (Map EndSegment (Map Param [a])) } deriving (Show)
+
+type Segments = ([Segment],EndSegment)
+
+routeTree :: (ServerMonad m, MonadPlus m) => Route (m a) -> RouteTree (m a)
+routeTree r = R $ foldr (\(((ps,es),mp),m) ->
+                          Trie.insertWith (Map.unionWith (Map.unionWith (++)))
+                              ps
+                              (Map.singleton es (Map.singleton mp [m])))
+                  Trie.empty (flatten r)
+
+flatten :: (ServerMonad m, MonadPlus m) => Route (m a) -> [((Segments, Param), m a)]
+flatten = f Nothing where
+  f p (Dir s r) = map (first (first (first (s:)))) (f p r)
+  f (Just p) (Param p' _) = error $ "flatten: cannot handle more than one param: "++show (p,p')
+  f _ (Param p' r) = f (Just p') r
+  f p (Handler e a) = [((([], e),p), a)]
+  f p (Choice rs) = concatMap (f p) rs
+
+-- | Compile routes, also return possible overlap report.  If the
+-- overlap report is 'Nothing', the routing table is order
+-- independent.  If the overlap report is @Just s@, then @s@ is a
+-- textual representation of all the paths that are order dependent,
+-- suitable for a warning message.
+compile :: (MonadIO m, HasRqData m, ServerMonad m, MonadPlus m) =>
+           Route (m a) -> (m a, Maybe String)
+compile r = ( dispatch t
+            , if null os then Nothing
+              else Just $ "Overlapping handlers: \n"++ showOverlaps os
+            )
+  where t = routeTree r
+        os = overlaps True t
+
+maybezero :: MonadPlus m => Maybe a -> (a -> m b) -> m b
+maybezero = flip (maybe mzero)
+
+-- | Dispatch a request given a route.  Give priority to more specific paths
+-- in case of overlap.
+dispatch :: (MonadIO m, HasRqData m, ServerMonad m, MonadPlus m) =>
+            RouteTree (m a) -> m a
+dispatch (R t) = do
+  let m = Trie.children1 t
+  rq  <- askRq
+  let ps = rqPaths rq
+  (case ps of
+      p:xs -> maybezero (Map.lookup (StringS p) m)
+                        (localRq (\newRq -> newRq{rqPaths = xs}) . dispatch . R)
+      []   -> mzero)
+    -- most specific: match against a given next segment
+    `mplus`
+    (maybezero (Trie.lookup [] t) $ \em ->
+     maybezero (Map.lookup (Just (length ps), rqMethod rq) em) dispatchParams
+    -- or else a 'path' taking a given specific number of remaining segments
+     `mplus`
+     maybezero (Map.lookup (Nothing, rqMethod rq) em) dispatchRemainingPath
+     -- least specific: a 'remainingPath' taking any number of remaining segments
+     )
+
+
+-- We want first to handle ones with params
+dispatchParams :: (MonadIO m, HasRqData m, ServerMonad m, MonadPlus m) =>
+                  Map (Maybe String) [m a] -> m a
+dispatchParams m = let
+                    (paramfull,paramless) = Map.partitionWithKey (const . isJust) m
+                   in msum $ [doParam p >> msum hs | (p,hs) <- Map.assocs paramfull] ++ [msum hs | (Nothing,hs) <- Map.assocs paramless]
+
+dispatchRemainingPath :: MonadPlus m => Map k [m a] -> m a
+dispatchRemainingPath m = msum (map msum (Map.elems m))
+
+-- | All paths with more than one handler.
+overlaps :: forall a .
+            Bool -- ^ Only include order-dependent paths (exclude paths overlapping with more specific paths)
+         -> RouteTree a -> [[([Segment],[(EndSegment,[(Param,[a])])])]]
+overlaps eso t = (filter (not . null) $
+                  map (filter (not . null . snd) . (:[]) . second f) $
+                  flattenTree t) ++
+                 if eso then [] else  pathOverlaps t
+  where f :: [(EndSegment,[(Param,[a])])] -> [(EndSegment,[(Param,[a])])]
+        f l = (filter (not . null . snd) . map (second g)) l
+        g l@((Nothing,_):_:_) | not eso = l  -- non-parameter handler overlaps with parameter handlers
+        g l = filter ((>1) . length . snd) l -- more than one handler for this path
+
+pathOverlaps :: RouteTree a -> [[([Segment], [(EndSegment, [(Param, [a])])])]]
+pathOverlaps (R t) =
+  (case Trie.lookup [] t of
+    Just em -> filter ((>1) . length) $ map f (Map.keys em)
+      where f es1 = filter ((>0) . length . snd)
+                    [ (ks, filter (lengthOverlaps es1 (length ks)) as)
+                    | (ks,as) <- flattenTree (R t) ]
+            lengthOverlaps (a1,m1) ksl ((a2,m2),_) =
+              m1 == m2 && case (a1,a2) of
+                            (Nothing,_) -> True
+                            (Just i1,Nothing) -> i1 >= ksl
+                            (Just i1,Just i2) -> i1 == ksl + i2
+
+    Nothing -> []) ++
+  [ [ (k:ks,a) | (ks,a) <- l ]
+  | (k,t') <- Map.assocs (Trie.children1 t)
+  , l <- pathOverlaps (R t') ]
+
+showOverlaps :: [[([Segment],[(EndSegment,[(Param,[a])])])]] -> String
+showOverlaps = unlines . intercalate [[]] . map (concatMap showPath)
+
+showPath :: ([Segment],[(EndSegment,[(Param,[a])])]) -> [String]
+showPath (ss,es) =
+  [ intercalate "/" (map showSegment ss++
+                     showArity i)++
+                     showParam p++showMethod m++
+                     showHandlers hs
+  | ((i,m),ps) <- es, (p,hs) <- ps ]
+  where showParam Nothing  = ""
+        showParam (Just p) = "?"++p++"=*"
+        showMethod H.GET = ""
+        showMethod m = " ("++show m++")"
+        showSegment (StringS s) = s
+        showArity Nothing = ["**"]
+        showArity (Just i) = replicate i "*"
+        showHandlers hs | length hs == 1 = ""
+                        | otherwise      = " -> "++show (length hs)
+
+-- | Convert to a list of path-value pairs.
+flattenTree :: RouteTree a -> [([Segment],[(EndSegment,[(Param,[a])])])]
+flattenTree (R t) =
+  (case Trie.lookup [] t of
+     Just em -> [([], map (second Map.assocs) (Map.assocs em))]
+     Nothing -> []) ++
+  [ (k:ks,a) | (k,t') <- Map.assocs (Trie.children1 t)
+             , (ks,a) <- flattenTree (R t') ]
