-- Copyright 2020 Fernando Rincon Martin
-- 
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
-- 
--     http://www.apache.org/licenses/LICENSE-2.0
-- 
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.Wai.Routing.Purescheme.Core.Path
  ( path
  , pathSegment
  , pathVar
  , pathEnd
  )
where

import Network.Wai.Routing.Purescheme.Core.Basic
import Network.Wai.Routing.Purescheme.Core.Internal

import Data.Text (Text, intercalate)
import Network.Wai (pathInfo)

-- | Match the remaining path
path :: Text -> GenericApplication r -> GenericApplication r
path :: Text -> GenericApplication r -> GenericApplication r
path Text
p GenericApplication r
app Request
req =
  if Text
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> [Text] -> Text
intercalate Text
"/" (Request -> [Text]
pathInfo Request
req)
    then GenericApplication r
app GenericApplication r -> GenericApplication r
forall a b. (a -> b) -> a -> b
$ Request
req {pathInfo :: [Text]
pathInfo = []}
    else Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject Rejection
notFoundDefaultRejection

-- | Match the next path segment and remove from the request
pathSegment :: Text -> GenericApplication r -> GenericApplication r
pathSegment :: Text -> GenericApplication r -> GenericApplication r
pathSegment Text
expectedSegment GenericApplication r
app Request
req =
  case Request -> [Text]
pathInfo Request
req of
    (Text
p:[Text]
rest) | Text
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expectedSegment -> GenericApplication r
app GenericApplication r -> GenericApplication r
forall a b. (a -> b) -> a -> b
$ Request
req {pathInfo :: [Text]
pathInfo = [Text]
rest}
    [Text]
_ -> Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject Rejection
notFoundDefaultRejection

-- | Use the next path segment as a variable and remove from the request
pathVar :: FromUri a => (a -> GenericApplication r) -> GenericApplication r
pathVar :: (a -> GenericApplication r) -> GenericApplication r
pathVar a -> GenericApplication r
f Request
req = 
  case Request -> [Text]
pathInfo Request
req of
    [] -> Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject Rejection
notFoundDefaultRejection
    [Text
""] -> Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject Rejection
notFoundDefaultRejection
    (Text
p:[Text]
rest) -> a -> GenericApplication r
f (Text -> a
forall a. FromUri a => Text -> a
fromText Text
p) (Request
req{pathInfo :: [Text]
pathInfo = [Text]
rest})

-- | Match if all the path has been consumed or the remaining is a trailing slash
pathEnd :: GenericApplication r -> GenericApplication r
pathEnd :: GenericApplication r -> GenericApplication r
pathEnd GenericApplication r
f Request
req = 
  case Request -> [Text]
pathInfo Request
req of
    [] -> GenericApplication r
f Request
req
    [Text
""] -> GenericApplication r
f Request
req{pathInfo :: [Text]
pathInfo = []}
    [Text]
_ -> Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject Rejection
notFoundDefaultRejection