diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -Wai Routes (wai-routes-0.6.2) +Wai Routes (wai-routes-0.7.0) ==================================== [![Build Status](https://travis-ci.org/ajnsit/wai-routes.png)](https://travis-ci.org/ajnsit/wai-routes) @@ -8,6 +8,7 @@ Features: - Automatic generation of Route boilerplate using TH - Easy Nested Routes + - Subsites - General purpose Route Attributes/Annotations - Sitewide Master datatype which is passed to all handlers and can be used for persistent data (like DB connections) @@ -26,7 +27,6 @@ The following features are planned for later releases - -- Subsites - Development mode - Keter and Heroku support - Scaffolding @@ -101,4 +101,5 @@ * 0.6.0 : Removed dependency on yesod-routes. Updated code to compile with wai-3 and ghc-7.8, ghc-7.10 * 0.6.1 : Fixed cabal and travis files * 0.6.2 : Added 'maybeRoute' and 'routeAttrSet', to get information about the currently executing route +* 0.7.0 : Subsites support added diff --git a/examples/Example.hs b/examples/Example.hs deleted file mode 100644 --- a/examples/Example.hs +++ /dev/null @@ -1,151 +0,0 @@ -{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, ViewPatterns #-} -module Main where - -import Network.Wai -import Network.Wai.Middleware.Routes -import Network.Wai.Middleware.Routes.ContentTypes -import Network.Wai.Application.Static -import Network.Wai.Handler.Warp -import Network.HTTP.Types -import qualified Data.Text as T -import Data.Text (Text) -import Data.Aeson hiding (json) -import Data.IORef -import qualified Data.Map as M -import Control.Monad.Trans -import Network.Wai.Middleware.RequestLogger - --- The database of users -data User = User - { userId :: Int - , userName :: Text - , userAge :: Int - } deriving (Show, Read, Eq) -type DB = [User] - --- JSON instance -instance ToJSON User where - toJSON x = object [ "uid" .= userId x, "name" .= userName x, "age" .= userAge x ] - - --- The Site argument -data MyRoute = MyRoute (IORef DB) - --- Make MyRoute Routable -mkRoute "MyRoute" [parseRoutes| -/ HomeR !hello GET -/users UsersR GET -/user/#Int UserR: - / UserRootR GET - /delete UserDeleteR GET POST -/skip/*[Text] SkipR GET -|] - - --- Handlers - --- Util: Fetch the database -getDB :: HandlerM MyRoute DB -getDB = do - MyRoute dbref <- master - liftIO $ readIORef dbref - --- Display the possible actions -getHomeR :: Handler MyRoute -getHomeR = runHandlerM $ do - mroute <- maybeRoute - attrs <- routeAttrSet - liftIO $ putStrLn $ show mroute - liftIO $ putStrLn $ show attrs - json $ M.fromList ( - [("description", [["Simple User database Example"]]) - ,("links" - ,[["home", showRoute HomeR] - ,["users", showRoute UsersR] - ,["skip", showRoute $ SkipR []] - ] - ) - ] :: [(Text, [[Text]])] ) - --- Display all the users -getUsersR :: Handler MyRoute -getUsersR = runHandlerM $ do - db <- getDB - let dblinks = map linkify db - json $ M.fromList ( - [("description", [["Users List"]]) - ,("links", dblinks)] :: [(Text, [[Text]])] ) - where - linkify user = [userName user, showRoute $ UserR (userId user) UserRootR] - --- Display a single user -getUserRootR :: Int -> Handler MyRoute -getUserRootR i = runHandlerM $ do - db <- getDB - case ulookup i db of - Nothing -> json ("ERROR: User not found" :: Text) - Just user -> do - json $ M.fromList ( - [("description", [["User details"]]) - ,("data" - ,[["Id", T.pack $ show $ userId user] - ,["Name", userName user] - ,["Age", T.pack $ show $ userAge user] - ] - ) - ,("links" - ,[["details", showRoute $ UserR (userId user) UserRootR] - ,["delete (post only)", showRoute $ UserR (userId user) UserDeleteR] - ] - ) - ] :: [(Text, [[Text]])] ) - where - ulookup _ [] = Nothing - ulookup ui (u:us) = if userId u == ui then Just u else ulookup ui us - --- Delete a user: GET -getUserDeleteR :: Int -> Handler MyRoute -getUserDeleteR _ = runHandlerM $ json (["DELETE","please use POST"]::[Text]) - --- Delete a user: POST -postUserDeleteR :: Int -> Handler MyRoute -postUserDeleteR _ = runHandlerM $ json (["DELETE","not implemented"]::[Text]) - --- Demonstrate skipping routes -getSkipR :: [Text] -> Handler MyRoute -getSkipR _ = runHandlerM $ next >> return () - --- Initial database -initdb :: [User] -initdb = - [ User 1 "Anon Amos" 23 - , User 2 "Bo Lively" 28 - ] - --- A new middleware to catch all skipped routes -data MySkippedRoute = MySkippedRoute - --- Catch all 'skipped` routes -mkRoute "MySkippedRoute" [parseRoutes| -/skip/*[Text] SkippedR GET -|] - -getSkippedR :: [Text] -> Handler MySkippedRoute -getSkippedR rest = runHandlerM $ json $ ["SKIPPED ROUTE: "] ++ rest - --- The application that uses our route --- NOTE: We use the Route Monad to simplify routing -application :: RouteM () -application = do - db <- liftIO $ newIORef initdb - middleware logStdoutDev - route (MyRoute db) - route MySkippedRoute - defaultAction $ staticApp $ defaultFileServerSettings "static" - --- Run the application -main :: IO () -main = do - putStrLn "Starting server on port 8080" - toWaiApp application >>= run 8080 - diff --git a/src/Network/Wai/Middleware/Routes.hs b/src/Network/Wai/Middleware/Routes.hs --- a/src/Network/Wai/Middleware/Routes.hs +++ b/src/Network/Wai/Middleware/Routes.hs @@ -18,6 +18,9 @@ -- * Template Haskell methods , mkRoute + , mkRouteData + , mkRouteDispatch + , mkRouteSubDispatch -- * Dispatch , routeDispatch @@ -28,6 +31,7 @@ -- * Application Handlers , Handler + , HandlerS -- * Generated Datatypes , Routable(..) -- | Used internally. However needs to be exported for TH to work. @@ -52,8 +56,10 @@ , HandlerM() , runHandlerM -- | Run a HandlerM to get a Handler , request -- | Access the request data + , maybeRootRoute -- | Access the current route for root route , maybeRoute -- | Access the current route , routeAttrSet -- | Access the current route attributes as a set + , rootRouteAttrSet -- | Access the current root route attributes as a set , master -- | Access the master datatype , header -- | Add a header to the response , status -- | Set the response status diff --git a/src/Network/Wai/Middleware/Routes/Handler.hs b/src/Network/Wai/Middleware/Routes/Handler.hs --- a/src/Network/Wai/Middleware/Routes/Handler.hs +++ b/src/Network/Wai/Middleware/Routes/Handler.hs @@ -15,7 +15,9 @@ , runHandlerM -- | Run a HandlerM to get a Handler , request -- | Access the request data , routeAttrSet -- | Access the route attribute list + , rootRouteAttrSet -- | Access the route attribute list for the root route , maybeRoute -- | Access the route data + , maybeRootRoute -- | Access the root route data , master -- | Access the master datatype , header -- | Add a header to the response , status -- | Set the response status @@ -33,7 +35,7 @@ import Control.Applicative (Applicative) -import Network.Wai.Middleware.Routes.Routes (RequestData, Handler, waiReq, currentRoute, runNext, ResponseHandler) +import Network.Wai.Middleware.Routes.Routes (Env(..), RequestData, HandlerS, waiReq, currentRoute, runNext, ResponseHandler) import Network.Wai.Middleware.Routes.Class (Route, RouteAttrs(..)) import Network.Wai.Middleware.Routes.ContentTypes (contentType, typeHtml, typeJson, typePlain) @@ -58,102 +60,120 @@ -- | The internal implementation of the HandlerM monad -- TODO: Should change this to StateT over ReaderT (but performance may suffer) -newtype HandlerMI master m a = H { extractH :: StateT (HandlerState master) m a } - deriving (Applicative, Monad, MonadIO, Functor, MonadTrans, MonadState (HandlerState master)) +newtype HandlerMI sub master m a = H { extractH :: StateT (HandlerState sub master) m a } + deriving (Applicative, Monad, MonadIO, Functor, MonadTrans, MonadState (HandlerState sub master)) -- | The HandlerM Monad -type HandlerM master a = HandlerMI master IO a +type HandlerM sub master a = HandlerMI sub master IO a -- | The state kept in a HandlerM Monad -data HandlerState master = HandlerState +data HandlerState sub master = HandlerState { getMaster :: master - , getRequestData :: RequestData master + , getRequestData :: RequestData sub , respHeaders :: [(HeaderName, ByteString)] , respStatus :: Status , respBody :: BL.ByteString , respResp :: Maybe ResponseHandler + , getSub :: sub + , toMasterRoute :: Route sub -> Route master } -- | "Run" HandlerM, resulting in a Handler -runHandlerM :: HandlerM master () -> Handler master -runHandlerM h m req hh = do - (_, state) <- runStateT (extractH h) (HandlerState m req [] status200 "" Nothing) +runHandlerM :: HandlerM sub master () -> HandlerS sub master +runHandlerM h env req hh = do + (_, state) <- runStateT (extractH h) (HandlerState (envMaster env) req [] status200 "" Nothing (envSub env) (envToMaster env)) case respResp state of Nothing -> hh $ toResp state Just resp -> resp hh -toResp :: HandlerState master -> Response +toResp :: HandlerState sub master -> Response toResp hs = responseBuilder (respStatus hs) (respHeaders hs) (fromLazyByteString $ respBody hs) -- | Get the master -master :: HandlerM master master +master :: HandlerM sub master master master = liftM getMaster get +-- | Get the sub +sub :: HandlerM sub master sub +sub = liftM getSub get + -- | Get the request -request :: HandlerM master Request +request :: HandlerM sub master Request request = liftM (waiReq . getRequestData) get -- | Get the current route -maybeRoute :: HandlerM master (Maybe (Route master)) +maybeRoute :: HandlerM sub master (Maybe (Route sub)) maybeRoute = liftM (currentRoute . getRequestData) get +-- | Get the current root route +maybeRootRoute :: HandlerM sub master (Maybe (Route master)) +maybeRootRoute = do + s <- get + return $ fmap (toMasterRoute s) $ currentRoute $ getRequestData s + -- | Get the current route attributes -routeAttrSet :: RouteAttrs master => HandlerM master (Set Text) +routeAttrSet :: RouteAttrs sub => HandlerM sub master (Set Text) routeAttrSet = liftM (S.map T.fromStrict . maybe S.empty routeAttrs . currentRoute . getRequestData) get +-- | Get the attributes for the current root route +rootRouteAttrSet :: RouteAttrs master => HandlerM sub master (Set Text) +rootRouteAttrSet = do + s <- get + return $ S.map T.fromStrict $ maybe S.empty (routeAttrs . toMasterRoute s) $ currentRoute $ getRequestData s + -- | Add a header to the application response -- TODO: Differentiate between setting and adding headers -header :: HeaderName -> ByteString -> HandlerM master () +header :: HeaderName -> ByteString -> HandlerM sub master () header h s = modify $ addHeader h s where - addHeader :: HeaderName -> ByteString -> HandlerState master -> HandlerState master + addHeader :: HeaderName -> ByteString -> HandlerState sub master -> HandlerState sub master addHeader h b s@(HandlerState {respHeaders=hs}) = s {respHeaders=(h,b):hs} -- | Set the response status -status :: Status -> HandlerM master () +status :: Status -> HandlerM sub master () status s = modify $ setStatus s where - setStatus :: Status -> HandlerState master -> HandlerState master + setStatus :: Status -> HandlerState sub master -> HandlerState sub master setStatus s st = st{respStatus=s} -- | Set the response body -- TODO: Add functions to append to body, and also to flush body contents -raw :: BL.ByteString -> HandlerM master () +raw :: BL.ByteString -> HandlerM sub master () raw s = modify $ setBody s where - setBody :: BL.ByteString -> HandlerState master -> HandlerState master + setBody :: BL.ByteString -> HandlerState sub master -> HandlerState sub master setBody s st = st{respBody=s} -- Standard response bodies -- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\" -- header to \"application/json\". -json :: ToJSON a => a -> HandlerM master () +json :: ToJSON a => a -> HandlerM sub master () json a = do header contentType typeJson raw $ A.encode a -- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\" -- header to \"text/plain\". -text :: Text -> HandlerM master () +text :: Text -> HandlerM sub master () text t = do header contentType typePlain raw $ encodeUtf8 t -- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\" -- header to \"text/html\". -html :: BL.ByteString -> HandlerM master () +html :: BL.ByteString -> HandlerM sub master () html s = do header contentType typeHtml raw s -- | Run the next application -next :: HandlerM master () +next :: HandlerM sub master () next = do s <- get let resp = runNext (getRequestData s) modify $ setResp resp where - setResp :: ResponseHandler -> HandlerState master -> HandlerState master + setResp :: ResponseHandler -> HandlerState sub master -> HandlerState sub master setResp r st = st{respResp=Just r} diff --git a/src/Network/Wai/Middleware/Routes/Monad.hs b/src/Network/Wai/Middleware/Routes/Monad.hs --- a/src/Network/Wai/Middleware/Routes/Monad.hs +++ b/src/Network/Wai/Middleware/Routes/Monad.hs @@ -59,7 +59,7 @@ -- | Add a route to the application. -- Routes are ordered so the one declared earlier is matched first. -route :: (Routable master) => master -> RouteM () +route :: (Routable master master) => master -> RouteM () route = middleware . routeDispatch -- | Set the default action of the Application. diff --git a/src/Network/Wai/Middleware/Routes/Routes.hs b/src/Network/Wai/Middleware/Routes/Routes.hs --- a/src/Network/Wai/Middleware/Routes/Routes.hs +++ b/src/Network/Wai/Middleware/Routes/Routes.hs @@ -23,6 +23,9 @@ -- * Template Haskell methods , mkRoute + , mkRouteData + , mkRouteDispatch + , mkRouteSubDispatch -- * Dispatch , routeDispatch @@ -33,6 +36,7 @@ -- * Application Handlers , Handler + , HandlerS -- * As of Wai 3, Application datatype now follows continuation passing style -- A `ResponseHandler` represents a continuation passed to the application @@ -45,6 +49,7 @@ , RouteAttrs(..) -- | A `RouteAttrs` instance for your site datatype is automatically generated by `mkRoute` -- * Accessing Request Data + , 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 @@ -55,8 +60,8 @@ where -- Wai -import Network.Wai (ResponseReceived, Middleware, Application, pathInfo, requestMethod, requestMethod, Response, Request(..), responseBuilder) -import Network.HTTP.Types (decodePath, encodePath, queryTextToQuery, queryToQueryText, status405) +import Network.Wai (ResponseReceived, Middleware, Application, pathInfo, requestMethod, requestMethod, Response, Request(..)) +import Network.HTTP.Types (decodePath, encodePath, queryTextToQuery, queryToQueryText) -- Network.Wai.Middleware.Routes import Network.Wai.Middleware.Routes.Class (Route, RenderRoute(..), ParseRoute(..), RouteAttrs(..)) @@ -64,9 +69,10 @@ import Network.Wai.Middleware.Routes.TH (mkRenderRouteInstance, mkParseRouteInstance, mkRouteAttrsInstance, mkDispatchClause, ResourceTree(..), MkDispatchSettings(..), defaultGetHandler) -- Text and Bytestring +import Data.ByteString (ByteString) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8, decodeUtf8) -import Blaze.ByteString.Builder (toByteString, fromByteString) +import Blaze.ByteString.Builder (toByteString) -- TH import Language.Haskell.TH.Syntax @@ -75,9 +81,6 @@ import Control.Arrow (second) import Data.Maybe (fromMaybe) --- Common ContentTypes -import Network.Wai.Middleware.Routes.ContentTypes - -- An abstract request data RequestData master = RequestData { waiReq :: Request @@ -88,72 +91,106 @@ -- AJ: Experimental type ResponseHandler = (Response -> IO ResponseReceived) -> IO ResponseReceived +-- Wai uses Application :: Wai.Request -> ResponseHandler +-- However, instead of Request, we use RequestData which has more information type App master = RequestData master -> ResponseHandler +data Env sub master = Env + { envMaster :: master + , envSub :: sub + , envToMaster :: Route sub -> Route master + } + -- | Run the next application in the stack runNext :: App master runNext req = nextApp req $ waiReq req -- | A `Handler` generates an App from the master datatype -type Handler master = master -> App master - --- Baked in applications that handle 404 and 405 errors --- TODO: Inspect the request to figure out acceptable output formats --- Currently we assume text/plain is acceptable -app404 :: Handler master -app404 _master = runNext - -app405 :: Handler master -app405 _master _req h = h $ responseBuilder status405 [(contentType, typePlain)] $ fromByteString "405 - Method Not Allowed" +type Handler master = HandlerS master master +type HandlerS sub master = Env sub master -> App sub --- | Generates all the things needed for efficient routing, --- including your application's `Route` datatype, and --- `RenderRoute`, `ParseRoute`, and `RouteAttr` instances -mkRoute :: String -> [ResourceTree String] -> Q [Dec] -mkRoute typName routes = do +-- | Generates everything except `Routable` instance and dispatch function +mkRouteData :: String -> [ResourceTree String] -> Q [Dec] +mkRouteData typName routes = do let typ = parseType typName + let rname = mkName $ "resources" ++ typName let resourceTrees = map (fmap parseType) routes + eres <- lift routes + let resourcesDec = + [ SigD rname $ ListT `AppT` (ConT ''ResourceTree `AppT` ConT ''String) + , FunD rname [Clause [] (NormalB eres) []] + ] rinst <- mkRenderRouteInstance typ resourceTrees pinst <- mkParseRouteInstance typ resourceTrees ainst <- mkRouteAttrsInstance typ resourceTrees + return $ concat [ [ainst] + , [pinst] + , resourcesDec + , rinst + ] + +mkRouteSubDispatch :: [ResourceTree a] -> Q Exp +mkRouteSubDispatch routes = do disp <- mkDispatchClause MkDispatchSettings - { mdsRunHandler = [| runHandler |] - -- We don't use subsites - , mdsSubDispatcher = [| undefined |] - , mdsGetPathInfo = [| pathInfo . waiReq |] - , mdsMethod = [| requestMethod . waiReq |] - -- We don't use subsites - , mdsSetPathInfo = [| undefined |] - , mds404 = [| app404 |] - , mds405 = [| app405 |] + { mdsRunHandler = [| runHandler |] + , mdsSubDispatcher = [| subDispatcher |] + , mdsGetPathInfo = [| getPathInfo |] + , mdsMethod = [| getReqMethod |] + , mdsSetPathInfo = [| setPathInfo |] + , mds404 = [| app404 |] + , mds405 = [| app405 |] , mdsGetHandler = defaultGetHandler } routes - return $ InstanceD [] - (ConT ''Routable `AppT` typ) - [FunD (mkName "dispatcher") [disp]] - : ainst - : pinst - : rinst + inner <- newName "inner" + let innerFun = FunD inner [disp] + helper <- newName "helper" + let fun = FunD helper + [ Clause + [] + (NormalB $ VarE inner) + [innerFun] + ] + return $ LetE [fun] (VarE helper) +-- | Generates a 'Routable' instance and dispatch function +mkRouteDispatch :: String -> [ResourceTree String] -> Q [Dec] +mkRouteDispatch typName routes = do + let typ = parseType typName + disp <- mkDispatchClause MkDispatchSettings + { mdsRunHandler = [| runHandler |] + , mdsSubDispatcher = [| subDispatcher |] + , mdsGetPathInfo = [| getPathInfo |] + , mdsMethod = [| getReqMethod |] + , mdsSetPathInfo = [| setPathInfo |] + , mds404 = [| app404 |] + , mds405 = [| app405 |] + , mdsGetHandler = defaultGetHandler + } routes + return [InstanceD [] + (ConT ''Routable `AppT` typ `AppT` typ) + [FunD (mkName "dispatcher") [disp]]] --- PRIVATE -runHandler - :: Handler master - -> master - -> Maybe (Route master) - -> App master -runHandler h master route reqdata = h master reqdata{currentRoute=route} +-- | Generates all the things needed for efficient routing, +-- including your application's `Route` datatype, and +-- `RenderRoute`, `ParseRoute`, and `RouteAttr` instances, and +-- `Routable` instance +mkRoute :: String -> [ResourceTree String] -> Q [Dec] +mkRoute typName routes = do + dat <- mkRouteData typName routes + disp <- mkRouteDispatch typName routes + return (disp++dat) -- | A `Routable` instance can be used in dispatching. -- An appropriate instance for your site datatype is --- automatically generated by `mkRoute` -class Routable master where - dispatcher :: Handler master +-- automatically generated by `mkRoute`. +class Routable sub master where + dispatcher :: HandlerS sub master -- | Generates the application middleware from a `Routable` master datatype -routeDispatch :: Routable master => master -> Middleware +routeDispatch :: Routable master master => master -> Middleware +-- Env master master is converted to Env sub master by subDispatcher -- Route information is filled in by runHandler -routeDispatch master def req = dispatcher master RequestData{waiReq=req, nextApp=def, currentRoute=Nothing} +routeDispatch master def req = dispatcher (_masterToEnv master) RequestData{waiReq=req, nextApp=def, currentRoute=Nothing} -- | Renders a `Route` as Text showRoute :: RenderRoute master => Route master -> Text @@ -169,3 +206,58 @@ readRoute :: ParseRoute master => Text -> Maybe (Route master) readRoute = parseRoute . second (map (second (fromMaybe "")) . queryToQueryText) . decodePath . encodeUtf8 +-- PRIVATE + +-- Get the request method from a RequestData +getReqMethod :: RequestData master -> ByteString +getReqMethod = requestMethod . waiReq + +-- Get the path info from a RequestData +getPathInfo :: RequestData master -> [Text] +getPathInfo = pathInfo . waiReq + +-- Set the path info in a RequestData +setPathInfo :: [Text] -> RequestData master -> RequestData master +setPathInfo p reqData = reqData { waiReq = (waiReq reqData){pathInfo=p} } + +-- Baked in applications that handle 404 and 405 errors +-- On no matching route, skip to next application +app404 :: HandlerS sub master +app404 _master = runNext + +-- On matching route, but no matching http method, skip to next application +-- This allows a later route to handle methods not implemented by the previous routes +app405 :: HandlerS sub master +app405 _master = runNext + +-- Run a route handler function +runHandler + :: HandlerS sub master + -> Env sub master + -> Maybe (Route sub) + -> App sub +runHandler h env route reqdata = h env reqdata{currentRoute=route} + +-- Run a route subsite handler function +subDispatcher + :: Routable sub master + => (HandlerS sub master -> Env sub master -> Maybe (Route sub) -> App sub) + -> (master -> sub) + -> (Route sub -> Route master) + -> Env master master + -> App master +subDispatcher _runhandler getSub toMasterRoute env reqData = dispatcher env' reqData' + where + env' = _envToSub getSub toMasterRoute env + reqData' = reqData{currentRoute=Nothing} + qq (k,mv) = (decodeUtf8 k, maybe "" decodeUtf8 mv) + req = waiReq reqData + +_masterToEnv :: master -> Env master master +_masterToEnv master = Env master master id + +_envToSub :: (master -> sub) -> (Route sub -> Route master) -> Env master master -> Env sub master +_envToSub getSub toMasterRoute env = Env master sub toMasterRoute + where + master = envMaster env + sub = getSub master diff --git a/wai-routes.cabal b/wai-routes.cabal --- a/wai-routes.cabal +++ b/wai-routes.cabal @@ -1,5 +1,5 @@ name : wai-routes -version : 0.6.2 +version : 0.7.0 cabal-version : >=1.18 build-type : Simple license : MIT @@ -8,54 +8,11 @@ stability : Experimental homepage : https://github.com/ajnsit/wai-routes synopsis : Typesafe URLs for Wai applications. -description : Provides easy to use typesafe URLs for Wai Applications. - . - Sample usage follows (See examples/Example.hs in the source bundle for the full code) - - . - @ - {-# LANGUAGE OverloadedStrings, TypeFamilies #-} - . - import Network.Wai - import Network.Wai.Middleware.Routes - . - import Data.IORef - . - -- The Site Argument - data MyRoute = MyRoute (IORef DB) - . - -- Generate Routes - mkRoute "MyRoute" [parseRoutes| - / UsersR GET - /user/#Int UserR: - / UserRootR GET - /delete UserDeleteR POST - |] - . - -- Define Handlers - -- All Users Page - getUsersR :: Handler MyRoute - getUsersR (MyRoute dbref) request = ... - -- Single User Page - getUserRootR :: Int -> Handler MyRoute - getUserRootR userid (MyRoute dbref) request = ... - -- Delete Single User - postUserDeleteR :: Int -> Handler MyRoute - postUserDeleteR userid (MyRoute dbref) request = ... - . - -- Define Application using RouteM Monad - myApp = do - db <- liftIO $ newIORef mydb - route (MyRoute db) - setDefaultAction $ staticApp $ defaultFileServerSettings "static" - . - -- Run the application - main :: IO () - main = toWaiApp myApp >>= run 8080 - @ +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 examples/Example.hs +extra-source-files : README.md source-repository head type : git @@ -63,8 +20,8 @@ source-repository this type : git - location : http://github.com/ajnsit/wai-routes/tree/v0.6.2 - tag : v0.6.2 + location : http://github.com/ajnsit/wai-routes/tree/v0.7.0 + tag : v0.7.0 library build-depends: base >= 4.7 && < 4.9