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

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

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

flatten :: ResourceTree t -> [Flattened t]
flatten =
    go id id True
  where
    go names pieces check (ResourceLeaf r) = return Flattened
        { fNames = names [resourceName r]
        , fPieces = pieces (resourcePieces r)
        , fHasSuffix = hasSuffix $ ResourceLeaf r
        , fCheck = check && resourceCheck r
        }
    go names pieces check (ResourceParent newname check' newpieces children) =
        concatMap (go names' pieces' (check && check')) children
      where
        names' = names . (newname:)
        pieces' = pieces . (newpieces ++)

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

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

overlaps :: [Piece t] -> [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

-- Compare the actual pieces
overlaps (pieceX:xs) (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 . findOverlapsF . filter fCheck . concatMap Yesod.Routes.Overlap.flatten
  where
    go (OverlapF x y) =
        (go' x, go' y)
      where
        go' = intercalate "/"

findOverlapsF :: [Flattened t] -> [OverlapF]
findOverlapsF [] = []
findOverlapsF (x:xs) = concatMap (findOverlapF x) xs ++ findOverlapsF xs

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

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