-- |
--
-- Module      : Network.URI.Template.Internal.VarSpec
-- Copyright   : (c) 2025 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Network.URI.Template.Internal.VarSpec
  ( VarSpec (..)
  , varSpecP
  , varSpecPretty
  , expandVarSpec
  ) where

import Prelude

import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text qualified as T
import Network.URI.Template.Internal.Modifier
import Network.URI.Template.Internal.Operator
import Network.URI.Template.Internal.Parse
import Network.URI.Template.Internal.Pretty
import Network.URI.Template.VarName
import Network.URI.Template.VarValue

data VarSpec = VarSpec
  { VarSpec -> VarName
name :: VarName
  , VarSpec -> Maybe Modifier
modifier :: Maybe Modifier
  }
  deriving stock (VarSpec -> VarSpec -> Bool
(VarSpec -> VarSpec -> Bool)
-> (VarSpec -> VarSpec -> Bool) -> Eq VarSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarSpec -> VarSpec -> Bool
== :: VarSpec -> VarSpec -> Bool
$c/= :: VarSpec -> VarSpec -> Bool
/= :: VarSpec -> VarSpec -> Bool
Eq, Int -> VarSpec -> ShowS
[VarSpec] -> ShowS
VarSpec -> String
(Int -> VarSpec -> ShowS)
-> (VarSpec -> String) -> ([VarSpec] -> ShowS) -> Show VarSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarSpec -> ShowS
showsPrec :: Int -> VarSpec -> ShowS
$cshow :: VarSpec -> String
show :: VarSpec -> String
$cshowList :: [VarSpec] -> ShowS
showList :: [VarSpec] -> ShowS
Show)

-- |
--
-- @
-- varspec       =  varname [ modifier-level4 ]
-- @
varSpecP :: Parser VarSpec
varSpecP :: Parser VarSpec
varSpecP =
  VarName -> Maybe Modifier -> VarSpec
VarSpec
    (VarName -> Maybe Modifier -> VarSpec)
-> ParsecT Void Text Identity VarName
-> ParsecT Void Text Identity (Maybe Modifier -> VarSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity VarName
varNameP
    ParsecT Void Text Identity (Maybe Modifier -> VarSpec)
-> ParsecT Void Text Identity (Maybe Modifier) -> Parser VarSpec
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 Modifier
-> ParsecT Void Text Identity (Maybe Modifier)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Modifier
modifierP

varSpecPretty :: VarSpec -> Doc Ann
varSpecPretty :: VarSpec -> Doc Ann
varSpecPretty VarSpec
v =
  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 -> Doc Ann) -> Text -> Doc Ann
forall a b. (a -> b) -> a -> b
$ VarName -> Text
unVarName VarSpec
v.name)
    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> (Modifier -> Doc Ann) -> Maybe Modifier -> Doc Ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Ann
forall a. Monoid a => a
mempty (Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnModifier (Doc Ann -> Doc Ann)
-> (Modifier -> Doc Ann) -> Modifier -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifier -> Doc Ann
forall ann. Modifier -> Doc ann
modifierPretty) VarSpec
v.modifier

expandVarSpec :: Map VarName VarValue -> OperatorActions -> VarSpec -> [Text]
expandVarSpec :: Map VarName VarValue -> OperatorActions -> VarSpec -> [Text]
expandVarSpec Map VarName VarValue
vars OperatorActions
oa VarSpec
vs = [Text] -> (VarValue -> [Text]) -> Maybe VarValue -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] VarValue -> [Text]
renderValues (Maybe VarValue -> [Text]) -> Maybe VarValue -> [Text]
forall a b. (a -> b) -> a -> b
$ VarName -> Map VarName VarValue -> Maybe VarValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VarSpec
vs.name Map VarName VarValue
vars
 where
  renderValues :: VarValue -> [Text]
  renderValues :: VarValue -> [Text]
renderValues = \case
    VarValue
VarNull -> []
    VarValue Text
t
      | Just (Prefix Int
n) <- VarSpec
vs.modifier -> Text -> [Text]
renderValueEsc (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
n Text
t
      | Bool
otherwise -> Text -> [Text]
renderValueEsc Text
t
    VarList [Text]
ts
      | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ts -> []
      | Just Modifier
Explode <- VarSpec
vs.modifier -> (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
renderValueEsc [Text]
ts
      | Bool
otherwise -> [Text] -> [Text]
renderValueCsv ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map OperatorActions
oa.escapeValue [Text]
ts
    VarMap [(Text, Text)]
kvs
      | [(Text, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
kvs -> []
      | Just Modifier
Explode <- VarSpec
vs.modifier -> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text) -> (Text, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Text -> Text -> Text) -> (Text, Text) -> Text)
-> (Text -> Text -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text -> Text
renderKeyValue Char
'=') [(Text, Text)]
kvs
      | Bool
otherwise -> [Text] -> [Text]
renderValueCsv ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text) -> (Text, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Text -> Text -> Text) -> (Text, Text) -> Text)
-> (Text -> Text -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text -> Text
renderKeyValue Char
',') [(Text, Text)]
kvs

  renderValue :: Text -> [Text]
renderValue = Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperatorActions
oa.renderValue VarSpec
vs.name
  renderValueEsc :: Text -> [Text]
renderValueEsc = Text -> [Text]
renderValue (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperatorActions
oa.escapeValue
  renderValueCsv :: [Text] -> [Text]
renderValueCsv = Text -> [Text]
renderValue (Text -> [Text]) -> ([Text] -> Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
","
  renderKeyValue :: Char -> Text -> Text -> Text
renderKeyValue Char
c Text
k Text
v = OperatorActions
oa.escapeValue Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OperatorActions
oa.escapeValue Text
v