yesod-routes 1.2.0.3 → 1.2.0.4
raw patch · 4 files changed
+78/−18 lines, 4 files
Files
- Yesod/Routes/Overlap.hs +48/−12
- Yesod/Routes/Parse.hs +1/−1
- test/Hierarchy.hs +28/−4
- yesod-routes.cabal +1/−1
Yesod/Routes/Overlap.hs view
@@ -8,15 +8,42 @@ import Yesod.Routes.TH.Types import Data.List (intercalate) +data Flattened t = Flattened+ { fNames :: [String]+ , fPieces :: [(CheckOverlap, Piece t)]+ , fHasSuffix :: Bool+ }++flatten :: ResourceTree t -> [Flattened t]+flatten =+ go id id+ where+ go names pieces (ResourceLeaf r) = return Flattened+ { fNames = names [resourceName r]+ , fPieces = pieces (resourcePieces r)+ , fHasSuffix = hasSuffix $ ResourceLeaf r+ }+ go names pieces (ResourceParent newname newpieces children) =+ concatMap (go names' pieces') 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]+ }+ findOverlaps :: ([String] -> [String]) -> [ResourceTree t] -> [Overlap t] findOverlaps _ [] = [] findOverlaps front (x:xs) = concatMap (findOverlap front x) xs ++ findOverlaps front xs+{-# DEPRECATED findOverlaps "This function is no longer used" #-} findOverlap :: ([String] -> [String]) -> ResourceTree t -> ResourceTree t -> [Overlap t] findOverlap front x y =@@ -30,14 +57,6 @@ 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@@ -66,9 +85,26 @@ findOverlapNames :: [ResourceTree t] -> [(String, String)] findOverlapNames =- map go . findOverlaps id+ map go . findOverlapsF . concatMap Yesod.Routes.Overlap.flatten where- go (Overlap front x y) =- (go' $ resourceTreeName x, go' $ resourceTreeName y)+ go (OverlapF x y) =+ (go' x, go' y) where- go' = intercalate "/" . front . return+ 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
Yesod/Routes/Parse.hs view
@@ -29,7 +29,7 @@ let res = resourcesFromString s case findOverlapNames res of [] -> lift res- z -> error $ "Overlapping routes: " ++ unlines (map show z)+ z -> error $ unlines $ "Overlapping routes: " : map show z parseRoutesFile :: FilePath -> Q Exp parseRoutesFile = parseRoutesFileWith parseRoutes
test/Hierarchy.hs view
@@ -71,7 +71,6 @@ -> App sub master runHandler h Env {..} route _ = (toText h, fmap envToMaster route) - data Hierarchy = Hierarchy do@@ -79,13 +78,29 @@ / HomeR GET /admin/#Int AdminR:- / AdminRootR GET- /login LoginR GET POST- /table/#Text TableR GET+ / AdminRootR GET+ /login LoginR GET POST+ /table/#Text TableR GET /nest/ NestR: /spaces SpacedR GET++ /nest2 Nest2:+ /get Get2 GET+ /post Post2 POST+-- /#Int Delete2 DELETE+ /nest3 Nest3:+ /get Get3 GET+ /post Post3 POST+-- /#Int Delete3 DELETE++/afterwards AfterR:+ / After GET++-- /trailing-nest TrailingNestR:+-- /foo TrailingFooR GET+-- /#Int TrailingIntR GET |] rrinst <- mkRenderRouteInstance (ConT ''Hierarchy) $ map (fmap parseType) resources@@ -112,6 +127,15 @@ getSpacedR :: Handler site String getSpacedR = "root-leaf"++getGet2 :: Handler site String; getGet2 = "get"+postPost2 :: Handler site String; postPost2 = "post"+deleteDelete2 :: Int -> Handler site String; deleteDelete2 = const "delete"+getGet3 :: Handler site String; getGet3 = "get"+postPost3 :: Handler site String; postPost3 = "post"+deleteDelete3 :: Int -> Handler site String; deleteDelete3 = const "delete"++getAfter :: Handler site String; getAfter = "after" getHomeR :: Handler site String getHomeR = "home"
yesod-routes.cabal view
@@ -1,5 +1,5 @@ name: yesod-routes-version: 1.2.0.3+version: 1.2.0.4 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>