diff --git a/lib/Hikaru/Route.hs b/lib/Hikaru/Route.hs index fe8742f1e29fe4768542427035872989263cddb7..e8902e18f20a7b4bfef895c7b519acc551a1f785 100644 --- a/lib/Hikaru/Route.hs +++ b/lib/Hikaru/Route.hs @@ -19,6 +19,7 @@ module Hikaru.Route -- ** Path Matching , seg + , (</) , arg , argWith , rest @@ -228,6 +229,13 @@ where else Nothing + -- | + -- Shortcut to append a path segment in a more readable way. + -- + (</) :: Route a -> Text -> Route a + (</) r t = r <* seg t + + -- | -- Match, parse and return following path segment. -- diff --git a/test/Hikaru/Demo.hs b/test/Hikaru/Demo.hs index 4bc1e735f967e6f0f26a53045163198476d875a9..437b7b17ca4b626e1947f34c4ff755ca2239e554 100644 --- a/test/Hikaru/Demo.hs +++ b/test/Hikaru/Demo.hs @@ -105,7 +105,7 @@ where runAction :: ModelEnv -> Action () -> Application runAction me act = do - respond $ \ae -> do + respond \ae -> do runReaderT (unAction act) (DemoEnv ae me) @@ -115,23 +115,30 @@ where -- Register nicer 404 error handler. handler NotFound handleNotFound + -- Read configuration from environment. + wrapActions (updateConfigFromEnv >>) + -- Negotiate content for the root page. route $ getRootHtmlR <$ get <* offerHTML route $ getRootTextR <$ get <* offerText - -- Disable caching for all the following endpoints. + -- Disable caching for these endpoints: wrapAction (defaultHeader hCacheControl "no-store" >>) do -- Present a simple greeting page. - route $ getHelloR <$ get <* seg "hello" <*> arg + route $ getHelloR <$ get </ "hello" <*> arg <* offerText -- Present an echoing JSON API. - route $ postEchoR <$ post <* seg "api" <* seg "echo" + route $ postEchoR <$ post </ "api" </ "echo" <* offerJSON <* acceptJSON - -- Case handling. - route $ postCaseR <$ post <* seg "case" <* seg "" <* acceptForm - route $ getCasesR <$ get <* seg "case" <* seg "" <* offerJSON + -- Handle new cases. + route $ postCaseR <$ post </ "case" </ "" + <* acceptForm + + -- Handle case listing. + route $ getCasesR <$ get </ "case" </ "" + <* offerJSON -- Handlers ----------------------------------------------------------------