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

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

    data Flattened t = Flattened
        { forall t. Flattened t -> [String]
    fNames :: [String]
        , forall t. Flattened t -> [Piece t]
    fPieces :: [Piece t]
        , forall t. Flattened t -> Bool
    fHasSuffix :: Bool
        , forall t. Flattened t -> Bool
    fCheck :: CheckOverlap
        }

    flatten :: ResourceTree t -> [Flattened t]
    flatten :: forall t. ResourceTree t -> [Flattened t]
    flatten =
        ([String] -> [String])
    -> ([Piece t] -> [Piece t])
    -> Bool
    -> ResourceTree t
    -> [Flattened t]
    forall {typ} {t}.
    ([String] -> [String])
    -> ([Piece typ] -> [Piece t])
    -> Bool
    -> ResourceTree typ
    -> [Flattened t]
    go [String] -> [String]
    forall a. a -> a
    id [Piece t] -> [Piece t]
    forall a. a -> a
    id Bool
    True
      where
        go :: ([String] -> [String])
    -> ([Piece typ] -> [Piece t])
    -> Bool
    -> ResourceTree typ
    -> [Flattened t]
    go [String] -> [String]
    names [Piece typ] -> [Piece t]
    pieces Bool
    check (ResourceLeaf Resource typ
    r) = Flattened t -> [Flattened t]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return Flattened
            { fNames :: [String]
    fNames = [String] -> [String]
    names [Resource typ -> String
    forall typ. Resource typ -> String
    resourceName Resource typ
    r]
            , fPieces :: [Piece t]
    fPieces = [Piece typ] -> [Piece t]
    pieces (Resource typ -> [Piece typ]
    forall typ. Resource typ -> [Piece typ]
    resourcePieces Resource typ
    r)
            , fHasSuffix :: Bool
    fHasSuffix = ResourceTree typ -> Bool
    forall t. ResourceTree t -> Bool
    hasSuffix (ResourceTree typ -> Bool) -> ResourceTree typ -> Bool
    forall a b. (a -> b) -> a -> b
    $ Resource typ -> ResourceTree typ
    forall typ. Resource typ -> ResourceTree typ
    ResourceLeaf Resource typ
    r
            , fCheck :: Bool
    fCheck = Bool
    check Bool -> Bool -> Bool
    && Resource typ -> Bool
    forall typ. Resource typ -> Bool
    resourceCheck Resource typ
    r
            }
        go [String] -> [String]
    names [Piece typ] -> [Piece t]
    pieces Bool
    check (ResourceParent String
    newname Bool
    check' [Piece typ]
    newpieces [ResourceTree typ]
    children) =
            (ResourceTree typ -> [Flattened t])
    -> [ResourceTree typ] -> [Flattened t]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (([String] -> [String])
    -> ([Piece typ] -> [Piece t])
    -> Bool
    -> ResourceTree typ
    -> [Flattened t]
    go [String] -> [String]
    names' [Piece typ] -> [Piece t]
    pieces' (Bool
    check Bool -> Bool -> Bool
    && Bool
    check')) [ResourceTree typ]
    children
          where
            names' :: [String] -> [String]
    names' = [String] -> [String]
    names ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    newnameString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :)
            pieces' :: [Piece typ] -> [Piece t]
    pieces' = [Piece typ] -> [Piece t]
    pieces ([Piece typ] -> [Piece t])
    -> ([Piece typ] -> [Piece typ]) -> [Piece typ] -> [Piece t]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Piece typ]
    newpieces [Piece typ] -> [Piece typ] -> [Piece typ]
    forall a. [a] -> [a] -> [a]
    ++)

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

    data OverlapF = OverlapF
        { OverlapF -> [String]
    _overlapF1 :: [String]
        , OverlapF -> [String]
    _overlapF2 :: [String]
        }

    overlaps :: [Piece t] -> [Piece t] -> Bool -> Bool -> Bool

    -- No pieces on either side, will overlap regardless of suffix
    overlaps :: forall t. [Piece t] -> [Piece t] -> Bool -> Bool -> Bool
    overlaps [] [] Bool
    _ Bool
    _ = Bool
    True

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

    -- Ditto for the right
    overlaps [Piece t]
    _ [] Bool
    _ Bool
    suffixY = Bool
    suffixY

    -- Compare the actual pieces
    overlaps (Piece t
    pieceX:[Piece t]
    xs) (Piece t
    pieceY:[Piece t]
    ys) Bool
    suffixX Bool
    suffixY =
        Piece t -> Piece t -> Bool
    forall t. Piece t -> Piece t -> Bool
    piecesOverlap Piece t
    pieceX Piece t
    pieceY Bool -> Bool -> Bool
    && [Piece t] -> [Piece t] -> Bool -> Bool -> Bool
    forall t. [Piece t] -> [Piece t] -> Bool -> Bool -> Bool
    overlaps [Piece t]
    xs [Piece t]
    ys Bool
    suffixX Bool
    suffixY

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

    findOverlapNames :: [ResourceTree t] -> [(String, String)]
    findOverlapNames :: forall t. [ResourceTree t] -> [(String, String)]
    findOverlapNames =
        (OverlapF -> (String, String)) -> [OverlapF] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map OverlapF -> (String, String)
    go ([OverlapF] -> [(String, String)])
    -> ([ResourceTree t] -> [OverlapF])
    -> [ResourceTree t]
    -> [(String, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Flattened t] -> [OverlapF]
    forall t. [Flattened t] -> [OverlapF]
    findOverlapsF ([Flattened t] -> [OverlapF])
    -> ([ResourceTree t] -> [Flattened t])
    -> [ResourceTree t]
    -> [OverlapF]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Flattened t -> Bool) -> [Flattened t] -> [Flattened t]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Flattened t -> Bool
    forall t. Flattened t -> Bool
    fCheck ([Flattened t] -> [Flattened t])
    -> ([ResourceTree t] -> [Flattened t])
    -> [ResourceTree t]
    -> [Flattened t]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ResourceTree t -> [Flattened t])
    -> [ResourceTree t] -> [Flattened t]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ResourceTree t -> [Flattened t]
    forall t. ResourceTree t -> [Flattened t]
    Yesod.Routes.Overlap.flatten
      where
        go :: OverlapF -> (String, String)
    go (OverlapF [String]
    x [String]
    y) =
            ([String] -> String
    go' [String]
    x, [String] -> String
    go' [String]
    y)
          where
            go' :: [String] -> String
    go' = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "/"

    findOverlapsF :: [Flattened t] -> [OverlapF]
    findOverlapsF :: forall t. [Flattened t] -> [OverlapF]
    findOverlapsF [] = []
    findOverlapsF (Flattened t
    x:[Flattened t]
    xs) = (Flattened t -> [OverlapF]) -> [Flattened t] -> [OverlapF]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Flattened t -> Flattened t -> [OverlapF]
    forall t. Flattened t -> Flattened t -> [OverlapF]
    findOverlapF Flattened t
    x) [Flattened t]
    xs [OverlapF] -> [OverlapF] -> [OverlapF]
    forall a. [a] -> [a] -> [a]
    ++ [Flattened t] -> [OverlapF]
    forall t. [Flattened t] -> [OverlapF]
    findOverlapsF [Flattened t]
    xs

    findOverlapF :: Flattened t -> Flattened t -> [OverlapF]
    findOverlapF :: forall t. Flattened t -> Flattened t -> [OverlapF]
    findOverlapF Flattened t
    x Flattened t
    y
        | [Piece t] -> [Piece t] -> Bool -> Bool -> Bool
    forall t. [Piece t] -> [Piece t] -> Bool -> Bool -> Bool
    overlaps (Flattened t -> [Piece t]
    forall t. Flattened t -> [Piece t]
    fPieces Flattened t
    x) (Flattened t -> [Piece t]
    forall t. Flattened t -> [Piece t]
    fPieces Flattened t
    y) (Flattened t -> Bool
    forall t. Flattened t -> Bool
    fHasSuffix Flattened t
    x) (Flattened t -> Bool
    forall t. Flattened t -> Bool
    fHasSuffix Flattened t
    y) = [[String] -> [String] -> OverlapF
    OverlapF (Flattened t -> [String]
    forall t. Flattened t -> [String]
    fNames Flattened t
    x) (Flattened t -> [String]
    forall t. Flattened t -> [String]
    fNames Flattened t
    y)]
        | Bool
    otherwise = []

    hasSuffix :: ResourceTree t -> Bool
    hasSuffix :: forall t. ResourceTree t -> Bool
    hasSuffix (ResourceLeaf Resource t
    r) =
        case Resource t -> Dispatch t
    forall typ. Resource typ -> Dispatch typ
    resourceDispatch Resource t
    r of
            Subsite{} -> Bool
    True
            Methods Just{} [String]
    _ -> Bool
    True
            Methods Maybe t
    Nothing [String]
    _ -> Bool
    False
    hasSuffix ResourceParent{} = Bool
    True