{-# LANGUAGE FlexibleContexts, FlexibleInstances,
             OverloadedStrings, RankNTypes, ScopedTypeVariables #-}
module Web.Scotty.Route
    ( get, post, put, delete, patch, options, addroute, matchAny, notFound,
      capture, regex, function, literal
    ) where

import           Control.Arrow ((***))
import Control.Concurrent.STM (newTVarIO)
import           Control.Monad.IO.Class (MonadIO(..))
import UnliftIO (MonadUnliftIO(..))
import qualified Control.Monad.Reader as MR
import qualified Control.Monad.State as MS
import Control.Monad.Trans.Resource (InternalState)

import           Data.String (fromString)
import qualified Data.Text as T

import           Network.HTTP.Types
import           Network.Wai (Request(..))

import qualified Text.Regex as Regex

import           Web.Scotty.Action

import           Web.Scotty.Internal.Types (Options, RoutePattern(..), RouteOptions, ActionEnv(..), ActionT, ScottyState(..), ScottyT(..), ErrorHandler, Middleware, BodyInfo, File, handler, addRoute, defaultScottyResponse)

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 :: forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
get = StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
addroute StdMethod
GET

-- | post = 'addroute' 'POST'
post :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m ()
post :: forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
post = StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
addroute StdMethod
POST

-- | put = 'addroute' 'PUT'
put :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m ()
put :: forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
put = StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
addroute StdMethod
PUT

-- | delete = 'addroute' 'DELETE'
delete :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m ()
delete :: forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
delete = StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
addroute StdMethod
DELETE

-- | patch = 'addroute' 'PATCH'
patch :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m ()
patch :: forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
patch = StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
addroute StdMethod
PATCH

-- | options = 'addroute' 'OPTIONS'
options :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m ()
options :: forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
options = StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
addroute StdMethod
OPTIONS

-- | Add a route that matches regardless of the HTTP verb.
matchAny :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m ()
matchAny :: forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
matchAny RoutePattern
pat ActionT m ()
action =
  ReaderT Options (State (ScottyState m)) () -> ScottyT m ()
forall (m :: * -> *) a.
ReaderT Options (State (ScottyState m)) a -> ScottyT m a
ScottyT (ReaderT Options (State (ScottyState m)) () -> ScottyT m ())
-> ReaderT Options (State (ScottyState m)) () -> ScottyT m ()
forall a b. (a -> b) -> a -> b
$ do
    Options
serverOptions <- ReaderT Options (State (ScottyState m)) Options
forall r (m :: * -> *). MonadReader r m => m r
MR.ask
    (ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyState m -> ScottyState m)
 -> ReaderT Options (State (ScottyState m)) ())
-> (ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ()
forall a b. (a -> b) -> a -> b
$ \ScottyState m
s ->
      (BodyInfo -> Middleware m) -> ScottyState m -> ScottyState m
forall (m :: * -> *).
(BodyInfo -> Middleware m) -> ScottyState m -> ScottyState m
addRoute
        (Options
-> RouteOptions
-> Maybe (ErrorHandler m)
-> Maybe StdMethod
-> RoutePattern
-> ActionT m ()
-> BodyInfo
-> Middleware m
forall (m :: * -> *).
MonadUnliftIO m =>
Options
-> RouteOptions
-> Maybe (ErrorHandler m)
-> Maybe StdMethod
-> RoutePattern
-> ActionT m ()
-> BodyInfo
-> Middleware m
route Options
serverOptions (ScottyState m -> RouteOptions
forall (m :: * -> *). ScottyState m -> RouteOptions
routeOptions ScottyState m
s) (ScottyState m -> Maybe (ErrorHandler m)
forall (m :: * -> *). ScottyState m -> Maybe (ErrorHandler m)
handler ScottyState m
s) Maybe StdMethod
forall a. Maybe a
Nothing RoutePattern
pat ActionT m ()
action)
        ScottyState 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 :: (MonadUnliftIO m) => ActionT m () -> ScottyT m ()
notFound :: forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m () -> ScottyT m ()
notFound ActionT m ()
action = RoutePattern -> ActionT m () -> ScottyT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
matchAny ((Request -> Maybe [Param]) -> RoutePattern
Function (\Request
req -> [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just [(Text
"path", Request -> Text
path Request
req)])) (Status -> ActionT m ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status404 ActionT m () -> ActionT m () -> ActionT m ()
forall a b. ActionT m a -> ActionT m b -> ActionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ActionT m ()
action)

{- | 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 :: forall (m :: * -> *).
MonadUnliftIO m =>
StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
addroute StdMethod
method RoutePattern
pat ActionT m ()
action =
  ReaderT Options (State (ScottyState m)) () -> ScottyT m ()
forall (m :: * -> *) a.
ReaderT Options (State (ScottyState m)) a -> ScottyT m a
ScottyT (ReaderT Options (State (ScottyState m)) () -> ScottyT m ())
-> ReaderT Options (State (ScottyState m)) () -> ScottyT m ()
forall a b. (a -> b) -> a -> b
$ do
    Options
serverOptions <- ReaderT Options (State (ScottyState m)) Options
forall r (m :: * -> *). MonadReader r m => m r
MR.ask
    (ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyState m -> ScottyState m)
 -> ReaderT Options (State (ScottyState m)) ())
-> (ScottyState m -> ScottyState m)
-> ReaderT Options (State (ScottyState m)) ()
forall a b. (a -> b) -> a -> b
$ \ScottyState m
s ->
      (BodyInfo -> Middleware m) -> ScottyState m -> ScottyState m
forall (m :: * -> *).
(BodyInfo -> Middleware m) -> ScottyState m -> ScottyState m
addRoute
        (Options
-> RouteOptions
-> Maybe (ErrorHandler m)
-> Maybe StdMethod
-> RoutePattern
-> ActionT m ()
-> BodyInfo
-> Middleware m
forall (m :: * -> *).
MonadUnliftIO m =>
Options
-> RouteOptions
-> Maybe (ErrorHandler m)
-> Maybe StdMethod
-> RoutePattern
-> ActionT m ()
-> BodyInfo
-> Middleware m
route Options
serverOptions (ScottyState m -> RouteOptions
forall (m :: * -> *). ScottyState m -> RouteOptions
routeOptions ScottyState m
s) (ScottyState m -> Maybe (ErrorHandler m)
forall (m :: * -> *). ScottyState m -> Maybe (ErrorHandler m)
handler ScottyState m
s) (StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
method) RoutePattern
pat ActionT m ()
action)
        ScottyState m
s


route :: (MonadUnliftIO m) =>
         Options
      -> RouteOptions
      -> Maybe (ErrorHandler m) -> Maybe StdMethod -> RoutePattern -> ActionT m () -> BodyInfo -> Middleware m
route :: forall (m :: * -> *).
MonadUnliftIO m =>
Options
-> RouteOptions
-> Maybe (ErrorHandler m)
-> Maybe StdMethod
-> RoutePattern
-> ActionT m ()
-> BodyInfo
-> Middleware m
route Options
serverOpts RouteOptions
opts Maybe (ErrorHandler m)
h Maybe StdMethod
method RoutePattern
pat ActionT m ()
action BodyInfo
bodyInfo 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 and 'matchAny'
      methodMatches :: Bool
      methodMatches :: Bool
methodMatches = Bool -> (StdMethod -> Bool) -> Maybe StdMethod -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\StdMethod
x -> (StdMethod -> Either ByteString StdMethod
forall a b. b -> Either a b
Right StdMethod
x Either ByteString StdMethod -> Either ByteString StdMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Either ByteString StdMethod
parseMethod (Request -> ByteString
requestMethod Request
req))) Maybe StdMethod
method

  in if Bool
methodMatches
     then case RoutePattern -> Request -> Maybe [Param]
matchRoute RoutePattern
pat Request
req of
            Just [Param]
captures -> do
              -- The user-facing API for "body" and "bodyReader" involve an IO action that
              -- reads the body/chunks thereof only once, so we shouldn't pass in our BodyInfo
              -- directly; otherwise, the body might get consumed and then it would be unavailable
              -- if `next` is called and we try to match further routes.
              -- Instead, make a "cloned" copy of the BodyInfo that allows the IO actions to be called
              -- without messing up the state of the original BodyInfo.
              BodyInfo
cbi <- BodyInfo -> m BodyInfo
forall (m :: * -> *). MonadIO m => BodyInfo -> m BodyInfo
cloneBodyInfo BodyInfo
bodyInfo

              ActionEnv
env <- BodyInfo -> Request -> [Param] -> RouteOptions -> m ActionEnv
forall (m :: * -> *).
MonadIO m =>
BodyInfo -> Request -> [Param] -> RouteOptions -> m ActionEnv
mkEnv BodyInfo
cbi Request
req [Param]
captures RouteOptions
opts
              Maybe Response
res <- Options
-> Maybe (ErrorHandler m)
-> ActionEnv
-> ActionT m ()
-> m (Maybe Response)
forall (m :: * -> *).
MonadUnliftIO m =>
Options
-> Maybe (ErrorHandler m)
-> ActionEnv
-> ActionT m ()
-> m (Maybe Response)
runAction Options
serverOpts Maybe (ErrorHandler m)
h ActionEnv
env ActionT m ()
action
              
              m Response
-> (Response -> m Response) -> Maybe Response -> m Response
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Response
tryNext Response -> m Response
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Response
res
            Maybe [Param]
Nothing -> m Response
tryNext
     else m Response
tryNext

matchRoute :: RoutePattern -> Request -> Maybe [Param]
matchRoute :: RoutePattern -> Request -> Maybe [Param]
matchRoute (Literal Text
pat)  Request
req | Text
pat Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> Text
path Request
req = [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just []
                              | Bool
otherwise       = Maybe [Param]
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') Text
pat) ([Text] -> [Text]
forall {a}. (Eq a, IsString a) => [a] -> [a]
compress ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Request -> [Text]
pathInfo Request
req) [] -- add empty segment to simulate being at the root
    where go :: [Text] -> [Text] -> [Param] -> Maybe [Param]
go [] [] [Param]
prs = [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just [Param]
prs -- request string and pattern match!
          go [] [Text]
r  [Param]
prs | Text -> Bool
T.null ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
r)  = [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just [Param]
prs -- in case request has trailing slashes
                       | Bool
otherwise           = Maybe [Param]
forall a. Maybe a
Nothing  -- request string is longer than pattern
          go [Text]
p  [] [Param]
prs | Text -> Bool
T.null ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
p)  = [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just [Param]
prs -- in case pattern has trailing slashes
                       | Bool
otherwise           = Maybe [Param]
forall a. Maybe a
Nothing  -- request string is not long enough
          go (Text
p:[Text]
ps) (Text
r:[Text]
rs) [Param]
prs = case Text -> Maybe (Char, Text)
T.uncons Text
p of
                        Just (Char
':', Text
name) -> [Text] -> [Text] -> [Param] -> Maybe [Param]
go [Text]
ps [Text]
rs ([Param] -> Maybe [Param]) -> [Param] -> Maybe [Param]
forall a b. (a -> b) -> a -> b
$ (Text
name, Text
r) Param -> [Param] -> [Param]
forall a. a -> [a] -> [a]
: [Param]
prs -- p is a capture, add to params
                        Maybe (Char, Text)
_ | Text
p Text -> Text -> Bool
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
                          | Bool
otherwise    -> Maybe [Param]
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 a -> [a] -> [a]
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 = Char -> Text -> Text
T.cons Char
'/' (Text -> Text) -> (Request -> Text) -> Request -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> (Request -> [Text]) -> Request -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> [Text]
pathInfo

-- | Parse the request and construct the initial 'ActionEnv' with a default 200 OK response
mkEnv :: MonadIO m =>
         BodyInfo
      -> Request
      -> [Param]
      -> RouteOptions
      -> m ActionEnv
mkEnv :: forall (m :: * -> *).
MonadIO m =>
BodyInfo -> Request -> [Param] -> RouteOptions -> m ActionEnv
mkEnv BodyInfo
bodyInfo Request
req [Param]
pathps RouteOptions
opts = do
  let
    getFormData :: InternalState -> ParseRequestBodyOptions -> IO ([Param], [File FilePath])
    getFormData :: InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File FilePath])
getFormData InternalState
istate ParseRequestBodyOptions
prbo = InternalState
-> ParseRequestBodyOptions
-> Request
-> BodyInfo
-> RouteOptions
-> IO ([Param], [File FilePath])
getFormParamsAndFilesAction InternalState
istate ParseRequestBodyOptions
prbo Request
req BodyInfo
bodyInfo RouteOptions
opts
    queryps :: [Param]
queryps = Query -> [Param]
parseEncodedParams (Query -> [Param]) -> Query -> [Param]
forall a b. (a -> b) -> a -> b
$ Request -> Query
queryString Request
req
  TVar ScottyResponse
responseInit <- IO (TVar ScottyResponse) -> m (TVar ScottyResponse)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar ScottyResponse) -> m (TVar ScottyResponse))
-> IO (TVar ScottyResponse) -> m (TVar ScottyResponse)
forall a b. (a -> b) -> a -> b
$ ScottyResponse -> IO (TVar ScottyResponse)
forall a. a -> IO (TVar a)
newTVarIO ScottyResponse
defaultScottyResponse
  ActionEnv -> m ActionEnv
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ActionEnv -> m ActionEnv) -> ActionEnv -> m ActionEnv
forall a b. (a -> b) -> a -> b
$ Request
-> [Param]
-> [Param]
-> (InternalState
    -> ParseRequestBodyOptions -> IO ([Param], [File FilePath]))
-> IO ByteString
-> IO ByteString
-> TVar ScottyResponse
-> ActionEnv
Env Request
req [Param]
pathps [Param]
queryps InternalState
-> ParseRequestBodyOptions -> IO ([Param], [File FilePath])
getFormData (BodyInfo -> RouteOptions -> IO ByteString
getBodyAction BodyInfo
bodyInfo RouteOptions
opts) (BodyInfo -> IO ByteString
getBodyChunkAction BodyInfo
bodyInfo) TVar ScottyResponse
responseInit



parseEncodedParams :: Query -> [Param]
parseEncodedParams :: Query -> [Param]
parseEncodedParams Query
qs = [ ( ByteString -> Text
decodeUtf8Lenient ByteString
k, Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ByteString -> Text
decodeUtf8Lenient Maybe ByteString
v) | (ByteString
k,Maybe ByteString
v) <- Query
qs ]

{- | 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 :: FilePath -> RoutePattern
regex FilePath
pat = (Request -> Maybe [Param]) -> RoutePattern
Function ((Request -> Maybe [Param]) -> RoutePattern)
-> (Request -> Maybe [Param]) -> RoutePattern
forall a b. (a -> b) -> a -> b
$ \ Request
req -> ((FilePath, FilePath, FilePath, [FilePath]) -> [Param])
-> Maybe (FilePath, FilePath, FilePath, [FilePath])
-> Maybe [Param]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, FilePath) -> Param) -> [(Int, FilePath)] -> [Param]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> Text) -> (FilePath -> Text) -> (Int, FilePath) -> Param
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** FilePath -> Text
T.pack) ([(Int, FilePath)] -> [Param])
-> ((FilePath, FilePath, FilePath, [FilePath])
    -> [(Int, FilePath)])
-> (FilePath, FilePath, FilePath, [FilePath])
-> [Param]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [FilePath] -> [(Int, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([FilePath] -> [(Int, FilePath)])
-> ((FilePath, FilePath, FilePath, [FilePath]) -> [FilePath])
-> (FilePath, FilePath, FilePath, [FilePath])
-> [(Int, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath, FilePath, [FilePath]) -> [FilePath]
forall {a} {a} {c}. (a, a, c, [a]) -> [a]
strip)
                                         (Regex
-> FilePath -> Maybe (FilePath, FilePath, FilePath, [FilePath])
Regex.matchRegexAll Regex
rgx (FilePath -> Maybe (FilePath, FilePath, FilePath, [FilePath]))
-> FilePath -> Maybe (FilePath, FilePath, FilePath, [FilePath])
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Request -> Text
path Request
req)
    where rgx :: Regex
rgx = FilePath -> Regex
Regex.mkRegex FilePath
pat
          strip :: (a, a, c, [a]) -> [a]
strip (a
_, a
match, c
_, [a]
subs) = a
match a -> [a] -> [a]
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 :: FilePath -> RoutePattern
capture = FilePath -> RoutePattern
forall a. IsString a => FilePath -> 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'.

>>> :{
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 :: (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 :: FilePath -> RoutePattern
literal = Text -> RoutePattern
Literal (Text -> RoutePattern)
-> (FilePath -> Text) -> FilePath -> RoutePattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack