scotty 0.4.6 → 0.5.0
raw patch · 15 files changed
+691/−198 lines, 15 filesdep +transformersdep ~http-types
Dependencies added: transformers
Dependency ranges changed: http-types
Files
- README +0/−38
- README.md +34/−0
- ReleaseNotes.md +28/−0
- Web/Scotty.hs +233/−31
- Web/Scotty/Action.hs +74/−47
- Web/Scotty/Route.hs +28/−51
- Web/Scotty/Trans.hs +100/−0
- Web/Scotty/Types.hs +25/−10
- Web/Scotty/Util.hs +20/−14
- examples/404.html +1/−0
- examples/basic.hs +1/−4
- examples/globalstate.hs +73/−0
- examples/gzip.hs +19/−0
- examples/upload.hs +45/−0
- scotty.cabal +10/−3
− README
@@ -1,38 +0,0 @@-Scotty-======--A Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp.-- {-# LANGUAGE OverloadedStrings #-}- import Web.Scotty-- import Data.Monoid (mconcat)-- main = scotty 3000 $ do- get "/:word" $ do- beam <- param "word"- html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]--Scotty is the cheap and cheerful way to write RESTful, declarative web applications.-- * A page is as simple as defining the verb, url pattern, and Text content.- * It is template-language agnostic. Anything that returns a Text value will do.- * Conforms to WAI Application interface.- * Uses very fast Warp webserver by default.--See examples/basic.hs to see Scotty in action. (basic.hs needs the wai-extra package)-- > runghc examples/basic.hs- Setting phasers to stun... (ctrl-c to quit)- (visit localhost:3000/somepath)--This design has been done in Haskell at least once before (to my knowledge) by-the miku framework. My issue with miku is that it uses the Hack2 interface-instead of WAI (they are analogous, but the latter seems to have more traction),-and that it is written using a custom prelude called Air (which appears to be an-attempt to turn Haskell into Ruby syntactically). I wanted something that-depends on relatively few other packages, with an API that fits on one page.--As for the name: Sinatra + Warp = Scotty.--Copyright (c) 2012 Andrew Farmer
+ README.md view
@@ -0,0 +1,34 @@+# Scotty++A Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp.++```haskell+{-# LANGUAGE OverloadedStrings #-}+import Web.Scotty++import Data.Monoid (mconcat)++main = scotty 3000 $ do+get "/:word" $ do+ beam <- param "word"+ html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]+```++Scotty is the cheap and cheerful way to write RESTful, declarative web applications.++* A page is as simple as defining the verb, url pattern, and Text content.+* It is template-language agnostic. Anything that returns a Text value will do.+* Conforms to WAI Application interface.+* Uses very fast Warp webserver by default.++See examples/basic.hs to see Scotty in action. (basic.hs needs the wai-extra package)++```bash+> runghc examples/basic.hs+Setting phasers to stun... (port 3000) (ctrl-c to quit)+(visit localhost:3000/somepath)+```++As for the name: Sinatra + Warp = Scotty.++Copyright (c) 2012-2013 Andrew Farmer
+ ReleaseNotes.md view
@@ -0,0 +1,28 @@+## 0.5.0++* The Scotty monads (`ScottyM` and `ActionM`) are now monad transformers,+ allowing Scotty applications to be embedded in arbitrary `MonadIO`s.+ The old API continues to be exported from `Web.Scotty` where:++ type ScottyM = ScottyT IO+ type ActionM = ActionT IO++ The new transformers are found in `Web.Scotty.Trans`. See the+ `globalstate` example for use. Special thanks to Dan Frumin (co-dan)+ for much of the legwork here.++* Added support for HTTP PATCH method.++* Removed lambda action syntax. This will return when we have a better+ story for typesafe routes.++* `reqHeader :: Text -> ActionM Text` ==> + `reqHeader :: Text -> ActionM (Maybe Text)`++* New `raw` method to set body to a raw `ByteString`++* Parse error thrown by `jsonData` now includes the body it couldn't parse.++* `header` split into `setHeader` and `addHeader`. The former replaces+ a response header (original behavior). The latter adds a header (useful+ for multiple `Set-Cookie`s, for instance.
Web/Scotty.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, RankNTypes #-} -- | It should be noted that most of the code snippets below depend on the -- OverloadedStrings language pragma. module Web.Scotty@@ -9,67 +9,269 @@ -- | 'Middleware' and routes are run in the order in which they -- are defined. All middleware is run first, followed by the first -- route that matches. If no route matches, a 404 response is given.- , middleware, get, post, put, delete, addroute, matchAny, notFound+ , middleware, get, post, put, delete, patch, addroute, matchAny, notFound -- ** Route Patterns , capture, regex, function, literal- -- * Defining Actions- , Action -- ** Accessing the Request, Captures, and Query Parameters , request, reqHeader, body, param, params, jsonData, files -- ** Modifying the Response and Redirecting- , status, header, redirect+ , status, addHeader, setHeader, redirect -- ** Setting Response Body -- -- | Note: only one of these should be present in any given route -- definition, as they completely replace the current 'Response' body.- , text, html, file, json, source+ , text, html, file, json, source, raw -- ** Exceptions , raise, rescue, next -- * Parsing Parameters- , Param, Parsable(..), readEither+ , Param, Trans.Parsable(..), Trans.readEither -- * Types , ScottyM, ActionM, RoutePattern, File ) where -import Blaze.ByteString.Builder (fromByteString)+-- With the exception of this, everything else better just import types.+import qualified Web.Scotty.Trans as Trans -import Control.Monad (when)-import Control.Monad.State (execStateT, modify)+import Blaze.ByteString.Builder (Builder) -import Data.Default (def)+import Data.Aeson (FromJSON, ToJSON)+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Conduit (Flush, ResourceT, Source)+import Data.Text.Lazy (Text) -import Network.HTTP.Types (status404)-import Network.Wai-import Network.Wai.Handler.Warp (Port, runSettings, settingsPort)+import Network.HTTP.Types (Status, StdMethod)+import Network.Wai (Application, Middleware, Request)+import Network.Wai.Handler.Warp (Port) -import Web.Scotty.Action-import Web.Scotty.Route-import Web.Scotty.Types+import Web.Scotty.Types (Param, ActionM, ScottyM, RoutePattern, Options, File) -- | Run a scotty application using the warp server. scotty :: Port -> ScottyM () -> IO ()-scotty p = scottyOpts $ def { settings = (settings def) { settingsPort = p } }+scotty p = Trans.scottyT p id id -- | Run a scotty application using the warp server, passing extra options.-scottyOpts :: Options -> ScottyM() -> IO ()-scottyOpts opts s = do- when (verbose opts > 0) $- putStrLn $ "Setting phasers to stun... (port " ++ show (settingsPort (settings opts)) ++ ") (ctrl-c to quit)"- runSettings (settings opts) =<< scottyApp s+scottyOpts :: Options -> ScottyM () -> IO ()+scottyOpts opts = Trans.scottyOptsT opts id id -- | Turn a scotty application into a WAI 'Application', which can be -- run with any WAI handler. scottyApp :: ScottyM () -> IO Application-scottyApp defs = do- s <- execStateT (runS defs) def- return $ foldl (flip ($)) notFoundApp $ routes s ++ middlewares s--notFoundApp :: Application-notFoundApp _ = return $ ResponseBuilder status404 [("Content-Type","text/html")]- $ fromByteString "<h1>404: File Not Found!</h1>"+scottyApp = Trans.scottyAppT id id -- | Use given middleware. Middleware is nested such that the first declared -- 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 = modify . addMiddleware+middleware = Trans.middleware++-- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions+-- turn into HTTP 500 responses.+raise :: Text -> ActionM a+raise = Trans.raise++-- | Abort execution of this action and continue pattern matching routes.+-- Like an exception, any code after 'next' is not executed.+--+-- As an example, these two routes overlap. The only way the second one will+-- ever run is if the first one calls 'next'.+--+-- > get "/foo/:number" $ do+-- > n <- param "number"+-- > unless (all isDigit n) $ next+-- > text "a number"+-- >+-- > get "/foo/:bar" $ do+-- > bar <- param "bar"+-- > text "not a number"+next :: ActionM a+next = Trans.next++-- | Catch an exception thrown by 'raise'.+--+-- > raise "just kidding" `rescue` (\msg -> text msg)+rescue :: ActionM a -> (Text -> ActionM a) -> ActionM a+rescue = Trans.rescue++-- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect+-- will not be run.+--+-- > redirect "http://www.google.com"+--+-- OR+--+-- > redirect "/foo/bar"+redirect :: Text -> ActionM a+redirect = Trans.redirect++-- | Get the 'Request' object.+request :: ActionM Request+request = Trans.request++-- | Get list of uploaded files.+files :: ActionM [File]+files = Trans.files++-- | Get a request header. Header name is case-insensitive.+reqHeader :: Text -> ActionM (Maybe Text)+reqHeader = Trans.reqHeader++-- | Get the request body.+body :: ActionM ByteString+body = Trans.body++-- | Parse the request body as a JSON object and return it. Raises an exception if parse is unsuccessful.+jsonData :: FromJSON a => ActionM a+jsonData = Trans.jsonData++-- | Get a parameter. First looks in captures, then form data, then query parameters.+--+-- * Raises an exception which can be caught by 'rescue' if parameter is not found.+--+-- * If parameter is found, but 'read' fails to parse to the correct type, 'next' is called.+-- This means captures are somewhat typed, in that a route won't match if a correctly typed+-- capture cannot be parsed.+param :: Trans.Parsable a => Text -> ActionM a+param = Trans.param++-- | Get all parameters from capture, form and query (in that order).+params :: ActionM [Param]+params = Trans.params++-- | Set the HTTP response status. Default is 200.+status :: Status -> ActionM ()+status = Trans.status++-- | Add to the response headers. Header names are case-insensitive.+addHeader :: Text -> Text -> ActionM ()+addHeader = Trans.addHeader++-- | Set one of the response headers. Will override any previously set value for that header.+-- Header names are case-insensitive.+setHeader :: Text -> Text -> ActionM ()+setHeader = Trans.setHeader++-- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\"+-- header to \"text/plain\".+text :: Text -> ActionM ()+text = Trans.text++-- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\"+-- header to \"text/html\".+html :: Text -> ActionM ()+html = Trans.html++-- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably+-- want to do that on your own with 'header'.+file :: FilePath -> ActionM ()+file = Trans.file++-- | 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 -> ActionM ()+json = Trans.json++-- | Set the body of the response to a Source. Doesn't set the+-- \"Content-Type\" header, so you probably want to do that on your+-- own with 'header'.+source :: Source (ResourceT IO) (Flush Builder) -> ActionM ()+source = Trans.source++-- | Set the body of the response to the given 'BL.ByteString' value. Doesn't set the+-- \"Content-Type\" header, so you probably want to do that on your own with 'header'.+raw :: ByteString -> ActionM ()+raw = Trans.raw++-- | get = 'addroute' 'GET'+get :: RoutePattern -> ActionM () -> ScottyM ()+get = Trans.get++-- | post = 'addroute' 'POST'+post :: RoutePattern -> ActionM () -> ScottyM ()+post = Trans.post++-- | put = 'addroute' 'PUT'+put :: RoutePattern -> ActionM () -> ScottyM ()+put = Trans.put++-- | delete = 'addroute' 'DELETE'+delete :: RoutePattern -> ActionM () -> ScottyM ()+delete = Trans.delete++-- | patch = 'addroute' 'PATCH'+patch :: RoutePattern -> ActionM () -> ScottyM ()+patch = Trans.patch++-- | Add a route that matches regardless of the HTTP verb.+matchAny :: RoutePattern -> ActionM () -> ScottyM ()+matchAny = Trans.matchAny++-- | Specify an action to take if nothing else is found. Note: this _always_ matches,+-- so should generally be the last route specified.+notFound :: ActionM () -> ScottyM ()+notFound = Trans.notFound++-- | Define a route with a 'StdMethod', 'Text' value representing the path spec,+-- and a body ('Action') which modifies the response.+--+-- > addroute GET "/" $ text "beam me up!"+--+-- The path spec can include values starting with a colon, which are interpreted+-- as /captures/. These are named wildcards that can be looked up with 'param'.+--+-- > addroute GET "/foo/:bar" $ do+-- > v <- param "bar"+-- > text v+--+-- >>> curl http://localhost:3000/foo/something+-- something+addroute :: StdMethod -> RoutePattern -> ActionM () -> ScottyM ()+addroute = Trans.addroute++-- | Match requests using a regular expression.+-- Named captures are not yet supported.+--+-- > get (regex "^/f(.*)r$") $ do+-- > path <- param "0"+-- > cap <- param "1"+-- > text $ mconcat ["Path: ", path, "\nCapture: ", cap]+--+-- >>> curl http://localhost:3000/foo/bar+-- Path: /foo/bar+-- Capture: oo/ba+--+regex :: String -> RoutePattern+regex = Trans.regex++-- | Standard Sinatra-style route. Named captures are prepended with colons.+-- This is the default route type generated by OverloadedString routes. i.e.+--+-- > get (capture "/foo/:bar") $ ...+--+-- and+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > ...+-- > get "/foo/:bar" $ ...+--+-- are equivalent.+capture :: String -> RoutePattern+capture = Trans.capture++-- | Build a route based on a function which can match using the entire 'Request' object.+-- 'Nothing' indicates the route does not match. A 'Just' value indicates+-- a successful match, optionally returning a list of key-value pairs accessible+-- by 'param'.+--+-- > get (function $ \req -> Just [("version", pack $ show $ httpVersion req)]) $ do+-- > v <- param "version"+-- > text v+--+-- >>> curl http://localhost:3000/+-- HTTP/1.1+--+function :: (Request -> Maybe [Param]) -> RoutePattern+function = Trans.function++-- | Build a route that requires the requested path match exactly, without captures.+literal :: String -> RoutePattern+literal = Trans.literal
Web/Scotty/Action.hs view
@@ -1,15 +1,34 @@ {-# LANGUAGE OverloadedStrings #-} module Web.Scotty.Action- ( request, files, reqHeader, body, param, params, jsonData- , status, header, redirect- , text, html, file, json, source- , raise, rescue, next- , ActionM, Parsable(..), readEither, Param, runAction+ ( addHeader+ , body+ , file+ , files+ , html+ , json+ , jsonData+ , next+ , param+ , params+ , raise+ , raw+ , readEither+ , redirect+ , reqHeader+ , request+ , rescue+ , setHeader+ , source+ , status+ , text+ , Param+ , Parsable(..)+ -- private to Scotty+ , runAction ) where import Blaze.ByteString.Builder (Builder, fromLazyByteString) -import Control.Applicative import Control.Monad.Error import Control.Monad.Reader import qualified Control.Monad.State as MS@@ -19,10 +38,10 @@ import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI import Data.Conduit (Flush, ResourceT, Source)-import Data.Default (Default, def)-import Data.Monoid (mconcat)+import Data.Default (def)+import Data.Monoid (mconcat, (<>)) import qualified Data.Text.Lazy as T-import Data.Text.Lazy.Encoding (encodeUtf8)+import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8) import Network.HTTP.Types import Network.Wai@@ -32,7 +51,7 @@ -- Nothing indicates route failed (due to Next) and pattern matching should continue. -- Just indicates a successful response.-runAction :: ActionEnv -> ActionM () -> IO (Maybe Response)+runAction :: Monad m => ActionEnv -> ActionT m () -> m (Maybe Response) runAction env action = do (e,r) <- flip MS.runStateT def $ flip runReaderT env@@ -41,10 +60,10 @@ $ action `catchError` defaultHandler return $ either (const Nothing) (const $ Just r) e -defaultHandler :: ActionError -> ActionM ()+defaultHandler :: Monad m => ActionError -> ActionT m () defaultHandler (Redirect url) = do status status302- header "Location" url+ setHeader "Location" url defaultHandler (ActionError msg) = do status status500 html $ mconcat ["<h1>500 Internal Server Error</h1>", msg]@@ -52,7 +71,7 @@ -- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions -- turn into HTTP 500 responses.-raise :: T.Text -> ActionM a+raise :: Monad m => T.Text -> ActionT m a raise = throwError . ActionError -- | Abort execution of this action and continue pattern matching routes.@@ -69,13 +88,13 @@ -- > get "/foo/:bar" $ do -- > bar <- param "bar" -- > text "not a number"-next :: ActionM a+next :: Monad m => ActionT m a next = throwError Next -- | Catch an exception thrown by 'raise'. -- -- > raise "just kidding" `rescue` (\msg -> text msg)-rescue :: ActionM a -> (T.Text -> ActionM a) -> ActionM a+rescue :: Monad m => ActionT m a -> (T.Text -> ActionT m a) -> ActionT m a rescue action handler = catchError action $ \e -> case e of ActionError msg -> handler msg -- handle errors other -> throwError other -- rethrow redirects and nexts@@ -88,34 +107,32 @@ -- OR -- -- > redirect "/foo/bar"-redirect :: T.Text -> ActionM a+redirect :: Monad m => T.Text -> ActionT m a redirect = throwError . Redirect -- | Get the 'Request' object.-request :: ActionM Request-request = getReq <$> ask+request :: Monad m => ActionT m Request+request = liftM getReq ask -- | Get list of uploaded files.-files :: ActionM [File]-files = getFiles <$> ask+files :: Monad m => ActionT m [File]+files = liftM getFiles ask -- | Get a request header. Header name is case-insensitive.-reqHeader :: T.Text -> ActionM T.Text+reqHeader :: Monad m => T.Text -> ActionT m (Maybe T.Text) reqHeader k = do- hs <- requestHeaders <$> request- maybe (raise (mconcat ["reqHeader: ", k, " not found"]))- (return . strictByteStringToLazyText)- (lookup (CI.mk (lazyTextToStrictByteString k)) hs)+ hs <- liftM requestHeaders request+ return $ fmap strictByteStringToLazyText $ lookup (CI.mk (lazyTextToStrictByteString k)) hs -- | Get the request body.-body :: ActionM BL.ByteString-body = getBody <$> ask+body :: Monad m => ActionT m BL.ByteString+body = liftM getBody ask -- | Parse the request body as a JSON object and return it. Raises an exception if parse is unsuccessful.-jsonData :: (A.FromJSON a) => ActionM a+jsonData :: (A.FromJSON a, Monad m) => ActionT m a jsonData = do b <- body- maybe (raise "jsonData: no parse") return $ A.decode b+ maybe (raise $ "jsonData - no parse: " <> decodeUtf8 b) return $ A.decode b -- | Get a parameter. First looks in captures, then form data, then query parameters. --@@ -124,16 +141,16 @@ -- * If parameter is found, but 'read' fails to parse to the correct type, 'next' is called. -- This means captures are somewhat typed, in that a route won't match if a correctly typed -- capture cannot be parsed.-param :: (Parsable a) => T.Text -> ActionM a+param :: (Parsable a, Monad m) => T.Text -> ActionT m a param k = do- val <- lookup k <$> getParams <$> ask+ val <- liftM (lookup k . getParams) ask case val of Nothing -> raise $ mconcat ["Param: ", k, " not found!"] Just v -> either (const next) return $ parseParam v -- | Get all parameters from capture, form and query (in that order).-params :: ActionM [Param]-params = getParams <$> ask+params :: Monad m => ActionT m [Param]+params = liftM getParams ask -- | Minimum implemention: 'parseParam' class Parsable a where@@ -178,42 +195,52 @@ _ -> Left "readEither: ambiguous parse" -- | Set the HTTP response status. Default is 200.-status :: Status -> ActionM ()+status :: Monad m => Status -> ActionT m () status = MS.modify . setStatus +-- | Add to the response headers. Header names are case-insensitive.+addHeader :: Monad m => T.Text -> T.Text -> ActionT m ()+addHeader k v = MS.modify $ setHeaderWith $ add (CI.mk $ lazyTextToStrictByteString k) (lazyTextToStrictByteString v)+ -- | Set one of the response headers. Will override any previously set value for that header. -- Header names are case-insensitive.-header :: T.Text -> T.Text -> ActionM ()-header k v = MS.modify $ setHeader (CI.mk $ lazyTextToStrictByteString k, lazyTextToStrictByteString v)+setHeader :: Monad m => T.Text -> T.Text -> ActionT m ()+setHeader k v = MS.modify $ setHeaderWith $ replace (CI.mk $ lazyTextToStrictByteString k) (lazyTextToStrictByteString v) -- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\" -- header to \"text/plain\".-text :: T.Text -> ActionM ()+text :: Monad m => T.Text -> ActionT m () text t = do- header "Content-Type" "text/plain"- MS.modify $ setContent $ ContentBuilder $ fromLazyByteString $ encodeUtf8 t+ setHeader "Content-Type" "text/plain"+ raw $ encodeUtf8 t -- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\" -- header to \"text/html\".-html :: T.Text -> ActionM ()+html :: Monad m => T.Text -> ActionT m () html t = do- header "Content-Type" "text/html"- MS.modify $ setContent $ ContentBuilder $ fromLazyByteString $ encodeUtf8 t+ setHeader "Content-Type" "text/html"+ raw $ encodeUtf8 t -- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably -- want to do that on your own with 'header'.-file :: FilePath -> ActionM ()+file :: Monad m => FilePath -> ActionT m () file = MS.modify . setContent . ContentFile -- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\" -- header to \"application/json\".-json :: (A.ToJSON a) => a -> ActionM ()+json :: (A.ToJSON a, Monad m) => a -> ActionT m () json v = do- header "Content-Type" "application/json"- MS.modify $ setContent $ ContentBuilder $ fromLazyByteString $ A.encode v+ setHeader "Content-Type" "application/json"+ raw $ A.encode v -- | Set the body of the response to a Source. Doesn't set the -- \"Content-Type\" header, so you probably want to do that on your -- own with 'header'.-source :: Source (ResourceT IO) (Flush Builder) -> ActionM ()+source :: Monad m => Source (ResourceT IO) (Flush Builder) -> ActionT m () source = MS.modify . setContent . ContentSource++-- | Set the body of the response to the given 'BL.ByteString' value. Doesn't set the+-- \"Content-Type\" header, so you probably want to do that on your+-- own with 'header'.+raw :: Monad m => BL.ByteString -> ActionT m ()+raw = MS.modify . setContent . ContentBuilder . fromLazyByteString
Web/Scotty/Route.hs view
@@ -1,14 +1,13 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances, ScopedTypeVariables #-} module Web.Scotty.Route- ( get, post, put, delete, addroute, matchAny, notFound,- capture, regex, function, literal, Action+ ( get, post, put, delete, patch, addroute, matchAny, notFound,+ capture, regex, function, literal ) where import Control.Arrow ((***))-import Control.Applicative import Control.Monad.Error import qualified Control.Monad.State as MS-import Control.Monad.Trans.Resource (ResourceT)+import Control.Monad.Trans.Resource (ResourceT, transResourceT) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL@@ -23,7 +22,7 @@ import qualified Data.Text as TS import Network.HTTP.Types-import Network.Wai+import Network.Wai (Request(..)) import qualified Network.Wai.Parse as Parse hiding (parseRequestBody) import qualified Text.Regex as Regex@@ -33,28 +32,32 @@ import Web.Scotty.Util -- | get = 'addroute' 'GET'-get :: (Action action) => RoutePattern -> action -> ScottyM ()+get :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m () get = addroute GET -- | post = 'addroute' 'POST'-post :: (Action action) => RoutePattern -> action -> ScottyM ()+post :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m () post = addroute POST -- | put = 'addroute' 'PUT'-put :: (Action action) => RoutePattern -> action -> ScottyM ()+put :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m () put = addroute PUT -- | delete = 'addroute' 'DELETE'-delete :: (Action action) => RoutePattern -> action -> ScottyM ()+delete :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m () delete = addroute DELETE +-- | patch = 'addroute' 'PATCH'+patch :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m ()+patch = addroute PATCH+ -- | Add a route that matches regardless of the HTTP verb.-matchAny :: (Action action) => RoutePattern -> action -> ScottyM ()+matchAny :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m () 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, -- so should generally be the last route specified.-notFound :: ActionM () -> ScottyM ()+notFound :: MonadIO m => ActionT m () -> ScottyT m () 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,@@ -71,47 +74,20 @@ -- -- >>> curl http://localhost:3000/foo/something -- something-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 $ mconcat ["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."+addroute :: MonadIO m => StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()+addroute method pat action = MS.modify $ addRoute $ route method pat action -route :: StdMethod -> RoutePattern -> ActionM () -> Middleware+route :: MonadIO m => StdMethod -> RoutePattern -> ActionT m () -> Middleware m route method pat action app req =- if Right method == parseMethod (requestMethod req)- then case matchRoute pat req of+ let tryNext = app req+ in if Right method == parseMethod (requestMethod req)+ then case matchRoute pat req of Just captures -> do env <- mkEnv req captures res <- lift $ runAction env action maybe tryNext return res Nothing -> tryNext- else tryNext- where tryNext = app req+ else tryNext matchRoute :: RoutePattern -> Request -> Maybe [Param] @@ -136,20 +112,21 @@ path = T.fromStrict . TS.cons '/' . TS.intercalate "/" . pathInfo -- Stolen from wai-extra, modified to accept body as lazy ByteString-parseRequestBody :: BL.ByteString+parseRequestBody :: MonadIO m+ => BL.ByteString -> Parse.BackEnd y -> Request- -> ResourceT IO ([Parse.Param], [Parse.File y])+ -> ResourceT m ([Parse.Param], [Parse.File y]) parseRequestBody b s r = case Parse.getRequestBodyType r of Nothing -> return ([], [])- Just rbt -> fmap partitionEithers $ sourceLbs b $$ Parse.conduitRequestBody s rbt =$ consume+ Just rbt -> transResourceT liftIO $ liftM partitionEithers $ sourceLbs b $$ Parse.conduitRequestBody s rbt =$ consume -mkEnv :: Request -> [Param] -> ResourceT IO ActionEnv+mkEnv :: MonadIO m => Request -> [Param] -> ResourceT m ActionEnv mkEnv req captures = do- b <- BL.fromChunks <$> lazyConsume (requestBody req)+ b <- transResourceT liftIO $ liftM BL.fromChunks $ lazyConsume (requestBody req) - (formparams, fs) <- parseRequestBody b Parse.lbsBackEnd req+ (formparams, fs) <- transResourceT liftIO $ parseRequestBody b Parse.lbsBackEnd req let convert (k, v) = (strictByteStringToLazyText k, strictByteStringToLazyText v) parameters = captures ++ map convert formparams ++ queryparams
+ Web/Scotty/Trans.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings, RankNTypes #-}+-- | It should be noted that most of the code snippets below depend on the+-- OverloadedStrings language pragma.+--+-- The functions in this module allow an arbitrary monad to be embedded+-- in Scotty's monad transformer stack in order that Scotty be combined+-- with other DSLs.+module Web.Scotty.Trans+ ( -- * scotty-to-WAI+ scottyT, scottyAppT, scottyOptsT, Options(..)+ -- * Defining Middleware and Routes+ --+ -- | 'Middleware' and routes are run in the order in which they+ -- are defined. All middleware is run first, followed by the first+ -- route that matches. If no route matches, a 404 response is given.+ , middleware, get, post, put, delete, patch, addroute, matchAny, notFound+ -- ** Route Patterns+ , capture, regex, function, literal+ -- ** Accessing the Request, Captures, and Query Parameters+ , request, reqHeader, body, param, params, jsonData, files+ -- ** Modifying the Response and Redirecting+ , status, addHeader, setHeader, redirect+ -- ** Setting Response Body+ --+ -- | Note: only one of these should be present in any given route+ -- definition, as they completely replace the current 'Response' body.+ , text, html, file, json, source, raw+ -- ** Exceptions+ , raise, rescue, next+ -- * Parsing Parameters+ , Param, Parsable(..), readEither+ -- * Types+ , ScottyM, ActionM, RoutePattern, File+ -- * Monad Transformers+ , ScottyT, ActionT+ ) where++import Blaze.ByteString.Builder (fromByteString)++import Control.Monad (when)+import Control.Monad.State (execStateT, modify)+import Control.Monad.Trans.Resource (transResourceT)+import Control.Monad.IO.Class++import Data.Default (def)++import Network.HTTP.Types (status404)+import Network.Wai+import Network.Wai.Handler.Warp (Port, runSettings, settingsPort)++import Web.Scotty.Action+import Web.Scotty.Route+import Web.Scotty.Types hiding (Application, Middleware)+import qualified Web.Scotty.Types as Scotty++-- | Run a scotty application using the warp server.+-- NB: 'scotty p' === 'scottyT p id id'+scottyT :: (Monad m, MonadIO n)+ => Port+ -> (forall a. m a -> n a) -- ^ Run monad 'm' into monad 'n', called once at 'ScottyT' level.+ -> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.+ -> ScottyT m ()+ -> n ()+scottyT p = scottyOptsT $ def { settings = (settings def) { settingsPort = p } }++-- | Run a scotty application using the warp server, passing extra options.+-- NB: 'scottyOpts opts' === 'scottyOptsT opts id id'+scottyOptsT :: (Monad m, MonadIO n)+ => Options+ -> (forall a. m a -> n a) -- ^ Run monad 'm' into monad 'n', called once at 'ScottyT' level.+ -> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.+ -> ScottyT m ()+ -> n ()+scottyOptsT opts runM runActionToIO s = do+ when (verbose opts > 0) $+ liftIO $ putStrLn $ "Setting phasers to stun... (port " ++ show (settingsPort (settings opts)) ++ ") (ctrl-c to quit)"+ liftIO . runSettings (settings opts) =<< scottyAppT runM runActionToIO s++-- | Turn a scotty application into a WAI 'Application', which can be+-- run with any WAI handler.+-- NB: 'scottyApp' === 'scottyAppT id id'+scottyAppT :: (Monad m, Monad n)+ => (forall a. m a -> n a) -- ^ Run monad 'm' into monad 'n', called once at 'ScottyT' level.+ -> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.+ -> ScottyT m ()+ -> n Application+scottyAppT runM runActionToIO defs = do+ s <- runM $ execStateT (runS defs) def+ let rapp = transResourceT runActionToIO . foldl (flip ($)) notFoundApp (routes s)+ return $ foldl (flip ($)) rapp (middlewares s)++notFoundApp :: Monad m => Scotty.Application m+notFoundApp _ = return $ ResponseBuilder status404 [("Content-Type","text/html")]+ $ fromByteString "<h1>404: File Not Found!</h1>"++-- | Use given middleware. Middleware is nested such that the first declared+-- 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 :: Monad m => Middleware -> ScottyT m ()+middleware = modify . addMiddleware
Web/Scotty/Types.hs view
@@ -10,7 +10,9 @@ import Data.String (IsString(..)) import Data.Text.Lazy (Text, pack) -import Network.Wai+import qualified Data.Conduit as C+import Network.Wai hiding (Middleware, Application)+import qualified Network.Wai as Wai import Network.Wai.Handler.Warp (Settings, defaultSettings) import Network.Wai.Parse (FileInfo) @@ -21,22 +23,30 @@ instance Default Options where def = Options 1 defaultSettings -data ScottyState = ScottyState { middlewares :: [Middleware]- , routes :: [Middleware]- }+data ScottyState m = ScottyState { middlewares :: [Wai.Middleware]+ , routes :: [Middleware m]+ } -addMiddleware :: Middleware -> ScottyState -> ScottyState+type Middleware m = Application m -> Application m+type Application m = Request -> C.ResourceT m Response++addMiddleware :: Wai.Middleware -> ScottyState m -> ScottyState m addMiddleware m s@(ScottyState {middlewares = ms}) = s { middlewares = m:ms } -addRoute :: Middleware -> ScottyState -> ScottyState+addRoute :: Monad m => Middleware m -> ScottyState m -> ScottyState m addRoute r s@(ScottyState {routes = rs}) = s { routes = r:rs } -instance Default ScottyState where+instance Default (ScottyState m) where def = ScottyState [] [] -newtype ScottyM a = S { runS :: StateT ScottyState IO a }- deriving (Monad, MonadIO, Functor, MonadState ScottyState)+newtype ScottyT m a = ScottyT { runS :: StateT (ScottyState m) m a }+ deriving (Monad, MonadIO, Functor, MonadState (ScottyState m)) +instance MonadTrans ScottyT where+ lift = ScottyT . lift++type ScottyM a = ScottyT IO a+ type Param = (Text, Text) data ActionError = Redirect Text@@ -51,9 +61,14 @@ data ActionEnv = Env { getReq :: Request, getParams :: [Param], getBody :: ByteString, getFiles :: [File] } -newtype ActionM a = AM { runAM :: ErrorT ActionError (ReaderT ActionEnv (StateT Response IO)) a }+newtype ActionT m a = ActionT { runAM :: ErrorT ActionError (ReaderT ActionEnv (StateT Response m)) a } deriving ( Monad, MonadIO, Functor , MonadReader ActionEnv, MonadState Response, MonadError ActionError)++instance MonadTrans ActionT where+ lift = ActionT . lift . lift . lift++type ActionM a = ActionT IO a data RoutePattern = Capture Text | Literal Text
Web/Scotty/Util.hs view
@@ -1,8 +1,12 @@ module Web.Scotty.Util ( lazyTextToStrictByteString , strictByteStringToLazyText- , setContent, setHeader, setStatus+ , setContent+ , setHeaderWith+ , setStatus , Content(..)+ , replace+ , add ) where import Network.Wai@@ -10,7 +14,6 @@ import Network.HTTP.Types import Blaze.ByteString.Builder (Builder)-import Data.CaseInsensitive (CI) import Data.Conduit (Flush, Source, ResourceT) import Data.Default import Data.Monoid@@ -33,20 +36,20 @@ | ContentSource (Source (ResourceT IO) (Flush Builder)) setContent :: Content -> Response -> Response-setContent (ContentBuilder b) (ResponseBuilder s h _) = ResponseBuilder s h b-setContent (ContentBuilder b) (ResponseFile s h _ _) = ResponseBuilder s h b-setContent (ContentBuilder b) (ResponseSource s h _) = ResponseBuilder s h b-setContent (ContentFile f) (ResponseBuilder s h _) = ResponseFile s h f Nothing-setContent (ContentFile f) (ResponseFile s h _ _) = ResponseFile s h f Nothing-setContent (ContentFile f) (ResponseSource s h _) = ResponseFile s h f Nothing+setContent (ContentBuilder b) (ResponseBuilder s h _) = ResponseBuilder s h b+setContent (ContentBuilder b) (ResponseFile s h _ _) = ResponseBuilder s h b+setContent (ContentBuilder b) (ResponseSource s h _) = ResponseBuilder s h b+setContent (ContentFile f) (ResponseBuilder s h _) = ResponseFile s h f Nothing+setContent (ContentFile f) (ResponseFile s h _ _) = ResponseFile s h f Nothing+setContent (ContentFile f) (ResponseSource s h _) = ResponseFile s h f Nothing setContent (ContentSource src) (ResponseBuilder s h _) = ResponseSource s h src setContent (ContentSource src) (ResponseFile s h _ _) = ResponseSource s h src setContent (ContentSource src) (ResponseSource s h _) = ResponseSource s h src -setHeader :: (CI B.ByteString, B.ByteString) -> Response -> Response-setHeader (k,v) (ResponseBuilder s h b) = ResponseBuilder s (update h k v) b-setHeader (k,v) (ResponseFile s h f fp) = ResponseFile s (update h k v) f fp-setHeader (k,v) (ResponseSource s h cs) = ResponseSource s (update h k v) cs+setHeaderWith :: ([(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)]) -> Response -> Response+setHeaderWith g (ResponseBuilder s h b) = ResponseBuilder s (g h) b+setHeaderWith g (ResponseFile s h f fp) = ResponseFile s (g h) f fp+setHeaderWith g (ResponseSource s h cs) = ResponseSource s (g h) cs setStatus :: Status -> Response -> Response setStatus s (ResponseBuilder _ h b) = ResponseBuilder s h b@@ -54,5 +57,8 @@ setStatus s (ResponseSource _ h cs) = ResponseSource s h cs -- Note: we assume headers are not sensitive to order here (RFC 2616 specifies they are not)-update :: (Eq a) => [(a,b)] -> a -> b -> [(a,b)]-update m k v = (k,v) : filter ((/= k) . fst) m+replace :: (Eq a) => a -> b -> [(a,b)] -> [(a,b)]+replace k v m = add k v $ filter ((/= k) . fst) m++add :: (Eq a) => a -> b -> [(a,b)] -> [(a,b)]+add k v m = (k,v):m
+ examples/404.html view
@@ -0,0 +1,1 @@+<h1>This is a 404 page!</h1>
examples/basic.hs view
@@ -85,12 +85,9 @@ b <- body text $ decodeUtf8 b - get "/lambda/:foo/:bar/:baz" $ \ foo bar baz -> do- text $ mconcat [foo, bar, baz]- get "/reqHeader" $ do agent <- reqHeader "User-Agent"- text agent+ maybe (raise "User-Agent header not found!") text agent {- If you don't want to use Warp as your webserver, you can use any WAI handler.
+ examples/globalstate.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+-- An example of embedding a custom monad into+-- Scotty's transformer stack, using ReaderT to provide access+-- to a TVar containing global state.+--+-- Note: this example is somewhat simple, as our top level+-- is IO itself. The types of 'scottyT' and 'scottyAppT' are+-- general enough to allow a Scotty application to be+-- embedded into any MonadIO monad.+module Main where++import Control.Concurrent.STM+import Control.Monad.Reader ++import Data.Default+import Data.Text.Lazy (pack)++import Network.Wai.Middleware.RequestLogger++import Web.Scotty.Trans++newtype AppState = AppState { tickCount :: Int }++instance Default AppState where+ def = AppState 0++-- Why 'ReaderT (TVar AppState)' rather than 'StateT AppState'?+-- With a state transformer, 'runActionToIO' (below) would have+-- to provide the state to _every action_, and save the resulting+-- state, using an MVar. This means actions would be blocking,+-- effectively meaning only one request could be serviced at a time.+-- The 'ReaderT' solution means only actions that actually modify +-- the state need to block/retry.+-- +-- Also note: your monad must be an instance of 'MonadIO' for+-- Scotty to use it.+newtype WebM a = WebM { runWebM :: ReaderT (TVar AppState) IO a }+ deriving (Monad, MonadIO, MonadReader (TVar AppState))++-- Scotty's monads are layered on top of our custom monad.+-- We define this synonym for lift in order to be explicit+-- about when we are operating at the 'WebM' layer.+webM :: MonadTrans t => WebM a -> t WebM a+webM = lift++-- Some helpers to make this feel more like a state monad.+gets :: (AppState -> b) -> WebM b+gets f = ask >>= liftIO . readTVarIO >>= return . f++modify :: (AppState -> AppState) -> WebM ()+modify f = ask >>= liftIO . atomically . flip modifyTVar' f++main :: IO ()+main = do+ sync <- newTVarIO def+ -- Note that 'runM' is only called once, at startup.+ let runM m = runReaderT (runWebM m) sync+ -- 'runActionToIO' is called once per action.+ runActionToIO = runM++ scottyT 3000 runM runActionToIO $ do+ middleware logStdoutDev+ get "/" $ do+ c <- webM $ gets tickCount+ text $ pack $ show c++ get "/plusone" $ do+ webM $ modify $ \ st -> st { tickCount = tickCount st + 1 }+ redirect "/"++ get "/plustwo" $ do+ webM $ modify $ \ st -> st { tickCount = tickCount st + 2 }+ redirect "/"
+ examples/gzip.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+import Network.Wai.Middleware.RequestLogger+import Network.Wai.Middleware.Gzip++import Web.Scotty++main :: IO ()+main = scotty 3000 $ do+ -- Note that files are not gzip'd by the default settings.+ middleware $ gzip $ def { gzipFiles = GzipCompress }+ middleware logStdoutDev++ -- gzip a normal response+ get "/" $ text "It works"++ -- gzip a file response (note non-default gzip settings above)+ get "/afile" $ do+ setHeader "content-type" "text/plain"+ file "gzip.hs"
+ examples/upload.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}+import Web.Scotty++import Control.Monad.IO.Class+import Data.Monoid++import Network.Wai.Middleware.RequestLogger+import Network.Wai.Middleware.Static+import Network.Wai.Parse++import qualified Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes+import Text.Blaze.Html.Renderer.Text (renderHtml)++import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Char8 as BS+import System.FilePath ((</>))++main :: IO ()+main = scotty 3000 $ do+ middleware logStdoutDev+ middleware $ staticPolicy (addBase "uploads")++ get "/" $ do+ html $ renderHtml+ $ H.html $ do+ H.body $ do+ H.form H.! method "post" H.! enctype "multipart/form-data" H.! action "/upload" $ do+ H.input H.! type_ "file" H.! name "foofile"+ H.br+ H.input H.! type_ "file" H.! name "barfile"+ H.br+ H.input H.! type_ "submit"++ post "/upload" $ do+ fs <- files+ let fs' = [ (fieldName, BS.unpack (fileName fi), fileContent fi) | (fieldName,fi) <- fs ]+ -- write the files to disk, so they will be served by the static middleware+ liftIO $ sequence_ [ B.writeFile ("uploads" </> fn) fc | (_,fn,fc) <- fs' ]+ -- generate list of links to the files just uploaded+ html $ mconcat [ mconcat [ fName+ , ": "+ , renderHtml $ H.a (H.toHtml fn) H.! (href $ H.toValue fn) >> H.br+ ]+ | (fName,fn,_) <- fs' ]
scotty.cabal view
@@ -1,5 +1,5 @@ Name: scotty-Version: 0.4.6+Version: 0.5.0 Synopsis: Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp Homepage: https://github.com/ku-fpg/scotty Bug-reports: https://github.com/ku-fpg/scotty/issues@@ -46,10 +46,15 @@ [Warp] <http://hackage.haskell.org/package/warp> Extra-source-files:- README+ README.md+ ReleaseNotes.md+ examples/404.html examples/basic.hs+ examples/globalstate.hs+ examples/gzip.hs examples/json.hs examples/options.hs+ examples/upload.hs examples/urlshortener.hs examples/static/jquery.js examples/static/jquery-json.js@@ -57,6 +62,7 @@ Library Exposed-modules: Web.Scotty+ Web.Scotty.Trans other-modules: Web.Scotty.Action Web.Scotty.Route Web.Scotty.Types@@ -69,11 +75,12 @@ case-insensitive >= 0.4.0.3, conduit >= 0.5.2.7, data-default >= 0.5.0,- http-types >= 0.7.3.0.1,+ http-types >= 0.8.0, mtl >= 2.1.2, regex-compat >= 0.95.1, resourcet >= 0.4.0.2, text >= 0.11.2.3,+ transformers >= 0.3.0.0, wai >= 1.3.0.1, wai-extra >= 1.3.0.3, warp >= 1.3.4.1