{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances,
             OverloadedStrings, RankNTypes, ScopedTypeVariables #-}
module Web.Scotty.Route
    ( get, post, put, delete, patch, options, addroute, matchAny, notFound,
      capture, regex, function, literal
    ) where
      
import           Blaze.ByteString.Builder (fromByteString)
import           Control.Arrow ((***))
import           Control.Concurrent.MVar
import           Control.Exception (throw, catch)
import           Control.Monad.IO.Class
import qualified Control.Monad.State as MS

import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL

import           Data.Maybe (fromMaybe, isJust)
import           Data.String (fromString)
import qualified Data.Text.Lazy as T
import qualified Data.Text as TS

import           Network.HTTP.Types
import           Network.Wai (Request(..), Response, responseBuilder)
#if MIN_VERSION_wai(3,2,2)
import           Network.Wai.Internal (getRequestBodyChunk)
#endif
import qualified Network.Wai.Parse as Parse hiding (parseRequestBody)

import           Prelude ()
import           Prelude.Compat

import qualified Text.Regex as Regex

import           Web.Scotty.Action
import           Web.Scotty.Internal.Types
import           Web.Scotty.Util

-- | get = 'addroute' 'GET'
get :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
get :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get = forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
GET

-- | post = 'addroute' 'POST'
post :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
post :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
post = forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
POST

-- | put = 'addroute' 'PUT'
put :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
put :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
put = forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
PUT

-- | delete = 'addroute' 'DELETE'
delete :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
delete :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
delete = forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
DELETE

-- | patch = 'addroute' 'PATCH'
patch :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
patch :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
patch = forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
PATCH

-- | options = 'addroute' 'OPTIONS'
options :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
options :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
options = forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
OPTIONS

-- | Add a route that matches regardless of the HTTP verb.
matchAny :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
matchAny :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
matchAny RoutePattern
pattern ActionT e m ()
action = forall e (m :: * -> *) a.
State (ScottyState e m) a -> ScottyT e m a
ScottyT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify forall a b. (a -> b) -> a -> b
$ \ScottyState e m
s -> forall (m :: * -> *) e.
Middleware m -> ScottyState e m -> ScottyState e m
addRoute (forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RouteOptions
-> ErrorHandler e m
-> Maybe StdMethod
-> RoutePattern
-> ActionT e m ()
-> Middleware m
route (forall e (m :: * -> *). ScottyState e m -> RouteOptions
routeOptions ScottyState e m
s) (forall e (m :: * -> *). ScottyState e m -> ErrorHandler e m
handler ScottyState e m
s) forall a. Maybe a
Nothing RoutePattern
pattern ActionT e m ()
action) ScottyState e m
s

-- | Specify an action to take if nothing else is found. Note: this _always_ matches,
-- so should generally be the last route specified.
notFound :: (ScottyError e, MonadIO m) => ActionT e m () -> ScottyT e m ()
notFound :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m () -> ScottyT e m ()
notFound ActionT e m ()
action = forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
matchAny ((Request -> Maybe [Param]) -> RoutePattern
Function (\Request
req -> forall a. a -> Maybe a
Just [(Text
"path", Request -> Text
path Request
req)])) (forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
status404 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ActionT e m ()
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 'param'.
--
-- > addroute GET "/foo/:bar" $ do
-- >     v <- param "bar"
-- >     text v
--
-- >>> curl http://localhost:3000/foo/something
-- something
addroute :: (ScottyError e, MonadIO m) => StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
method RoutePattern
pat ActionT e m ()
action = forall e (m :: * -> *) a.
State (ScottyState e m) a -> ScottyT e m a
ScottyT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify forall a b. (a -> b) -> a -> b
$ \ScottyState e m
s -> forall (m :: * -> *) e.
Middleware m -> ScottyState e m -> ScottyState e m
addRoute (forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RouteOptions
-> ErrorHandler e m
-> Maybe StdMethod
-> RoutePattern
-> ActionT e m ()
-> Middleware m
route (forall e (m :: * -> *). ScottyState e m -> RouteOptions
routeOptions ScottyState e m
s) (forall e (m :: * -> *). ScottyState e m -> ErrorHandler e m
handler ScottyState e m
s) (forall a. a -> Maybe a
Just StdMethod
method) RoutePattern
pat ActionT e m ()
action) ScottyState e m
s

route :: (ScottyError e, MonadIO m) => RouteOptions -> ErrorHandler e m -> Maybe StdMethod -> RoutePattern -> ActionT e m () -> Middleware m
route :: forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RouteOptions
-> ErrorHandler e m
-> Maybe StdMethod
-> RoutePattern
-> ActionT e m ()
-> Middleware m
route RouteOptions
opts ErrorHandler e m
h Maybe StdMethod
method RoutePattern
pat ActionT e m ()
action Application m
app Request
req =
    let tryNext :: m Response
tryNext = Application m
app Request
req
        {- |
          We match all methods in the case where 'method' is 'Nothing'.
          See https://github.com/scotty-web/scotty/issues/196
        -}
        methodMatches :: Bool
        methodMatches :: Bool
methodMatches =
            case Maybe StdMethod
method of
                Maybe StdMethod
Nothing -> Bool
True
                Just StdMethod
m -> forall a b. b -> Either a b
Right StdMethod
m forall a. Eq a => a -> a -> Bool
== ByteString -> Either ByteString StdMethod
parseMethod (Request -> ByteString
requestMethod Request
req)
    in if Bool
methodMatches
       then case RoutePattern -> Request -> Maybe [Param]
matchRoute RoutePattern
pat Request
req of
            Just [Param]
captures -> do
                Either ScottyException ActionEnv
env <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
Request -> [Param] -> RouteOptions -> m ActionEnv
mkEnv Request
req [Param]
captures RouteOptions
opts) (\ScottyException
ex -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ScottyException
ex)
                Maybe Response
res <- forall e (m :: * -> *).
(ScottyError e, Monad m) =>
ErrorHandler e m
-> Either ScottyException ActionEnv
-> ActionT e m ()
-> m (Maybe Response)
evalAction ErrorHandler e m
h Either ScottyException ActionEnv
env ActionT e m ()
action
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Response
tryNext forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Response
res
            Maybe [Param]
Nothing -> m Response
tryNext
       else m Response
tryNext

evalAction :: (ScottyError e, Monad m) => ErrorHandler e m -> (Either ScottyException ActionEnv) -> ActionT e m () -> m (Maybe Response)
evalAction :: forall e (m :: * -> *).
(ScottyError e, Monad m) =>
ErrorHandler e m
-> Either ScottyException ActionEnv
-> ActionT e m ()
-> m (Maybe Response)
evalAction ErrorHandler e m
_ (Left (RequestException ByteString
msg Status
s)) ActionT e m ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
responseBuilder Status
s [(HeaderName
"Content-Type",ByteString
"text/html")] forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
msg
evalAction ErrorHandler e m
h (Right ActionEnv
env) ActionT e m ()
action = forall e (m :: * -> *).
(ScottyError e, Monad m) =>
ErrorHandler e m
-> ActionEnv -> ActionT e m () -> m (Maybe Response)
runAction ErrorHandler e m
h ActionEnv
env ActionT e m ()
action
  
matchRoute :: RoutePattern -> Request -> Maybe [Param]
matchRoute :: RoutePattern -> Request -> Maybe [Param]
matchRoute (Literal Text
pat)  Request
req | Text
pat forall a. Eq a => a -> a -> Bool
== Request -> Text
path Request
req = forall a. a -> Maybe a
Just []
                              | Bool
otherwise       = forall a. Maybe a
Nothing
matchRoute (Function Request -> Maybe [Param]
fun) Request
req = Request -> Maybe [Param]
fun Request
req
matchRoute (Capture Text
pat)  Request
req = [Text] -> [Text] -> [Param] -> Maybe [Param]
go ((Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
==Char
'/') Text
pat) (forall {a}. (Eq a, IsString a) => [a] -> [a]
compress forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
==Char
'/') forall a b. (a -> b) -> a -> b
$ Request -> Text
path Request
req) []
    where go :: [Text] -> [Text] -> [Param] -> Maybe [Param]
go [] [] [Param]
prs = forall a. a -> Maybe a
Just [Param]
prs -- request string and pattern match!
          go [] [Text]
r  [Param]
prs | Text -> Bool
T.null (forall a. Monoid a => [a] -> a
mconcat [Text]
r)  = forall a. a -> Maybe a
Just [Param]
prs -- in case request has trailing slashes
                       | Bool
otherwise           = forall a. Maybe a
Nothing  -- request string is longer than pattern
          go [Text]
p  [] [Param]
prs | Text -> Bool
T.null (forall a. Monoid a => [a] -> a
mconcat [Text]
p)  = forall a. a -> Maybe a
Just [Param]
prs -- in case pattern has trailing slashes
                       | Bool
otherwise           = forall a. Maybe a
Nothing  -- request string is not long enough
          go (Text
p:[Text]
ps) (Text
r:[Text]
rs) [Param]
prs | Text
p forall a. Eq a => a -> a -> Bool
== Text
r          = [Text] -> [Text] -> [Param] -> Maybe [Param]
go [Text]
ps [Text]
rs [Param]
prs -- equal literals, keeping checking
                               | Text -> Bool
T.null Text
p        = forall a. Maybe a
Nothing      -- p is null, but r is not, fail
                               | Text -> Char
T.head Text
p forall a. Eq a => a -> a -> Bool
== Char
':' = [Text] -> [Text] -> [Param] -> Maybe [Param]
go [Text]
ps [Text]
rs forall a b. (a -> b) -> a -> b
$ (Text -> Text
T.tail Text
p, Text
r) forall a. a -> [a] -> [a]
: [Param]
prs -- p is a capture, add to params
                               | Bool
otherwise       = forall a. Maybe a
Nothing      -- both literals, but unequal, fail
          compress :: [a] -> [a]
compress (a
"":rest :: [a]
rest@(a
"":[a]
_)) = [a] -> [a]
compress [a]
rest
          compress (a
x:[a]
xs) = a
x forall a. a -> [a] -> [a]
: [a] -> [a]
compress [a]
xs
          compress [] = []

-- Pretend we are at the top level.
path :: Request -> T.Text
path :: Request -> Text
path = Text -> Text
T.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
TS.cons Char
'/' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
TS.intercalate Text
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> [Text]
pathInfo

-- Stolen from wai-extra's Network.Wai.Parse, modified to accept body as list of Bytestrings.
-- Reason: WAI's getRequestBodyChunk is an IO action that returns the body as chunks.
-- Once read, they can't be read again. We read them into a lazy Bytestring, so Scotty
-- user can get the raw body, even if they also want to call wai-extra's parsing routines.
parseRequestBody :: MonadIO m
                 => [B.ByteString]
                 -> Parse.BackEnd y
                 -> Request
                 -> m ([Parse.Param], [Parse.File y])
parseRequestBody :: forall (m :: * -> *) y.
MonadIO m =>
[ByteString] -> BackEnd y -> Request -> m ([Param], [File y])
parseRequestBody [ByteString]
bl BackEnd y
s Request
r =
    case Request -> Maybe RequestBodyType
Parse.getRequestBodyType Request
r of
        Maybe RequestBodyType
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
        Just RequestBodyType
rbt -> do
            MVar [ByteString]
mvar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar [ByteString]
bl -- MVar is a bit of a hack so we don't have to inline
                                        -- large portions of Network.Wai.Parse
            let provider :: IO ByteString
provider = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar [ByteString]
mvar forall a b. (a -> b) -> a -> b
$ \[ByteString]
bsold -> case [ByteString]
bsold of
                                                []     -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], ByteString
B.empty)
                                                (ByteString
b:[ByteString]
bs) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString]
bs, ByteString
b)
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall y.
BackEnd y
-> RequestBodyType -> IO ByteString -> IO ([Param], [File y])
Parse.sinkRequestBody BackEnd y
s RequestBodyType
rbt IO ByteString
provider

mkEnv :: forall m. MonadIO m => Request -> [Param] -> RouteOptions ->m ActionEnv
mkEnv :: forall (m :: * -> *).
MonadIO m =>
Request -> [Param] -> RouteOptions -> m ActionEnv
mkEnv Request
req [Param]
captures RouteOptions
opts = do
    MVar RequestBodyState
bodyState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar RequestBodyState
BodyUntouched

    let rbody :: IO ByteString
rbody = Request -> IO ByteString
getRequestBodyChunk Request
req

        safeBodyReader :: IO B.ByteString
        safeBodyReader :: IO ByteString
safeBodyReader =  do
          RequestBodyState
state <- forall a. MVar a -> IO a
takeMVar MVar RequestBodyState
bodyState
          let direct :: IO ByteString
direct = forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState RequestBodyState
BodyCorrupted forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ByteString
rbody
          case RequestBodyState
state of
            s :: RequestBodyState
s@(BodyCached ByteString
_ []) ->
              do forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState RequestBodyState
s
                 forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
            BodyCached ByteString
b (ByteString
chunk:[ByteString]
rest) ->
              do forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> RequestBodyState
BodyCached ByteString
b [ByteString]
rest
                 forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
chunk
            RequestBodyState
BodyUntouched -> IO ByteString
direct
            RequestBodyState
BodyCorrupted -> IO ByteString
direct

        bs :: IO BL.ByteString
        bs :: IO ByteString
bs = do
          RequestBodyState
state <- forall a. MVar a -> IO a
takeMVar MVar RequestBodyState
bodyState
          case RequestBodyState
state of
            s :: RequestBodyState
s@(BodyCached ByteString
b [ByteString]
_) ->
              do forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState RequestBodyState
s
                 forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
            RequestBodyState
BodyCorrupted -> forall a e. Exception e => e -> a
throw BodyPartiallyStreamed
BodyPartiallyStreamed
            RequestBodyState
BodyUntouched ->
              do [ByteString]
chunks <- IO ByteString
-> ([ByteString] -> IO [ByteString])
-> Maybe Int
-> IO [ByteString]
readRequestBody IO ByteString
rbody forall (m :: * -> *) a. Monad m => a -> m a
return (RouteOptions -> Maybe Int
maxRequestBodySize RouteOptions
opts)
                 let b :: ByteString
b = [ByteString] -> ByteString
BL.fromChunks [ByteString]
chunks
                 forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> RequestBodyState
BodyCached ByteString
b [ByteString]
chunks
                 forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b

        shouldParseBody :: Bool
shouldParseBody = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Request -> Maybe RequestBodyType
Parse.getRequestBodyType Request
req

    ([Param]
formparams, [File ByteString]
fs) <- if Bool
shouldParseBody
      then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do [ByteString]
wholeBody <- ByteString -> [ByteString]
BL.toChunks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO ByteString
bs
                       forall (m :: * -> *) y.
MonadIO m =>
[ByteString] -> BackEnd y -> Request -> m ([Param], [File y])
parseRequestBody [ByteString]
wholeBody forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
Parse.lbsBackEnd Request
req
      else forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])

    let
        convert :: Param -> Param
convert (ByteString
k, ByteString
v) = (ByteString -> Text
strictByteStringToLazyText ByteString
k, ByteString -> Text
strictByteStringToLazyText ByteString
v)
        parameters :: [Param]
parameters =  [Param]
captures forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Param -> Param
convert [Param]
formparams forall a. [a] -> [a] -> [a]
++ [Param]
queryparams
        queryparams :: [Param]
queryparams = ByteString -> [Param]
parseEncodedParams forall a b. (a -> b) -> a -> b
$ Request -> ByteString
rawQueryString Request
req

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Request
-> [Param] -> IO ByteString -> IO ByteString -> [File] -> ActionEnv
Env Request
req [Param]
parameters IO ByteString
bs IO ByteString
safeBodyReader [ (ByteString -> Text
strictByteStringToLazyText ByteString
k, FileInfo ByteString
fi) | (ByteString
k,FileInfo ByteString
fi) <- [File ByteString]
fs ]

parseEncodedParams :: B.ByteString -> [Param]
parseEncodedParams :: ByteString -> [Param]
parseEncodedParams ByteString
bs = [ (Text -> Text
T.fromStrict Text
k, Text -> Text
T.fromStrict forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
v) | (Text
k,Maybe Text
v) <- ByteString -> QueryText
parseQueryText ByteString
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
--
regex :: String -> RoutePattern
regex :: String -> RoutePattern
regex String
pattern = (Request -> Maybe [Param]) -> RoutePattern
Function forall a b. (a -> b) -> a -> b
$ \ Request
req -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Text
T.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a} {c}. (a, a, c, [a]) -> [a]
strip)
                                         (Regex -> String -> Maybe (String, String, String, [String])
Regex.matchRegexAll Regex
rgx forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Request -> Text
path Request
req)
    where rgx :: Regex
rgx = String -> Regex
Regex.mkRegex String
pattern
          strip :: (a, a, c, [a]) -> [a]
strip (a
_, a
match, c
_, [a]
subs) = a
match forall a. a -> [a] -> [a]
: [a]
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 :: String -> RoutePattern
capture = forall a. IsString a => String -> a
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
--
function :: (Request -> Maybe [Param]) -> RoutePattern
function :: (Request -> Maybe [Param]) -> RoutePattern
function = (Request -> Maybe [Param]) -> RoutePattern
Function

-- | Build a route that requires the requested path match exactly, without captures.
literal :: String -> RoutePattern
literal :: String -> RoutePattern
literal = Text -> RoutePattern
Literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

#if !(MIN_VERSION_wai(3,2,2))
getRequestBodyChunk :: Request -> IO B.ByteString
getRequestBodyChunk = requestBody
#endif