    {-# LANGUAGE BangPatterns     #-}
    {-# LANGUAGE CPP              #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE Rank2Types       #-}
    module Snap.Internal.Routing
      ( Route(..)
      , pRoute
      , route
      , routeEarliestNC
      , routeHeight
      , routeLocal
      , splitPath
      ) where
    ------------------------------------------------------------------------------
    import           Control.Applicative      ((<|>))
    import           Data.ByteString          (ByteString)
    import qualified Data.ByteString          as B (head, intercalate, length, null, pack, splitWith, tail)
    import           Data.ByteString.Internal (c2w)
    import           Data.HashMap.Strict      (HashMap)
    import qualified Data.HashMap.Strict      as H (elems, empty, fromList, lookup, unionWith)
    import qualified Data.Map                 as Map (empty, insertWith, unionWith)
    import           Snap.Internal.Core       (MonadSnap, getRequest, getsRequest, localRequest, modifyRequest, pass, updateContextPath)
    import           Snap.Internal.Http.Types (Params, Request (rqContextPath, rqParams, rqPathInfo))
    import           Snap.Internal.Parsing    (urlDecode)
    #if !MIN_VERSION_base(4,8,0)
    import           Data.Monoid              (Monoid (..))
    #endif
    import           Data.Semigroup           (Semigroup (..))

    ------------------------------------------------------------------------------

    ------------------------------------------------------------------------------
    -- | The internal data type you use to build a routing tree. Matching is
    -- done unambiguously.
    --
    -- 'Capture' and 'Dir' routes can have a "fallback" route:
    --
    --   - For 'Capture', the fallback is routed when there is nothing to capture
    --   - For 'Dir', the fallback is routed when we can't find a route in its map
    --
    -- Fallback routes are stacked: i.e. for a route like:
    --
    -- > Dir [("foo", Capture "bar" (Action bar) NoRoute)] baz
    --
    -- visiting the URI foo/ will result in the "bar" capture being empty and
    -- triggering its fallback. It's NoRoute, so we go to the nearest parent
    -- fallback and try that, which is the baz action.
    data Route a m = Action ((MonadSnap m) => m a)   -- wraps a 'Snap' action
                   -- captures the dir in a param
                   | Capture ByteString (Route a m) (Route a m)
                   -- match on a dir
                   | Dir (HashMap ByteString (Route a m)) (Route a m)
                   | NoRoute

    ------------------------------------------------------------------------------

    instance Semigroup (Route a m) where
        Route a m
    NoRoute <> :: Route a m -> Route a m -> Route a m
    <> Route a m
    r = Route a m
    r

        l :: Route a m
    l@(Action MonadSnap m => m a
    a) <> Route a m
    r = case Route a m
    r of
          (Action MonadSnap m => m a
    a')       -> (MonadSnap m => m a) -> Route a m
    forall a (m :: * -> *). (MonadSnap m => m a) -> Route a m
    Action (m a
    MonadSnap m => m a
    a m a -> m a -> m a
    forall a. m a -> m a -> m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> m a
    MonadSnap m => m a
    a')
          (Capture ByteString
    p Route a m
    r' Route a m
    fb) -> ByteString -> Route a m -> Route a m -> Route a m
    forall a (m :: * -> *).
    ByteString -> Route a m -> Route a m -> Route a m
    Capture ByteString
    p Route a m
    r' (Route a m
    fb Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    l)
          (Dir HashMap ByteString (Route a m)
    _ Route a m
    _)         -> HashMap ByteString (Route a m) -> Route a m -> Route a m
    forall a (m :: * -> *).
    HashMap ByteString (Route a m) -> Route a m -> Route a m
    Dir HashMap ByteString (Route a m)
    forall k v. HashMap k v
    H.empty Route a m
    l Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    r
          Route a m
    NoRoute           -> Route a m
    l

        -- Whenever we're unioning two Captures and their capture variables
        -- differ, we have an ambiguity. We resolve this in the following order:
        --   1. Prefer whichever route is longer
        --   2. Else, prefer whichever has the earliest non-capture
        --   3. Else, prefer the right-hand side
        l :: Route a m
    l@(Capture ByteString
    p Route a m
    r' Route a m
    fb) <> Route a m
    r = case Route a m
    r of
          (Action MonadSnap m => m a
    _)           -> ByteString -> Route a m -> Route a m -> Route a m
    forall a (m :: * -> *).
    ByteString -> Route a m -> Route a m -> Route a m
    Capture ByteString
    p Route a m
    r' (Route a m
    fb Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    r)
          (Capture ByteString
    p' Route a m
    r'' Route a m
    fb')
                  | ByteString
    p ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    p'    -> ByteString -> Route a m -> Route a m -> Route a m
    forall a (m :: * -> *).
    ByteString -> Route a m -> Route a m -> Route a m
    Capture ByteString
    p (Route a m
    r' Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    r'') (Route a m
    fb Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    fb')
                  | Int
    rh' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    rh'' -> ByteString -> Route a m -> Route a m -> Route a m
    forall a (m :: * -> *).
    ByteString -> Route a m -> Route a m -> Route a m
    Capture ByteString
    p Route a m
    r' (Route a m
    fb Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    r)
                  | Int
    rh' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    rh'' -> ByteString -> Route a m -> Route a m -> Route a m
    forall a (m :: * -> *).
    ByteString -> Route a m -> Route a m -> Route a m
    Capture ByteString
    p' Route a m
    r'' (Route a m
    fb' Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    l)
                  | Int
    en' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    en'' -> ByteString -> Route a m -> Route a m -> Route a m
    forall a (m :: * -> *).
    ByteString -> Route a m -> Route a m -> Route a m
    Capture ByteString
    p Route a m
    r' (Route a m
    fb Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    r)
                  | Bool
    otherwise  -> ByteString -> Route a m -> Route a m -> Route a m
    forall a (m :: * -> *).
    ByteString -> Route a m -> Route a m -> Route a m
    Capture ByteString
    p' Route a m
    r'' (Route a m
    fb' Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    l)
            where
              rh' :: Int
    rh'  = Route a m -> Int
    forall a (m :: * -> *). Route a m -> Int
    routeHeight Route a m
    r'
              rh'' :: Int
    rh'' = Route a m -> Int
    forall a (m :: * -> *). Route a m -> Int
    routeHeight Route a m
    r''
              en' :: Int
    en'  = Route a m -> Int -> Int
    forall a (m :: * -> *). Route a m -> Int -> Int
    routeEarliestNC Route a m
    r' Int
    1
              en'' :: Int
    en'' = Route a m -> Int -> Int
    forall a (m :: * -> *). Route a m -> Int -> Int
    routeEarliestNC Route a m
    r'' Int
    1
          (Dir HashMap ByteString (Route a m)
    rm Route a m
    fb')         -> HashMap ByteString (Route a m) -> Route a m -> Route a m
    forall a (m :: * -> *).
    HashMap ByteString (Route a m) -> Route a m -> Route a m
    Dir HashMap ByteString (Route a m)
    rm (Route a m
    fb' Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    l)
          Route a m
    NoRoute              -> Route a m
    l

        (<>) l :: Route a m
    l@(Dir HashMap ByteString (Route a m)
    rm Route a m
    fb) Route a m
    r = case Route a m
    r of
          (Action MonadSnap m => m a
    _)      -> HashMap ByteString (Route a m) -> Route a m -> Route a m
    forall a (m :: * -> *).
    HashMap ByteString (Route a m) -> Route a m -> Route a m
    Dir HashMap ByteString (Route a m)
    rm (Route a m
    fb Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    r)
          (Capture ByteString
    _ Route a m
    _ Route a m
    _) -> HashMap ByteString (Route a m) -> Route a m -> Route a m
    forall a (m :: * -> *).
    HashMap ByteString (Route a m) -> Route a m -> Route a m
    Dir HashMap ByteString (Route a m)
    rm (Route a m
    fb Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    r)
          (Dir HashMap ByteString (Route a m)
    rm' Route a m
    fb')   -> HashMap ByteString (Route a m) -> Route a m -> Route a m
    forall a (m :: * -> *).
    HashMap ByteString (Route a m) -> Route a m -> Route a m
    Dir ((Route a m -> Route a m -> Route a m)
    -> HashMap ByteString (Route a m)
    -> HashMap ByteString (Route a m)
    -> HashMap ByteString (Route a m)
    forall k v.
    Eq k =>
    (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
    H.unionWith Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    (<>) HashMap ByteString (Route a m)
    rm HashMap ByteString (Route a m)
    rm') (Route a m
    fb Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    <> Route a m
    fb')
          Route a m
    NoRoute         -> Route a m
    l

    instance Monoid (Route a m) where
        mempty :: Route a m
    mempty = Route a m
    forall a (m :: * -> *). Route a m
    NoRoute
        mappend :: Route a m -> Route a m -> Route a m
    mappend = Route a m -> Route a m -> Route a m
    forall a. Semigroup a => a -> a -> a
    (<>)

    ------------------------------------------------------------------------------
    routeHeight :: Route a m -> Int
    routeHeight :: forall a (m :: * -> *). Route a m -> Int
    routeHeight Route a m
    r = case Route a m
    r of
      Route a m
    NoRoute          -> Int
    1
      (Action MonadSnap m => m a
    _)       -> Int
    1
      (Capture ByteString
    _ Route a m
    r' Route a m
    _) -> Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Route a m -> Int
    forall a (m :: * -> *). Route a m -> Int
    routeHeight Route a m
    r'
      (Dir HashMap ByteString (Route a m)
    rm Route a m
    _)       -> Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int -> Int -> Int) -> Int -> [Int] -> Int
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 ((Route a m -> Int) -> [Route a m] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Route a m -> Int
    forall a (m :: * -> *). Route a m -> Int
    routeHeight ([Route a m] -> [Int]) -> [Route a m] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ HashMap ByteString (Route a m) -> [Route a m]
    forall k v. HashMap k v -> [v]
    H.elems HashMap ByteString (Route a m)
    rm)
    {-# INLINE routeHeight #-}

    ------------------------------------------------------------------------------
    routeEarliestNC :: Route a m -> Int -> Int
    routeEarliestNC :: forall a (m :: * -> *). Route a m -> Int -> Int
    routeEarliestNC Route a m
    r Int
    n = case Route a m
    r of
      Route a m
    NoRoute           -> Int
    n
      (Action MonadSnap m => m a
    _)        -> Int
    n
      (Capture ByteString
    _ Route a m
    r' Route a m
    _)  -> Route a m -> Int -> Int
    forall a (m :: * -> *). Route a m -> Int -> Int
    routeEarliestNC Route a m
    r' Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1
      (Dir HashMap ByteString (Route a m)
    _ Route a m
    _)         -> Int
    n
    {-# INLINE routeEarliestNC #-}

    ------------------------------------------------------------------------------
    -- | A web handler which, given a mapping from URL entry points to web
    -- handlers, efficiently routes requests to the correct handler.
    --
    --
    -- __Usage__
    --
    -- The URL entry points are given as relative paths, for example:
    --
    -- > route [ ("foo/bar/quux", fooBarQuux) ]
    --
    -- If the URI of the incoming request is @\/foo\/bar\/quux@ or
    -- @\/foo\/bar\/quux\/...anything...@ then the request will be routed to
    -- @\"fooBarQuux\"@, with 'rqContextPath' set to @\"\/foo\/bar\/quux\/\"@ and
    -- 'rqPathInfo' set to @\"...anything...\"@.
    --
    -- A path component within an URL entry point beginning with a colon (@\":\"@)
    -- is treated as a /variable capture/; the corresponding path component within
    -- the request URI will be entered into the 'rqParams' parameters mapping with
    -- the given name. For instance, if the routes were:
    --
    -- > route [ ("foo/:bar/baz", fooBazHandler) ]
    --
    -- Then a request for @\"\/foo\/saskatchewan\/baz\"@ would be routed to
    -- @fooBazHandler@ with a mapping for @\"bar\" => \"saskatchewan\"@ in its
    -- parameters table.
    --
    -- Longer paths are matched first, and specific routes are matched before
    -- captures. That is, if given routes:
    --
    -- > [ ("a", h1), ("a/b", h2), ("a/:x", h3) ]
    --
    -- a request for @\"\/a\/b\"@ will go to @h2@, @\"\/a\/s\"@ for any /s/ will go
    -- to @h3@, and @\"\/a\"@ will go to @h1@.
    --
    -- The following example matches @\"\/article\"@ to an article index,
    -- @\"\/login\"@ to a login, and @\"\/article\/...\"@ to an article renderer.
    --
    -- @
    -- 'route' [ (\"article\",     renderIndex)
    --       , (\"article\/:id\", renderArticle)
    --       , (\"login\",       'Snap.Core.method' POST doLogin) ]
    -- @
    --
    -- __Note: URL decoding__
    --
    -- A short note about URL decoding: path matching and variable capture are done
    -- on /decoded/ URLs, but the contents of 'rqContextPath' and 'rqPathInfo' will
    -- contain the original encoded URL, i.e. what the user entered. For example,
    -- in the following scenario:
    --
    -- > route [ ("a b c d/", foo ) ]
    --
    -- A request for \"@/a+b+c+d@\" will be sent to @foo@ with 'rqContextPath' set
    -- to @\"/a+b+c+d/\"@.
    --
    -- This behaviour changed as of Snap 0.6.1; previous versions had unspecified
    -- (and buggy!) semantics here.
    --
    --
    -- __Example:__
    --
    -- @
    -- ghci> :set -XOverloadedStrings
    -- ghci> import qualified "Data.Map" as Map
    -- ghci> import qualified "Data.ByteString.Char8" as B8
    -- ghci> import "Snap.Test"
    -- ghci> :{
    -- ghci| let handler = do r \<- 'getRequest'
    -- ghci|                  'Snap.Core.writeBS' $ \"rqContextPath: \" \<> 'rqContextPath' r \<> \"\\n\"
    -- ghci|                  'Snap.Core.writeBS' $ \"rqPathInfo: \" \<> 'rqPathInfo' r \<> \"\\n\"
    -- ghci|                  'Snap.Core.writeBS' $ \"rqParams: \" \<> (B8.pack . show $ 'rqParams' r)
    -- ghci| :}
    -- ghci> 'Snap.Test.runHandler' ('Snap.Test.get' \"\/foo\/bar\" "Map.empty") ('route' [(\"foo\", handler)])
    -- HTTP\/1.1 200 OK
    -- server: Snap\/test
    -- date: Sat, 02 Aug 2014 05:16:59 GMT
    --
    -- rqContextPath: \/foo\/
    -- rqPathInfo: bar
    -- rqParams: fromList []
    -- ghci> 'Snap.Test.runHandler' ('Snap.Test.get' \"\/foo\/bar\" "Map.empty") ('route' [(\"foo\/:bar\", handler)])
    -- [...]
    --
    -- rqContextPath: \/foo\/bar\/
    -- rqPathInfo:
    -- rqParams: fromList [(\"bar\",[\"bar\"])]
    -- @
    route :: MonadSnap m => [(ByteString, m a)] -> m a
    route :: forall (m :: * -> *) a. MonadSnap m => [(ByteString, m a)] -> m a
    route [(ByteString, m a)]
    rts = do
      p <- (Request -> ByteString) -> m ByteString
    forall (m :: * -> *) a. MonadSnap m => (Request -> a) -> m a
    getsRequest Request -> ByteString
    rqPathInfo
      route' (return $! ()) [] (splitPath p) Map.empty rts'
      where
        rts' :: Route a m
    rts' = [Route a m] -> Route a m
    forall a. Monoid a => [a] -> a
    mconcat (((ByteString, m a) -> Route a m)
    -> [(ByteString, m a)] -> [Route a m]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString, m a) -> Route a m
    forall (m :: * -> *) a.
    MonadSnap m =>
    (ByteString, m a) -> Route a m
    pRoute [(ByteString, m a)]
    rts)
    {-# INLINE route #-}

    ------------------------------------------------------------------------------
    -- | The 'routeLocal' function is the same as 'route', except it doesn't
    -- change the request's context path. This is useful if you want to route to a
    -- particular handler but you want that handler to receive the 'rqPathInfo' as
    -- it is.
    --
    -- Example:
    --
    -- @
    -- ghci> :set -XOverloadedStrings
    -- ghci> import qualified "Data.Map" as M
    -- ghci> import qualified "Data.ByteString.Char8" as B8
    -- ghci> import "Snap.Test"
    -- ghci> :{
    -- ghci| let handler = do r \<- 'getRequest'
    -- ghci|                  'Snap.Core.writeBS' $ \"rqContextPath: \" \<> 'rqContextPath' r \<> \"\\n\"
    -- ghci|                  'Snap.Core.writeBS' $ \"rqPathInfo: \" \<> 'rqPathInfo' r \<> \"\\n\"
    -- ghci|                  'Snap.Core.writeBS' $ \"rqParams: \" \<> (B8.pack . show $ 'rqParams' r)
    -- ghci| :}
    -- ghci> 'Snap.Test.runHandler' ('Snap.Test.get' \"\/foo\/bar\" M.empty) ('routeLocal' [(\"foo\", handler)])
    -- HTTP\/1.1 200 OK
    -- server: Snap\/test
    -- date: Sat, 02 Aug 2014 05:17:28 GMT
    --
    -- rqContextPath: \/
    -- rqPathInfo: foo\/bar
    -- ghci> 'Snap.Test.runHandler' ('Snap.Test.get' \"\/foo\/bar\" M.empty) ('routeLocal' [(\"foo\/:bar\", handler)])
    -- [...]
    --
    -- rqContextPath: \/
    -- rqPathInfo: foo\/bar
    -- rqParams: fromList [(\"bar\",[\"bar\"])]
    -- @
    routeLocal :: MonadSnap m => [(ByteString, m a)] -> m a
    routeLocal :: forall (m :: * -> *) a. MonadSnap m => [(ByteString, m a)] -> m a
    routeLocal [(ByteString, m a)]
    rts = do
        req    <- m Request
    forall (m :: * -> *). MonadSnap m => m Request
    getRequest
        let ctx = Request -> ByteString
    rqContextPath Request
    req
        let p   = Request -> ByteString
    rqPathInfo Request
    req
        let md  = (Request -> Request) -> m ()
    forall (m :: * -> *). MonadSnap m => (Request -> Request) -> m ()
    modifyRequest ((Request -> Request) -> m ()) -> (Request -> Request) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Request
    r -> Request
    r {rqContextPath=ctx, rqPathInfo=p}

        (route' md [] (splitPath p) Map.empty rts') <|> (md >> pass)

      where
        rts' :: Route a m
    rts' = [Route a m] -> Route a m
    forall a. Monoid a => [a] -> a
    mconcat (((ByteString, m a) -> Route a m)
    -> [(ByteString, m a)] -> [Route a m]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString, m a) -> Route a m
    forall (m :: * -> *) a.
    MonadSnap m =>
    (ByteString, m a) -> Route a m
    pRoute [(ByteString, m a)]
    rts)
    {-# INLINE routeLocal #-}

    ------------------------------------------------------------------------------
    splitPath :: ByteString -> [ByteString]
    splitPath :: ByteString -> [ByteString]
    splitPath = (Word8 -> Bool) -> ByteString -> [ByteString]
    B.splitWith (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Char -> Word8
    c2w Char
    '/'))
    {-# INLINE splitPath #-}

    ------------------------------------------------------------------------------
    pRoute :: MonadSnap m => (ByteString, m a) -> Route a m
    pRoute :: forall (m :: * -> *) a.
    MonadSnap m =>
    (ByteString, m a) -> Route a m
    pRoute (ByteString
    r, m a
    a) = (ByteString -> Route a m -> Route a m)
    -> Route a m -> [ByteString] -> Route a m
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ByteString -> Route a m -> Route a m
    forall {a} {m :: * -> *}. ByteString -> Route a m -> Route a m
    f ((MonadSnap m => m a) -> Route a m
    forall a (m :: * -> *). (MonadSnap m => m a) -> Route a m
    Action m a
    MonadSnap m => m a
    a) [ByteString]
    hier
      where
        hier :: [ByteString]
    hier   = (ByteString -> Bool) -> [ByteString] -> [ByteString]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Bool
    B.null) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> Bool) -> ByteString -> [ByteString]
    B.splitWith (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Char -> Word8
    c2w Char
    '/')) ByteString
    r
        f :: ByteString -> Route a m -> Route a m
    f ByteString
    s Route a m
    rt = if HasCallStack => ByteString -> Word8
    ByteString -> Word8
    B.head ByteString
    s Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    c2w Char
    ':'
            then ByteString -> Route a m -> Route a m -> Route a m
    forall a (m :: * -> *).
    ByteString -> Route a m -> Route a m -> Route a m
    Capture (HasCallStack => ByteString -> ByteString
    ByteString -> ByteString
    B.tail ByteString
    s) Route a m
    rt Route a m
    forall a (m :: * -> *). Route a m
    NoRoute
            else HashMap ByteString (Route a m) -> Route a m -> Route a m
    forall a (m :: * -> *).
    HashMap ByteString (Route a m) -> Route a m -> Route a m
    Dir ([(ByteString, Route a m)] -> HashMap ByteString (Route a m)
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    H.fromList [(ByteString
    s, Route a m
    rt)]) Route a m
    forall a (m :: * -> *). Route a m
    NoRoute
    {-# INLINE pRoute #-}

    ------------------------------------------------------------------------------
    route' :: MonadSnap m
           => m ()           -- ^ action to run before we call the user handler
           -> [ByteString]   -- ^ the \"context\"; the list of path segments we've
                             -- already successfully matched, in reverse order
           -> [ByteString]   -- ^ the list of path segments we haven't yet matched
           -> Params
           -> Route a m
           -> m a
    route' :: forall (m :: * -> *) a.
    MonadSnap m =>
    m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    route' m ()
    pre ![ByteString]
    ctx [ByteString]
    _ !Params
    params (Action MonadSnap m => m a
    action) =
        (Request -> Request) -> m a -> m a
    forall (m :: * -> *) a.
    MonadSnap m =>
    (Request -> Request) -> m a -> m a
    localRequest (Int -> Request -> Request
    updateContextPath (ByteString -> Int
    B.length ByteString
    ctx') (Request -> Request) -> (Request -> Request) -> Request -> Request
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Request -> Request
    updateParams)
                     (m ()
    pre m () -> m a -> m a
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> m a
    MonadSnap m => m a
    action)
      where
        ctx' :: ByteString
    ctx' = ByteString -> [ByteString] -> ByteString
    B.intercalate ([Word8] -> ByteString
    B.pack [Char -> Word8
    c2w Char
    '/']) ([ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse [ByteString]
    ctx)
        updateParams :: Request -> Request
    updateParams Request
    req = Request
    req
          { rqParams = Map.unionWith (flip (++)) params (rqParams req) }

    route' m ()
    pre ![ByteString]
    ctx [] !Params
    params (Capture ByteString
    _ Route a m
    _  Route a m
    fb) =
        m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    forall (m :: * -> *) a.
    MonadSnap m =>
    m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    route' m ()
    pre [ByteString]
    ctx [] Params
    params Route a m
    fb

    route' m ()
    pre ![ByteString]
    ctx paths :: [ByteString]
    paths@(ByteString
    cwd:[ByteString]
    rest) !Params
    params (Capture ByteString
    p Route a m
    rt Route a m
    fb)
        | ByteString -> Bool
    B.null ByteString
    cwd = m a
    fallback
        | Bool
    otherwise  = m a
    m m a -> m a -> m a
    forall a. m a -> m a -> m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> m a
    fallback
      where
        fallback :: m a
    fallback = m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    forall (m :: * -> *) a.
    MonadSnap m =>
    m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    route' m ()
    pre [ByteString]
    ctx [ByteString]
    paths Params
    params Route a m
    fb
        m :: m a
    m = m a -> (ByteString -> m a) -> Maybe ByteString -> m a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe m a
    forall (m :: * -> *) a. MonadSnap m => m a
    pass
                  (\ByteString
    cwd' -> let params' :: Params
    params' = ([ByteString] -> [ByteString] -> [ByteString])
    -> ByteString -> [ByteString] -> Params -> Params
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    Map.insertWith (([ByteString] -> [ByteString] -> [ByteString])
    -> [ByteString] -> [ByteString] -> [ByteString]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    (++)) ByteString
    p [ByteString
    cwd'] Params
    params
                            in m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    forall (m :: * -> *) a.
    MonadSnap m =>
    m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    route' m ()
    pre (ByteString
    cwdByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    ctx) [ByteString]
    rest Params
    params' Route a m
    rt)
                  (ByteString -> Maybe ByteString
    urlDecode ByteString
    cwd)

    route' m ()
    pre ![ByteString]
    ctx [] !Params
    params (Dir HashMap ByteString (Route a m)
    _ Route a m
    fb) =
        m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    forall (m :: * -> *) a.
    MonadSnap m =>
    m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    route' m ()
    pre [ByteString]
    ctx [] Params
    params Route a m
    fb
    route' m ()
    pre ![ByteString]
    ctx paths :: [ByteString]
    paths@(ByteString
    cwd:[ByteString]
    rest) !Params
    params (Dir HashMap ByteString (Route a m)
    rtm Route a m
    fb) = do
        cwd' <- m ByteString
    -> (ByteString -> m ByteString) -> Maybe ByteString -> m ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe m ByteString
    forall (m :: * -> *) a. MonadSnap m => m a
    pass ByteString -> m ByteString
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> m ByteString)
    -> Maybe ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString
    urlDecode ByteString
    cwd
        case H.lookup cwd' rtm of
          Just Route a m
    rt -> (m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    forall (m :: * -> *) a.
    MonadSnap m =>
    m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    route' m ()
    pre (ByteString
    cwdByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    ctx) [ByteString]
    rest Params
    params Route a m
    rt) m a -> m a -> m a
    forall a. m a -> m a -> m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
                     (m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    forall (m :: * -> *) a.
    MonadSnap m =>
    m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    route' m ()
    pre [ByteString]
    ctx [ByteString]
    paths Params
    params Route a m
    fb)
          Maybe (Route a m)
    Nothing -> m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    forall (m :: * -> *) a.
    MonadSnap m =>
    m () -> [ByteString] -> [ByteString] -> Params -> Route a m -> m a
    route' m ()
    pre [ByteString]
    ctx [ByteString]
    paths Params
    params Route a m
    fb

    route' m ()
    _ [ByteString]
    _ [ByteString]
    _ Params
    _ Route a m
    NoRoute = m a
    forall (m :: * -> *) a. MonadSnap m => m a
    pass