diff --git a/examples/Example.hs b/examples/Example.hs new file mode 100644 --- /dev/null +++ b/examples/Example.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Control.Applicative +import Data.String +import Network.Wai +import Network.Wai.Application.Static +import Network.Wai.Handler.Warp +import Network.Waitra +import Network.Waitra.Embedded +import System.Environment (lookupEnv) + +echoRoute :: Route +echoRoute = routeGet (echoApp <$ string "/api/echo/" <*> many anySym) + where echoApp msg _req respond = respond $ responseLBS status200 [] (fromString msg) + +app :: Application +app = waitraMiddleware [echoRoute] $ staticApp $ embeddedSettings $(mkRecursiveEmbedded "static") + +main :: IO () +main = do + port <- maybe 8000 read <$> lookupEnv "PORT" + run port app diff --git a/src/Network/Waitra.hs b/src/Network/Waitra.hs --- a/src/Network/Waitra.hs +++ b/src/Network/Waitra.hs @@ -32,12 +32,16 @@ -- * Compilation , routeMiddleware , waitraMiddleware + -- * Re-exports + , module Text.Regex.Applicative + , module Network.HTTP.Types.Status ) where import Data.Aeson import Data.String (fromString) import qualified Data.Text as T import qualified Network.HTTP.Types as H +import Network.HTTP.Types.Status import Network.Wai import Text.Regex.Applicative diff --git a/static/favicon.ico b/static/favicon.ico new file mode 100644 Binary files /dev/null and b/static/favicon.ico differ diff --git a/static/index.html b/static/index.html new file mode 100644 --- /dev/null +++ b/static/index.html @@ -0,0 +1,13 @@ + + + + + + Waitra demo + + +

Waitra

+

Try /api/echo/hello

+ + + diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -3,26 +3,25 @@ import Data.Aeson import Data.String (fromString) -import qualified Network.HTTP.Types as H import Network.Wai import Network.Wai.Test import Network.Waitra import Test.Tasty +import Network.HTTP.Types.Header import Test.Tasty.HUnit -import Text.Regex.Applicative echoRoute :: Route echoRoute = routeGet (echoApp <$ string "/api/echo/" <*> many anySym) - where echoApp msg _req respond = respond $ responseLBS H.status200 [] (fromString msg) + where echoApp msg _req respond = respond $ responseLBS status200 [] (fromString msg) jsonRoute :: Route jsonRoute = simpleGet "/api/json" $ jsonApp (return . f) - where f (Object _) = (H.status200, [], "object" :: String) - f (Array _) = (H.status200, [], "array") - f v = (H.status404, [], show v) + where f (Object _) = (status200, [], "object" :: String) + f (Array _) = (status200, [], "array") + f v = (status404, [], show v) emptyApp :: Application -emptyApp _ respond = respond $ responseLBS H.status404 [] (fromString "Fallback: Not found") +emptyApp _ respond = respond $ responseLBS status404 [] (fromString "Fallback: Not found") app :: Application app = waitraMiddleware [echoRoute, jsonRoute] emptyApp @@ -36,7 +35,7 @@ res <- request req assertStatus 200 res assertBody "foobar" res - + echoCase2 :: IO () echoCase2 = runApp $ do let req = setPath defaultRequest "/not-found" @@ -48,14 +47,14 @@ let req = setPath defaultRequest "/api/json" res <- srequest $ SRequest req "{}" assertStatus 200 res - assertHeader H.hContentType "application/json" res + assertHeader hContentType "application/json" res assertBody "\"object\"" res --- Cannot parse number as json +-- Cannot parse random string as json jsonCase2 :: IO () jsonCase2 = runApp $ do let req = setPath defaultRequest "/api/json" - res <- srequest $ SRequest req "42" + res <- srequest $ SRequest req "foo" assertStatus 400 res tests :: TestTree diff --git a/waitra.cabal b/waitra.cabal --- a/waitra.cabal +++ b/waitra.cabal @@ -1,5 +1,5 @@ name: waitra -version: 0.0.3.0 +version: 0.0.4.0 synopsis: A very simple Wai router description: Waitra is a very simple router. @@ -20,9 +20,15 @@ copyright: (c) 2015 Futurice category: Web build-type: Simple -extra-source-files: README.md +extra-source-files: README.md, static/index.html, static/favicon.ico cabal-version: >=1.10 +flag examples + description: Build example executables + default: False + manual: True + + library exposed-modules: Network.Waitra, Network.Waitra.Embedded @@ -43,11 +49,9 @@ test-suite test main-is: Main.hs type: exitcode-stdio-1.0 - build-depends: base >= 4.6 && < 4.9, aeson, http-types, - regex-applicative, tasty, tasty-hunit, wai, @@ -56,6 +60,21 @@ hs-source-dirs: test ghc-options: -Wall default-language: Haskell2010 + +executable waitra-example + if !flag(examples) + buildable: False + main-is: Example.hs + ghc-options: -Wall + hs-source-dirs: examples/ + default-language: Haskell2010 + build-depends: base, + aeson, + warp, + wai, + wai-app-static >= 3.0, + waitra, + warp source-repository head type: git