yesod-core 1.4.32 → 1.4.33

raw patch · 5 files changed

+46/−9 lines, 5 files

Files

• ChangeLog.md +4/−0
• Yesod/Routes/Parse.hs +34/−7
• test/RouteSpec.hs +3/−1
• test/YesodCoreTest/Links.hs +4/−0
• yesod-core.cabal +1/−1

@@ -1,3 +1,7 @@+## 1.4.33++* Adds curly brackets to route parser. [#1363](https://github.com/yesodweb/yesod/pull/1363)+ ## 1.4.32  * Fix warnings

@@ -13,7 +13,7 @@     ) where  import Language.Haskell.TH.Syntax-import Data.Char (isUpper)+import Data.Char (isUpper, isSpace) import Language.Haskell.TH.Quote import qualified System.IO as SIO import Yesod.Routes.TH@@ -86,7 +86,7 @@         spaces = takeWhile (== ' ') thisLine         (others, remainder) = parse indent otherLines'         (this, otherLines') =-            case takeWhile (not . isPrefixOf "--") $ words thisLine of+            case takeWhile (not . isPrefixOf "--") $ splitSpaces thisLine of                 (pattern:rest0)                     | Just (constr:rest) <- stripColonLast rest0                     , Just attrs <- mapM parseAttr rest ->@@ -102,6 +102,26 @@                 [] -> (id, otherLines)                 _ -> error $ "Invalid resource line: " ++ thisLine +-- | Splits a string by spaces, as long as the spaces are not enclosed by curly brackets (not recursive).+splitSpaces :: String -> [String]+splitSpaces "" = []+splitSpaces str = +    let (rest, piece) = parse $ dropWhile isSpace str in+    piece:(splitSpaces rest)++    where +        parse :: String -> ( String, String)+        parse ('{':s) = fmap ('{':) $ parseBracket s+        parse (c:s) | isSpace c = (s, [])+        parse (c:s) = fmap (c:) $ parse s+        parse "" = ("", "")++        parseBracket :: String -> ( String, String)+        parseBracket ('{':_) = error $ "Invalid resource line (nested curly bracket): " ++ str+        parseBracket ('}':s) = fmap ('}':) $ parse s+        parseBracket (c:s) = fmap (c:) $ parseBracket s+        parseBracket "" = error $ "Invalid resource line (unclosed curly bracket): " ++ str+ piecesFromStringCheck :: String -> ([Piece String], Maybe String, Bool) piecesFromStringCheck s0 =     (pieces, mmulti, check)@@ -181,7 +201,7 @@ parseTypeTree orig =     toTypeTree pieces   where-    pieces = filter (not . null) $ splitOn '-' $ addDashes orig+    pieces = filter (not . null) $ splitOn (\c -> c == '-' || c == ' ') $ addDashes orig     addDashes [] = []     addDashes (x:xs) =         front $ addDashes xs@@ -194,7 +214,7 @@             _:y -> x : splitOn c y             [] -> [x]       where-        (x, y') = break (== c) s+        (x, y') = break c s  data TypeTree = TTTerm String               | TTApp TypeTree TypeTree@@ -237,9 +257,9 @@ ttToType (TTList t) = ListT `AppT` ttToType t  pieceFromString :: String -> Either (CheckOverlap, String) (CheckOverlap, Piece String)-pieceFromString ('#':'!':x) = Right $ (False, Dynamic x)-pieceFromString ('!':'#':x) = Right $ (False, Dynamic x) -- https://github.com/yesodweb/yesod/issues/652-pieceFromString ('#':x) = Right $ (True, Dynamic x)+pieceFromString ('#':'!':x) = Right $ (False, dynamicPieceFromString x)+pieceFromString ('!':'#':x) = Right $ (False, dynamicPieceFromString x) -- https://github.com/yesodweb/yesod/issues/652+pieceFromString ('#':x) = Right $ (True, dynamicPieceFromString x)  pieceFromString ('*':'!':x) = Left (False, x) pieceFromString ('+':'!':x) = Left (False, x)@@ -252,3 +272,10 @@  pieceFromString ('!':x) = Right $ (False, Static x) pieceFromString x = Right $ (True, Static x)++dynamicPieceFromString :: String -> Piece String+dynamicPieceFromString str@('{':x) = case break (== '}') x of+    (s, "}") -> Dynamic s+    _ -> error $ "Invalid path piece: " ++ str+dynamicPieceFromString x = Dynamic x+-- JP: Should we check if there are curly brackets or other invalid characters?

@@ -322,7 +322,7 @@         it "hierarchy" $ do             routeAttrs (ParentR (pack "ignored") ChildR) @?= Set.singleton (pack "child")     hierarchy-    describe "parseRouteTyoe" $ do+    describe "parseRouteType" $ do         let success s t = it s $ parseTypeTree s @?= Just t             failure s = it s $ parseTypeTree s @?= Nothing         success "Int" $ TTTerm "Int"@@ -334,6 +334,8 @@         success "[Int]" $ TTList $ TTTerm "Int"         success "Foo-Bar" $ TTApp (TTTerm "Foo") (TTTerm "Bar")         success "Foo-Bar-Baz" $ TTApp (TTTerm "Foo") (TTTerm "Bar") `TTApp` TTTerm "Baz"+        success "Foo Bar" $ TTApp (TTTerm "Foo") (TTTerm "Bar")+        success "Foo Bar Baz" $ TTApp (TTTerm "Foo") (TTTerm "Bar") `TTApp` TTTerm "Baz"  getRootR :: Text getRootR = pack "this is the root"

@@ -25,6 +25,7 @@ /route-test-2/*Vector-String RT2 GET /route-test-3/*Vector-(Maybe-Int) RT3 GET /route-test-4/#(Foo-Int-Int) RT4 GET+/route-test-4-spaces/#{Foo Int Int} RT4Spaces GET |]  data Vector a = Vector@@ -63,6 +64,9 @@  getRT4 :: Foo Int Int -> Handler () getRT4 _ = return ()++getRT4Spaces :: Foo Int Int -> Handler ()+getRT4Spaces _ = return ()  linksTest :: Spec linksTest = describe "Test.Links" $ do

@@ -1,5 +1,5 @@ name:            yesod-core-version:         1.4.32+version:         1.4.33 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>