diff --git a/Web/Scotty.hs b/Web/Scotty.hs index e4e2954f..5317f085 100644 --- a/Web/Scotty.hs +++ b/Web/Scotty.hs @@ -61,22 +61,33 @@ import Network.Wai.Handler.Warp (Port) import Web.Scotty.Internal.Types (ScottyT, ActionT, ErrorHandler, Param, RoutePattern, Options, defaultOptions, File, Kilobytes, ScottyState, defaultScottyState, ScottyException, StatusError(..), Content(..)) import UnliftIO.Exception (Handler(..), catch) - --- $setup --- >>> import Control.Monad.IO.Class (liftIO) --- >>> import qualified Network.HTTP.Client as H --- >>> import qualified Network.HTTP.Types as H --- >>> import qualified Data.ByteString.Lazy.Char8 as LBS (unpack) --- >>> import qualified Web.Scotty as S (scotty, get, text, pathParam) --- >>> :{ --- let --- curl :: MonadIO m => String -> m String --- curl path = liftIO $ do --- req0 <- H.parseRequest path --- let req = req0 { H.method = "GET"} --- mgr <- H.newManager H.defaultManagerSettings --- (LBS.unpack . H.responseBody) <$> H.httpLbs req mgr --- :} +{- $setup +>>> :{ +import Control.Monad.IO.Class (MonadIO(..)) +import qualified Network.HTTP.Client as H +import qualified Network.HTTP.Types as H +import qualified Network.Wai as W (httpVersion) +import qualified Data.ByteString.Lazy.Char8 as LBS (unpack) +import qualified Data.Text as T (pack) +import Control.Concurrent (ThreadId, forkIO, killThread) +import Control.Exception (bracket) +import qualified Web.Scotty as S (ScottyM, scottyOpts, get, text, regex, pathParam, Options(..), defaultOptions) +-- | GET an HTTP path +curl :: MonadIO m => + String -- ^ path + -> m String -- ^ response body +curl path = liftIO $ do + req0 <- H.parseRequest path + let req = req0 { H.method = "GET"} + mgr <- H.newManager H.defaultManagerSettings + (LBS.unpack . H.responseBody) <$> H.httpLbs req mgr +-- | Fork a process, run a Scotty server in it and run an action while the server is running. Kills the scotty thread once the inner action is done. +withScotty :: S.ScottyM () + -> IO a -- ^ inner action, e.g. 'curl "localhost:3000/"' + -> IO a +withScotty serv act = bracket (forkIO $ S.scottyOpts (S.defaultOptions{ S.verbose = 0 }) serv) killThread (\_ -> act) +:} +-} type ScottyM = ScottyT IO type ActionM = ActionT IO @@ -423,39 +434,37 @@ matchAny = Trans.matchAny 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. --- --- > get "/" $ text "beam me up!" --- --- The path spec can include values starting with a colon, which are interpreted --- as /captures/. These are parameters that can be looked up with 'pathParam'. --- --- >>> :{ --- let server = S.get "/foo/:bar" (S.pathParam "bar" >>= S.text) --- in do --- S.scotty 3000 server --- --- curl "http://localhost:3000/foo/something" --- :} --- something +{- | Define a route with a 'StdMethod', a route pattern representing the path spec, +and an 'Action' which may modify the response. + +> get "/" $ text "beam me up!" + +The path spec can include values starting with a colon, which are interpreted +as /captures/. These are parameters that can be looked up with 'pathParam'. + +>>> :{ +let server = S.get "/foo/:bar" (S.pathParam "bar" >>= S.text) + in do + withScotty server $ 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. --- --- >>> :{ --- let server = S.get (S.regex "^/f(.*)r$") $ do --- cap <- S.pathParam "1" --- S.text ["Capture:", cap] --- in do --- S.scotty 3000 server --- --- curl "http://localhost:3000/foo/bar" --- :} --- Capture: oo/ba --- + +{- | Match requests using a regular expression. +Named captures are not yet supported. + +>>> :{ +let server = S.get (S.regex "^/f(.*)r$") $ do + cap <- S.pathParam "1" + S.text cap + in do + withScotty server $ curl "http://localhost:3000/foo/bar" +:} +"oo/ba" +-} regex :: String -> RoutePattern regex = Trans.regex @@ -474,18 +483,20 @@ regex = Trans.regex 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 --- + +{- | 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'. + +>>> :{ +let server = S.get (function $ \req -> Just [("version", T.pack $ show $ W.httpVersion req)]) $ do + v <- S.pathParam "version" + S.text v + in do + withScotty server $ curl "http://localhost:3000/" +:} +"HTTP/1.1" +-} function :: (Request -> Maybe [Param]) -> RoutePattern function = Trans.function diff --git a/Web/Scotty/Route.hs b/Web/Scotty/Route.hs index 1005d01b..cd96a837 100644 --- a/Web/Scotty/Route.hs +++ b/Web/Scotty/Route.hs @@ -27,6 +27,34 @@ import Web.Scotty.Internal.Types (RoutePattern(..), RouteOptions, Acti import Web.Scotty.Util (decodeUtf8Lenient) import Web.Scotty.Body (cloneBodyInfo, getBodyAction, getBodyChunkAction, getFormParamsAndFilesAction) +{- $setup +>>> :{ +import Control.Monad.IO.Class (MonadIO(..)) +import qualified Network.HTTP.Client as H +import qualified Network.HTTP.Types as H +import qualified Network.Wai as W (httpVersion) +import qualified Data.ByteString.Lazy.Char8 as LBS (unpack) +import qualified Data.Text as T (pack) +import Control.Concurrent (ThreadId, forkIO, killThread) +import Control.Exception (bracket) +import qualified Web.Scotty as S (ScottyM, scottyOpts, get, text, regex, pathParam, Options(..), defaultOptions) +-- | GET an HTTP path +curl :: MonadIO m => + String -- ^ path + -> m String -- ^ response body +curl path = liftIO $ do + req0 <- H.parseRequest path + let req = req0 { H.method = "GET"} + mgr <- H.newManager H.defaultManagerSettings + (LBS.unpack . H.responseBody) <$> H.httpLbs req mgr +-- | Fork a process, run a Scotty server in it and run an action while the server is running. Kills the scotty thread once the inner action is done. +withScotty :: S.ScottyM () + -> IO a -- ^ inner action, e.g. 'curl "localhost:3000/"' + -> IO a +withScotty serv act = bracket (forkIO $ S.scottyOpts (S.defaultOptions{ S.verbose = 0 }) serv) killThread (\_ -> act) +:} +-} + -- | get = 'addroute' 'GET' get :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m () get = addroute GET @@ -60,23 +88,21 @@ matchAny pat action = ScottyT $ MS.modify $ \s -> addRoute (route (routeOptions notFound :: (MonadUnliftIO 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, --- 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 'captureParam'. --- --- > addroute GET "/foo/:bar" $ do --- > v <- captureParam "bar" --- > text v --- --- >>> curl http://localhost:3000/foo/something --- something --- --- NB: the 'RouteOptions' and the exception handler of the newly-created route will be --- copied from the previously-created routes. +{- | Define a route with a 'StdMethod', a route pattern representing the path spec, +and an 'Action' which may modify the response. + +> get "/" $ text "beam me up!" + +The path spec can include values starting with a colon, which are interpreted +as /captures/. These are parameters that can be looked up with 'pathParam'. + +>>> :{ +let server = S.get "/foo/:bar" (S.pathParam "bar" >>= S.text) + in do + withScotty server $ curl "http://localhost:3000/foo/something" +:} +"something" +-} addroute :: (MonadUnliftIO m) => StdMethod -> RoutePattern -> ActionT m () -> ScottyT m () addroute method pat action = ScottyT $ MS.modify $ \s -> addRoute (route (routeOptions s) (handler s) (Just method) pat action) s @@ -145,22 +171,22 @@ mkEnv bodyInfo req captureps opts = do parseEncodedParams :: B.ByteString -> [Param] parseEncodedParams bs = [ (k, fromMaybe "" v) | (k,v) <- parseQueryText bs ] --- | 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 --- +{- | Match requests using a regular expression. +Named captures are not yet supported. + +>>> :{ +let server = S.get (S.regex "^/f(.*)r$") $ do + cap <- S.pathParam "1" + S.text cap + in do + withScotty server $ curl "http://localhost:3000/foo/bar" +:} +"oo/ba" +-} regex :: String -> RoutePattern -regex pattern = Function $ \ req -> fmap (map (T.pack . show *** T.pack) . zip [0 :: Int ..] . strip) +regex pat = 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 + where rgx = Regex.mkRegex pat strip (_, match, _, subs) = match : subs -- | Standard Sinatra-style route. Named captures are prepended with colons. @@ -178,18 +204,19 @@ regex pattern = Function $ \ req -> fmap (map (T.pack . show *** T.pack) . zip [ capture :: String -> RoutePattern capture = fromString --- | 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 --- +{- | 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'. + +>>> :{ +let server = S.get (function $ \req -> Just [("version", T.pack $ show $ W.httpVersion req)]) $ do + v <- S.pathParam "version" + S.text v + in do + withScotty server $ curl "http://localhost:3000/" +:} +"HTTP/1.1" +-} function :: (Request -> Maybe [Param]) -> RoutePattern function = Function diff --git a/scotty.cabal b/scotty.cabal index 72abcfa2..b6b2941e 100644 --- a/scotty.cabal +++ b/scotty.cabal @@ -134,6 +134,8 @@ test-suite doctest , http-client , http-types , scotty + , text + , wai benchmark weigh main-is: Main.hs