-- |
--
-- Module      : Network.URI.Template.VarValue
-- Copyright   : (c) 2025 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Network.URI.Template.VarValue
  ( VarValue (..)
  , varValueP
  , varValuePretty
  ) where

import Prelude

import Data.String (IsString (..))
import Data.Text (Text, pack)
import Network.URI.Template.Internal.Parse
import Network.URI.Template.Internal.Pretty

data VarValue
  = VarNull
  | VarValue Text
  | VarList [Text]
  | VarMap [(Text, Text)]
  deriving stock (Int -> VarValue -> ShowS
[VarValue] -> ShowS
VarValue -> String
(Int -> VarValue -> ShowS)
-> (VarValue -> String) -> ([VarValue] -> ShowS) -> Show VarValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarValue -> ShowS
showsPrec :: Int -> VarValue -> ShowS
$cshow :: VarValue -> String
show :: VarValue -> String
$cshowList :: [VarValue] -> ShowS
showList :: [VarValue] -> ShowS
Show)

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

varValueP :: Parser VarValue
varValueP :: Parser VarValue
varValueP =
  [Parser VarValue] -> Parser VarValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser VarValue
varMapP Parser VarValue -> String -> Parser VarValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"map variable value"
    , Parser VarValue
varListP Parser VarValue -> String -> Parser VarValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"list variable value"
    , Parser VarValue
varStringP Parser VarValue -> String -> Parser VarValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"string variable value"
    , Parser VarValue
varNumberP Parser VarValue -> String -> Parser VarValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"numeric variable value"
    , Parser VarValue
varNullP Parser VarValue -> String -> Parser VarValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"null variable value"
    ]

varMapP :: Parser VarValue
varMapP :: Parser VarValue
varMapP = [(Text, Text)] -> VarValue
VarMap ([(Text, Text)] -> VarValue)
-> ParsecT Void Text Identity [(Text, Text)] -> Parser VarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> Char
-> Parser (Text, Text)
-> ParsecT Void Text Identity [(Text, Text)]
forall a. Char -> Char -> Parser a -> Parser [a]
csvP Char
'[' Char
']' Parser (Text, Text)
kvP

kvP :: Parser (Text, Text)
kvP :: Parser (Text, Text)
kvP =
  (,)
    (Text -> Text -> (Text, Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
'(' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
quoted ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
commaP)
    ParsecT Void Text Identity (Text -> (Text, Text))
-> ParsecT Void Text Identity Text -> Parser (Text, Text)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity Text
quoted ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => 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
')')

varListP :: Parser VarValue
varListP :: Parser VarValue
varListP = [Text] -> VarValue
VarList ([Text] -> VarValue)
-> ParsecT Void Text Identity [Text] -> Parser VarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall a. Char -> Char -> Parser a -> Parser [a]
csvP Char
'(' Char
')' ParsecT Void Text Identity Text
quoted

varStringP :: Parser VarValue
varStringP :: Parser VarValue
varStringP = Text -> VarValue
VarValue (Text -> VarValue)
-> ParsecT Void Text Identity Text -> Parser VarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
quoted

varNumberP :: Parser VarValue
varNumberP :: Parser VarValue
varNumberP = Text -> VarValue
VarValue (Text -> VarValue) -> (String -> Text) -> String -> VarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> VarValue)
-> ParsecT Void Text Identity String -> Parser VarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

varNullP :: Parser VarValue
varNullP :: Parser VarValue
varNullP = VarValue
VarNull VarValue
-> ParsecT Void Text Identity (Tokens Text) -> Parser VarValue
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
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"null"

csvP :: Char -> Char -> Parser a -> Parser [a]
csvP :: forall a. Char -> Char -> Parser a -> Parser [a]
csvP Char
l Char
r Parser a
p = 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
l ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [a] -> ParsecT Void Text Identity [a]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser a
p ParsecT Void Text Identity Char
commaP ParsecT Void Text Identity [a]
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity [a]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity [a]
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [a]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => 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
r

commaP :: Parser Char
commaP :: ParsecT Void Text Identity Char
commaP = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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
',' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Char
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace) ParsecT Void Text Identity Char
-> String -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"comma"

varValuePretty :: VarValue -> Doc Ann
varValuePretty :: VarValue -> Doc Ann
varValuePretty = \case
  VarValue
VarNull -> Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnVarName Doc Ann
"null"
  VarValue Text
t -> Text -> Doc Ann
stPretty Text
t
  VarList [Text]
ts -> Text -> Text -> [Doc Ann] -> Doc Ann
csvPretty Text
"(" Text
")" ([Doc Ann] -> Doc Ann) -> [Doc Ann] -> Doc Ann
forall a b. (a -> b) -> a -> b
$ (Text -> Doc Ann) -> [Text] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Ann
stPretty [Text]
ts
  VarMap [(Text, Text)]
kvs -> Text -> Text -> [Doc Ann] -> Doc Ann
csvPretty Text
"[" Text
"]" ([Doc Ann] -> Doc Ann) -> [Doc Ann] -> Doc Ann
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Doc Ann) -> [(Text, Text)] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Doc Ann) -> (Text, Text) -> Doc Ann
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Doc Ann
kvPretty) [(Text, Text)]
kvs

csvPretty :: Text -> Text -> [Doc Ann] -> Doc Ann
csvPretty :: Text -> Text -> [Doc Ann] -> Doc Ann
csvPretty Text
l Text
r [Doc Ann]
ds =
  [Doc Ann] -> Doc Ann
forall ann. [Doc ann] -> Doc ann
hcat
    [ Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnPunctuation (Doc Ann -> Doc Ann) -> Doc Ann -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
l
    , [Doc Ann] -> Doc Ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc Ann] -> Doc Ann) -> [Doc Ann] -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Doc Ann -> [Doc Ann] -> [Doc Ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnPunctuation Doc Ann
forall ann. Doc ann
comma) [Doc Ann]
ds
    , Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnPunctuation (Doc Ann -> Doc Ann) -> Doc Ann -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
r
    ]

stPretty :: Text -> Doc Ann
stPretty :: Text -> Doc Ann
stPretty Text
t =
  [Doc Ann] -> Doc Ann
forall ann. [Doc ann] -> Doc ann
hcat
    [ Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnPunctuation Doc Ann
"\""
    , Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnString (Doc Ann -> Doc Ann) -> Doc Ann -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
t
    , Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnPunctuation Doc Ann
"\""
    ]

kvPretty :: Text -> Text -> Doc Ann
kvPretty :: Text -> Text -> Doc Ann
kvPretty Text
k Text
v =
  [Doc Ann] -> Doc Ann
forall ann. [Doc ann] -> Doc ann
hcat
    [ Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnPunctuation Doc Ann
"("
    , Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnVarName (Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
k)
    , Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnPunctuation Doc Ann
","
    , Text -> Doc Ann
stPretty Text
v
    , Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnPunctuation Doc Ann
")"
    ]