diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[Wai-Routes](https://ajnsit.github.io/wai-routes) [![Hackage](https://img.shields.io/badge/hackage-v0.10.0-brightgreen.svg)](https://hackage.haskell.org/package/wai-routes) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/wai-routes.svg)](http://packdeps.haskellers.com/feed?needle=wai-routes) [![Build Status](https://img.shields.io/travis/ajnsit/wai-routes.svg)](https://travis-ci.org/ajnsit/wai-routes) [![Join the chat at https://gitter.im/ajnsit/wai-routes](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%A3-blue.svg)](https://gitter.im/ajnsit/wai-routes) +[Wai-Routes](https://ajnsit.github.io/wai-routes) [![Hackage](https://img.shields.io/badge/hackage-v0.10.1-brightgreen.svg)](https://hackage.haskell.org/package/wai-routes) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/wai-routes.svg)](http://packdeps.haskellers.com/feed?needle=wai-routes) [![Build Status](https://img.shields.io/travis/ajnsit/wai-routes.svg)](https://travis-ci.org/ajnsit/wai-routes) [![Join the chat at https://gitter.im/ajnsit/wai-routes](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%A3-blue.svg)](https://gitter.im/ajnsit/wai-routes) ==================================== Wai-routes is a micro web framework for Haskell that focuses on typesafe URLs. @@ -57,23 +57,27 @@ A simple example of how to generate HTML/CSS/JS using shakespearean templates. You can use both external and inline templates. -**Example 5. Building a JSON REST Service** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/rest-json/src) +**Example 5. Using Digestive Functors and Hamlet** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/digestive-functors-hamlet/src) +An example of using digestive functors for form handling and hamlet for templating. It demonstrates composing nested forms with validation, nested views defined in hamlet templates, and how to wire it together with wai-routes. + +**Example 6. Building a JSON REST Service** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/rest-json/src) + Provides a simple example of how to build JSON REST services with wai-routes. Uses Aeson for JSON conversion. Note that this example just demonstrates the web facing side of the application. It doesn't permanently persist data, and is also not threadsafe. You must use a more robust data storage mechanism in production! An example of doing this with a Relational DB adapter (like persistent) is in the works. -**Example 6. Stream a response** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/streaming-response/src) +**Example 7. Stream a response** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/streaming-response/src) Wai has had the ability to stream content for a long time. Now wai-routes exposes this functionality with the `stream` function. This example shows how to stream content in a handler. Note that most browsers using default settings will not show content as it is being streamed. You can use "curl" to observe the effect of streaming. E.g. - `curl localhost:8080` will dump the data as it is being streamed from the server. -**Example 7. Kitchen sink** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/kitchen/src) +**Example 8. Kitchen sink** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/kitchen/src) *Work in progress*. Demonstrates all major features in wai-routes. -**Example 8. Unrouted** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/unrouted/src) +**Example 9. Unrouted** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/unrouted/src) Demonstrates "unrouted" applications. These require no TH, or GHC extensions. Basically allow you to sequence request handlers in a cascade, with each handler having the full functionality of HandlerM monad available to them. Each handler also has access to untyped (but parsed) route information. Unrouted handlers are freely mixable with typesafe routing. -**Example 9. Typesafe "Bare" Wai routing** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/bare-wai/src) +**Example 10. Typesafe "Bare" Wai routing** - [Code](https://github.com/ajnsit/wai-routes/tree/master/examples/bare-wai/src) Demonstrates writing no-overhead "bare" wai applications with routing. Wai-routes handlers are simple functions that return wai responses. This means that you are free to use typesafe routing, but without using runHandlerM, instead accessing the master datatype and the route args as arguments passed to the handler function. @@ -103,7 +107,6 @@ The following features are planned for later releases - -- Support for raw network responses (see http://hackage.haskell.org/package/wai-3.0.3.0/docs/Network-Wai.html#v:responseRaw) - Seamless websocket support - Development mode - Scaffolding @@ -114,6 +117,7 @@ Changelog ========= +* 0.10.1: Compatibility with template-haskell 2.12. * 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 diff --git a/src/Routes/Parse.hs b/src/Routes/Parse.hs --- a/src/Routes/Parse.hs +++ b/src/Routes/Parse.hs @@ -13,7 +13,7 @@ ) where import Language.Haskell.TH.Syntax -import Data.Char (isUpper, isSpace) +import Data.Char (isUpper, isLower, isSpace) import Language.Haskell.TH.Quote import qualified System.IO as SIO import Routes.TH @@ -252,14 +252,18 @@ gos' (front . (t:)) xs' ttToType :: TypeTree -> Type -ttToType (TTTerm s) = ConT $ mkName s +ttToType (TTTerm s) = nameToType s ttToType (TTApp x y) = ttToType x `AppT` ttToType y ttToType (TTList t) = ListT `AppT` ttToType t +nameToType :: String -> Type +nameToType t@(h:_) | isLower h = VarT $ mkName t +nameToType t = ConT $ mkName t + pieceFromString :: String -> Either (CheckOverlap, String) (CheckOverlap, Piece String) -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) = Right $ (False, Dynamic $ dropBracket x) +pieceFromString ('!':'#':x) = Right $ (False, Dynamic $ dropBracket x) -- https://github.com/yesodweb/yesod/issues/652 +pieceFromString ('#':x) = Right $ (True, Dynamic $ dropBracket x) pieceFromString ('*':'!':x) = Left (False, x) pieceFromString ('+':'!':x) = Left (False, x) @@ -273,9 +277,9 @@ 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? +dropBracket :: String -> String +dropBracket str@('{':x) = case break (== '}') x of + (s, "}") -> s + _ -> error $ "Unclosed bracket ('{'): " ++ str +dropBracket x = x + diff --git a/src/Routes/Routes.hs b/src/Routes/Routes.hs --- a/src/Routes/Routes.hs +++ b/src/Routes/Routes.hs @@ -134,17 +134,19 @@ , rinst ] +instanceD :: Cxt -> Type -> [Dec] -> Dec +#if MIN_VERSION_template_haskell(2,11,0) +instanceD = InstanceD Nothing +#else +instanceD = InstanceD +#endif + -- | Generates a 'Routable' instance and dispatch function mkRouteDispatch :: String -> [ResourceTree String] -> Q [Dec] mkRouteDispatch typName routes = do let typ = parseType typName disp <- mkRouteDispatchClause routes -#if MIN_VERSION_template_haskell(2,11,0) - let inst = InstanceD Nothing -#else - let inst = InstanceD -#endif - return [inst [] + return [instanceD [] (ConT ''Routable `AppT` typ `AppT` typ) [FunD (mkName "dispatcher") [disp]]] @@ -160,12 +162,7 @@ className <- lookupTypeName constraint -- Check if this is a classname or a type let contract = maybe (error $ "Unknown typeclass " ++ show constraint) (getContract master) className -#if MIN_VERSION_template_haskell(2,11,0) - let inst = InstanceD Nothing -#else - let inst = InstanceD -#endif - return [inst [contract] + return [instanceD [contract] (ConT ''Routable `AppT` typ `AppT` VarT master) [FunD (mkName "dispatcher") [disp]]] where diff --git a/src/Routes/TH.hs b/src/Routes/TH.hs --- a/src/Routes/TH.hs +++ b/src/Routes/TH.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} module Routes.TH ( module Routes.TH.Types -- * Functions diff --git a/src/Routes/TH/ParseRoute.hs b/src/Routes/TH/ParseRoute.hs --- a/src/Routes/TH/ParseRoute.hs +++ b/src/Routes/TH/ParseRoute.hs @@ -3,6 +3,7 @@ module Routes.TH.ParseRoute ( -- ** ParseRoute mkParseRouteInstance + , mkParseRouteInstance' ) where import Routes.TH.Types @@ -12,7 +13,10 @@ import Routes.TH.Dispatch mkParseRouteInstance :: Type -> [ResourceTree a] -> Q Dec -mkParseRouteInstance typ ress = do +mkParseRouteInstance = mkParseRouteInstance' [] + +mkParseRouteInstance' :: Cxt -> Type -> [ResourceTree a] -> Q Dec +mkParseRouteInstance' cxt typ ress = do cls <- mkDispatchClause MkDispatchSettings { mdsRunHandler = [|\_ _ x _ -> x|] @@ -28,7 +32,7 @@ (map removeMethods ress) helper <- newName "helper" fixer <- [|(\f x -> f () x) :: (() -> ([Text], [(Text, Text)]) -> Maybe (Route a)) -> ([Text], [(Text, Text)]) -> Maybe (Route a)|] - return $ instanceD [] (ConT ''ParseRoute `AppT` typ) + return $ instanceD cxt (ConT ''ParseRoute `AppT` typ) [ FunD 'parseRoute $ return $ Clause [] (NormalB $ fixer `AppE` VarE helper) diff --git a/src/Routes/TH/RenderRoute.hs b/src/Routes/TH/RenderRoute.hs --- a/src/Routes/TH/RenderRoute.hs +++ b/src/Routes/TH/RenderRoute.hs @@ -12,6 +12,9 @@ import Language.Haskell.TH (conT) #endif import Language.Haskell.TH.Syntax +#if MIN_VERSION_template_haskell(2,11,0) +import Data.Bits (xor) +#endif import Data.Maybe (maybeToList) import Control.Monad (replicateM) import Data.Text (pack) @@ -156,18 +159,28 @@ cls <- mkRenderRouteClauses ress (cons, decs) <- mkRouteCons ress #if MIN_VERSION_template_haskell(2,12,0) - did <- DataInstD [] ''Route [typ] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT clazzes) + did <- DataInstD [] ''Route [typ] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT (clazzes False)) + let sds = fmap (\t -> StandaloneDerivD Nothing cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True) #elif MIN_VERSION_template_haskell(2,11,0) - did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT clazzes + did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT (clazzes False) + let sds = fmap (\t -> StandaloneDerivD cxt $ ConT t `AppT` ( ConT ''Route `AppT` typ)) (clazzes True) #else - let did = DataInstD [] ''Route [typ] cons clazzes + let did = DataInstD [] ''Route [typ] cons clazzes' + let sds = [] #endif return $ instanceD cxt (ConT ''RenderRoute `AppT` typ) [ did , FunD (mkName "renderRoute") cls - ] : decs + ] + : sds ++ decs where - clazzes = [''Show, ''Eq, ''Read] +#if MIN_VERSION_template_haskell(2,11,0) + clazzes standalone = if standalone `xor` null cxt then + clazzes' + else + [] +#endif + clazzes' = [''Show, ''Eq, ''Read] #if MIN_VERSION_template_haskell(2,11,0) notStrict :: Bang diff --git a/src/Routes/TH/RouteAttrs.hs b/src/Routes/TH/RouteAttrs.hs --- a/src/Routes/TH/RouteAttrs.hs +++ b/src/Routes/TH/RouteAttrs.hs @@ -3,6 +3,7 @@ {-# LANGUAGE RecordWildCards #-} module Routes.TH.RouteAttrs ( mkRouteAttrsInstance + , mkRouteAttrsInstance' ) where import Routes.TH.Types @@ -15,9 +16,12 @@ #endif mkRouteAttrsInstance :: Type -> [ResourceTree a] -> Q Dec -mkRouteAttrsInstance typ ress = do +mkRouteAttrsInstance = mkRouteAttrsInstance' [] + +mkRouteAttrsInstance' :: Cxt -> Type -> [ResourceTree a] -> Q Dec +mkRouteAttrsInstance' cxt typ ress = do clauses <- mapM (goTree id) ress - return $ instanceD [] (ConT ''RouteAttrs `AppT` typ) + return $ instanceD cxt (ConT ''RouteAttrs `AppT` typ) [ FunD 'routeAttrs $ concat clauses ] diff --git a/test/HelloSpec.hs b/test/HelloSpec.hs --- a/test/HelloSpec.hs +++ b/test/HelloSpec.hs @@ -99,8 +99,8 @@ handler handleInfoRequest route MyRoute handler $ runHandlerM $ do - Just (DefaultRoute (route,_)) <- maybeRoute - plain $ T.pack $ show route + Just (DefaultRoute (r,_)) <- maybeRoute + plain $ T.pack $ show r -- catchall $ plain "This will never be reached" diff --git a/wai-routes.cabal b/wai-routes.cabal --- a/wai-routes.cabal +++ b/wai-routes.cabal @@ -1,85 +1,88 @@ -name : wai-routes -version : 0.10.0 -cabal-version : >=1.18 -build-type : Simple -license : MIT -license-file : LICENSE -maintainer : ajnsit@gmail.com -stability : Experimental -homepage : https://ajnsit.github.io/wai-routes/ -synopsis : Typesafe URLs for Wai applications. -description : Provides easy to use typesafe URLs for Wai Applications. See README for more information. Also see examples/ directory for usage examples. -category : Network -author : Anupam Jain -data-dir : "" -extra-source-files : README.md +name: wai-routes +version: 0.10.1 +cabal-version: >=1.18 +build-type: Simple +license: MIT +license-file: LICENSE +maintainer: ajnsit@gmail.com +stability: Experimental +homepage: https://ajnsit.github.io/wai-routes/ +synopsis: Typesafe URLs for Wai applications. +description: + Provides easy to use typesafe URLs for Wai Applications. See README for more information. Also see examples/ directory for usage examples. +category: Network +author: Anupam Jain +extra-source-files: + README.md source-repository head - type : git - location : http://github.com/ajnsit/wai-routes + type: git + location: http://github.com/ajnsit/wai-routes source-repository this - type : git - location : http://github.com/ajnsit/wai-routes/tree/v0.10.0 - tag : v0.10.0 + type: git + location: http://github.com/ajnsit/wai-routes/tree/v0.10.1 + tag: v0.10.1 library - build-depends : base >= 4.7 && < 4.10 - , wai >= 3.0 && < 3.3 - , wai-extra >= 3.0 && < 3.1 - , text >= 1.2 && < 1.3 - , template-haskell >= 2.9 && < 2.12 - , mtl >= 2.1 && < 2.3 - , aeson >= 0.8 && < 1.3 - , containers >= 0.5 && < 0.6 - , random >= 1.1 && < 1.2 - , path-pieces >= 0.2 && < 0.3 - , bytestring >= 0.10 && < 0.11 - , http-types >= 0.8 && < 0.10 - , blaze-builder >= 0.4 && < 0.5 - , monad-loops >= 0.4 && < 0.5 - , case-insensitive >= 1.2 && < 1.3 - , mime-types >= 0.1 && < 0.2 - , filepath >= 1.3 && < 1.5 - , cookie >= 0.4 && < 0.5 - , data-default-class >= 0.0 && < 0.2 - , vault >= 0.3 && < 0.4 - exposed-modules : Wai.Routes, Network.Wai.Middleware.Routes - other-modules : Routes.Parse - Routes.Overlap - Routes.Class - Routes.Routes - Routes.Monad - Routes.Handler - Routes.ContentTypes - Routes.DefaultRoute - Routes.TH - Routes.TH.Types - Routes.TH.Dispatch - Routes.TH.ParseRoute - Routes.TH.RenderRoute - Routes.TH.RouteAttrs - Util.Free - exposed : True - buildable : True - hs-source-dirs : src - default-language : Haskell2010 - ghc-options : -Wall - -test-suite test - main-is : Spec.hs - other-modules : HelloSpec - type : exitcode-stdio-1.0 - default-language : Haskell2010 - hs-source-dirs : test - GHC-options : -Wall -threaded -fno-warn-orphans + exposed-modules: + Wai.Routes + Network.Wai.Middleware.Routes + build-depends: + base >=4.7 && <4.11, + wai >=3.0 && <3.3, + wai-extra ==3.0.*, + text ==1.2.*, + template-haskell >=2.9 && <2.13, + mtl >=2.1 && <2.3, + aeson >=0.8 && <1.3, + containers ==0.5.*, + random ==1.1.*, + path-pieces ==0.2.*, + bytestring ==0.10.*, + http-types >=0.8 && <0.10, + blaze-builder ==0.4.*, + monad-loops ==0.4.*, + case-insensitive ==1.2.*, + mime-types ==0.1.*, + filepath >=1.3 && <1.5, + cookie ==0.4.*, + data-default-class >=0.0 && <0.2, + vault ==0.3.* + default-language: Haskell2010 + hs-source-dirs: src + other-modules: + Routes.Parse + Routes.Overlap + Routes.Class + Routes.Routes + Routes.Monad + Routes.Handler + Routes.ContentTypes + Routes.DefaultRoute + Routes.TH + Routes.TH.Types + Routes.TH.Dispatch + Routes.TH.ParseRoute + Routes.TH.RenderRoute + Routes.TH.RouteAttrs + Util.Free + ghc-options: -Wall - build-depends : base >= 4.7 && < 4.10 - , wai >= 3.0 && < 3.3 - , aeson >= 0.8 && < 1.3 - , hspec >= 2.1 && < 2.5 - , hspec-wai >= 0.6 && < 0.9 - , hspec-wai-json >= 0.6 && < 0.9 - , text >= 1.2 && < 1.3 - , wai-routes - ghc-options : -Wall +test-suite test + type: exitcode-stdio-1.0 + main-is: Spec.hs + build-depends: + base >=4.7 && <4.11, + wai >=3.0 && <3.3, + aeson >=0.8 && <1.3, + hspec >=2.1 && <2.5, + hspec-wai >=0.6 && <0.10, + hspec-wai-json >=0.6 && <0.10, + text ==1.2.*, + wai-routes -any + default-language: Haskell2010 + hs-source-dirs: test + other-modules: + HelloSpec + ghc-options: -Wall -threaded -fno-warn-orphans -Wall