scotty 0.3.0 → 0.4.0
raw patch · 6 files changed
+437/−289 lines, 6 filesdep +regex-compatdep +resourcetdep ~conduitdep ~http-types
Dependencies added: regex-compat, resourcet
Dependency ranges changed: conduit, http-types
Files
- Web/Scotty.hs +16/−285
- Web/Scotty/Action.hs +204/−0
- Web/Scotty/Route.hs +150/−0
- Web/Scotty/Types.hs +52/−0
- examples/basic.hs +6/−0
- scotty.cabal +9/−4
Web/Scotty.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} -- | It should be noted that most of the code snippets below depend on the -- OverloadedStrings language pragma. module Web.Scotty@@ -9,7 +9,9 @@ -- | '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+ , middleware, get, post, put, delete, addroute, matchAny, notFound+ -- ** Route Patterns+ , capture, regex, function, literal -- * Defining Actions -- ** Accessing the Request, Captures, and Query Parameters , request, body, param, jsonData@@ -23,53 +25,32 @@ -- ** Exceptions , raise, rescue, next -- * Types- , ScottyM, ActionM, Parsable+ , ScottyM, ActionM, Param, Parsable, RoutePattern ) where -import Blaze.ByteString.Builder (fromByteString, fromLazyByteString)+import Web.Scotty.Action+import Web.Scotty.Route+import Web.Scotty.Types -import Control.Applicative-import Control.Monad.Error-import Control.Monad.Reader-import qualified Control.Monad.State as MS-import Control.Monad.Trans.Resource (ResourceT)+import Blaze.ByteString.Builder (fromByteString) -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)+import Control.Monad.State (execStateT, modify) -import Network.HTTP.Types+import Data.Default (def)++import Network.HTTP.Types (status404) import Network.Wai import Network.Wai.Handler.Warp (Port, run) -import Web.Scotty.Util--data ScottyState = ScottyState { middlewares :: [Middleware]- , routes :: [Middleware]- }--instance Default ScottyState where- def = ScottyState [] []--newtype ScottyM a = S { runS :: MS.StateT ScottyState IO a }- deriving (Monad, MonadIO, Functor, MS.MonadState ScottyState)- -- | Run a scotty application using the warp server. scotty :: Port -> ScottyM () -> IO ()-scotty p s = putStrLn "Setting phasers to stun... (ctrl-c to quit)" >> (run p =<< scottyApp s)+scotty p s = 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. scottyApp :: ScottyM () -> IO Application scottyApp defs = do- s <- MS.execStateT (runS defs) def+ s <- execStateT (runS defs) def return $ foldl (flip ($)) notFoundApp $ routes s ++ middlewares s notFoundApp :: Application@@ -80,254 +61,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 = MS.modify (\ (ScottyState ms rs) -> ScottyState (m:ms) rs)--type Param = (T.Text, T.Text)--data ActionError = Redirect T.Text- | ActionError T.Text- | Next- deriving (Eq,Show)--instance Error ActionError where- strMsg = ActionError . T.pack--data ActionEnv = Env { getReq :: Request, getParams :: [Param], getBody :: BL.ByteString }--newtype ActionM a = AM { runAM :: ErrorT ActionError (ReaderT ActionEnv (MS.StateT Response IO)) a }- deriving ( Monad, MonadIO, Functor- , MonadReader ActionEnv, MS.MonadState Response, MonadError ActionError)---- Nothing indicates route failed (due to Next) and pattern matching should continue.--- Just indicates a successful response.-runAction :: ActionEnv -> ActionM () -> IO (Maybe Response)-runAction env action = do- (e,r) <- flip MS.runStateT def- $ flip runReaderT env- $ runErrorT- $ runAM- $ action `catchError` defaultHandler- return $ either (const Nothing) (const $ Just r) e--defaultHandler :: ActionError -> ActionM ()-defaultHandler (Redirect url) = do- status status302- header "Location" url-defaultHandler (ActionError msg) = do- status status500- html $ mconcat ["<h1>500 Internal Server Error</h1>", msg]-defaultHandler Next = next---- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions--- turn into HTTP 500 responses.-raise :: T.Text -> ActionM a-raise = throwError . ActionError---- | 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 = 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 action handler = catchError action $ \e -> case e of- ActionError msg -> handler msg -- handle errors- other -> throwError other -- rethrow redirects and nexts---- | 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 :: T.Text -> ActionM a-redirect = throwError . Redirect---- | Get the 'Request' object.-request :: ActionM Request-request = getReq <$> ask---- | Get the request body.-body :: ActionM BL.ByteString-body = 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 = do- b <- body- maybe (raise "jsonData: no parse") return $ A.decode b---- | 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 :: (Parsable a) => T.Text -> ActionM a-param k = do- val <- lookup k <$> getParams <$> ask- case val of- Nothing -> raise $ mconcat ["Param: ", k, " not found!"]- Just v -> either (const next) return $ parseParam v--class Parsable a where- parseParam :: T.Text -> Either T.Text a-- -- if any individual element fails to parse, the whole list fails to parse.- parseParamList :: T.Text -> Either T.Text [a]- parseParamList t = sequence $ map parseParam (T.split (==',') t)---- No point using 'read' for Text, ByteString, Char, and String.-instance Parsable T.Text where parseParam = Right-instance Parsable B.ByteString where parseParam = Right . lazyTextToStrictByteString-instance Parsable Char where- parseParam t = case T.unpack t of- [c] -> Right c- _ -> Left "parseParam Char: no parse"- parseParamList = Right . T.unpack -- String-instance Parsable () where- parseParam t = if T.null t then Right () else Left "parseParam Unit: no parse"--instance (Parsable a) => Parsable [a] where parseParam = parseParamList--instance Parsable Bool where parseParam = readEither-instance Parsable Double where parseParam = readEither-instance Parsable Float where parseParam = readEither-instance Parsable Int where parseParam = readEither-instance Parsable Integer where parseParam = readEither--readEither :: (Read a) => T.Text -> Either T.Text a-readEither t = case [ x | (x,"") <- reads (T.unpack t) ] of- [x] -> Right x- [] -> Left "readEither: no parse"- _ -> Left "readEither: ambiguous parse"---- | get = addroute 'GET'-get :: T.Text -> ActionM () -> ScottyM ()-get = addroute GET---- | post = addroute 'POST'-post :: T.Text -> ActionM () -> ScottyM ()-post = addroute POST---- | put = addroute 'PUT'-put :: T.Text -> ActionM () -> ScottyM ()-put = addroute PUT---- | delete = addroute 'DELETE'-delete :: T.Text -> ActionM () -> ScottyM ()-delete = addroute DELETE---- | Define a route with a 'StdMethod', 'T.Text' value representing the path spec,--- and a body ('ActionM') 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 -> T.Text -> ActionM () -> ScottyM ()-addroute method path action = MS.modify (\ (ScottyState ms rs) -> ScottyState ms (r:rs))- where r = route method withSlash action- withSlash = case T.uncons path of- Just ('/',_) -> path- _ -> T.cons '/' path--route :: StdMethod -> T.Text -> ActionM () -> Middleware-route method path action app req =- if Right method == parseMethod (requestMethod req)- then case matchRoute path (strictByteStringToLazyText $ rawPathInfo req) of- Just captures -> do- env <- mkEnv method req captures- res <- lift $ runAction env action- maybe tryNext return res- Nothing -> tryNext- else tryNext- where tryNext = app req--mkEnv :: StdMethod -> Request -> [Param] -> ResourceT IO ActionEnv-mkEnv method req captures = do- b <- BL.fromChunks <$> (lazyConsume $ requestBody req)-- let params = captures ++ formparams ++ queryparams- formparams = case (method, lookup "Content-Type" [(CI.mk k, CI.mk v) | (k,v) <- requestHeaders req]) of- (POST, Just "application/x-www-form-urlencoded") -> parseEncodedParams $ mconcat $ BL.toChunks b- _ -> []- queryparams = parseEncodedParams $ rawQueryString req-- return $ Env req params b--parseEncodedParams :: B.ByteString -> [Param]-parseEncodedParams bs = [ (T.fromStrict k, T.fromStrict $ fromMaybe "" v) | (k,v) <- parseQueryText bs ]---- todo: wildcards?-matchRoute :: T.Text -> T.Text -> Maybe [Param]-matchRoute pat req = go (T.split (=='/') pat) (T.split (=='/') req) []- where go [] [] ps = Just ps -- request string and pattern match!- go [] r ps | T.null (mconcat r) = Just ps -- in case request has trailing slashes- | otherwise = Nothing -- request string is longer than pattern- go p [] ps | T.null (mconcat p) = Just ps -- in case pattern has trailing slashes- | otherwise = Nothing -- request string is not long enough- go (p:ps) (r:rs) prs | p == r = go ps rs prs -- equal literals, keeping checking- | T.null p = Nothing -- p is null, but r is not, fail- | 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---- | Set the HTTP response status. Default is 200.-status :: Status -> ActionM ()-status = MS.modify . setStatus---- | 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)---- | 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 t = do- header "Content-Type" "text/plain"- MS.modify $ setContent $ Left $ fromLazyByteString $ 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 t = do- header "Content-Type" "text/html"- MS.modify $ setContent $ Left $ fromLazyByteString $ 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 = MS.modify . setContent . Right---- | 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 v = do- header "Content-Type" "application/json"- MS.modify $ setContent $ Left $ fromLazyByteString $ A.encode v+middleware m = modify (addMiddleware m)
+ Web/Scotty/Action.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE OverloadedStrings #-}+module Web.Scotty.Action+ ( request, body, param, jsonData+ , status, header, redirect+ , text, html, file, json+ , raise, rescue, next+ , ActionM, Parsable, Param, mkEnv, runAction+ ) where++import Blaze.ByteString.Builder (fromLazyByteString)++import Control.Applicative+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)++import Network.HTTP.Types+import Network.Wai++import Web.Scotty.Types+import Web.Scotty.Util++-- Nothing indicates route failed (due to Next) and pattern matching should continue.+-- Just indicates a successful response.+runAction :: ActionEnv -> ActionM () -> IO (Maybe Response)+runAction env action = do+ (e,r) <- flip MS.runStateT def+ $ flip runReaderT env+ $ runErrorT+ $ runAM+ $ action `catchError` defaultHandler+ return $ either (const Nothing) (const $ Just r) e++defaultHandler :: ActionError -> ActionM ()+defaultHandler (Redirect url) = do+ status status302+ header "Location" url+defaultHandler (ActionError msg) = do+ 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.+raise :: T.Text -> ActionM a+raise = throwError . ActionError++-- | 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 = 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 action handler = catchError action $ \e -> case e of+ ActionError msg -> handler msg -- handle errors+ other -> throwError other -- rethrow redirects and nexts++-- | 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 :: T.Text -> ActionM a+redirect = throwError . Redirect++-- | Get the 'Request' object.+request :: ActionM Request+request = getReq <$> ask++-- | Get the request body.+body :: ActionM BL.ByteString+body = 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 = do+ b <- body+ maybe (raise "jsonData: no parse") return $ A.decode b++-- | 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 :: (Parsable a) => T.Text -> ActionM a+param k = do+ val <- lookup k <$> getParams <$> ask+ case val of+ Nothing -> raise $ mconcat ["Param: ", k, " not found!"]+ Just v -> either (const next) return $ parseParam v++class Parsable a where+ parseParam :: T.Text -> Either T.Text a++ -- if any individual element fails to parse, the whole list fails to parse.+ parseParamList :: T.Text -> Either T.Text [a]+ parseParamList t = mapM parseParam (T.split (== ',') t)++-- No point using 'read' for Text, ByteString, Char, and String.+instance Parsable T.Text where parseParam = Right+instance Parsable B.ByteString where parseParam = Right . lazyTextToStrictByteString+instance Parsable Char where+ parseParam t = case T.unpack t of+ [c] -> Right c+ _ -> Left "parseParam Char: no parse"+ parseParamList = Right . T.unpack -- String+instance Parsable () where+ parseParam t = if T.null t then Right () else Left "parseParam Unit: no parse"++instance (Parsable a) => Parsable [a] where parseParam = parseParamList++instance Parsable Bool where parseParam = readEither+instance Parsable Double where parseParam = readEither+instance Parsable Float where parseParam = readEither+instance Parsable Int where parseParam = readEither+instance Parsable Integer where parseParam = readEither++readEither :: (Read a) => T.Text -> Either T.Text a+readEither t = case [ x | (x,"") <- reads (T.unpack t) ] of+ [x] -> Right x+ [] -> Left "readEither: no parse"+ _ -> Left "readEither: ambiguous parse"++-- | Set the HTTP response status. Default is 200.+status :: Status -> ActionM ()+status = MS.modify . setStatus++-- | 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)++-- | 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 t = do+ header "Content-Type" "text/plain"+ MS.modify $ setContent $ Left $ fromLazyByteString $ 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 t = do+ header "Content-Type" "text/html"+ MS.modify $ setContent $ Left $ fromLazyByteString $ 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 = MS.modify . setContent . Right++-- | 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 v = do+ header "Content-Type" "application/json"+ MS.modify $ setContent $ Left $ fromLazyByteString $ A.encode v
+ Web/Scotty/Route.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE OverloadedStrings #-}+module Web.Scotty.Route+ ( get, post, put, delete, addroute, matchAny, notFound,+ capture, regex, function, literal+ ) where++import Web.Scotty.Action+import Web.Scotty.Types++import Control.Monad.Error+import qualified Control.Monad.State as MS++import Data.Monoid (mconcat)+import qualified Data.Text.Lazy as T++import Network.HTTP.Types+import Network.Wai++import Web.Scotty.Util++import qualified Text.Regex as Regex+import Control.Arrow ((***))++-- | get = 'addroute' 'GET'+get :: RoutePattern -> ActionM () -> ScottyM ()+get = addroute GET++-- | post = 'addroute' 'POST'+post :: RoutePattern -> ActionM () -> ScottyM ()+post = addroute POST++-- | put = 'addroute' 'PUT'+put :: RoutePattern -> ActionM () -> ScottyM ()+put = addroute PUT++-- | delete = 'addroute' 'DELETE'+delete :: RoutePattern -> ActionM () -> ScottyM ()+delete = addroute DELETE++-- | Add a route that matches regardless of the HTTP verb.+matchAny :: RoutePattern -> ActionM () -> 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,+-- so should generally be the last route specified.+notFound :: ActionM () -> ScottyM ()+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.+--+-- > 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 method pat action = MS.modify (addRoute r)+ where r = route method pat action++route :: StdMethod -> RoutePattern -> ActionM () -> Middleware+route method pat action app req =+ if Right method == parseMethod (requestMethod req)+ then case matchRoute pat req of+ Just captures -> do+ env <- mkEnv method req captures+ res <- lift $ runAction env action+ maybe tryNext return res+ Nothing -> tryNext+ else tryNext+ where tryNext = app req++matchRoute :: RoutePattern -> Request -> Maybe [Param]++matchRoute (Literal pat) req | pat == path req = Just []+ | otherwise = Nothing++matchRoute (Function fun) req = fun req++matchRoute (Capture pat) req = go (T.split (=='/') pat) (T.split (=='/') $ path req) []+ where go [] [] prs = Just prs -- request string and pattern match!+ go [] r prs | T.null (mconcat r) = Just prs -- in case request has trailing slashes+ | otherwise = Nothing -- request string is longer than pattern+ go p [] prs | T.null (mconcat p) = Just prs -- in case pattern has trailing slashes+ | otherwise = Nothing -- request string is not long enough+ go (p:ps) (r:rs) prs | p == r = go ps rs prs -- equal literals, keeping checking+ | T.null p = Nothing -- p is null, but r is not, fail+ | 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++path :: Request -> T.Text+path = strictByteStringToLazyText . rawPathInfo++-- | 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 pattern = Function $ \ req -> fmap (map (T.pack . show *** T.pack) . zip [0 :: Int ..] . strip)+ (Regex.matchRegexAll rgx $ T.unpack $ path req)+ where rgx = Regex.mkRegex pattern+ strip (_, match, _, subs) = match : subs++-- | 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 = Capture . T.pack++-- | 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", T.pack $ show $ httpVersion req)]) $ do+-- > v <- param "version"+-- > text v+--+-- >>> curl http://localhost:3000/+-- HTTP/1.1+--+function :: (Request -> Maybe [Param]) -> RoutePattern+function = Function++-- | Build a route that requires the requested path match exactly, without captures.+literal :: String -> RoutePattern+literal = Literal . T.pack
+ Web/Scotty/Types.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Web.Scotty.Types where++import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.State++import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Default (Default, def)+import Data.Text.Lazy (Text, pack)++import Network.Wai++import Data.String (IsString(..))++data ScottyState = ScottyState { middlewares :: [Middleware]+ , routes :: [Middleware]+ }++addMiddleware :: Middleware -> ScottyState -> ScottyState+addMiddleware m (ScottyState ms rs) = ScottyState (m:ms) rs++addRoute :: Middleware -> ScottyState -> ScottyState+addRoute r (ScottyState ms rs) = ScottyState ms (r:rs)++instance Default ScottyState where+ def = ScottyState [] []++newtype ScottyM a = S { runS :: StateT ScottyState IO a }+ deriving (Monad, MonadIO, Functor, MonadState ScottyState)++type Param = (Text, Text)++data ActionError = Redirect Text+ | ActionError Text+ | Next+ deriving (Eq,Show)++instance Error ActionError where+ strMsg = ActionError . pack++data ActionEnv = Env { getReq :: Request, getParams :: [Param], getBody :: ByteString }++newtype ActionM a = AM { runAM :: ErrorT ActionError (ReaderT ActionEnv (StateT Response IO)) a }+ deriving ( Monad, MonadIO, Functor+ , MonadReader ActionEnv, MonadState Response, MonadError ActionError)++data RoutePattern = Capture Text+ | Literal Text+ | Function (Request -> Maybe [Param])++instance IsString RoutePattern where fromString = Capture . pack
examples/basic.hs view
@@ -8,6 +8,8 @@ import System.Random (newStdGen, randomRs) import Network.HTTP.Types (status302)+import Network.Wai+import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding (decodeUtf8) @@ -15,6 +17,10 @@ main = scotty 3000 $ do -- Add any WAI middleware, they are run top-down. middleware logStdoutDev++-- get (function $ \req -> Just [("version", T.pack $ show $ httpVersion req)]) $ do+-- v <- param "version"+-- text v -- To demonstrate that routes are matched top-down. get "/" $ text "foobar"
scotty.cabal view
@@ -1,5 +1,5 @@ Name: scotty-Version: 0.3.0+Version: 0.4.0 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@@ -63,20 +63,25 @@ Library Exposed-modules: Web.Scotty- other-modules: Web.Scotty.Util+ other-modules: Web.Scotty.Action+ Web.Scotty.Route+ Web.Scotty.Types+ Web.Scotty.Util default-language: Haskell2010 build-depends: aeson >= 0.5, base >= 4.3.1 && < 5, blaze-builder >= 0.3, bytestring >= 0.9.1, case-insensitive >= 0.4,- conduit >= 0.1.1.1,+ conduit >= 0.4.0.1 && < 0.5, data-default >= 0.3, http-types >= 0.6.8 && < 0.7, mtl >= 2.0.1,+ resourcet >= 0.3.2 && < 0.4, text >= 0.11.1, wai >= 1.0.0,- warp >= 1.0.0+ warp >= 1.0.0,+ regex-compat >= 0.95.1 GHC-options: -Wall -fno-warn-orphans