{-# OPTIONS_HADDOCK not-home #-}

{- |
Module      : Servant.API.Routes.Internal.Path
Copyright   : (c) Frederick Pringle, 2025
License     : BSD-3-Clause
Maintainer  : frederick.pringle@fpringle.com

Internal module, subject to change.
-}
module Servant.API.Routes.Internal.Path
  ( Path (..)
  , renderPath
  , pathSeparator
  , PathPart (..)
  )
where

import Data.Aeson
import Data.String
import qualified Data.Text as T
import Data.Typeable

-- | A segment of an API path (between @"/"@s).
data PathPart
  = -- | Just a plain path part, e.g. @"api/"@.
    StringPart T.Text
  | -- | Capture a path part as a variable.
    CapturePart T.Text TypeRep
  | -- | Capture all path part as a list of variables.
    CaptureAllPart T.Text TypeRep
  deriving (PathPart -> PathPart -> Bool
(PathPart -> PathPart -> Bool)
-> (PathPart -> PathPart -> Bool) -> Eq PathPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathPart -> PathPart -> Bool
== :: PathPart -> PathPart -> Bool
$c/= :: PathPart -> PathPart -> Bool
/= :: PathPart -> PathPart -> Bool
Eq, Eq PathPart
Eq PathPart =>
(PathPart -> PathPart -> Ordering)
-> (PathPart -> PathPart -> Bool)
-> (PathPart -> PathPart -> Bool)
-> (PathPart -> PathPart -> Bool)
-> (PathPart -> PathPart -> Bool)
-> (PathPart -> PathPart -> PathPart)
-> (PathPart -> PathPart -> PathPart)
-> Ord PathPart
PathPart -> PathPart -> Bool
PathPart -> PathPart -> Ordering
PathPart -> PathPart -> PathPart
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PathPart -> PathPart -> Ordering
compare :: PathPart -> PathPart -> Ordering
$c< :: PathPart -> PathPart -> Bool
< :: PathPart -> PathPart -> Bool
$c<= :: PathPart -> PathPart -> Bool
<= :: PathPart -> PathPart -> Bool
$c> :: PathPart -> PathPart -> Bool
> :: PathPart -> PathPart -> Bool
$c>= :: PathPart -> PathPart -> Bool
>= :: PathPart -> PathPart -> Bool
$cmax :: PathPart -> PathPart -> PathPart
max :: PathPart -> PathPart -> PathPart
$cmin :: PathPart -> PathPart -> PathPart
min :: PathPart -> PathPart -> PathPart
Ord)

instance IsString PathPart where
  fromString :: String -> PathPart
fromString = Text -> PathPart
StringPart (Text -> PathPart) -> (String -> Text) -> String -> PathPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance Show PathPart where
  show :: PathPart -> String
show = Text -> String
T.unpack (Text -> String) -> (PathPart -> Text) -> PathPart -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathPart -> Text
renderPathPart

-- | Pretty-print a path part.
renderPathPart :: PathPart -> T.Text
renderPathPart :: PathPart -> Text
renderPathPart = \case
  StringPart Text
t -> Text
t
  CapturePart Text
_ TypeRep
typ -> Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRep -> String
forall a. Show a => a -> String
show TypeRep
typ) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
  CaptureAllPart Text
_ TypeRep
typ -> Text
"<[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRep -> String
forall a. Show a => a -> String
show TypeRep
typ) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]>"

-- | Standard path separator @"/"@.
pathSeparator :: T.Text
pathSeparator :: Text
pathSeparator = Text
"/"

-- | Simple representation of a URL path.
newtype Path = Path
  { Path -> [PathPart]
unPath :: [PathPart]
  }
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq, Eq Path
Eq Path =>
(Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Path -> Path -> Ordering
compare :: Path -> Path -> Ordering
$c< :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
>= :: Path -> Path -> Bool
$cmax :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
min :: Path -> Path -> Path
Ord) via [PathPart]

instance Show Path where
  show :: Path -> String
show = Text -> String
T.unpack (Text -> String) -> (Path -> Text) -> Path -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Text
renderPath

instance ToJSON Path where
  toJSON :: Path -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Path -> Text) -> Path -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Text
renderPath

-- | Pretty-print a path, including the leading @/@.
renderPath :: Path -> T.Text
renderPath :: Path -> Text
renderPath = (Text
pathSeparator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Path -> Text) -> Path -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
pathSeparator ([Text] -> Text) -> (Path -> [Text]) -> Path -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathPart -> Text) -> [PathPart] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathPart -> Text
renderPathPart ([PathPart] -> [Text]) -> (Path -> [PathPart]) -> Path -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> [PathPart]
unPath