network-uri-template (empty) → 0.1.0.0
raw patch · 26 files changed
+1728/−0 lines, 26 filesdep +basedep +conduitdep +containers
Dependencies added: base, conduit, containers, hspec, megaparsec, network-uri, network-uri-template, optparse-applicative, prettyprinter, prettyprinter-ansi-terminal, text
Files
- CHANGELOG.md +1/−0
- README.lhs +124/−0
- README.md +124/−0
- app/Main.hs +129/−0
- network-uri-template.cabal +170/−0
- src/Network/URI/Template.hs +41/−0
- src/Network/URI/Template/Expand.hs +27/−0
- src/Network/URI/Template/Internal.hs +61/−0
- src/Network/URI/Template/Internal/Expression.hs +63/−0
- src/Network/URI/Template/Internal/Modifier.hs +47/−0
- src/Network/URI/Template/Internal/Operator.hs +137/−0
- src/Network/URI/Template/Internal/Parse.hs +64/−0
- src/Network/URI/Template/Internal/Pretty.hs +30/−0
- src/Network/URI/Template/Internal/TemplatePart.hs +40/−0
- src/Network/URI/Template/Internal/VarSpec.hs +72/−0
- src/Network/URI/Template/Parse.hs +24/−0
- src/Network/URI/Template/VarName.hs +82/−0
- src/Network/URI/Template/VarValue.hs +100/−0
- test/Network/URI/Template/Internal/ExpressionSpec.hs +40/−0
- test/Network/URI/Template/Internal/TemplatePartSpec.hs +84/−0
- test/Network/URI/Template/Internal/VarSpecSpec.hs +42/−0
- test/Network/URI/Template/Test.hs +44/−0
- test/Network/URI/Template/Test/RFC.hs +116/−0
- test/Network/URI/Template/VarNameSpec.hs +39/−0
- test/Network/URI/TemplateSpec.hs +17/−0
- test/Spec.hs +10/−0
+ CHANGELOG.md view
@@ -0,0 +1,1 @@+See https://codeberg.org/pbrisbin/mdoc/releases
+ README.lhs view
@@ -0,0 +1,124 @@+# network-uri-template++Library for parsing and expanding URI Templates, as per [RFC 6570][rfc6570].++[rfc6570]: https://datatracker.ietf.org/doc/html/rfc6570++## URI Templates++An example from the RFC:++> For example, the following URI Template includes a form-style+> parameter expression, as indicated by the "?" operator appearing+> before the variable names.+>+> ```+> http://www.example.com/foo{?query,number}+> ```+>+> The expansion process for expressions beginning with the question-+> mark ("?") operator follows the same pattern as form-style interfaces+> on the World Wide Web:+>+> ```+> http://www.example.com/foo{?query,number}+> \_____________/+> |+> |+> For each defined variable in [ 'query', 'number' ],+> substitute "?" if it is the first substitution or "&"+> thereafter, followed by the variable name, '=', and the+> variable's value.+> ```+>+> If the variables have the values+>+> ```+> query := "mycelium"+> number := 100+> ```+>+> then the expansion of the above URI Template is+>+> ```+> http://www.example.com/foo?query=mycelium&number=100+> ```+>+> Alternatively, if 'query' is undefined, then the expansion would be+>+> ```+> http://www.example.com/foo?number=100+> ```+>+> or if both variables are undefined, then it would be+>+> ```+> http://www.example.com/foo+> ```++For a complete description of URI Templates, consult the RFC or see our+extracted [test cases][examples].++[examples]: rfc/examples.txt++## Example++```haskell+{-# LANGUAGE OverloadedStrings #-}++module Main+ ( main+ ) where++import Prelude++import Data.Text (Text)+import Data.Text.IO qualified as T+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Network.URI.Template+import System.Exit (die)++main :: IO ()+main = do+ let+ vars :: Map VarName VarValue+ vars =+ Map.fromList+ [ ("query", "mycelium")+ , ("number", "100")+ ]++ template :: Text+ template = "http://www.example.com/foo{?query,number}"++ handle = either (die . templateErrorPretty) T.putStrLn++ handle $ processTemplate vars template+ -- => http://www.example.com/foo?query=mycelium&number=100++ handle $ processTemplate (Map.delete "query" vars) template+ -- => http://www.example.com/foo?number=100++ handle $ processTemplate (Map.empty) template+ -- => http://www.example.com/foo+```++## CLI++This project includes a small CLI to experiment with template expansion.++```console+network-uri-template \+ --var 'query := "mycelium"' \+ --var 'number := "100"' \+ --var 'path := ("foo", "bar")' \+ --var 'keys := [("sort","asc"), ("page","2")]' \+ 'http://www.example.com{/path*}/foo{?query:2,number}{&keys*}'+```++++## License++This project is licensed AGPLv3. See [COPYING](./COPYING).
+ README.md view
@@ -0,0 +1,124 @@+# network-uri-template++Library for parsing and expanding URI Templates, as per [RFC 6570][rfc6570].++[rfc6570]: https://datatracker.ietf.org/doc/html/rfc6570++## URI Templates++An example from the RFC:++> For example, the following URI Template includes a form-style+> parameter expression, as indicated by the "?" operator appearing+> before the variable names.+>+> ```+> http://www.example.com/foo{?query,number}+> ```+>+> The expansion process for expressions beginning with the question-+> mark ("?") operator follows the same pattern as form-style interfaces+> on the World Wide Web:+>+> ```+> http://www.example.com/foo{?query,number}+> \_____________/+> |+> |+> For each defined variable in [ 'query', 'number' ],+> substitute "?" if it is the first substitution or "&"+> thereafter, followed by the variable name, '=', and the+> variable's value.+> ```+>+> If the variables have the values+>+> ```+> query := "mycelium"+> number := 100+> ```+>+> then the expansion of the above URI Template is+>+> ```+> http://www.example.com/foo?query=mycelium&number=100+> ```+>+> Alternatively, if 'query' is undefined, then the expansion would be+>+> ```+> http://www.example.com/foo?number=100+> ```+>+> or if both variables are undefined, then it would be+>+> ```+> http://www.example.com/foo+> ```++For a complete description of URI Templates, consult the RFC or see our+extracted [test cases][examples].++[examples]: rfc/examples.txt++## Example++```haskell+{-# LANGUAGE OverloadedStrings #-}++module Main+ ( main+ ) where++import Prelude++import Data.Text (Text)+import Data.Text.IO qualified as T+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Network.URI.Template+import System.Exit (die)++main :: IO ()+main = do+ let+ vars :: Map VarName VarValue+ vars =+ Map.fromList+ [ ("query", "mycelium")+ , ("number", "100")+ ]++ template :: Text+ template = "http://www.example.com/foo{?query,number}"++ handle = either (die . templateErrorPretty) T.putStrLn++ handle $ processTemplate vars template+ -- => http://www.example.com/foo?query=mycelium&number=100++ handle $ processTemplate (Map.delete "query" vars) template+ -- => http://www.example.com/foo?number=100++ handle $ processTemplate (Map.empty) template+ -- => http://www.example.com/foo+```++## CLI++This project includes a small CLI to experiment with template expansion.++```console+network-uri-template \+ --var 'query := "mycelium"' \+ --var 'number := "100"' \+ --var 'path := ("foo", "bar")' \+ --var 'keys := [("sort","asc"), ("page","2")]' \+ 'http://www.example.com{/path*}/foo{?query:2,number}{&keys*}'+```++++## License++This project is licensed AGPLv3. See [COPYING](./COPYING).
+ app/Main.hs view
@@ -0,0 +1,129 @@+-- |+--+-- Module : Main+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Main+ ( main+ ) where++import Prelude++import Data.Foldable (fold)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as T+import Network.URI.Template+import Network.URI.Template.Expand+import Network.URI.Template.Internal+import Network.URI.Template.Internal.Parse (parseOpt)+import Network.URI.Template.Internal.Pretty hiding (Ann)+import Network.URI.Template.Internal.Pretty qualified as Template+import Options.Applicative+import Prettyprinter.Render.Terminal qualified as Ansi+import Prettyprinter.Render.Text qualified as Text+import System.IO (hIsTerminalDevice, stdout)++data Options = Options+ { variables :: Map VarName VarValue+ , template :: Template+ }++parseOptions :: IO Options+parseOptions =+ execParser+ $ info (optionsParser <**> helper)+ $ progDesc "Expand a URI template"++optionsParser :: Parser Options+optionsParser =+ Options . fold+ <$> many+ ( option (eitherReader $ parseOpt variableP)+ $ mconcat+ [ long "var"+ , helpDoc+ $ Just+ $ vsep+ [ "Variables to use in expansion"+ , indent 2+ $ vsep+ [ "--var 'name := \"scalar\"'"+ , "--var 'name := (\"scalar\", ...)'"+ , "--var 'name := [(\"scalar\",\"scalar\"), ...)'"+ , ""+ ]+ ]+ , metavar "ARG"+ ]+ )+ <*> argument+ (eitherReader $ parseOpt templateP)+ ( mconcat+ [ metavar "TEMPLATE"+ , help "URI template to expand"+ ]+ )++main :: IO ()+main = do+ opts <- parseOptions++ tty <- hIsTerminalDevice stdout++ let+ render =+ if tty+ then Ansi.renderStrict+ else Text.renderStrict++ maxWidth =+ maximum+ $ map (T.length . unVarName)+ $ Map.keys opts.variables++ T.putStrLn+ $ render+ $ layoutPretty defaultLayoutOptions+ $ reAnnotate annToAnsi+ $ vsep+ [ sectionPretty "Variables"+ $ reAnnotate AnnTemplate+ $ vsep+ $ map (uncurry $ variablePretty maxWidth)+ $ Map.toList opts.variables+ , ""+ , sectionPretty "Template"+ $ reAnnotate AnnTemplate+ $ templatePretty opts.template+ , ""+ , sectionPretty "Expanded"+ $ pretty+ $ expandTemplate opts.variables opts.template+ ]++sectionPretty :: Text -> Doc Ann -> Doc Ann+sectionPretty name d =+ vsep+ [ annotate AnnLabel (pretty name) <> ":"+ , indent 2 d+ ]++data Ann+ = AnnLabel+ | AnnTemplate Template.Ann++annToAnsi :: Ann -> Ansi.AnsiStyle+annToAnsi = \case+ AnnLabel -> Ansi.bold+ AnnTemplate x -> case x of+ AnnPunctuation -> Ansi.bold+ AnnOperator -> Ansi.color Ansi.Magenta+ AnnVarName -> Ansi.colorDull Ansi.Cyan+ AnnModifier -> Ansi.colorDull Ansi.Green+ AnnString -> Ansi.italicized <> Ansi.colorDull Ansi.Green
+ network-uri-template.cabal view
@@ -0,0 +1,170 @@+cabal-version: 1.18+name: network-uri-template+version: 0.1.0.0+license: AGPL-3+maintainer: Pat Brisbin+synopsis: TODO+description: Please see README.md+build-type: Simple+extra-doc-files:+ README.md+ CHANGELOG.md++library+ exposed-modules:+ Network.URI.Template+ Network.URI.Template.Expand+ Network.URI.Template.Internal+ Network.URI.Template.Internal.Expression+ Network.URI.Template.Internal.Modifier+ Network.URI.Template.Internal.Operator+ Network.URI.Template.Internal.Parse+ Network.URI.Template.Internal.Pretty+ Network.URI.Template.Internal.TemplatePart+ Network.URI.Template.Internal.VarSpec+ Network.URI.Template.Parse+ Network.URI.Template.VarName+ Network.URI.Template.VarValue++ hs-source-dirs: src+ other-modules: Paths_network_uri_template+ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies QuasiQuotes++ ghc-options:+ -fwrite-ide-info -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction+ -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe+ -optP-Wno-nonportable-include-path++ build-depends:+ base >=4.20.2.0 && <5,+ containers >=0.7,+ megaparsec >=9.7.0,+ network-uri >=2.6.4.2,+ prettyprinter >=1.7.0,+ text >=2.1.3++ if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++executable network-uri-template+ main-is: Main.hs+ hs-source-dirs: app+ other-modules: Paths_network_uri_template+ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies QuasiQuotes++ ghc-options:+ -fwrite-ide-info -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction+ -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe+ -optP-Wno-nonportable-include-path -threaded -rtsopts+ -with-rtsopts=-N++ build-depends:+ base >=4.20.2.0 && <5,+ containers >=0.7,+ network-uri-template,+ optparse-applicative >=0.18.1.0,+ prettyprinter >=1.7.1,+ prettyprinter-ansi-terminal >=1.1.3,+ text >=2.1.3++ if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++test-suite readme+ type: exitcode-stdio-1.0+ main-is: README.lhs+ build-tool-depends: markdown-unlit:markdown-unlit+ other-modules: Paths_network_uri_template+ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies QuasiQuotes++ ghc-options:+ -fwrite-ide-info -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction+ -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe+ -optP-Wno-nonportable-include-path -pgmL markdown-unlit++ build-depends:+ base >=4.20.2.0 && <5,+ containers >=0.7,+ network-uri-template,+ text >=2.1.3++ if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ other-modules:+ Network.URI.Template.Internal.ExpressionSpec+ Network.URI.Template.Internal.TemplatePartSpec+ Network.URI.Template.Internal.VarSpecSpec+ Network.URI.Template.Test+ Network.URI.Template.Test.RFC+ Network.URI.Template.VarNameSpec+ Network.URI.TemplateSpec+ Paths_network_uri_template++ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies QuasiQuotes++ ghc-options:+ -fwrite-ide-info -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction+ -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe+ -optP-Wno-nonportable-include-path -threaded -rtsopts+ -with-rtsopts=-N++ build-depends:+ base >=4.20.2.0 && <5,+ conduit >=1.3.6.1,+ containers >=0.7,+ hspec >=2.11.14,+ megaparsec >=9.7.0,+ network-uri-template,+ text >=2.1.3++ if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures
+ src/Network/URI/Template.hs view
@@ -0,0 +1,41 @@+-- |+--+-- Module : Network.URI.Template+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template+ ( Template+ , TemplateError (..)+ , templateErrorPretty+ , processTemplate++ -- * Template variables+ , module Network.URI.Template.VarName+ , module Network.URI.Template.VarValue+ ) where++import Prelude++import Data.Bifunctor (first)+import Data.Map.Strict (Map)+import Data.Text (Text)+import Network.URI.Template.Expand+import Network.URI.Template.Internal+import Network.URI.Template.Internal.Parse+import Network.URI.Template.Parse+import Network.URI.Template.VarName+import Network.URI.Template.VarValue++newtype TemplateError = TemplateParseError ParseError++templateErrorPretty :: TemplateError -> String+templateErrorPretty = \case+ TemplateParseError pe -> errorBundlePretty pe++processTemplate :: Map VarName VarValue -> Text -> Either TemplateError Text+processTemplate env t = do+ template <- first TemplateParseError $ parseTemplate t+ pure $ expandTemplate env template
+ src/Network/URI/Template/Expand.hs view
@@ -0,0 +1,27 @@+-- |+--+-- Module : Network.URI.Template.Expand+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Expand+ ( expandTemplate+ ) where++import Prelude++import Data.Map.Strict (Map)+import Data.Text (Text)+import Network.URI.Template.Internal+import Network.URI.Template.VarName+import Network.URI.Template.VarValue++expandTemplate :: Map VarName VarValue -> Template -> Text+expandTemplate env = foldMap (expandTemplatePart env) . (.unwrap)++expandTemplatePart :: Map VarName VarValue -> TemplatePart -> Text+expandTemplatePart env = \case+ Lit t -> t+ Exp e -> expandExpression env e
+ src/Network/URI/Template/Internal.hs view
@@ -0,0 +1,61 @@+-- |+--+-- 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+ { unwrap :: [TemplatePart]+ }+ deriving stock (Eq, Show)++templateP :: Parser Template+templateP = Template <$> some templatePartP++templatePretty :: Template -> Doc Ann+templatePretty = mconcat . map templatePartPretty . (.unwrap)++-- | Parse one @name := value@ assignment+variableP :: Parser (Map VarName VarValue)+variableP =+ Map.singleton+ <$> varNameP+ <*> (hspace *> string ":=" *> hspace *> varValueP)++-- | Prettyprint a variable and value, 'fill'ing the name to the given width+variablePretty :: Int -> VarName -> VarValue -> Doc Ann+variablePretty w n v =+ hsep+ [ fill w $ varNamePretty n+ , annotate AnnPunctuation ":="+ , varValuePretty v+ ]
+ src/Network/URI/Template/Internal/Expression.hs view
@@ -0,0 +1,63 @@+-- |+--+-- Module : Network.URI.Template.Internal.Expression+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Internal.Expression+ ( Expression (..)+ , expressionP+ , expressionPretty+ , expandExpression+ ) where++import Prelude++import Data.Map.Strict (Map)+import Data.Text (Text)+import Data.Text qualified as T+import Network.URI.Template.Internal.Operator+import Network.URI.Template.Internal.Parse+import Network.URI.Template.Internal.Pretty+import Network.URI.Template.Internal.VarSpec+import Network.URI.Template.VarName+import Network.URI.Template.VarValue++data Expression = Expression+ { operator :: Maybe Operator+ , variableList :: [VarSpec]+ }+ deriving stock (Eq, Show)++-- |+--+-- @+-- expression = "{" [ operator ] variable-list "}"+-- variable-list = varspec *( "," varspec )+-- @+expressionP :: Parser Expression+expressionP =+ Expression+ <$> (char '{' *> optional operatorP)+ <*> (sepBy1 varSpecP (char ',') <* char '}')++expressionPretty :: Expression -> Doc Ann+expressionPretty e = do+ annotate AnnPunctuation "{"+ <> maybe mempty (annotate AnnOperator . operatorPretty) e.operator+ <> hcat (punctuate "," $ map varSpecPretty e.variableList)+ <> annotate AnnPunctuation "}"++expandExpression :: Map VarName VarValue -> Expression -> Text+expandExpression env e =+ prefix <> T.intercalate oa.listIntercalate vars+ where+ oa = maybe nullOperatorActions operatorActions e.operator++ prefix+ | null vars = ""+ | otherwise = oa.listPrefix++ vars = concatMap (expandVarSpec env oa) e.variableList
+ src/Network/URI/Template/Internal/Modifier.hs view
@@ -0,0 +1,47 @@+-- |+--+-- Module : Network.URI.Template.Internal.Modifier+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Internal.Modifier+ ( Modifier (..)+ , modifierP+ , modifierPretty+ ) where++import Prelude++import Network.URI.Template.Internal.Parse+import Network.URI.Template.Internal.Pretty++data Modifier+ = Prefix Int+ | Explode+ deriving stock (Eq, Show)++-- |+--+-- @+-- modifier-level4 = prefix / explode+--+-- prefix = ":" max-length+-- max-length = %x31-39 0*3DIGIT ; positive integer < 10000+--+-- explode = *+-- @+modifierP :: Parser Modifier+modifierP = prefixP <|> explodeP++modifierPretty :: Modifier -> Doc ann+modifierPretty = \case+ Prefix n -> ":" <> pretty n+ Explode -> "*"++prefixP :: Parser Modifier+prefixP = char ':' *> (Prefix . read <$> some digitChar) <?> "prefix modifier"++explodeP :: Parser Modifier+explodeP = Explode <$ char '*' <?> "explode modifier"
+ src/Network/URI/Template/Internal/Operator.hs view
@@ -0,0 +1,137 @@+-- |+--+-- 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 (Eq, Show)++-- |+--+-- @+-- operator = op-level2 / op-level3 / op-reserve+-- op-level2 = "+" / "#"+-- op-level3 = "." / "/" / ";" / "?" / "&"+-- op-reserve = "=" / "," / "!" / "@" / "|"+-- @+operatorP :: Parser Operator+operatorP =+ choice+ [ Reserved <$ char '+' <?> "reserved operator"+ , Fragments <$ char '#' <?> "fragment operator"+ , Labels <$ char '.' <?> "label operator"+ , PathSegments <$ char '/' <?> "path segment operator"+ , PathParameters <$ char ';' <?> "path parameter operator"+ , Query <$ char '?' <?> "query operator"+ , QueryContinuation <$ char '&' <?> "query continuation operator"+ , SpecReserved <$> oneOf ("=,!@|" :: String) <?> "spec-reserved operator"+ ]++operatorPretty :: Operator -> Doc ann+operatorPretty = \case+ Reserved -> "+"+ Fragments -> "#"+ Labels -> "."+ PathSegments -> "/"+ PathParameters -> ";"+ Query -> "?"+ QueryContinuation -> "&"+ SpecReserved c -> pretty c++data OperatorActions = OperatorActions+ { listPrefix :: Text+ , listIntercalate :: Text+ , renderValue :: VarName -> Text -> Text+ , escapeValue :: Text -> Text+ }++-- | 'OperatorActions' to use when there was no 'Operator'+nullOperatorActions :: OperatorActions+nullOperatorActions =+ OperatorActions+ { listPrefix = ""+ , listIntercalate = ","+ , escapeValue = escapeURIText isUnescapedInURIComponent+ , renderValue = \_ v -> v+ }++operatorActions :: Operator -> OperatorActions+operatorActions = \case+ Reserved ->+ nullOperatorActions+ { escapeValue = escapeURIText $ \c ->+ or+ [ isUnescapedInURIComponent c+ , isReserved c+ ]+ }+ Fragments ->+ nullOperatorActions+ { listPrefix = "#"+ , escapeValue = escapeURIText $ \c ->+ or+ [ isUnescapedInURIComponent c+ , isReserved c+ ]+ }+ Labels ->+ nullOperatorActions+ { listPrefix = "."+ , listIntercalate = "."+ }+ PathSegments ->+ nullOperatorActions+ { listPrefix = "/"+ , listIntercalate = "/"+ }+ PathParameters ->+ nullOperatorActions+ { listPrefix = ";"+ , listIntercalate = ";"+ , renderValue = \k v -> unVarName k <> if T.null v then "" else "=" <> v+ }+ Query ->+ nullOperatorActions+ { listPrefix = "?"+ , listIntercalate = "&"+ , renderValue = \k v -> unVarName k <> "=" <> v+ }+ QueryContinuation ->+ nullOperatorActions+ { listPrefix = "&"+ , listIntercalate = "&"+ , renderValue = \k v -> unVarName k <> "=" <> v+ }+ SpecReserved {} -> nullOperatorActions++escapeURIText :: (Char -> Bool) -> Text -> Text+escapeURIText p = pack . escapeURIString p . unpack
+ src/Network/URI/Template/Internal/Parse.hs view
@@ -0,0 +1,64 @@+-- |+--+-- Module : Network.URI.Template.Internal.Parse+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Internal.Parse+ ( -- * Parsing+ Parser+ , parse+ , parseOpt++ -- * Errors+ , ParseError+ , errorBundlePretty++ -- * Re-exports+ , module Text.Megaparsec+ , module Text.Megaparsec.Char++ -- * Extensions+ , quoted+ , restOfLine+ ) where++import Prelude++import Control.Monad (void)+import Data.Text (Text, pack)+import Data.Void (Void)+import Text.Megaparsec hiding (ParseError, errorBundlePretty, parse)+import Text.Megaparsec qualified as Megaparsec+import Text.Megaparsec.Char++type Parser = Parsec Void Text++type ParseError = ParseErrorBundle Text Void++errorBundlePretty :: ParseError -> String+errorBundlePretty = Megaparsec.errorBundlePretty++parse :: Parser a -> Text -> Either ParseError a+parse p = Megaparsec.parse p "<uri>"++parseOpt :: Parser a -> String -> Either String a+parseOpt p s = case Megaparsec.parse p "<input>" $ pack s of+ Left err ->+ Left+ $ unlines+ [ "Unable to parse option"+ , "input: " <> s+ , "error:"+ , Megaparsec.errorBundlePretty err+ ]+ Right a -> Right a++-- | NOTE: doesn't handle escaping+quoted :: Parser Text+quoted = pack <$> (char '"' *> manyTill anySingle (char '"'))++restOfLine :: Parser Text+restOfLine = pack <$> manyTill anySingle (lookAhead $ void eol <|> eof)
+ src/Network/URI/Template/Internal/Pretty.hs view
@@ -0,0 +1,30 @@+-- |+--+-- Module : Network.URI.Template.Internal.Pretty+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Internal.Pretty+ ( Ann (..)+ , renderPlain++ -- * Re-exports+ , module Prettyprinter+ ) where++import Prelude++import Prettyprinter+import Prettyprinter.Render.String++data Ann+ = AnnPunctuation+ | AnnOperator+ | AnnVarName+ | AnnModifier+ | AnnString++renderPlain :: Doc ann -> String+renderPlain = renderString . layoutPretty defaultLayoutOptions
+ src/Network/URI/Template/Internal/TemplatePart.hs view
@@ -0,0 +1,40 @@+-- |+--+-- Module : Network.URI.Template.Internal.TemplatePart+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Internal.TemplatePart+ ( TemplatePart (..)+ , templatePartP+ , templatePartPretty+ ) where++import Prelude++import Data.Text (Text, pack)+import Network.URI.Template.Internal.Expression+import Network.URI.Template.Internal.Parse+import Network.URI.Template.Internal.Pretty++data TemplatePart+ = Lit Text+ | Exp Expression+ deriving stock (Eq, Show)++templatePartP :: Parser TemplatePart+templatePartP =+ choice+ [ Exp <$> expressionP <?> "template expression"+ , Lit . pack <$> some litChar <?> "template literal"+ ]+ where+ litChar :: Parser Char+ litChar = noneOf ['\r', '\n', '\t', ' ', '{']++templatePartPretty :: TemplatePart -> Doc Ann+templatePartPretty = \case+ Lit t -> pretty t+ Exp e -> expressionPretty e
+ src/Network/URI/Template/Internal/VarSpec.hs view
@@ -0,0 +1,72 @@+-- |+--+-- 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+ { name :: VarName+ , modifier :: Maybe Modifier+ }+ deriving stock (Eq, Show)++-- |+--+-- @+-- varspec = varname [ modifier-level4 ]+-- @+varSpecP :: Parser VarSpec+varSpecP =+ VarSpec+ <$> varNameP+ <*> optional modifierP++varSpecPretty :: VarSpec -> Doc Ann+varSpecPretty v =+ annotate AnnVarName (pretty $ unVarName v.name)+ <> maybe mempty (annotate AnnModifier . modifierPretty) v.modifier++expandVarSpec :: Map VarName VarValue -> OperatorActions -> VarSpec -> [Text]+expandVarSpec vars oa vs = maybe [] renderValues $ Map.lookup vs.name vars+ where+ renderValues :: VarValue -> [Text]+ renderValues = \case+ VarNull -> []+ VarValue t+ | Just (Prefix n) <- vs.modifier -> renderValueEsc $ T.take n t+ | otherwise -> renderValueEsc t+ VarList ts+ | null ts -> []+ | Just Explode <- vs.modifier -> concatMap renderValueEsc ts+ | otherwise -> renderValueCsv $ map oa.escapeValue ts+ VarMap kvs+ | null kvs -> []+ | Just Explode <- vs.modifier -> map (uncurry $ renderKeyValue '=') kvs+ | otherwise -> renderValueCsv $ map (uncurry $ renderKeyValue ',') kvs++ renderValue = pure . oa.renderValue vs.name+ renderValueEsc = renderValue . oa.escapeValue+ renderValueCsv = renderValue . T.intercalate ","+ renderKeyValue c k v = oa.escapeValue k <> T.singleton c <> oa.escapeValue v
+ src/Network/URI/Template/Parse.hs view
@@ -0,0 +1,24 @@+-- |+--+-- Module : Network.URI.Template.Parse+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Parse+ ( parseTemplate++ -- * Errors+ , ParseError+ , errorBundlePretty+ ) where++import Prelude++import Data.Text (Text)+import Network.URI.Template.Internal+import Network.URI.Template.Internal.Parse++parseTemplate :: Text -> Either ParseError Template+parseTemplate = parse templateP
+ src/Network/URI/Template/VarName.hs view
@@ -0,0 +1,82 @@+-- |+--+-- Module : Network.URI.Template.VarName+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.VarName+ ( VarName+ , varNameP+ , varNamePretty+ , readVarName+ , unVarName+ ) where++import Prelude++import Data.Bifunctor (first)+import Data.String (IsString (..))+import Data.Text (Text, pack)+import Network.URI.Template.Internal.Parse+import Network.URI.Template.Internal.Pretty++newtype VarName = VarName+ { unwrap :: Text+ }+ deriving stock (Eq, Ord, Show)++instance IsString VarName where+ fromString = either error id . readVarName++readVarName :: String -> Either String VarName+readVarName = first errorBundlePretty . parse (varNameP <* eof) . pack++unVarName :: VarName -> Text+unVarName = (.unwrap)++-- |+--+-- @+-- varname = varchar *( ["."] varchar )+-- varchar = ALPHA / DIGIT / "_" / pct-encoded+-- @+varNameP :: Parser VarName+varNameP = (<?> "variable name") $ do+ v <- varCharP+ vs <- many $ (,) <$> optional (char '.') <*> varCharP++ pure+ $ VarName+ $ foldMap+ ( \case+ (mc, VarChar c) -> pack $ maybe id (:) mc [c]+ (mc, PctEncoded s) -> pack $ maybe id (:) mc s+ )+ $ (Nothing, v) : vs++varNamePretty :: VarName -> Doc Ann+varNamePretty = annotate AnnVarName . pretty . unVarName++data VarChar+ = VarChar Char+ | PctEncoded String++varCharP :: Parser VarChar+varCharP =+ choice+ [ VarChar <$> alphaNumChar+ , VarChar <$> char '_'+ , PctEncoded <$> pcntEncodedP+ ]+ <?> "variable character"++pcntEncodedP :: Parser String+pcntEncodedP =+ sequenceA+ [ char '%'+ , hexDigitChar+ , hexDigitChar+ ]+ <?> "percent-encoded triplet"
+ src/Network/URI/Template/VarValue.hs view
@@ -0,0 +1,100 @@+-- |+--+-- 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 (Show)++instance IsString VarValue where+ fromString = VarValue . pack++varValueP :: Parser VarValue+varValueP =+ choice+ [ varMapP <?> "map variable value"+ , varListP <?> "list variable value"+ , varStringP <?> "string variable value"+ , varNumberP <?> "numeric variable value"+ , varNullP <?> "null variable value"+ ]++varMapP :: Parser VarValue+varMapP = VarMap <$> csvP '[' ']' kvP++kvP :: Parser (Text, Text)+kvP =+ (,)+ <$> (char '(' *> hspace *> quoted <* commaP)+ <*> (quoted <* hspace <* char ')')++varListP :: Parser VarValue+varListP = VarList <$> csvP '(' ')' quoted++varStringP :: Parser VarValue+varStringP = VarValue <$> quoted++varNumberP :: Parser VarValue+varNumberP = VarValue . pack <$> some digitChar++varNullP :: Parser VarValue+varNullP = VarNull <$ string "null"++csvP :: Char -> Char -> Parser a -> Parser [a]+csvP l r p = char l *> hspace *> sepBy p commaP <* hspace <* char r++commaP :: Parser Char+commaP = try (hspace *> char ',' <* hspace) <?> "comma"++varValuePretty :: VarValue -> Doc Ann+varValuePretty = \case+ VarNull -> annotate AnnVarName "null"+ VarValue t -> stPretty t+ VarList ts -> csvPretty "(" ")" $ map stPretty ts+ VarMap kvs -> csvPretty "[" "]" $ map (uncurry kvPretty) kvs++csvPretty :: Text -> Text -> [Doc Ann] -> Doc Ann+csvPretty l r ds =+ hcat+ [ annotate AnnPunctuation $ pretty l+ , hsep $ punctuate (annotate AnnPunctuation comma) ds+ , annotate AnnPunctuation $ pretty r+ ]++stPretty :: Text -> Doc Ann+stPretty t =+ hcat+ [ annotate AnnPunctuation "\""+ , annotate AnnString $ pretty t+ , annotate AnnPunctuation "\""+ ]++kvPretty :: Text -> Text -> Doc Ann+kvPretty k v =+ hcat+ [ annotate AnnPunctuation "("+ , annotate AnnVarName (pretty k)+ , annotate AnnPunctuation ","+ , stPretty v+ , annotate AnnPunctuation ")"+ ]
+ test/Network/URI/Template/Internal/ExpressionSpec.hs view
@@ -0,0 +1,40 @@+-- |+--+-- Module : Network.URI.Template.Internal.ExpressionSpec+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Internal.ExpressionSpec+ ( spec+ ) where++import Prelude++import Network.URI.Template.Internal.Expression+import Network.URI.Template.Internal.Modifier+import Network.URI.Template.Internal.Operator+import Network.URI.Template.Internal.VarSpec+import Network.URI.Template.Test+import Test.Hspec++spec :: Spec+spec = do+ describe "expressionP" $ do+ it "parses a query variable"+ $ assertParse expressionP "{?var}"+ $ Expression+ { operator = Just Query+ , variableList = [VarSpec {name = "var", modifier = Nothing}]+ }++ it "parses multiple variables"+ $ assertParse expressionP "{?var,var*}"+ $ Expression+ { operator = Just Query+ , variableList =+ [ VarSpec {name = "var", modifier = Nothing}+ , VarSpec {name = "var", modifier = Just Explode}+ ]+ }
+ test/Network/URI/Template/Internal/TemplatePartSpec.hs view
@@ -0,0 +1,84 @@+-- |+--+-- Module : Network.URI.Template.Internal.TemplatePartSpec+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Internal.TemplatePartSpec+ ( spec+ ) where++import Prelude++import Network.URI.Template.Internal.Expression+import Network.URI.Template.Internal.Operator+import Network.URI.Template.Internal.Parse+import Network.URI.Template.Internal.TemplatePart+import Network.URI.Template.Internal.VarSpec+import Network.URI.Template.Test+import Test.Hspec++spec :: Spec+spec = do+ describe "templatePartP" $ do+ it "parses a URI with query variable"+ $ assertParse+ (some templatePartP)+ "foo/{?var}&bat"+ [ Lit "foo/"+ , Exp+ $ Expression+ { operator = Just Query+ , variableList = [VarSpec {name = "var", modifier = Nothing}]+ }+ , Lit "&bat"+ ]++ it "parses a template with literal at end of input" $ do+ assertParse+ (some templatePartP <* eof)+ "{&who}X"+ [ Exp+ $ Expression+ { operator = Just QueryContinuation+ , variableList = [VarSpec {name = "who", modifier = Nothing}]+ }+ , Lit "X"+ ]++ it "parses a template at end of line" $ do+ assertParse+ (sepEndBy (some templatePartP) eol <* eof)+ "{&who}X\n"+ [+ [ Exp+ $ Expression+ { operator = Just QueryContinuation+ , variableList = [VarSpec {name = "who", modifier = Nothing}]+ }+ , Lit "X"+ ]+ ]++ it "parses a template within RFC examples" $ do+ let+ p =+ (,)+ <$> (hspace1 *> some templatePartP)+ <*> (hspace1 *> manyTill anySingle eof)++ input = " {&who} &who=fred"+ expected =+ (+ [ Exp+ $ Expression+ { operator = Just QueryContinuation+ , variableList = [VarSpec {name = "who", modifier = Nothing}]+ }+ ]+ , "&who=fred"+ )++ assertParse p input expected
+ test/Network/URI/Template/Internal/VarSpecSpec.hs view
@@ -0,0 +1,42 @@+-- |+--+-- Module : Network.URI.Template.Internal.VarSpecSpec+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Internal.VarSpecSpec+ ( spec+ ) where++import Prelude++import Network.URI.Template.Internal.Modifier+import Network.URI.Template.Internal.VarSpec+import Network.URI.Template.Test+import Test.Hspec++spec :: Spec+spec = do+ describe "varSpecP" $ do+ it "parses a variable without modifier"+ $ assertParse varSpecP "var"+ $ VarSpec+ { name = "var"+ , modifier = Nothing+ }++ it "parses a variable with prefix modifier"+ $ assertParse varSpecP "var:3"+ $ VarSpec+ { name = "var"+ , modifier = Just $ Prefix 3+ }++ it "parses a variable with explode modifier"+ $ assertParse varSpecP "var*"+ $ VarSpec+ { name = "var"+ , modifier = Just Explode+ }
+ test/Network/URI/Template/Test.hs view
@@ -0,0 +1,44 @@+-- |+--+-- Module : Network.URI.Template.Test+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Test+ ( assertParse+ , refuteParse+ , runRFCTests+ ) where++import Prelude++import Data.Text (Text)+import Network.URI.Template.Internal.Parse+import Network.URI.Template.Test.RFC+import Test.Hspec++-- | Expect a parse to the given value+assertParse+ :: (Eq a, HasCallStack, Show a)+ => Parser a+ -> Text+ -> a+ -> Expectation+assertParse p input expected =+ case parse (p <* eof) input of+ Left err -> expectationFailure $ "Expected parse, got error:\n" <> errorBundlePretty err+ Right a -> a `shouldBe` expected++-- | Expect a parse error that satisfies the given predicate+refuteParse+ :: (HasCallStack, Show a)+ => Parser a+ -> Text+ -> (String -> Bool)+ -> Expectation+refuteParse p input f =+ case parse (p <* eof) input of+ Left err -> errorBundlePretty err `shouldSatisfy` f+ Right a -> expectationFailure $ "Expected error, got parse:\n" <> show a
+ test/Network/URI/Template/Test/RFC.hs view
@@ -0,0 +1,116 @@+-- |+--+-- Module : Network.URI.Template.Test.RFC+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.Test.RFC+ ( runRFCTests+ ) where++import Prelude++import Conduit+import Control.Monad (void)+import Data.Bifunctor (first)+import Data.Foldable (fold, for_, traverse_)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text, unpack)+import Data.Text qualified as T+import Data.Text.IO qualified as T+import Network.URI.Template.Expand+import Network.URI.Template.Internal+import Network.URI.Template.Internal.Parse (restOfLine)+import Network.URI.Template.Internal.Pretty+import Network.URI.Template.VarName+import Network.URI.Template.VarValue+import Test.Hspec+import Text.Megaparsec+import Text.Megaparsec.Char++runRFCTests :: HasCallStack => Spec+runRFCTests = do+ ecases <- runIO parseTestCases+ either (it "parsed examples" . expectationFailure) runTestCases ecases++runTestCases :: [TestCase] -> Spec+runTestCases tcs = traverse_ (runTestCase inputMaxWidth) tcs+ where+ inputMaxWidth =+ maximum -- unsafe: we don't expect empty test cases+ $ map (length . (.input))+ $ concatMap (.examples) tcs++runTestCase :: Int -> TestCase -> Spec+runTestCase inputMaxWidth tc = do+ context (renderPlain varDoc) $ do+ for_ tc.examples $ \e -> do+ it (pad inputMaxWidth e.input <> " => " <> unpack e.expected) $ do+ expandTemplate tc.vars e.template `shouldBe` e.expected+ where+ varMaxWidth =+ max inputMaxWidth+ $ maximum -- unsafe: we don't expect empty variables+ $ map (T.length . unVarName)+ $ Map.keys tc.vars++ varDoc =+ vsep+ [ "Variables"+ , indent 6+ $ vsep+ $ map (uncurry $ variablePretty varMaxWidth)+ $ Map.toList tc.vars+ , indent 4 "Examples"+ ]++pad :: Int -> String -> String+pad w s =+ let n = w - length s+ in s <> if n > 0 then replicate n ' ' else ""++data TestCase = TestCase+ { vars :: Map VarName VarValue+ , examples :: [TestExample]+ }++data TestExample = TestExample+ { input :: String+ , template :: Template+ , expected :: Text+ }++parseTestCases :: IO (Either String [TestCase])+parseTestCases = do+ t <- T.readFile examples++ pure+ $ first (("RFC parse error:\n" <>) . errorBundlePretty)+ $ parse (some testCaseP <* eof) examples t+ where+ examples :: FilePath+ examples = "rfc/examples.txt"++type Parser = Parsec Void Text++testCaseP :: Parser TestCase+testCaseP =+ TestCase . fold+ <$> someTill (taggedP 'V' variableP) (lookAhead $ void (char 'E') <|> eof)+ <*> someTill (taggedP 'E' texampleP) (lookAhead $ void (char 'V') <|> eof)++taggedP :: Char -> Parser a -> Parser a+taggedP c p = char c *> char ' ' *> p <* hspace <* newline++texampleP :: Parser TestExample+texampleP = do+ (template, expected) <- (,) <$> templateP <*> (char ' ' *> restOfLine)+ pure+ TestExample+ { input = renderPlain $ templatePretty template+ , template+ , expected+ }
+ test/Network/URI/Template/VarNameSpec.hs view
@@ -0,0 +1,39 @@+-- |+--+-- Module : Network.URI.Template.VarNameSpec+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.Template.VarNameSpec+ ( spec+ ) where++import Prelude++import Data.List (isInfixOf)+import Network.URI.Template.Test+import Network.URI.Template.VarName+import Test.Hspec++spec :: Spec+spec = do+ describe "varNameP" $ do+ it "parses a simple variable" $ do+ assertParse varNameP "var" "var"++ it "parses alphanumerics and _" $ do+ assertParse varNameP "foo_123" "foo_123"++ it "parses percent-encoding" $ do+ assertParse varNameP "foo%25bar" "foo%25bar"++ it "parses dot-separated" $ do+ assertParse varNameP "foo.b.a.r" "foo.b.a.r"++ it "rejects other characters" $ do+ refuteParse varNameP "foo-bar" ("unexpected '-'" `isInfixOf`)++ it "rejects consecutive dots" $ do+ refuteParse varNameP "foo..bar" ("unexpected '.'" `isInfixOf`)
+ test/Network/URI/TemplateSpec.hs view
@@ -0,0 +1,17 @@+-- |+--+-- Module : Network.URI.TemplateSpec+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Network.URI.TemplateSpec+ ( spec+ ) where++import Network.URI.Template.Test+import Test.Hspec++spec :: Spec+spec = context "All RFC Examples" runRFCTests
+ test/Spec.hs view
@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-missing-export-lists #-}++-- |+--+-- Module : Main+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX