-- |
--
-- Module      : Network.URI.Template.Internal
-- Copyright   : (c) 2025 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Network.URI.Template.Internal
  ( Template (..)
  , templateP
  , templatePretty
  , variableP
  , variablePretty
  , module Network.URI.Template.Internal.Expression
  , module Network.URI.Template.Internal.Modifier
  , module Network.URI.Template.Internal.Operator
  , module Network.URI.Template.Internal.TemplatePart
  , module Network.URI.Template.Internal.VarSpec
  ) where

import Prelude

import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Network.URI.Template.Internal.Expression
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.Internal.TemplatePart
import Network.URI.Template.Internal.VarSpec
import Network.URI.Template.VarName
import Network.URI.Template.VarValue

newtype Template = Template
  { Template -> [TemplatePart]
unwrap :: [TemplatePart]
  }
  deriving stock (Template -> Template -> Bool
(Template -> Template -> Bool)
-> (Template -> Template -> Bool) -> Eq Template
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Template -> Template -> Bool
== :: Template -> Template -> Bool
$c/= :: Template -> Template -> Bool
/= :: Template -> Template -> Bool
Eq, Int -> Template -> ShowS
[Template] -> ShowS
Template -> String
(Int -> Template -> ShowS)
-> (Template -> String) -> ([Template] -> ShowS) -> Show Template
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Template -> ShowS
showsPrec :: Int -> Template -> ShowS
$cshow :: Template -> String
show :: Template -> String
$cshowList :: [Template] -> ShowS
showList :: [Template] -> ShowS
Show)

templateP :: Parser Template
templateP :: Parser Template
templateP = [TemplatePart] -> Template
Template ([TemplatePart] -> Template)
-> ParsecT Void Text Identity [TemplatePart] -> Parser Template
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity TemplatePart
-> ParsecT Void Text Identity [TemplatePart]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity TemplatePart
templatePartP

templatePretty :: Template -> Doc Ann
templatePretty :: Template -> Doc Ann
templatePretty = [Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat ([Doc Ann] -> Doc Ann)
-> (Template -> [Doc Ann]) -> Template -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemplatePart -> Doc Ann) -> [TemplatePart] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map TemplatePart -> Doc Ann
templatePartPretty ([TemplatePart] -> [Doc Ann])
-> (Template -> [TemplatePart]) -> Template -> [Doc Ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.unwrap)

-- | Parse one @name := value@ assignment
variableP :: Parser (Map VarName VarValue)
variableP :: Parser (Map VarName VarValue)
variableP =
  VarName -> VarValue -> Map VarName VarValue
forall k a. k -> a -> Map k a
Map.singleton
    (VarName -> VarValue -> Map VarName VarValue)
-> ParsecT Void Text Identity VarName
-> ParsecT Void Text Identity (VarValue -> Map VarName VarValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity VarName
varNameP
    ParsecT Void Text Identity (VarValue -> Map VarName VarValue)
-> ParsecT Void Text Identity VarValue
-> Parser (Map VarName VarValue)
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 ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens 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
*> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":=" ParsecT Void Text Identity (Tokens Text)
-> 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 VarValue
-> ParsecT Void Text Identity VarValue
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 VarValue
varValueP)

-- | Prettyprint a variable and value, 'fill'ing the name to the given width
variablePretty :: Int -> VarName -> VarValue -> Doc Ann
variablePretty :: Int -> VarName -> VarValue -> Doc Ann
variablePretty Int
w VarName
n VarValue
v =
  [Doc Ann] -> Doc Ann
forall ann. [Doc ann] -> Doc ann
hsep
    [ Int -> Doc Ann -> Doc Ann
forall ann. Int -> Doc ann -> Doc ann
fill Int
w (Doc Ann -> Doc Ann) -> Doc Ann -> Doc Ann
forall a b. (a -> b) -> a -> b
$ VarName -> Doc Ann
varNamePretty VarName
n
    , Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
annotate Ann
AnnPunctuation Doc Ann
":="
    , VarValue -> Doc Ann
varValuePretty VarValue
v
    ]