-- |
--
-- Module      : Network.URI.Template.Internal.Operator
-- Copyright   : (c) 2025 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Network.URI.Template.Internal.Operator
  ( Operator (..)
  , operatorP
  , operatorPretty
  , OperatorActions (..)
  , operatorActions
  , nullOperatorActions
  ) where

import Prelude

import Data.Text (Text, pack, unpack)
import Data.Text qualified as T
import Network.URI (escapeURIString, isReserved, isUnescapedInURIComponent)
import Network.URI.Template.Internal.Parse
import Network.URI.Template.Internal.Pretty
import Network.URI.Template.VarName

data Operator
  = Reserved
  | Fragments
  | Labels
  | PathSegments
  | PathParameters
  | Query
  | QueryContinuation
  | SpecReserved Char
  deriving stock (Operator -> Operator -> Bool
(Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool) -> Eq Operator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
/= :: Operator -> Operator -> Bool
Eq, Int -> Operator -> ShowS
[Operator] -> ShowS
Operator -> String
(Int -> Operator -> ShowS)
-> (Operator -> String) -> ([Operator] -> ShowS) -> Show Operator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operator -> ShowS
showsPrec :: Int -> Operator -> ShowS
$cshow :: Operator -> String
show :: Operator -> String
$cshowList :: [Operator] -> ShowS
showList :: [Operator] -> ShowS
Show)

-- |
--
-- @
-- operator      =  op-level2 / op-level3 / op-reserve
-- op-level2     =  "+" / "#"
-- op-level3     =  "." / "/" / ";" / "?" / "&"
-- op-reserve    =  "=" / "," / "!" / "@" / "|"
-- @
operatorP :: Parser Operator
operatorP :: Parser Operator
operatorP =
  [Parser Operator] -> Parser Operator
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Operator
Reserved Operator -> ParsecT Void Text Identity Char -> Parser Operator
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+' Parser Operator -> String -> Parser Operator
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"reserved operator"
    , Operator
Fragments Operator -> ParsecT Void Text Identity Char -> Parser Operator
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#' Parser Operator -> String -> Parser Operator
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"fragment operator"
    , Operator
Labels Operator -> ParsecT Void Text Identity Char -> Parser Operator
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.' Parser Operator -> String -> Parser Operator
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"label operator"
    , Operator
PathSegments Operator -> ParsecT Void Text Identity Char -> Parser Operator
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/' Parser Operator -> String -> Parser Operator
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"path segment operator"
    , Operator
PathParameters Operator -> ParsecT Void Text Identity Char -> Parser Operator
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
';' Parser Operator -> String -> Parser Operator
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"path parameter operator"
    , Operator
Query Operator -> ParsecT Void Text Identity Char -> Parser Operator
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'?' Parser Operator -> String -> Parser Operator
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"query operator"
    , Operator
QueryContinuation Operator -> ParsecT Void Text Identity Char -> Parser Operator
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'&' Parser Operator -> String -> Parser Operator
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"query continuation operator"
    , Char -> Operator
SpecReserved (Char -> Operator)
-> ParsecT Void Text Identity Char -> Parser Operator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"=,!@|" :: String) Parser Operator -> String -> Parser Operator
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"spec-reserved operator"
    ]

operatorPretty :: Operator -> Doc ann
operatorPretty :: forall ann. Operator -> Doc ann
operatorPretty = \case
  Operator
Reserved -> Doc ann
"+"
  Operator
Fragments -> Doc ann
"#"
  Operator
Labels -> Doc ann
"."
  Operator
PathSegments -> Doc ann
"/"
  Operator
PathParameters -> Doc ann
";"
  Operator
Query -> Doc ann
"?"
  Operator
QueryContinuation -> Doc ann
"&"
  SpecReserved Char
c -> Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
c

data OperatorActions = OperatorActions
  { OperatorActions -> Text
listPrefix :: Text
  , OperatorActions -> Text
listIntercalate :: Text
  , OperatorActions -> VarName -> Text -> Text
renderValue :: VarName -> Text -> Text
  , OperatorActions -> Text -> Text
escapeValue :: Text -> Text
  }

-- | 'OperatorActions' to use when there was no 'Operator'
nullOperatorActions :: OperatorActions
nullOperatorActions :: OperatorActions
nullOperatorActions =
  OperatorActions
    { listPrefix :: Text
listPrefix = Text
""
    , listIntercalate :: Text
listIntercalate = Text
","
    , escapeValue :: Text -> Text
escapeValue = (Char -> Bool) -> Text -> Text
escapeURIText Char -> Bool
isUnescapedInURIComponent
    , renderValue :: VarName -> Text -> Text
renderValue = \VarName
_ Text
v -> Text
v
    }

operatorActions :: Operator -> OperatorActions
operatorActions :: Operator -> OperatorActions
operatorActions = \case
  Operator
Reserved ->
    OperatorActions
nullOperatorActions
      { escapeValue = escapeURIText $ \Char
c ->
          [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
            [ Char -> Bool
isUnescapedInURIComponent Char
c
            , Char -> Bool
isReserved Char
c
            ]
      }
  Operator
Fragments ->
    OperatorActions
nullOperatorActions
      { listPrefix = "#"
      , escapeValue = escapeURIText $ \Char
c ->
          [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
            [ Char -> Bool
isUnescapedInURIComponent Char
c
            , Char -> Bool
isReserved Char
c
            ]
      }
  Operator
Labels ->
    OperatorActions
nullOperatorActions
      { listPrefix = "."
      , listIntercalate = "."
      }
  Operator
PathSegments ->
    OperatorActions
nullOperatorActions
      { listPrefix = "/"
      , listIntercalate = "/"
      }
  Operator
PathParameters ->
    OperatorActions
nullOperatorActions
      { listPrefix = ";"
      , listIntercalate = ";"
      , renderValue = \VarName
k Text
v -> VarName -> Text
unVarName VarName
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
v then Text
"" else Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v
      }
  Operator
Query ->
    OperatorActions
nullOperatorActions
      { listPrefix = "?"
      , listIntercalate = "&"
      , renderValue = \VarName
k Text
v -> VarName -> Text
unVarName VarName
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v
      }
  Operator
QueryContinuation ->
    OperatorActions
nullOperatorActions
      { listPrefix = "&"
      , listIntercalate = "&"
      , renderValue = \VarName
k Text
v -> VarName -> Text
unVarName VarName
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v
      }
  SpecReserved {} -> OperatorActions
nullOperatorActions

escapeURIText :: (Char -> Bool) -> Text -> Text
escapeURIText :: (Char -> Bool) -> Text -> Text
escapeURIText Char -> Bool
p = String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
p ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack