-- |
-- Single-route path parsers (specialization of "Web.Route.Invertible.Sequence").
-- The most important type here is 'Path', which can be used to represent a single path endpoint within your application, including placeholders.
-- For example, the following represents a path of @\/item\/$id@ where @$id@ is an integer placeholder:
--
-- > Path ("item" *< parameter) :: Path Int
--
{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances, FlexibleContexts #-}
module Web.Route.Invertible.Path
  ( PathString
  , normalizePath
  , Path(..)
  , pathValues
  , renderPath
  , urlPathBuilder
  ) where

import Prelude hiding (lookup)

import Control.Invertible.Monoidal
import qualified Data.ByteString.Builder as B
import qualified Data.Invertible as I
import Data.String (IsString(..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Network.HTTP.Types.URI as H

import Web.Route.Invertible.Parameter
import Web.Route.Invertible.Placeholder
import Web.Route.Invertible.Sequence

-- |A component of a path, such that paths are represented by @['PathString']@ (after splitting on \'/\').
-- Paths can be created by 'H.decodePath'.
type PathString = T.Text

-- |Remove double- and trailing-slashes (i.e., empty path segments).
normalizePath :: [PathString] -> [PathString]
normalizePath :: [PathString] -> [PathString]
normalizePath = (PathString -> Bool) -> [PathString] -> [PathString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (PathString -> Bool) -> PathString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathString -> Bool
T.null)

-- |A URL path parser/generator.
-- These should typically be constructed using the 'IsString' and 'Parameterized' instances.
-- Note that the individual components are /decoded/ path segments, so a literal slash in a component (e.g., as produced with 'fromString') will match \"%2F\".
-- Example:
--
-- > "get" *< parameter >*< "value" *< parameter :: Path (String, Int)
--
-- matches (or generates) @\/get\/$x\/value\/$y@ for any string @$x@ and any int @$y@ and returns those values.
newtype Path a = Path { Path a -> Sequence PathString a
pathSequence :: Sequence PathString a }
  deriving ((a <-> b) -> Path a -> Path b
(forall a b. (a <-> b) -> Path a -> Path b) -> Functor Path
forall a b. (a <-> b) -> Path a -> Path b
forall (f :: * -> *).
(forall a b. (a <-> b) -> f a -> f b) -> Functor f
fmap :: (a <-> b) -> Path a -> Path b
$cfmap :: forall a b. (a <-> b) -> Path a -> Path b
I.Functor, Functor Path
Path ()
Functor Path
-> Path ()
-> (forall a b. Path a -> Path b -> Path (a, b))
-> Monoidal Path
Path a -> Path b -> Path (a, b)
forall a b. Path a -> Path b -> Path (a, b)
forall (f :: * -> *).
Functor f
-> f () -> (forall a b. f a -> f b -> f (a, b)) -> Monoidal f
>*< :: Path a -> Path b -> Path (a, b)
$c>*< :: forall a b. Path a -> Path b -> Path (a, b)
unit :: Path ()
$cunit :: Path ()
$cp1Monoidal :: Functor Path
Monoidal, Monoidal Path
Path Void
Monoidal Path
-> Path Void
-> (forall a b. Path a -> Path b -> Path (Either a b))
-> MonoidalAlt Path
Path a -> Path b -> Path (Either a b)
forall a b. Path a -> Path b -> Path (Either a b)
forall (f :: * -> *).
Monoidal f
-> f Void
-> (forall a b. f a -> f b -> f (Either a b))
-> MonoidalAlt f
>|< :: Path a -> Path b -> Path (Either a b)
$c>|< :: forall a b. Path a -> Path b -> Path (Either a b)
zero :: Path Void
$czero :: Path Void
$cp1MonoidalAlt :: Monoidal Path
MonoidalAlt, Parameterized PathString, Int -> Path a -> ShowS
[Path a] -> ShowS
Path a -> String
(Int -> Path a -> ShowS)
-> (Path a -> String) -> ([Path a] -> ShowS) -> Show (Path a)
forall a. Int -> Path a -> ShowS
forall a. [Path a] -> ShowS
forall a. Path a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path a] -> ShowS
$cshowList :: forall a. [Path a] -> ShowS
show :: Path a -> String
$cshow :: forall a. Path a -> String
showsPrec :: Int -> Path a -> ShowS
$cshowsPrec :: forall a. Int -> Path a -> ShowS
Show)

deriving instance IsString (Path ())

-- |Render a 'Path' as instantiated by a value to a list of placeholder values.
pathValues :: Path a -> a -> [PlaceholderValue PathString]
pathValues :: Path a -> a -> [PlaceholderValue PathString]
pathValues (Path Sequence PathString a
p) = Sequence PathString a -> a -> [PlaceholderValue PathString]
forall s a. Sequence s a -> a -> [PlaceholderValue s]
sequenceValues Sequence PathString a
p

-- |Render a 'Path' as instantiated by a value to a list of string segments.
renderPath :: Path a -> a -> [PathString]
renderPath :: Path a -> a -> [PathString]
renderPath (Path Sequence PathString a
p) = Sequence PathString a -> a -> [PathString]
forall s a. Sequence s a -> a -> [s]
renderSequence Sequence PathString a
p

-- |Build a 'Path' as applied to a value into a bytestring 'B.Builder' by encoding the segments with 'urlEncodePath' and joining them with \"/\".
urlPathBuilder :: Path a -> a -> B.Builder
urlPathBuilder :: Path a -> a -> Builder
urlPathBuilder Path a
p a
a = (PathString -> Builder) -> [PathString] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PathString -> Builder
es ([PathString] -> Builder) -> [PathString] -> Builder
forall a b. (a -> b) -> a -> b
$ Path a -> a -> [PathString]
forall a. Path a -> a -> [PathString]
renderPath Path a
p a
a where
  es :: PathString -> Builder
es PathString
s = Char -> Builder
B.char7 Char
'/' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> ByteString -> Builder
H.urlEncodeBuilder Bool
False (PathString -> ByteString
TE.encodeUtf8 PathString
s)