wai-routes 0.9.10 → 0.10.0
raw patch · 10 files changed
+83/−41 lines, 10 filesdep −wai-app-staticdep ~aesonPVP ok
version bump matches the API change (PVP)
Dependencies removed: wai-app-static
Dependency ranges changed: aeson
API changes (from Hackage documentation)
Files
- README.md +2/−1
- src/Routes/Parse.hs +36/−9
- src/Routes/TH/ParseRoute.hs +2/−1
- src/Routes/TH/RenderRoute.hs +9/−5
- src/Routes/TH/RouteAttrs.hs +8/−4
- src/Routes/TH/Types.hs +2/−2
- src/Wai/Routes.hs +0/−6
- test/HelloSpec.hs +19/−6
- test/static/lambda.png binary
- wai-routes.cabal +5/−7
README.md view
@@ -1,4 +1,4 @@-[Wai-Routes](https://ajnsit.github.io/wai-routes) [](https://hackage.haskell.org/package/wai-routes) [](http://packdeps.haskellers.com/feed?needle=wai-routes) [](https://travis-ci.org/ajnsit/wai-routes) [](https://gitter.im/ajnsit/wai-routes)+[Wai-Routes](https://ajnsit.github.io/wai-routes) [](https://hackage.haskell.org/package/wai-routes) [](http://packdeps.haskellers.com/feed?needle=wai-routes) [](https://travis-ci.org/ajnsit/wai-routes) [](https://gitter.im/ajnsit/wai-routes) ==================================== Wai-routes is a micro web framework for Haskell that focuses on typesafe URLs.@@ -114,6 +114,7 @@ Changelog ========= +* 0.10.0: Allow aeson v1.2. Routing improvements. Remove wai-app-static dependency. Add nix expression. * 0.9.10: Aeson and hspec version bump. * 0.9.9 : GHC 8 compatibility. Change namespace from Network.Wai.Middleware.Routes -> Wai.Routes * 0.9.8 : Allow Data.Default-0.1.0. Allow comments in route definitions. Some other minor changes.
src/Routes/Parse.hs view
@@ -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 Routes.TH@@ -58,12 +58,12 @@ { quoteExp = lift . resourcesFromString } --- | Convert a multi-line string to a set of resources. See documentation for+-- | Converts a multi-line string to a set of resources. See documentation for -- the format of this string. This is a partial function which calls 'error' on -- invalid input. resourcesFromString :: String -> [ResourceTree String] resourcesFromString =- fst . parse 0 . filter (not . all (== ' ')) . lines+ fst . parse 0 . filter (not . all (== ' ')) . lines . filter (/= '\r') where parse _ [] = ([], []) parse indent (thisLine:otherLines)@@ -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?
src/Routes/TH/ParseRoute.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TemplateHaskell, CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} module Routes.TH.ParseRoute ( -- ** ParseRoute mkParseRouteInstance
src/Routes/TH/RenderRoute.hs view
@@ -46,7 +46,9 @@ mkRouteCon (ResourceParent name _check pieces children) = do (cons, decs) <- mkRouteCons children-#if MIN_VERSION_template_haskell(2,11,0)+#if MIN_VERSION_template_haskell(2,12,0)+ dec <- DataD [] (mkName name) [] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT [''Show, ''Read, ''Eq])+#elif MIN_VERSION_template_haskell(2,11,0) dec <- DataD [] (mkName name) [] Nothing cons <$> mapM conT [''Show, ''Read, ''Eq] #else let dec = DataD [] (mkName name) [] cons [''Show, ''Read, ''Eq]@@ -55,7 +57,7 @@ where con = NormalC (mkName name) $ map (\x -> (notStrict, x))- $ concat [singles, [ConT $ mkName name]]+ $ singles ++ [ConT $ mkName name] singles = concatMap toSingle pieces toSingle Static{} = []@@ -99,7 +101,7 @@ dyns <- replicateM cnt $ newName "dyn" sub <- case resourceDispatch res of- Subsite{} -> fmap return $ newName "sub"+ Subsite{} -> return <$> newName "sub" _ -> return [] let pat = ConP (mkName $ resourceName res) $ map VarP $ dyns ++ sub @@ -136,7 +138,7 @@ mkPieces _ _ [] _ = [] mkPieces toText tsp (Static s:ps) dyns = toText s : mkPieces toText tsp ps dyns mkPieces toText tsp (Dynamic{}:ps) (d:dyns) = tsp `AppE` VarE d : mkPieces toText tsp ps dyns- mkPieces _ _ ((Dynamic _) : _) [] = error "mkPieces 120"+ mkPieces _ _ (Dynamic _ : _) [] = error "mkPieces 120" -- | Generate the 'RenderRoute' instance. --@@ -153,7 +155,9 @@ mkRenderRouteInstance' cxt typ ress = do cls <- mkRenderRouteClauses ress (cons, decs) <- mkRouteCons ress-#if MIN_VERSION_template_haskell(2,11,0)+#if MIN_VERSION_template_haskell(2,12,0)+ did <- DataInstD [] ''Route [typ] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT clazzes)+#elif MIN_VERSION_template_haskell(2,11,0) did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT clazzes #else let did = DataInstD [] ''Route [typ] cons clazzes
src/Routes/TH/RouteAttrs.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TemplateHaskell, CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RecordWildCards #-} module Routes.TH.RouteAttrs ( mkRouteAttrsInstance@@ -9,6 +10,9 @@ import Language.Haskell.TH.Syntax import Data.Set (fromList) import Data.Text (pack)+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif mkRouteAttrsInstance :: Type -> [ResourceTree a] -> Q Dec mkRouteAttrsInstance typ ress = do@@ -18,11 +22,11 @@ ] goTree :: (Pat -> Pat) -> ResourceTree a -> Q [Clause]-goTree front (ResourceLeaf res) = fmap return $ goRes front res+goTree front (ResourceLeaf res) = return <$> goRes front res goTree front (ResourceParent name _check pieces trees) =- fmap concat $ mapM (goTree front') trees+ concat <$> mapM (goTree front') trees where- ignored = ((replicate toIgnore WildP ++) . return)+ ignored = (replicate toIgnore WildP ++) . return toIgnore = length $ filter isDynamic pieces isDynamic Dynamic{} = True isDynamic Static{} = False
src/Routes/TH/Types.hs view
@@ -53,11 +53,11 @@ deriving Show instance Functor Piece where- fmap _ (Static s) = (Static s)+ fmap _ (Static s) = Static s fmap f (Dynamic t) = Dynamic (f t) instance Lift t => Lift (Piece t) where- lift (Static s) = [|Static $(lift s)|]+ lift (Static s) = [|Static $(lift s)|] lift (Dynamic t) = [|Dynamic $(lift t)|] data Dispatch typ =
src/Wai/Routes.hs view
@@ -109,15 +109,10 @@ -- * Bare Handlers , Env(..)- , RequestData -- | An abstract representation of the request data. You can get the wai request object by using `waiReq`- , waiReq -- | Extract the wai `Request` object from `RequestData`- , nextApp -- | Extract the next Application in the stack , currentRoute -- | Extract the current `Route` from `RequestData`- , runNext -- | Run the next application in the stack , module Network.HTTP.Types.Status , module Network.Wai.Middleware.RequestLogger- , module Network.Wai.Application.Static ) where @@ -126,4 +121,3 @@ import Routes.Handler import Network.HTTP.Types.Status import Network.Wai.Middleware.RequestLogger-import Network.Wai.Application.Static
test/HelloSpec.hs view
@@ -20,11 +20,12 @@ data SubRoute = SubRoute Text -class MasterContract master where+class RenderRoute master => MasterContract master where getMasterName :: master -> Text mkRouteSub "SubRoute" "MasterContract" [parseRoutes|-/ SubHomeR GET+/ SubHomeR GET+/route SubRouteR GET |] getSubHomeR :: MasterContract master => HandlerS SubRoute master@@ -33,6 +34,11 @@ m <- master plain $ T.concat ["subsite-", s, "-", getMasterName m] +getSubRouteR :: MasterContract master => HandlerS SubRoute master+getSubRouteR = runHandlerM $ do+ showRouteS <- showRouteSub+ plain $ T.concat ["this route as sub:", showRouteS SubRouteR, ", this route as master:", showRoute SubRouteR]+ getSubRoute :: master -> Text -> SubRoute getSubRoute = const SubRoute @@ -92,7 +98,10 @@ application = return $ waiApp $ do handler handleInfoRequest route MyRoute- catchall $ staticApp $ defaultFileServerSettings "test/static"+ handler $ runHandlerM $ do+ Just (DefaultRoute (route,_)) <- maybeRoute+ plain $ T.pack $ show route+ -- catchall $ plain "This will never be reached" ---- THE TESTS ----@@ -123,6 +132,10 @@ it "can access the subsite correctly" $ get "/subsite" `shouldRespondWith` "subsite-default-MyRoute" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]} + describe "GET /subsite/route" $+ it "can handle routing across subsite correctly" $+ get "/subsite/route" `shouldRespondWith` "this route as sub:/subsite/route, this route as master:/route" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]}+ describe "GET /nested" $ it "can access nested routes root correctly" $ get "/nested" `shouldRespondWith` "Nested ROOT" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]}@@ -139,6 +152,6 @@ it "can pass route arguments to the nested subsite correctly" $ get "/nested/nested2/nested3/helloworld/argsub" `shouldRespondWith` "subsite-helloworld-MyRoute" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]} - describe "GET /lambda.png" $- it "returns a file correctly" $- get "/lambda.png" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "image/png"]}+ describe "GET /does/not/exist" $+ it "handles catch all routes correctly" $+ get "/does/not/exist" `shouldRespondWith` "[\"does\",\"not\",\"exist\"]" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]}
− test/static/lambda.png
binary file changed (3056 → absent bytes)
wai-routes.cabal view
@@ -1,5 +1,5 @@ name : wai-routes-version : 0.9.10+version : 0.10.0 cabal-version : >=1.18 build-type : Simple license : MIT@@ -13,7 +13,6 @@ author : Anupam Jain data-dir : "" extra-source-files : README.md- , test/static/lambda.png source-repository head type : git@@ -21,18 +20,17 @@ source-repository this type : git- location : http://github.com/ajnsit/wai-routes/tree/v0.9.10- tag : v0.9.10+ location : http://github.com/ajnsit/wai-routes/tree/v0.10.0+ tag : v0.10.0 library build-depends : base >= 4.7 && < 4.10 , wai >= 3.0 && < 3.3 , wai-extra >= 3.0 && < 3.1- , wai-app-static >= 3.0 && < 3.2 , text >= 1.2 && < 1.3 , template-haskell >= 2.9 && < 2.12 , mtl >= 2.1 && < 2.3- , aeson >= 0.8 && < 1.2+ , aeson >= 0.8 && < 1.3 , containers >= 0.5 && < 0.6 , random >= 1.1 && < 1.2 , path-pieces >= 0.2 && < 0.3@@ -78,7 +76,7 @@ build-depends : base >= 4.7 && < 4.10 , wai >= 3.0 && < 3.3- , aeson >= 0.8 && < 1.2+ , aeson >= 0.8 && < 1.3 , hspec >= 2.1 && < 2.5 , hspec-wai >= 0.6 && < 0.9 , hspec-wai-json >= 0.6 && < 0.9