scotty 0.4.0 → 0.4.1

raw patch · 6 files changed

+82/−47 lines, 6 files

Files

• Web/Scotty.hs +9/−6
• Web/Scotty/Action.hs +1/−19
• Web/Scotty/Route.hs +67/−19
• Web/Scotty/Types.hs +1/−2
• examples/basic.hs +3/−0
• scotty.cabal +1/−1

@@ -13,6 +13,7 @@       -- ** Route Patterns     , capture, regex, function, literal       -- * Defining Actions+    , Action       -- ** Accessing the Request, Captures, and Query Parameters     , request, body, param, jsonData       -- ** Modifying the Response and Redirecting@@ -28,10 +29,6 @@     , ScottyM, ActionM, Param, Parsable, RoutePattern     ) where -import Web.Scotty.Action-import Web.Scotty.Route-import Web.Scotty.Types- import Blaze.ByteString.Builder (fromByteString)  import Control.Monad.State (execStateT, modify)@@ -42,9 +39,15 @@ import Network.Wai import Network.Wai.Handler.Warp (Port, run) +import Web.Scotty.Action+import Web.Scotty.Route+import Web.Scotty.Types+ -- | Run a scotty application using the warp server. scotty :: Port -> ScottyM () -> IO ()-scotty p s = putStrLn ("Setting phasers to stun... (ctrl-c to quit) (port " ++ show p ++ ")") >> (run p =<< scottyApp s)+scotty p s = do+    putStrLn $ "Setting phasers to stun... (ctrl-c to quit) (port " ++ show p ++ ")"+    run p =<< scottyApp s  -- | Turn a scotty application into a WAI 'Application', which can be -- run with any WAI handler.@@ -61,4 +64,4 @@ -- is the outermost middleware (it has first dibs on the request and last action -- on the response). Every middleware is run on each request. middleware :: Middleware -> ScottyM ()-middleware m = modify (addMiddleware m)+middleware = modify . addMiddleware

@@ -4,7 +4,7 @@     , status, header, redirect     , text, html, file, json     , raise, rescue, next-    , ActionM, Parsable, Param, mkEnv, runAction+    , ActionM, Parsable, Param, runAction     ) where  import Blaze.ByteString.Builder (fromLazyByteString)@@ -13,15 +13,12 @@ import Control.Monad.Error import Control.Monad.Reader import qualified Control.Monad.State as MS-import Control.Monad.Trans.Resource (ResourceT)  import qualified Data.Aeson as A import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI import Data.Default (Default, def)-import Data.Conduit.Lazy (lazyConsume)-import Data.Maybe (fromMaybe) import Data.Monoid (mconcat) import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding (encodeUtf8)@@ -51,21 +48,6 @@     status status500     html $ mconcat ["<h1>500 Internal Server Error</h1>", msg] defaultHandler Next = next--mkEnv :: StdMethod -> Request -> [Param] -> ResourceT IO ActionEnv-mkEnv method req captures = do-    b <- BL.fromChunks <$> lazyConsume (requestBody req)--    let parameters = captures ++ formparams ++ queryparams-        formparams = case (method, lookup "Content-Type" [(CI.mk k, CI.mk v) | (k,v) <- requestHeaders req]) of-                        (_, Just "application/x-www-form-urlencoded") -> parseEncodedParams $ mconcat $ BL.toChunks b-                        _ -> []-        queryparams = parseEncodedParams $ rawQueryString req--    return $ Env req parameters b--parseEncodedParams :: B.ByteString -> [Param]-parseEncodedParams bs = [ (T.fromStrict k, T.fromStrict $ fromMaybe "" v) | (k,v) <- parseQueryText bs ]  -- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions -- turn into HTTP 500 responses.

@@ -1,44 +1,50 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, FlexibleInstances, ScopedTypeVariables #-} module Web.Scotty.Route     ( get, post, put, delete, addroute, matchAny, notFound,-      capture, regex, function, literal+      capture, regex, function, literal, Action     ) where -import Web.Scotty.Action-import Web.Scotty.Types-+import Control.Arrow ((***))+import Control.Applicative import Control.Monad.Error import qualified Control.Monad.State as MS+import Control.Monad.Trans.Resource (ResourceT) -import Data.Monoid (mconcat)+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.CaseInsensitive as CI+import Data.Conduit.Lazy (lazyConsume)+import Data.Maybe (fromMaybe)+import Data.Monoid (mconcat, (<>)) import qualified Data.Text.Lazy as T+import qualified Data.Text as TS  import Network.HTTP.Types import Network.Wai -import Web.Scotty.Util- import qualified Text.Regex as Regex-import Control.Arrow ((***)) +import Web.Scotty.Action+import Web.Scotty.Types+ -- | get = 'addroute' 'GET'-get :: RoutePattern -> ActionM () -> ScottyM ()+get :: (Action action) => RoutePattern -> action -> ScottyM () get = addroute GET  -- | post = 'addroute' 'POST'-post :: RoutePattern -> ActionM () -> ScottyM ()+post :: (Action action) => RoutePattern -> action -> ScottyM () post = addroute POST  -- | put = 'addroute' 'PUT'-put :: RoutePattern -> ActionM () -> ScottyM ()+put :: (Action action) => RoutePattern -> action -> ScottyM () put = addroute PUT  -- | delete = 'addroute' 'DELETE'-delete :: RoutePattern -> ActionM () -> ScottyM ()+delete :: (Action action) => RoutePattern -> action -> ScottyM () delete = addroute DELETE  -- | Add a route that matches regardless of the HTTP verb.-matchAny :: RoutePattern -> ActionM () -> ScottyM ()+matchAny :: (Action action) => RoutePattern -> action -> ScottyM () matchAny pattern action = mapM_ (\v -> addroute v pattern action) [minBound..maxBound]  -- | Specify an action to take if nothing else is found. Note: this _always_ matches,@@ -47,7 +53,7 @@ notFound action = matchAny (Function (\req -> Just [("path", path req)])) (status status404 >> action)  -- | Define a route with a 'StdMethod', 'T.Text' value representing the path spec,--- and a body ('ActionM') which modifies the response.+-- and a body ('Action') which modifies the response. -- -- > addroute GET "/" $ text "beam me up!" --@@ -60,10 +66,36 @@ -- -- >>> curl http://localhost:3000/foo/something -- something-addroute :: StdMethod -> RoutePattern -> ActionM () -> ScottyM ()-addroute method pat action = MS.modify (addRoute r)-    where r = route method pat action+addroute :: (Action action) => StdMethod -> RoutePattern -> action -> ScottyM ()+addroute method pat action = MS.modify $ addRoute $ route method pat $ build action pat +-- | An action (executed when a route matches) can either be an 'ActionM' computation, or+-- a function with an argument for each capture in the route. For example:+--+-- > get "/lambda/:foo/:bar" $ \ a b -> do+-- >     text $ mconcat [a,b]+--+-- is elaborated by Scotty to:+--+-- > get "/lambda/:foo/:bar" $ do+-- >     a <- param "foo"+-- >     b <- param "bar"+-- >     text $ mconcat [a,b]+class Action a where+    build :: a -> RoutePattern -> ActionM ()++instance Action (ActionM a) where+    build action _ = action >> return ()++instance (Parsable a, Action b) => Action (a -> b) where+    build f pat = findCapture pat >>= \ (v, pat') -> build (f v) pat'+        where findCapture :: RoutePattern -> ActionM (a, RoutePattern)+              findCapture (Literal l) = raise $ "Lambda trying to capture a literal route: " <> l+              findCapture (Capture p) = case T.span (/='/') (T.dropWhile (/=':') p) of+                                            (m,r) | T.null m -> raise "More function arguments than captures."+                                                  | otherwise -> param (T.tail m) >>= \ v -> return (v, Capture r)+              findCapture (Function _) = raise "Lambda trying to capture a function route."+ route :: StdMethod -> RoutePattern -> ActionM () -> Middleware route method pat action app req =     if Right method == parseMethod (requestMethod req)@@ -94,8 +126,24 @@                                | T.head p == ':' = go ps rs $ (T.tail p, r) : prs -- p is a capture, add to params                                | otherwise       = Nothing      -- both literals, but unequal, fail +-- Pretend we are at the top level. path :: Request -> T.Text-path = strictByteStringToLazyText . rawPathInfo+path = T.fromStrict . TS.cons '/' . TS.intercalate "/" . pathInfo++mkEnv :: StdMethod -> Request -> [Param] -> ResourceT IO ActionEnv+mkEnv method req captures = do+    b <- BL.fromChunks <$> lazyConsume (requestBody req)++    let parameters = captures ++ formparams ++ queryparams+        formparams = case (method, lookup "Content-Type" [(CI.mk k, CI.mk v) | (k,v) <- requestHeaders req]) of+                        (_, Just "application/x-www-form-urlencoded") -> parseEncodedParams $ mconcat $ BL.toChunks b+                        _ -> []+        queryparams = parseEncodedParams $ rawQueryString req++    return $ Env req parameters b++parseEncodedParams :: B.ByteString -> [Param]+parseEncodedParams bs = [ (T.fromStrict k, T.fromStrict $ fromMaybe "" v) | (k,v) <- parseQueryText bs ]  -- | Match requests using a regular expression. --   Named captures are not yet supported.

@@ -7,11 +7,10 @@  import Data.ByteString.Lazy.Char8 (ByteString) import Data.Default (Default, def)+import Data.String (IsString(..)) import Data.Text.Lazy (Text, pack)  import Network.Wai--import Data.String (IsString(..))  data ScottyState = ScottyState { middlewares :: [Middleware]                                , routes :: [Middleware]

@@ -85,6 +85,9 @@         b <- body         text $ decodeUtf8 b +    get "/lambda/:foo/:bar" $ \ foo bar baz -> do+        text $ mconcat [foo, bar, baz]+ {- If you don't want to use Warp as your webserver,    you can use any WAI handler. 

@@ -1,5 +1,5 @@ Name:                scotty-Version:             0.4.0+Version:             0.4.1 Synopsis:            Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp Homepage:            https://github.com/xich/scotty Bug-reports:         https://github.com/xich/scotty/issues