    -- | Check for overlapping routes.
    module Yesod.Routes.Overlap
        ( findOverlaps
        , findOverlapNames
        , Overlap (..)
        ) where

    import Yesod.Routes.TH.Types
    import Data.List (intercalate)

    data Overlap t = Overlap
        { overlapParents :: [String] -> [String] -- ^ parent resource trees
        , overlap1 :: ResourceTree t
        , overlap2 :: ResourceTree t
        }

    findOverlaps :: ([String] -> [String]) -> [ResourceTree t] -> [Overlap t]
    findOverlaps _ [] = []
    findOverlaps front (x:xs) = concatMap (findOverlap front x) xs ++ findOverlaps front xs

    findOverlap :: ([String] -> [String]) -> ResourceTree t -> ResourceTree t -> [Overlap t]
    findOverlap front x y =
        here rest
      where
        here
            | overlaps (resourceTreePieces x) (resourceTreePieces y) (hasSuffix x) (hasSuffix y) = (Overlap front x y:)
            | otherwise = id
        rest =
            case x of
                ResourceParent name _ children -> findOverlaps (front . (name:)) children
                ResourceLeaf{} -> []

    hasSuffix :: ResourceTree t -> Bool
    hasSuffix (ResourceLeaf r) =
        case resourceDispatch r of
            Subsite{} -> True
            Methods Just{} _ -> True
            Methods Nothing _ -> False
    hasSuffix ResourceParent{} = True

    overlaps :: [(CheckOverlap, Piece t)] -> [(CheckOverlap, Piece t)] -> Bool -> Bool -> Bool

    -- No pieces on either side, will overlap regardless of suffix
    overlaps [] [] _ _ = True

    -- No pieces on the left, will overlap if the left side has a suffix
    overlaps [] _ suffixX _ = suffixX

    -- Ditto for the right
    overlaps _ [] _ suffixY = suffixY

    -- As soon as we ignore a single piece (via CheckOverlap == False), we say that
    -- the routes don't overlap at all. In other words, disabling overlap checking
    -- on a single piece disables it on the whole route.
    overlaps ((False, _):_) _ _ _ = False
    overlaps _ ((False, _):_) _ _ = False

    -- Compare the actual pieces
    overlaps ((True, pieceX):xs) ((True, pieceY):ys) suffixX suffixY =
        piecesOverlap pieceX pieceY && overlaps xs ys suffixX suffixY

    piecesOverlap :: Piece t -> Piece t -> Bool
    -- Statics only match if they equal. Dynamics match with anything
    piecesOverlap (Static x) (Static y) = x == y
    piecesOverlap _ _ = True

    findOverlapNames :: [ResourceTree t] -> [(String, String)]
    findOverlapNames =
        map go . findOverlaps id
      where
        go (Overlap front x y) =
            (go' $ resourceTreeName x, go' $ resourceTreeName y)
          where
            go' = intercalate "/" . front . return