{-# LANGUAGE OverloadedStrings #-}
module Servant.Server.Internal.PathInfo where

import qualified Data.ByteString.Char8 as B
import           Data.List             (unfoldr)
import           Data.Text             (Text)
import qualified Data.Text             as T
import qualified Data.Text.Encoding    as T
import           Snap.Core


rqPath :: Request -> B.ByteString
rqPath r = B.append (rqContextPath r) (rqPathInfo r)

pathInfo :: Request -> [Text]
pathInfo = T.splitOn "/" . T.decodeUtf8 . rqPathInfo


pathSafeTail :: Request -> ([B.ByteString], [B.ByteString])
pathSafeTail r =
  let contextParts = B.split '/' (rqContextPath r)
      restParts    = B.split '/' (rqPathInfo r)
  in (contextParts, drop 1 restParts)


-- TODO: Is this right? Does it drop leading/trailing slashes?
reqSafeTail :: Request -> Request
reqSafeTail r = let (ctx,inf) = pathSafeTail r
                in  r { rqContextPath = B.intercalate "/" ctx
                      , rqPathInfo    = B.intercalate "/" inf
                      }

reqNoPath :: Request -> Request
reqNoPath r = r {rqPathInfo = ""}

-- | Like `null . pathInfo`, but works with redundant trailing slashes.
pathIsEmpty :: Request -> Bool
pathIsEmpty = f . processedPathInfo
  where
    f []   = True
    f [""] = True
    f _    = False


splitMatrixParameters :: Text -> (Text, Text)
splitMatrixParameters = T.break (== ';')

parsePathInfo :: Request -> [Text]
parsePathInfo = filter (/= "") . mergePairs . map splitMatrixParameters . pathInfo
  where mergePairs = concat . unfoldr pairToList
        pairToList []          = Nothing
        pairToList ((a, b):xs) = Just ([a, b], xs)

-- | Returns a processed pathInfo from the request.
--
-- In order to handle matrix parameters in the request correctly, the raw pathInfo needs to be
-- processed, so routing works as intended. Therefor this function should be used to access
-- the pathInfo for routing purposes.
processedPathInfo :: Request -> [Text]
processedPathInfo r =
  case pinfo of
    (x:xs) | T.head x == ';' -> xs
    _                        -> pinfo
  where pinfo = parsePathInfo r

# LANGUAGE OverloadedStrings #
 TODO: Is this right? Does it drop leading/trailing slashes?
 | Like `null . pathInfo`, but works with redundant trailing slashes.
 | Returns a processed pathInfo from the request.

 In order to handle matrix parameters in the request correctly, the raw pathInfo needs to be
 processed, so routing works as intended. Therefor this function should be used to access
 the pathInfo for routing purposes.
module Servant.Server.Internal.PathInfo where

import qualified Data.ByteString.Char8 as B
import           Data.List             (unfoldr)
import           Data.Text             (Text)
import qualified Data.Text             as T
import qualified Data.Text.Encoding    as T
import           Snap.Core


rqPath :: Request -> B.ByteString
rqPath r = B.append (rqContextPath r) (rqPathInfo r)

pathInfo :: Request -> [Text]
pathInfo = T.splitOn "/" . T.decodeUtf8 . rqPathInfo


pathSafeTail :: Request -> ([B.ByteString], [B.ByteString])
pathSafeTail r =
  let contextParts = B.split '/' (rqContextPath r)
      restParts    = B.split '/' (rqPathInfo r)
  in (contextParts, drop 1 restParts)


reqSafeTail :: Request -> Request
reqSafeTail r = let (ctx,inf) = pathSafeTail r
                in  r { rqContextPath = B.intercalate "/" ctx
                      , rqPathInfo    = B.intercalate "/" inf
                      }

reqNoPath :: Request -> Request
reqNoPath r = r {rqPathInfo = ""}

pathIsEmpty :: Request -> Bool
pathIsEmpty = f . processedPathInfo
  where
    f []   = True
    f [""] = True
    f _    = False


splitMatrixParameters :: Text -> (Text, Text)
splitMatrixParameters = T.break (== ';')

parsePathInfo :: Request -> [Text]
parsePathInfo = filter (/= "") . mergePairs . map splitMatrixParameters . pathInfo
  where mergePairs = concat . unfoldr pairToList
        pairToList []          = Nothing
        pairToList ((a, b):xs) = Just ([a, b], xs)

processedPathInfo :: Request -> [Text]
processedPathInfo r =
  case pinfo of
    (x:xs) | T.head x == ';' -> xs
    _                        -> pinfo
  where pinfo = parsePathInfo r
