uri-templater 0.3.1.0 → 1.0.0

raw patch · 12 files changed

+2777/−680 lines, 12 filesdep +cookiedep +doctestdep +flatparsedep −HTTPdep −ansi-wl-pprintdep −charsetdep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: cookie, doctest, flatparse, http-api-data, http-types, prettyprinter, prettyprinter-ansi-terminal, tagged, time-compat

Dependencies removed: HTTP, ansi-wl-pprint, charset, parsers, trifecta

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Setup.hs +2/−0
• src/Network/URI/Template.hs +108/−70
• src/Network/URI/Template/Error.hs +180/−0
• src/Network/URI/Template/Internal.hs +171/−101
• src/Network/URI/Template/Parser.hs +186/−85
• src/Network/URI/Template/Render.hs +68/−0
• src/Network/URI/Template/TH.hs +330/−32
• src/Network/URI/Template/Types.hs +581/−195
• test/Doctests.hs +4/−0
• test/Test.hs +1112/−181
• uri-templater.cabal +34/−15

@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2013 SaneTracker+Copyright (c) 2021-2025 Ian Duncan  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in

@@ -1,2 +1,4 @@ import Distribution.Simple++ main = defaultMain

@@ -7,31 +7,62 @@   This implementation supports outputting these URI fragments to all widely-used textual/bytestring   formats, and provides basic facilities for extending the URI rendering to support other output formats. -}- module Network.URI.Template (   -- $overview    -- * Quasi-Quoting URI templates-    uri+  uri,+   -- * Manually parsing, constructing, & writing URI templates-  , render-  , ToTemplateValue(..)-  , AList(..)-  , TemplateString(..)-  , parseTemplate-  , UriTemplate(..)-  , TemplateSegment(..)-  , Modifier(..)-  , ValueModifier(..)-  , TemplateValue(..)+  render,+  renderTemplate,+  parseTemplate,++  -- * Convenience rendering functions+  renderText,+  renderLazyText,+  renderByteString,+  renderLazyByteString,+  renderString,+  renderBuilder,++  -- * Core types+  UriTemplate (..),+  AList (..),+  TemplateString (..),++  -- * Error handling+  ParseError (..),+  RenderError (..),+  displayParseError,+  displayParseErrorSimple,+  displayRenderError,++  -- * Value conversion+  ToTemplateValue (..),+  ViaHttpApiData (..),+   -- * Implementing a new output format for URI templates-  , Buildable(..)+  Buildable (..),++  -- * Advanced: Internal types (use with caution)+  -- | These types are exposed for advanced use cases and library implementers.+  -- Regular users should not need to use these directly.+  WrappedValue (..),+  TemplateSegment (..),+  Modifier (..),+  ValueModifier (..),+  TemplateValue (..), ) where++import Network.URI.Template.Error import Network.URI.Template.Internal import Network.URI.Template.Parser+import Network.URI.Template.Render import Network.URI.Template.TH import Network.URI.Template.Types + {- $overview  Due to the large number of different interpolation options available, it is arguably easiest@@ -39,28 +70,39 @@ RFC 6570 itself <https://tools.ietf.org/html/rfc6570> also provides a large number of these same examples, so it may help to look at it directly. -For these examples, the following values are assumed:+== Error Handling -@-var :: TemplateString-var = "value"+This library provides structured error types for better error handling: -semi :: TemplateString-semi = ";"+* 'ParseError' - Returned when parsing URI templates fails+* 'RenderError' - For future use with safe rendering functions -hello :: TemplateString-hello = "Hello World!"+The 'parseTemplate' function returns @Either ParseError UriTemplate@, which allows+you to handle parse errors programmatically: -path :: TemplateString-path = "\/foo\/bar"+>>> case parseTemplate "/users/{userId}" of { Right tpl -> "success"; Left err -> "failed" }+"success" -list :: [TemplateString]-list = ["red", "green", "blue"]+For better error messages with source context, use 'displayParseError',+which shows the source location and surrounding text. -keys :: AList TemplateString TemplateString-keys = AList [("semi", ";"), ("dot", "."), ("comma", ",")]-@+Note: The 'IsString' instance for 'UriTemplate' still uses partial parsing+for convenience with string literals. For production code, prefer explicit+parsing with 'parseTemplate' or use the 'uri' quasi-quoter which validates+at compile-time. +$setup+>>> :set -XQuasiQuotes+>>> :set -XOverloadedStrings+>>> import Network.URI.Template+>>> import qualified Data.Text as T+>>> let var = "value" :: TemplateString+>>> let semi = ";" :: TemplateString+>>> let hello = "Hello World!" :: TemplateString+>>> let path = "/foo/bar" :: TemplateString+>>> let list = ["red", "green", "blue"] :: [TemplateString]+>>> let keys = AList [("semi", ";"), ("dot", "."), ("comma", ",")] :: AList TemplateString TemplateString+ = Simple interpolation  Simple string expansion is the default expression type when no@@ -74,54 +116,54 @@ == Without modifiers  >>> [uri|{var}|]-value+"value"  == Interpolating with a length modifier  >>> [uri|{var:3}|]-val+"val"  == Interpolating multiple values:  >>> [uri|{var,hello}|]-value,hello+"value,Hello%20World%21"  == Interpolating a list:  >>> [uri|{list}|]-red,green,blue+"red,green,blue"  == Exploding a list (not super useful without modifiers):  >>> [uri|{list*}|]-red,green,blue+"red,green,blue"  == Interpolating associative values:  >>> [uri|{keys}|]-semi,%3B,dot,.,comma,%2C+"semi,%3B,dot,.,comma,%2C"  == Exploding associative values  >>> [uri|{keys*}|]-semi=%3B,dot=.,comma=%2C+"semi=%3B,dot=.,comma=%2C"  = Unescaped interpolation  >>> [uri|{+path:6}/here|]-/foo/b/here+"/foo/b/here"  >>> [uri|{+list}|]-red,green,blue+"red,green,blue"  >>> [uri|{+list*}|]-red,green,blue+"red,green,blue" ->>> [uri|{+keys}]-semi,;,dot,.,comma,,+>>> [uri|{+keys}|]+"semi,;,dot,.,comma,," ->>> [uri|{+keys*}]-semi=;,dot=.,comma=,+>>> [uri|{+keys*}|]+"semi=;,dot=.,comma=,"  = Path piece interpolation @@ -137,47 +179,47 @@ character and will be percent-encoded if found in a value.  >>> [uri|{/var:1,var}|]-/v/value+"/v/value"  >>> [uri|{/list}|]-/red,green,blue+"/red,green,blue" ->>> [uri|{/list*}]-/red/green/blue+>>> [uri|{/list*}|]+"/red/green/blue"  = Query param interpolation  >>> [uri|{?var:3}|]-?var=val+"?var=val"  >>> [uri|{?list}|]-?list=red,green.blue+"?list=red,green,blue"  >>> [uri|{?list*}|]-?list=red&list=green&list=blue+"?list=red&list=green&list=blue"  >>> [uri|{?keys}|]-?keys=semi,%3B,dot,.,comma,%2C+"?keys=semi,%3B,dot,.,comma,%2C"  >>> [uri|{?keys*}|]-?semi=%3B&dot=.&comma=%2C+"?semi=%3B&dot=.&comma=%2C"  = Continued query param interpolation  >>> [uri|{?var:3}|]-&var=val+"?var=val"  >>> [uri|{?list}|]-&list=red,green.blue+"?list=red,green,blue"  >>> [uri|{?list*}|]-&list=red&list=green&list=blue+"?list=red&list=green&list=blue"  >>> [uri|{?keys}|]-&keys=semi,%3B,dot,.,comma,%2C+"?keys=semi,%3B,dot,.,comma,%2C"  >>> [uri|{?keys*}|]-&semi=%3B&dot=.&comma=%2C+"?semi=%3B&dot=.&comma=%2C"  = Label interpolation @@ -185,19 +227,19 @@ domain names or path selectors (e.g., filename extensions).  >>> [uri|X{.var:3}|]-X.val+"X.val"  >>> [uri|X{.list}|]-X.red,green,blue+"X.red,green,blue"  >>> [uri|X{.list*}|]-X.red.green.blue+"X.red.green.blue"  >>> [uri|X{.keys}|]-X.semi,%3B,dot,.,comma,%2C+"X.semi,%3B,dot,.,comma,%2C"  >>> [uri|X{.keys*}|]-X.semi=%3B.dot=..comma=%2C+"X.semi=%3B.dot=..comma=%2C"  = Fragment interpolation @@ -205,23 +247,19 @@ is useful for describing URI path parameters, such as "path;property" or "path;name=value".  >>> [uri|{;hello:5}|]-;hello=Hello-+";hello=Hello"  >>> [uri|{;list}|]-;list=red,green,blue-+";list=red,green,blue"  >>> [uri|{;list*}|]-;list=red;list=green;list=blue-+";list=red;list=green;list=blue"  >>> [uri|{;keys}|]-;keys=semi,%3B,dot,.,comma,%2C-+";keys=semi,%3B,dot,.,comma,%2C"  >>> [uri|{;keys*}|]-;semi=%3B;dot=.;comma=%2C+";semi=%3B;dot=.;comma=%2C"  = Security Considerations 

@@ -0,0 +1,180 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Error types for URI template parsing and rendering.++This module provides structured error types that can be programmatically+inspected and pattern-matched, unlike the previous Doc AnsiStyle approach.+-}+module Network.URI.Template.Error (+  -- * Parse Errors+  ParseError (..),+  displayParseError,+  displayParseErrorSimple,++  -- * Render Errors+  RenderError (..),+  displayRenderError,+) where++import Control.Exception (Exception)+import qualified Data.Text as T+import GHC.Generics (Generic)+++-- | Errors that can occur when parsing a URI template.+data ParseError+  = -- | The parser encountered an unexpected character at a specific position+    UnexpectedCharacter+      { errorPosition :: !Int+      -- ^ Position in the input string where the error occurred+      , errorChar :: !Char+      -- ^ The unexpected character+      , errorContext :: !String+      -- ^ Additional context about what was expected+      }+  | -- | The template expression was not properly terminated+    UnterminatedExpression+      { errorPosition :: !Int+      -- ^ Position where the expression started+      }+  | -- | An invalid modifier character was used+    InvalidModifier+      { errorPosition :: !Int+      -- ^ Position of the invalid modifier+      , errorChar :: !Char+      -- ^ The invalid modifier character+      }+  | -- | A variable name was malformed+    MalformedVariable+      { errorPosition :: !Int+      -- ^ Position of the malformed variable+      , errorVariable :: !String+      -- ^ The malformed variable name+      }+  | -- | An invalid max length specification+    InvalidMaxLength+      { errorPosition :: !Int+      -- ^ Position of the max length specification+      , errorLengthSpec :: !String+      -- ^ The invalid length specification+      }+  | -- | Generic parse error (fallback for non-specific errors)+    GenericParseError+      { errorMessage :: !String+      -- ^ Error message+      }+  deriving (Show, Eq, Generic)+++instance Exception ParseError+++-- | Display a parse error with full context, including source location+-- and surrounding text for better error messages.+displayParseError :: String -> ParseError -> T.Text+displayParseError source err = case err of+  UnexpectedCharacter pos ch ctx ->+    T.pack $+      unlines+        [ "Parse error at position " ++ show pos ++ ":"+        , showSourceContext source pos+        , "Unexpected character '" ++ [ch] ++ "'"+        , ctx+        ]+  UnterminatedExpression pos ->+    T.pack $+      unlines+        [ "Parse error at position " ++ show pos ++ ":"+        , showSourceContext source pos+        , "Unterminated expression: expected '}'"+        ]+  InvalidModifier pos ch ->+    T.pack $+      unlines+        [ "Parse error at position " ++ show pos ++ ":"+        , showSourceContext source pos+        , "Invalid modifier character '" ++ [ch] ++ "'"+        , "Valid modifiers are: + # . / ; ? & ="+        ]+  MalformedVariable pos var ->+    T.pack $+      unlines+        [ "Parse error at position " ++ show pos ++ ":"+        , showSourceContext source pos+        , "Malformed variable name: " ++ var+        ]+  InvalidMaxLength pos spec ->+    T.pack $+      unlines+        [ "Parse error at position " ++ show pos ++ ":"+        , showSourceContext source pos+        , "Invalid max length specification: " ++ spec+        , "Expected a positive integer"+        ]+  GenericParseError msg ->+    T.pack $ "Parse error: " ++ msg+++-- | Display a parse error in a simple format without source context.+displayParseErrorSimple :: ParseError -> T.Text+displayParseErrorSimple err = case err of+  UnexpectedCharacter pos ch ctx ->+    T.pack $ "Unexpected character '" ++ [ch] ++ "' at position " ++ show pos ++ ": " ++ ctx+  UnterminatedExpression pos ->+    T.pack $ "Unterminated expression at position " ++ show pos+  InvalidModifier pos ch ->+    T.pack $ "Invalid modifier '" ++ [ch] ++ "' at position " ++ show pos+  MalformedVariable pos var ->+    T.pack $ "Malformed variable '" ++ var ++ "' at position " ++ show pos+  InvalidMaxLength pos spec ->+    T.pack $ "Invalid max length '" ++ spec ++ "' at position " ++ show pos+  GenericParseError msg ->+    T.pack msg+++-- | Show source context around an error position+showSourceContext :: String -> Int -> String+showSourceContext source pos =+  let+    contextSize = 40+    start = max 0 (pos - contextSize)+    end = min (length source) (pos + contextSize)+    before = take (pos - start) $ drop start source+    after = take (end - pos) $ drop pos source+    caretPos = length before+  in+    unlines+      [ "  " ++ before ++ after+      , "  " ++ replicate caretPos ' ' ++ "^"+      ]+++-- | Errors that can occur when rendering a URI template.+data RenderError+  = -- | A required variable was not provided in the bindings+    MissingVariable+      { renderVarName :: !T.Text+      -- ^ The name of the missing variable+      }+  | -- | A variable had an incompatible value type for the template context+    InvalidValueType+      { renderVarName :: !T.Text+      -- ^ The name of the variable+      , renderTypeError :: !String+      -- ^ Description of the type mismatch+      }+  deriving (Show, Eq, Generic)+++instance Exception RenderError+++-- | Display a render error in a human-readable format.+displayRenderError :: RenderError -> T.Text+displayRenderError err = case err of+  MissingVariable var ->+    "Missing required variable: " <> var+  InvalidValueType var typeErr ->+    "Invalid value type for variable '" <> var <> "': " <> T.pack typeErr

@@ -1,86 +1,122 @@-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}+ module Network.URI.Template.Internal where+ import Control.Monad.Writer.Strict import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB- import Data.DList hiding (map) import Data.List (intersperse) import Data.Maybe import Data.Monoid import Data.Proxy-import Network.HTTP.Base (urlEncode)+import qualified Data.Text as T+import Data.Text.Encoding+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Vector as V+import Network.HTTP.Types.URI import Network.URI.Template.Types+import Web.HttpApiData (toUrlPiece)+import Web.Internal.HttpApiData (ToHttpApiData (..)) + class Monoid (Builder a) => Buildable a where   type Builder a++   -- | Convert the intermediate output into the end result   build :: Builder a -> a++   -- | Construct an appendable character representation   addChar :: Proxy a -> Char -> Builder a++   -- | Construct an appendable string representation-  addString :: Proxy a -> String -> Builder a+  addString :: Proxy a -> T.Text -> Builder a ++  -- | Convert a bytestring builder into the appropriate format+  addBytestringBuilder :: Proxy a -> BB.Builder -> Builder a++ instance Buildable String where   type Builder String = DList Char   build = Data.DList.toList   addChar _ = singleton-  addString _ = fromList+  addString _ = fromList . T.unpack+  addBytestringBuilder _ = fromList . BL.unpack . BB.toLazyByteString + instance Buildable BS.ByteString where   type Builder BS.ByteString = BB.Builder   build = BL.toStrict . BB.toLazyByteString   addChar _ = BB.char8-  addString _ = BB.string8+  addString _ = BB.byteString . T.encodeUtf8+  addBytestringBuilder _ = id + instance Buildable BL.ByteString where   type Builder BL.ByteString = BB.Builder   build = BB.toLazyByteString   addChar _ = BB.char8-  addString _ = BB.string8+  addString _ = BB.byteString . T.encodeUtf8+  addBytestringBuilder _ = id + instance Buildable T.Text where   type Builder T.Text = TB.Builder   build = TL.toStrict . TB.toLazyText   addChar _ = TB.singleton-  addString _ = TB.fromString+  addString _ = TB.fromText+  addBytestringBuilder _ = TB.fromLazyText . TL.decodeUtf8 . BB.toLazyByteString + instance Buildable TL.Text where   type Builder TL.Text = TB.Builder   build = TB.toLazyText   addChar _ = TB.singleton-  addString _ = TB.fromString+  addString _ = TB.fromText+  addBytestringBuilder _ = TB.fromLazyText . TL.decodeUtf8 . BB.toLazyByteString + instance Buildable BB.Builder where   type Builder BB.Builder = BB.Builder   build = id   addChar _ = BB.char8-  addString _ = BB.string8+  addString _ = BB.byteString . T.encodeUtf8+  addBytestringBuilder _ = id + instance Buildable TB.Builder where   type Builder TB.Builder = TB.Builder   build = id   addChar _ = TB.singleton-  addString _ = TB.fromString+  addString _ = TB.fromText+  addBytestringBuilder _ = TB.fromLazyText . TL.decodeUtf8 . BB.toLazyByteString + -- instance Buildable (Path, QueryParams, Hash)  data Allow = Unreserved | UnreservedOrReserved -allowEncoder Unreserved           = urlEncode-allowEncoder UnreservedOrReserved = id +allowEncoder :: (Buildable str, ToHttpApiData a) => Proxy str -> Allow -> a -> Builder str+allowEncoder p Unreserved = addBytestringBuilder p . urlEncodeBuilder True . T.encodeUtf8 . toUrlPiece+allowEncoder p UnreservedOrReserved = addString p . toUrlPiece++ data ProcessingOptions = ProcessingOptions   { modifierPrefix :: Maybe Char   , modifierSeparator :: Char@@ -89,41 +125,61 @@   , modifierAllow :: Allow   } -type BoundValue = (String, WrappedValue) +type BoundValue = (T.Text, WrappedValue)++ option :: Maybe Char -> Char -> Bool -> Maybe Char -> Allow -> ProcessingOptions option = ProcessingOptions + options :: Modifier -> ProcessingOptions options m = case m of-  Simple            -> option  Nothing   ',' False  Nothing    Unreserved-  Reserved          -> option  Nothing   ',' False  Nothing    UnreservedOrReserved-  Label             -> option (Just '.') '.' False  Nothing    Unreserved-  PathSegment       -> option (Just '/') '/' False  Nothing    Unreserved-  PathParameter     -> option (Just ';') ';' True   Nothing    Unreserved-  Query             -> option (Just '?') '&' True  (Just '=')  Unreserved-  QueryContinuation -> option (Just '&') '&' True  (Just '=')  Unreserved-  Fragment          -> option (Just '#') ',' False  Nothing    UnreservedOrReserved+  Simple -> option Nothing ',' False Nothing Unreserved+  Reserved -> option Nothing ',' False Nothing UnreservedOrReserved+  Label -> option (Just '.') '.' False Nothing Unreserved+  PathSegment -> option (Just '/') '/' False Nothing Unreserved+  PathParameter -> option (Just ';') ';' True Nothing Unreserved+  Query -> option (Just '?') '&' True (Just '=') Unreserved+  QueryContinuation -> option (Just '&') '&' True (Just '=') Unreserved+  Fragment -> option (Just '#') ',' False Nothing UnreservedOrReserved + templateValueIsEmpty :: TemplateValue a -> Bool-templateValueIsEmpty (Single s)      = null s+templateValueIsEmpty (Single s) = T.null $ toUrlPiece s templateValueIsEmpty (Associative s) = null s-templateValueIsEmpty (List s)        = null s+templateValueIsEmpty (List s) = null s+{-# INLINE templateValueIsEmpty #-} -namePrefix :: forall str a.-              (Buildable str)-           => Proxy str -> ProcessingOptions -> String -> TemplateValue a -> Builder str-namePrefix p opts name val = addString p name <> if templateValueIsEmpty val-  then maybe mempty (addChar p) $ modifierIfEmpty opts-  else addChar p '=' +namePrefix ::+  forall str a.+  (Buildable str) =>+  Proxy str ->+  ProcessingOptions ->+  T.Text ->+  TemplateValue a ->+  Builder str+namePrefix p opts name val =+  addString p name+    <> if templateValueIsEmpty val+      then maybe mempty (addChar p) $ modifierIfEmpty opts+      else addChar p '='++ whenM :: Monoid m => Bool -> m -> m whenM pred m = if pred then m else mempty -processVariable-  :: forall str.-     (Buildable str)-  => Proxy str -> Modifier -> Bool -> Variable -> WrappedValue -> Builder str++processVariable ::+  forall str.+  (Buildable str) =>+  Proxy str ->+  Modifier ->+  Bool ->+  Variable ->+  WrappedValue ->+  Builder str processVariable p m isFirst (Variable varName varMod) (WrappedValue val) =   let prefix = maybe mempty (addChar p) $ modifierPrefix settings       separator = addChar p $ modifierSeparator settings@@ -131,88 +187,102 @@         Normal -> do           whenM             (modifierSupportsNamed settings)-            (namePrefix p settings varName val) <> unexploded+            (namePrefix p settings varName val)+            <> unexploded         Explode -> exploded         MaxLength l ->           whenM             (modifierSupportsNamed settings)-            (namePrefix p settings varName val) <> unexploded-  in (if isFirst then prefix else separator) <> rest-  where-    settings = options m+            (namePrefix p settings varName val)+            <> unexploded+   in (if isFirst then prefix else separator) <> rest+ where+  settings = options m -    addEncodeString :: String -> Builder str-    addEncodeString = addString p . (allowEncoder $ modifierAllow settings)+  addEncodeString :: ToHttpApiData a => a -> Builder str+  addEncodeString = allowEncoder (Proxy @str) (modifierAllow settings) -    sepByCommas = mconcat . intersperse (addChar p ',')+  sepByCommas = mconcat . intersperse (addChar p ',') -    associativeCommas :: (String -> String) -> (TemplateValue Single, TemplateValue Single) -> Builder str-    associativeCommas f (Single n, Single v) =-      addEncodeString n <>-      addChar p ',' <>-      addEncodeString (f v)+  associativeCommas :: (TemplateValue Single, TemplateValue Single) -> Builder str+  associativeCommas (Single n, Single v) =+    addEncodeString n+      <> addChar p ','+      <> addEncodeString (preprocess v) -    preprocess :: String -> String-    preprocess = case varMod of-      MaxLength l -> take l-      _ -> id+  preprocess :: ToHttpApiData a => a -> T.Text+  preprocess = case varMod of+    MaxLength l -> T.take l . toUrlPiece+    _ -> toUrlPiece -    unexploded = case val of-      (Associative l) -> sepByCommas $ map (associativeCommas preprocess) l-      (List l) -> sepByCommas $ map (\(Single s) -> addEncodeString $ preprocess s) l-      (Single s) -> addEncodeString $ preprocess s+  unexploded :: Builder str+  unexploded = case val of+    (Associative l) -> sepByCommas $ map associativeCommas l+    (List l) -> sepByCommas $ map (\(Single s) -> addEncodeString $ preprocess s) l+    (Single s) -> addEncodeString $ preprocess s -    explodedAssociative :: (TemplateValue Single, TemplateValue Single) -> Builder str-    explodedAssociative (Single k, Single v) =-      addEncodeString k <>-      addChar p '=' <>-      addEncodeString (preprocess v)+  explodedAssociative :: (TemplateValue Single, TemplateValue Single) -> Builder str+  explodedAssociative (Single k, Single v) =+    addEncodeString k+      <> addChar p '='+      <> addEncodeString (preprocess v) -    exploded :: Builder str-    exploded = case val of-      (Single s) -> whenM-                    (modifierSupportsNamed settings)-                    (namePrefix p settings varName val) <> addEncodeString (preprocess s)-      (Associative l) ->-        mconcat $+  exploded :: Builder str+  exploded = case val of+    (Single s) ->+      whenM+        (modifierSupportsNamed settings)+        (namePrefix p settings varName val)+        <> addEncodeString (preprocess s)+    (Associative l) ->+      mconcat $         intersperse (addChar p $ modifierSeparator settings) $-        map explodedAssociative l-      (List l) ->-        mconcat $+          map explodedAssociative l+    (List l) ->+      mconcat $         intersperse (addChar p $ modifierSeparator settings) $-        map (\(Single s) ->-               whenM-                 (modifierSupportsNamed settings)-                 (namePrefix p settings varName val) <> addEncodeString (preprocess s)) l+          map+            ( \(Single s) ->+                whenM+                  (modifierSupportsNamed settings)+                  (namePrefix p settings varName val)+                  <> addEncodeString (preprocess s)+            )+            l -processVariables :: forall str.-                    (Buildable str)-                 => Proxy str -> [(String, WrappedValue)] -> Modifier -> [Variable] -> Builder str++processVariables ::+  forall str.+  (Buildable str) =>+  Proxy str ->+  [(T.Text, WrappedValue)] ->+  Modifier ->+  [Variable] ->+  Builder str processVariables p env m vs = mconcat processedVariables-  where-    findValue (Variable varName _) = lookup varName env+ where+  findValue (Variable varName _) = lookup varName env -    nonEmptyVariables :: [(Variable, WrappedValue)]-    nonEmptyVariables = catMaybes $ map (\v -> fmap (\mv -> (v, mv)) $ findValue v) vs+  nonEmptyVariables :: [(Variable, WrappedValue)]+  nonEmptyVariables = mapMaybe (\v -> (\mv -> (v, mv)) <$> findValue v) vs -    processors :: [Variable -> WrappedValue -> Builder str]-    processors = (processVariable p m True) : repeat (processVariable p m False)+  processors :: [Variable -> WrappedValue -> Builder str]+  processors = processVariable p m True : repeat (processVariable p m False) -    processedVariables :: [Builder str]-    processedVariables = zipWith uncurry processors nonEmptyVariables+  processedVariables :: [Builder str]+  processedVariables = zipWith uncurry processors nonEmptyVariables -render :: (Buildable str) => UriTemplate -> [BoundValue] -> str-render tpl env = render' tpl env -render' :: forall str. (Buildable str) => UriTemplate -> [BoundValue] -> str-render' tpl env = build $ mconcat $ map go tpl-  where-    p :: Proxy str-    p = Proxy--    go :: TemplateSegment -> Builder str-    go (Literal s) = addString p s-    go (Embed m vs) = processVariables p env m vs+render :: (Buildable str) => UriTemplate -> [BoundValue] -> str+render = render'  +render' :: forall str. (Buildable str) => UriTemplate -> [BoundValue] -> str+render' (UriTemplate tpl) env = build $ V.foldMap go tpl+ where+  p :: Proxy str+  p = Proxy +  go :: TemplateSegment -> Builder str+  go (Literal s) = addString p s+  go (Embed m vs) = processVariables p env m vs

@@ -1,106 +1,207 @@-module Network.URI.Template.Parser where-import Control.Applicative-import Data.Char-import Data.List-import Data.Monoid-import Text.Trifecta-import Text.Parser.Char-import Text.PrettyPrint.ANSI.Leijen (Doc)+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Network.URI.Template.Parser (+  parseTemplate,+) where++import qualified Data.ByteString as BS+import qualified Data.Char as C+import qualified Data.String as S+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Vector as V+import FlatParse.Basic+import Network.URI.Template.Error import Network.URI.Template.Types -range :: Char -> Char -> Parser Char-range l r = satisfy (\c -> l <= c && c <= r) -ranges :: [(Char, Char)] -> Parser Char-ranges = choice . map (uncurry range)+-- | Parse a character in a specific range+{-# INLINE charRange #-}+charRange :: Char -> Char -> Parser e Char+charRange l r = satisfy (\c -> l <= c && c <= r) -ucschar :: Parser Char-ucschar = ranges-  [ ('\xA0', '\xD7FF')-  , ('\xF900', '\xFDCF')-  , ('\xFDF0', '\xFFEF')-  , ('\x10000', '\x1FFFD')-  , ('\x20000', '\x2FFFD')-  , ('\x30000', '\x3FFFD')-  , ('\x40000', '\x4FFFD')-  , ('\x50000', '\x5FFFD')-  , ('\x60000', '\x6FFFD')-  , ('\x70000', '\x7FFFD')-  , ('\x80000', '\x8FFFD')-  , ('\x90000', '\x9FFFD')-  , ('\xA0000', '\xAFFFD')-  , ('\xB0000', '\xBFFFD')-  , ('\xC0000', '\xCFFFD')-  , ('\xD0000', '\xDFFFD')-  , ('\xE1000', '\xEFFFD')-  ] -iprivate :: Parser Char-iprivate = ranges-  [ ('\xE000', '\xF8FF')-  , ('\xF0000', '\xFFFFD')-  , ('\x100000', '\x10FFFD')-  ]+-- | Parse a character matching any of the given ranges+-- Uses fusedSatisfy for better performance when possible+charRanges :: [(Char, Char)] -> Parser e Char+charRanges [] = empty+charRanges ((l, r) : rest) = satisfy (\c -> l <= c && c <= r) <|> charRanges rest -pctEncoded :: Parser String++-- | Parse Unicode characters as specified in RFC 6570+ucschar :: Parser e Char+ucschar =+  charRanges+    [ ('\xA0', '\xD7FF')+    , ('\xF900', '\xFDCF')+    , ('\xFDF0', '\xFFEF')+    , ('\x10000', '\x1FFFD')+    , ('\x20000', '\x2FFFD')+    , ('\x30000', '\x3FFFD')+    , ('\x40000', '\x4FFFD')+    , ('\x50000', '\x5FFFD')+    , ('\x60000', '\x6FFFD')+    , ('\x70000', '\x7FFFD')+    , ('\x80000', '\x8FFFD')+    , ('\x90000', '\x9FFFD')+    , ('\xA0000', '\xAFFFD')+    , ('\xB0000', '\xBFFFD')+    , ('\xC0000', '\xCFFFD')+    , ('\xD0000', '\xDFFFD')+    , ('\xE1000', '\xEFFFD')+    ]+++-- | Parse private use area characters+iprivate :: Parser e Char+iprivate =+  charRanges+    [ ('\xE000', '\xF8FF')+    , ('\xF0000', '\xFFFFD')+    , ('\x100000', '\x10FFFD')+    ]+++-- | Parse a percent-encoded sequence+{-# INLINE pctEncoded #-}+pctEncoded :: Parser e String pctEncoded = do-  h <- char '%'+  $(char '%')   d1 <- hexDigit   d2 <- hexDigit-  return [h, d1, d2]+  return ['%', d1, d2]+ where+  {-# INLINE hexDigit #-}+  hexDigit = satisfy (\c -> C.isDigit c || (c >= 'A' && c <= 'F') || (c >= 'a' && c <= 'f')) -literalChar :: Parser Char++-- | Parse a literal character+literalChar :: Parser e Char literalChar =-  (choice $ map char-    ['\x21', '\x23', '\x24', '\x26', '\x3D', '\x5D', '\x5F', '\x7E']) <|>-  ranges [('\x28', '\x3B'), ('\x3F', '\x5B'), ('\x61', '\x7A')] <|>-  ucschar <|>-  iprivate+  ($(char '\x21') >> pure '\x21')+    <|> ($(char '\x23') >> pure '\x23')+    <|> ($(char '\x24') >> pure '\x24')+    <|> ($(char '\x26') >> pure '\x26')+    <|> ($(char '\x3D') >> pure '\x3D')+    <|> ($(char '\x5D') >> pure '\x5D')+    <|> ($(char '\x5F') >> pure '\x5F')+    <|> ($(char '\x7E') >> pure '\x7E')+    <|> charRanges [('\x28', '\x3B'), ('\x3F', '\x5B'), ('\x61', '\x7A')]+    <|> ucschar+    <|> iprivate -literal :: Parser TemplateSegment-literal = (Literal . concat) <$> some ((pure <$> literalChar) <|> pctEncoded) -variables :: Parser TemplateSegment-variables = Embed <$> modifier <*> sepBy1 variable (spaces *> char ',' *> spaces)+-- | Parse a literal segment+-- Uses byteStringOf to avoid intermediate list allocations+{-# INLINE literal #-}+literal :: Parser e TemplateSegment+literal = Literal . TE.decodeUtf8 <$> byteStringOf (skipSome literalCharOrPct)+ where+  {-# INLINE literalCharOrPct #-}+  literalCharOrPct = (() <$ literalChar) <|> (() <$ pctEncoded) -means :: Parser a -> b -> Parser b-means p v = p *> pure v -charMeans = means . char+-- | Parse variables in an embed+{-# INLINE variables #-}+variables :: Parser e TemplateSegment+variables = do+  mod <- modifier+  vars <- sepBy1 variable (ws *> $(char ',') *> ws)+  return $ Embed mod vars -modifier :: Parser Modifier-modifier = (choice $ map (uncurry charMeans) modifiers) <|> pure Simple-  where-    modifiers =-      [ ('+', Reserved)-      , ('#', Fragment)-      , ('.', Label)-      , ('/', PathSegment)-      , (';', PathParameter)-      , ('?', Query)-      , ('&', QueryContinuation)-      , ('=', Reserved)-      , ('@', Reserved)-      , ('!', Reserved)-      , ('|', Reserved)-      ] -variable :: Parser Variable-variable = Variable <$> name <*> valueModifier-  where-    name = concat <$> some ((pure <$> (alphaNum <|> char '_')) <|> pctEncoded)-    valueModifier = charMeans '*' Explode <|> (MaxLength <$> (char ':' *> parseInt)) <|> pure Normal-    parseInt = read <$> some digit+-- | Parse optional whitespace+{-# INLINE ws #-}+ws :: Parser e ()+ws = skipMany (satisfy (\c -> c == ' ' || c == '\t' || c == '\n' || c == '\r')) -embed :: Parser TemplateSegment-embed = between (char '{') (char '}') variables -uriTemplate :: Parser UriTemplate-uriTemplate = spaces *> many (literal <|> embed)+-- | Parse a modifier character+modifier :: Parser e Modifier+modifier =+  ($(char '+') *> pure Reserved)+    <|> ($(char '#') *> pure Fragment)+    <|> ($(char '.') *> pure Label)+    <|> ($(char '/') *> pure PathSegment)+    <|> ($(char ';') *> pure PathParameter)+    <|> ($(char '?') *> pure Query)+    <|> ($(char '&') *> pure QueryContinuation)+    <|> ($(char '=') *> pure Reserved)+    <|> ($(char '@') *> pure Reserved)+    <|> ($(char '!') *> pure Reserved)+    <|> ($(char '|') *> pure Reserved)+    <|> pure Simple -parseTemplate :: String -> Either Doc UriTemplate-parseTemplate t =-  case parseString uriTemplate mempty t of-    Failure err -> Left (_errDoc err)-    Success r -> Right r +-- | Parse a variable+variable :: Parser e Variable+variable = do+  nm <- name+  valMod <- valueModifier+  return $ Variable nm valMod+ where+  {-# INLINE name #-}+  name = TE.decodeUtf8 <$> byteStringOf (skipSome nameChar)+   where+    {-# INLINE nameChar #-}+    nameChar = (() <$ alphaNum) <|> (() <$ $(char '_')) <|> (() <$ pctEncoded)+  {-# INLINE valueModifier #-}+  valueModifier =+    ($(char '*') *> pure Explode)+      <|> ($(char ':') *> (MaxLength <$> parseInt))+      <|> pure Normal+  {-# INLINE parseInt #-}+  parseInt = do+    digits <- some digit+    return $ read digits+  {-# INLINE alphaNum #-}+  alphaNum = satisfy (\c -> C.isAlphaNum c)+  {-# INLINE digit #-}+  digit = satisfy C.isDigit+++-- | Parse an embedded variable expression+{-# INLINE embed #-}+embed :: Parser e TemplateSegment+embed = $(char '{') *> variables <* $(char '}')+++-- | Parse a URI template segments+{-# INLINE uriTemplate #-}+uriTemplate :: Parser e (V.Vector TemplateSegment)+uriTemplate = V.fromList <$> (ws *> many (literal <|> embed))+++-- | Helper to separate a parser by a separator+{-# INLINE sepBy1 #-}+sepBy1 :: Parser e a -> Parser e sep -> Parser e [a]+sepBy1 p sep = (:) <$> p <*> many (sep *> p)+++-- | Parse a template from a String+parseTemplate :: String -> Either ParseError UriTemplate+parseTemplate input =+  case runParser uriTemplate (TE.encodeUtf8 $ T.pack input) of+    OK result _ -> Right (UriTemplate result)+    Err _ -> Left (GenericParseError ("Parse error in URI template: " ++ input))+    Fail -> Left (GenericParseError ("Parse error in URI template: " ++ input))+++{- | 'IsString' instance for 'UriTemplate' allows using string literals directly as templates+when @OverloadedStrings@ is enabled.++>>> :set -XOverloadedStrings+>>> let template = "/users/{userId}" :: UriTemplate+>>> renderTemplate template+"/users/{userId}"++Note: If the string fails to parse as a valid URI template, this will call 'error'.+For fallible parsing, use 'parseTemplate' instead.+-}+instance S.IsString UriTemplate where+  fromString s = case parseTemplate s of+    Right template -> template+    Left err -> error $ "Invalid URI template: " ++ s ++ "\n" ++ show err

@@ -0,0 +1,68 @@+{-# LANGUAGE ScopedTypeVariables #-}++{- |+Convenience functions for rendering URI templates to common output formats.++This module provides type-specific rendering functions that make it easier+to work with the library without needing to explicitly specify types.+-}+module Network.URI.Template.Render (+  -- * Convenience rendering functions+  renderText,+  renderLazyText,+  renderByteString,+  renderLazyByteString,+  renderString,+  renderBuilder,+) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Network.URI.Template.Internal+import Network.URI.Template.Types+++-- | Render a URI template to strict 'T.Text'.+--+-- This is the most common rendering target for modern Haskell applications.+renderText :: UriTemplate -> [BoundValue] -> T.Text+renderText = render+++-- | Render a URI template to lazy 'TL.Text'.+--+-- Useful for building large URIs incrementally.+renderLazyText :: UriTemplate -> [BoundValue] -> TL.Text+renderLazyText = render+++-- | Render a URI template to strict 'BS.ByteString'.+--+-- Useful for network operations where ByteString is preferred.+renderByteString :: UriTemplate -> [BoundValue] -> BS.ByteString+renderByteString = render+++-- | Render a URI template to lazy 'BL.ByteString'.+--+-- Useful for building large URIs or streaming operations.+renderLazyByteString :: UriTemplate -> [BoundValue] -> BL.ByteString+renderLazyByteString = render+++-- | Render a URI template to 'String'.+--+-- Note: For most applications, 'renderText' is preferred for better performance.+renderString :: UriTemplate -> [BoundValue] -> String+renderString = render+++-- | Render a URI template to a 'BB.Builder'.+--+-- This is the most efficient option for incremental construction or when+-- you need to combine the result with other builders.+renderBuilder :: UriTemplate -> [BoundValue] -> BB.Builder+renderBuilder = render

@@ -1,42 +1,66 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}-module Network.URI.Template.TH where+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}++module Network.URI.Template.TH+  ( -- * Quasi-quoter+    uri+    -- * Template Haskell derivation+  , deriveToTemplateValue+  , deriveToTemplateValueWith+    -- * Options+  , Options(..)+  , defaultOptions+    -- * Field name modifiers+  , camelTo2+  , camelTo+  ) where++import Control.Monad (zipWithM)+import Data.Char (isUpper, toLower, toUpper) import Data.List+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Vector as V import Language.Haskell.TH-import Language.Haskell.TH.Syntax import Language.Haskell.TH.Quote-import Network.HTTP.Base+import Language.Haskell.TH.Syntax import Network.URI.Template.Internal import Network.URI.Template.Parser import Network.URI.Template.Types -variableNames :: UriTemplate -> [String]-variableNames = nub . foldr go []-  where-    go (Literal _) l = l-    go (Embed m vs) l = map variableName vs ++ l +variableNames :: UriTemplate -> [T.Text]+variableNames (UriTemplate segments) = Set.toList $ V.foldr go Set.empty segments+ where+  go (Literal _) acc = acc+  go (Embed _ vs) acc = foldr (Set.insert . variableName) acc vs++ segmentToExpr :: TemplateSegment -> Q Exp-segmentToExpr (Literal str) = appE (conE 'Literal) (litE $ StringL str)+segmentToExpr (Literal str) = appE (conE 'Literal) (litE $ StringL $ T.unpack str) segmentToExpr (Embed m vs) = appE (appE (conE 'Embed) modifier) $ listE $ map variableToExpr vs-  where-    modifier = do-      mname <- lookupValueName (show m)-      case mname of-        Nothing -> fail (show m ++ " is not a valid modifier")-        Just n -> conE n-    variableToExpr (Variable varName varModifier) = [| Variable $(litE $ StringL varName) $(varModifierE varModifier) |]-    varModifierE vm = case vm of-      Normal -> conE 'Normal-      Explode -> conE 'Explode-      (MaxLength x) -> appE (conE 'MaxLength) $ litE $ IntegerL $ fromIntegral x+ where+  modifier = do+    mname <- lookupValueName (show m)+    case mname of+      Nothing -> fail (show m ++ " is not a valid modifier")+      Just n -> conE n+  variableToExpr (Variable varName varModifier) = [|Variable $(litE $ StringL $ T.unpack varName) $(varModifierE varModifier)|]+  varModifierE vm = case vm of+    Normal -> conE 'Normal+    Explode -> conE 'Explode+    (MaxLength x) -> appE (conE 'MaxLength) $ litE $ IntegerL $ fromIntegral x + templateToExp :: UriTemplate -> Q Exp-templateToExp ts = [| render' $(listE $ map segmentToExpr ts) $(templateValues) |]-  where-    templateValues = listE $ map makePair vns-    vns = variableNames ts-    makePair str = [| ($(litE $ StringL str), WrappedValue $ toTemplateValue $ $(varE $ mkName str)) |]+templateToExp tpl@(UriTemplate segments) = [|render' (UriTemplate $(appE (varE 'V.fromList) (listE $ map segmentToExpr $ V.toList segments))) $(templateValues)|]+ where+  templateValues = listE $ map makePair vns+  vns = variableNames tpl+  makePair str = [|($(litE $ StringL $ T.unpack str), WrappedValue $ toTemplateValue $(varE $ mkName $ T.unpack str))|] + quasiEval :: String -> Q Exp quasiEval str = do   l <- location@@ -46,11 +70,285 @@     Left err -> fail $ show err     Right tpl -> templateToExp tpl --- | URI quasiquoter. Can only be used in expressions, not for top-level declarations++-- | Parse a template and create a pattern that matches the exact template structure+-- and binds variables from the template as pattern variables.+--+-- Variables in the template become bound pattern variables that can be used in the+-- pattern match body. For example:+--+-- @+-- case template of+--   [uri|/users/{userId}/posts/{postId}|] -> (userId, postId)+--   _ -> ...+-- @+--+-- This will bind 'userId' and 'postId' as variables containing the variable names+-- from the matched template.+quasiPat :: String -> Q Pat+quasiPat str = do+  let res = parseTemplate str+  case res of+    Left err -> fail $ show err+    Right (UriTemplate segments) -> do+      -- Create a view pattern that converts Vector to list for pattern matching+      -- Pattern: UriTemplate (V.toList -> [segment1, segment2, ...])+      let segmentPats = map segmentToPat $ V.toList segments+      vecPat <- viewP (varE 'V.toList) (listP segmentPats)+      conP 'UriTemplate [return vecPat]+ where+  segmentToPat :: TemplateSegment -> Q Pat+  segmentToPat (Literal txt) = conP 'Literal [litP $ StringL $ T.unpack txt]+  segmentToPat (Embed mod vars) = conP 'Embed [modifierPat mod, listP $ map variableToPat vars]++  modifierPat :: Modifier -> Q Pat+  modifierPat m = do+    mname <- lookupValueName (show m)+    case mname of+      Nothing -> fail (show m ++ " is not a valid modifier")+      Just n -> conP n []++  variableToPat :: Variable -> Q Pat+  variableToPat (Variable name valMod) =+    -- Bind the variable name as a pattern variable+    conP 'Variable [varP $ mkName $ T.unpack name, valueModifierPat valMod]++  valueModifierPat :: ValueModifier -> Q Pat+  valueModifierPat Normal = conP 'Normal []+  valueModifierPat Explode = conP 'Explode []+  valueModifierPat (MaxLength n) = conP 'MaxLength [litP $ IntegerL $ fromIntegral n]+++{- | URI quasiquoter supporting expressions and patterns.++__Expression context:__ Interpolates variables into the template at compile time.++@+let userId = 123 :: Int+url = [uri|/users/{userId}/profile|]  -- produces "/users/123/profile"+@++__Pattern context:__ Matches against a UriTemplate structure and binds variable names.++@+case parsedTemplate of+  [uri|/users/{userId}/posts/{postId}|] -> do+    -- userId and postId are now bound to their Text values+    print (userId, postId)+  _ -> putStrLn "Different template"+@++The pattern match checks that the template has the exact structure specified,+and binds each variable name from the template as a pattern variable of type 'Text'.++__Not supported:__+- Type context: URI templates are runtime values, not types+- Declaration context: Would hardcode variable names, not useful in practice+-} uri :: QuasiQuoter-uri = QuasiQuoter-  { quoteExp = quasiEval-  , quotePat = error "Cannot use uri quasiquoter in pattern"-  , quoteType = error "Cannot use uri quasiquoter in type"-  , quoteDec = error "Cannot use uri quasiquoter as declarations"+uri =+  QuasiQuoter+    { quoteExp = quasiEval+    , quotePat = quasiPat+    , quoteType = \_ -> fail "URI templates cannot be used in type context - they are runtime values, not types"+    , quoteDec = \_ -> fail "URI templates cannot be used in declaration context - this would hardcode variable names"+    }+++-------------------------------------------------------------------------------+-- Template Haskell Derivation+-------------------------------------------------------------------------------++-- | Options that specify how to encode/decode your datatype to/from template values.+--+-- This is designed to be similar to Aeson's 'Options' type.+data Options = Options+  { fieldLabelModifier :: String -> String+    -- ^ Function applied to field labels. Handy for removing common record prefixes for example.+  , constructorTagModifier :: String -> String+    -- ^ Function applied to constructor tags which could be used as keys in associative values.+  , omitNothingFields :: Bool+    -- ^ If 'True', fields with 'Nothing' values will be omitted from the output.+    --   Default is 'False'.+  , unwrapUnaryRecords :: Bool+    -- ^ If 'True', record constructors with a single field will have their value+    --   unwrapped instead of being wrapped in an associative value.+    --   Default is 'False'.   }++-- | Default encoding 'Options':+--+-- @+-- 'Options'+-- { 'fieldLabelModifier'      = id+-- , 'constructorTagModifier'  = id+-- , 'omitNothingFields'       = False+-- , 'unwrapUnaryRecords'      = False+-- }+-- @+defaultOptions :: Options+defaultOptions = Options+  { fieldLabelModifier = id+  , constructorTagModifier = id+  , omitNothingFields = False+  , unwrapUnaryRecords = False+  }++-- | Derive a 'ToTemplateValue' instance for a data type.+--+-- For record types, this generates an 'Associative' template value where field names+-- are used as keys. For example:+--+-- @+-- data Person = Person { personName :: String, personAge :: Int }+-- deriveToTemplateValue ''Person+-- @+--+-- Will generate an instance that converts @Person \"Alice\" 30@ to an associative value+-- like @[(\"personName\", \"Alice\"), (\"personAge\", \"30\")]@.+--+-- Uses 'defaultOptions'.+deriveToTemplateValue :: Name -> Q [Dec]+deriveToTemplateValue = deriveToTemplateValueWith defaultOptions++-- | Like 'deriveToTemplateValue', but lets you customize the encoding options.+--+-- Example usage with custom options:+--+-- @+-- data Person = Person { personName :: String, personAge :: Int }+-- deriveToTemplateValueWith defaultOptions+--   { fieldLabelModifier = drop 6  -- Drops \"person\" prefix+--   } ''Person+-- @+deriveToTemplateValueWith :: Options -> Name -> Q [Dec]+deriveToTemplateValueWith opts name = do+  info <- reify name+  case info of+    TyConI dec -> deriveDec opts dec+    _ -> fail $ "Cannot derive ToTemplateValue for " ++ show name ++ ": not a type constructor"++deriveDec :: Options -> Dec -> Q [Dec]+deriveDec opts dec = case dec of+  DataD _ name tyVars _ cons _ -> deriveForDataType opts name (map stripTyVarBndr tyVars) cons+  NewtypeD _ name tyVars _ con _ -> deriveForDataType opts name (map stripTyVarBndr tyVars) [con]+  _ -> fail "Can only derive ToTemplateValue for data and newtype declarations"++-- | Strip the annotation from TyVarBndr to get just the name+stripTyVarBndr :: TyVarBndr flag -> Name+stripTyVarBndr (PlainTV n _) = n+stripTyVarBndr (KindedTV n _ _) = n++deriveForDataType :: Options -> Name -> [Name] -> [Con] -> Q [Dec]+deriveForDataType opts typeName tyVarNames cons = do+  let instanceType = foldl AppT (ConT typeName) (map VarT tyVarNames)++  -- For now, we only support single-constructor record types+  case cons of+    [con] -> deriveForSingleCon opts instanceType con+    _ -> fail "Currently only single-constructor types are supported for deriveToTemplateValue"++deriveForSingleCon :: Options -> Type -> Con -> Q [Dec]+deriveForSingleCon opts instanceType con = case con of+  RecC conName fields -> deriveForRecord opts instanceType conName fields+  NormalC conName [] -> deriveForNullary opts instanceType conName+  _ -> fail "Currently only record constructors and nullary constructors are supported"++deriveForRecord :: Options -> Type -> Name -> [VarBangType] -> Q [Dec]+deriveForRecord opts instanceType conName fields = do+  let fieldsInfo = [(fieldName, fieldType) | (fieldName, _, fieldType) <- fields]++  -- Check if this is a unary record and unwrapUnaryRecords is enabled+  if unwrapUnaryRecords opts && length fieldsInfo == 1+    then deriveForUnaryRecord opts instanceType conName (head fieldsInfo)+    else deriveForMultiFieldRecord opts instanceType conName fieldsInfo++deriveForUnaryRecord :: Options -> Type -> Name -> (Name, Type) -> Q [Dec]+deriveForUnaryRecord opts instanceType conName (fieldName, fieldType) = do+  valueVar <- newName "x"++  -- For unwrapped unary records, we just delegate to the field's ToTemplateValue instance+  let toTemplateValueImpl = LamE [ConP conName [] [VarP valueVar]]+        (AppE (VarE 'toTemplateValue) (VarE valueVar))++  return+    [ InstanceD Nothing [] (AppT (ConT ''ToTemplateValue) instanceType)+        [ TySynInstD (TySynEqn Nothing (AppT (ConT ''TemplateRep) instanceType) (ConT ''Single))+        , FunD 'toTemplateValue [Clause [] (NormalB toTemplateValueImpl) []]+        ]+    ]++deriveForMultiFieldRecord :: Options -> Type -> Name -> [(Name, Type)] -> Q [Dec]+deriveForMultiFieldRecord opts instanceType conName fieldsInfo = do+  varNames <- mapM (const $ newName "field") fieldsInfo++  -- Build the pattern match+  let pat = ConP conName [] (map VarP varNames)++  -- Build the list of key-value pairs+  pairExprs <- zipWithM (mkPairExpr opts) fieldsInfo varNames++  let listExpr = ListE pairExprs+  let toTemplateValueImpl = LamE [pat] (AppE (ConE 'Associative) listExpr)++  return+    [ InstanceD Nothing [] (AppT (ConT ''ToTemplateValue) instanceType)+        [ TySynInstD (TySynEqn Nothing (AppT (ConT ''TemplateRep) instanceType) (ConT ''Associative))+        , FunD 'toTemplateValue [Clause [] (NormalB toTemplateValueImpl) []]+        ]+    ]++mkPairExpr :: Options -> (Name, Type) -> Name -> Q Exp+mkPairExpr opts (fieldName, _) varName = do+  let originalFieldStr = nameBase fieldName+  let modifiedFieldStr = fieldLabelModifier opts originalFieldStr+  -- Use T.pack to convert String to Text, which has ToHttpApiData instance+  let keyExpr = AppE (ConE 'Single) (AppE (VarE 'T.pack) (LitE (StringL modifiedFieldStr)))+  let valueExpr = AppE (VarE 'toTemplateValue) (VarE varName)+  return $ TupE [Just keyExpr, Just valueExpr]++deriveForNullary :: Options -> Type -> Name -> Q [Dec]+deriveForNullary opts instanceType conName = do+  let constructorStr = nameBase conName+  let modifiedStr = constructorTagModifier opts constructorStr+  -- Use T.pack to convert String to Text+  let toTemplateValueImpl = LamE [ConP conName [] []]+        (AppE (ConE 'Single) (AppE (VarE 'T.pack) (LitE (StringL modifiedStr))))++  return+    [ InstanceD Nothing [] (AppT (ConT ''ToTemplateValue) instanceType)+        [ TySynInstD (TySynEqn Nothing (AppT (ConT ''TemplateRep) instanceType) (ConT ''Single))+        , FunD 'toTemplateValue [Clause [] (NormalB toTemplateValueImpl) []]+        ]+    ]+++-------------------------------------------------------------------------------+-- Field name transformation utilities+-------------------------------------------------------------------------------++-- | Converts from camel case to another lower case, separated by the given character.+-- Has two special rules: an acronym (all uppercase) is converted to all lowercase,+-- and the first character (whether uppercase or lowercase) is never prefixed with the separator.+--+-- Example: @camelTo2 \'_\' \"SomeFieldName\" == \"some_field_name\"@+-- Example: @camelTo2 \'_\' \"productName\" == \"product_name\"@+camelTo2 :: Char -> String -> String+camelTo2 _ "" = ""+camelTo2 c (x:xs) = toLower x : go xs+  where+    go "" = ""+    go (u:l:rest) | isUpper u && isUpper l = c : toLower u : toLower l : go rest+    go (u:rest) | isUpper u = c : toLower u : go rest+    go (l:rest) = toLower l : go rest++-- | Converts from camel case to another lower case, separated by the given character.+-- Consecutive uppercase characters are not handled specially.+--+-- Example: @camelTo \'_\' \"SomeFieldName\" == \"some_field_name\"@+camelTo :: Char -> String -> String+camelTo c = go+  where+    go "" = ""+    go (x:xs) | isUpper x = c : toLower x : go xs+              | otherwise = x : go xs

@@ -1,327 +1,713 @@-{-# LANGUAGE EmptyDataDecls, GADTs, FunctionalDependencies, MultiParamTypeClasses, FlexibleContexts, TypeSynonymInstances, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}+ module Network.URI.Template.Types where-import Control.Arrow-import Data.Foldable as F-import Data.Functor.Identity-import Data.List-import qualified Data.String as S++import Control.Arrow (Arrow ((***)))+import Data.Bifunctor (Bifunctor (bimap))+import Data.Char (isUpper, toLower)+import Data.Kind (Type)+import Data.Fixed (Fixed, HasResolution)+import Data.Foldable as F (Foldable (toList))+import Data.Functor.Const (Const)+import Data.Functor.Identity (Identity)+import qualified Data.Text as T+import GHC.Generics import qualified Data.HashMap.Strict as HS-import Data.Int-import Data.Word-import qualified Data.Map.Strict as MS-import Data.Monoid+import Data.Int (Int16, Int32, Int64, Int8)+import Data.List (intercalate) import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as MS+import Data.Monoid (All, Any, Dual, First, Last, Product, Sum)+import Data.Semigroup (Max, Min)+import qualified Data.String as S+import Data.Tagged (Tagged, unTagged) import qualified Data.Text as T import qualified Data.Text.Lazy as TL-import Data.Time-import Data.Version+import Data.Time (+  Day,+  DayOfWeek,+  LocalTime,+  NominalDiffTime,+  TimeOfDay,+  UTCTime,+  ZonedTime,+ )+import Data.Time.Calendar.Month.Compat (Month)+import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear) import qualified Data.UUID.Types as UUID import qualified Data.Vector as V-import Numeric.Natural+import Data.Version (Version)+import Data.Void (Void)+import Data.Word (Word16, Word32, Word64, Word8)+import Numeric.Natural (Natural)+import Web.Cookie (SetCookie)+import Web.HttpApiData (ToHttpApiData (toUrlPiece)) + data Single++ data Associative++ data List + -- | All values must reduce to a single value pair, an associative list of keys and values, or a list of values without keys. data TemplateValue a where-  Single :: String -> TemplateValue Single+  Single :: ToHttpApiData a => a -> TemplateValue Single   Associative :: [(TemplateValue Single, TemplateValue Single)] -> TemplateValue Associative   List :: [TemplateValue Single] -> TemplateValue List + instance Show (TemplateValue a) where-  show (Single s) = "Single " ++ s+  show (Single s) = "Single " ++ show (toUrlPiece s)   show (Associative as) = "Associative [" ++ intercalate ", " (map formatTuple as) ++ "]"-    where-      formatTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"+   where+    formatTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"   show (List s) = "List [" ++ intercalate ", " (map show s) ++ "]" ++instance Semigroup (TemplateValue Associative) where+  Associative l <> Associative r = Associative (l <> r)+++instance Monoid (TemplateValue Associative) where+  mempty = Associative mempty+++instance Semigroup (TemplateValue List) where+  List l <> List r = List (l <> r)+++instance Monoid (TemplateValue List) where+  mempty = List []++ data WrappedValue where   WrappedValue :: TemplateValue a -> WrappedValue + -- | A simple wrapper for interpolating Haskell 98 strings into templates.-newtype TemplateString = String { fromString :: String }-  deriving (Read, Show, Eq, S.IsString)+newtype TemplateString = String {fromString :: String}+  deriving (Read, Show, Eq, S.IsString, ToHttpApiData) --- | A simple list of key value pairs. Useful when you want to be able to have multiple duplicate--- keys, which 'Map' and 'HashMap' don't support.++{- | A simple list of key value pairs. Useful when you want to be able to have multiple duplicate+ keys, which 'Map' and 'HashMap' don't support.+-} newtype AList k v = AList   { fromAList :: [(k, v)]-  } deriving (Read, Show, Eq)+  }+  deriving (Read, Show, Eq, Ord, Semigroup, Monoid) ++instance Functor (AList k) where+  fmap f (AList l) = AList $ fmap (fmap f) l+++instance Bifunctor AList where+  bimap f g (AList l) = AList $ map (bimap f g) l++ class ToTemplateValue a where-  type TemplateRep a :: *+  type TemplateRep a :: Type   type TemplateRep a = Single   toTemplateValue :: a -> TemplateValue (TemplateRep a)+  default toTemplateValue :: (ToHttpApiData a, TemplateRep a ~ Single) => a -> TemplateValue (TemplateRep a)+  toTemplateValue = Single -instance ToTemplateValue () where-  toTemplateValue = const $ Single "_" -instance ToTemplateValue Bool where-  toTemplateValue = Single . show+{- | A newtype wrapper for deriving 'ToTemplateValue' instances via 'ToHttpApiData'. -instance ToTemplateValue Int where-  toTemplateValue = Single . show+This allows you to easily derive 'ToTemplateValue' instances for your custom types+that already have a 'ToHttpApiData' instance using @DerivingVia@. -instance ToTemplateValue Integer where-  toTemplateValue = Single . show+Example usage: -instance ToTemplateValue Natural where-  toTemplateValue = Single . show+@+newtype MyId = MyId Int+  deriving (ToHttpApiData) via Int+  deriving (ToTemplateValue) via (ViaHttpApiData MyId)+@ -instance ToTemplateValue Double where-  toTemplateValue = Single . show+The derived instance will use the 'ToHttpApiData' instance to convert the value+to a 'Single' template value.+-}+newtype ViaHttpApiData a = ViaHttpApiData a -instance ToTemplateValue Float where-  toTemplateValue = Single . show -instance ToTemplateValue Int8 where-  toTemplateValue = Single . show+instance (ToHttpApiData a) => ToTemplateValue (ViaHttpApiData a) where+  type TemplateRep (ViaHttpApiData a) = Single+  toTemplateValue (ViaHttpApiData a) = Single a -instance ToTemplateValue Int16 where-  toTemplateValue = Single . show -instance ToTemplateValue Int32 where-  toTemplateValue = Single . show+instance ToTemplateValue Bool -instance ToTemplateValue Int64 where-  toTemplateValue = Single . show -instance ToTemplateValue Word where-  toTemplateValue = Single . show+instance ToTemplateValue Char -instance ToTemplateValue Word8 where-  toTemplateValue = Single . show -instance ToTemplateValue Word16 where-  toTemplateValue = Single . show+instance ToTemplateValue Double -instance ToTemplateValue Word32 where-  toTemplateValue = Single . show -instance ToTemplateValue Word64 where-  toTemplateValue = Single . show+instance ToTemplateValue Float -instance ToTemplateValue TemplateString where-  toTemplateValue = Single . fromString -instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Dual a) where-  toTemplateValue = toTemplateValue . getDual+instance ToTemplateValue Int -instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Sum a) where-  toTemplateValue = toTemplateValue . getSum -instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Product a) where-  toTemplateValue = toTemplateValue . getProduct+instance ToTemplateValue Int8 -instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (First a) where-  toTemplateValue = toTemplateValue . getFirst -instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Last a) where-  toTemplateValue = toTemplateValue . getLast+instance ToTemplateValue Int16 -instance ToTemplateValue All where-  toTemplateValue = toTemplateValue . getAll -instance ToTemplateValue Any where-  toTemplateValue = toTemplateValue . getAny+instance ToTemplateValue Int32 -instance ToTemplateValue UUID.UUID where-  toTemplateValue = Single . UUID.toString -timeToString :: FormatTime t => String -> t -> String-timeToString fmt = formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))+instance ToTemplateValue Int64 -instance ToTemplateValue UTCTime where-  toTemplateValue = Single . timeToString "%H:%M:%S%QZ" -instance ToTemplateValue NominalDiffTime where-  toTemplateValue = toTemplateValue . (floor :: NominalDiffTime -> Integer)+instance ToTemplateValue Integer -instance ToTemplateValue LocalTime where-  toTemplateValue = Single . timeToString "%H:%M:%S%Q" -instance ToTemplateValue ZonedTime where-  toTemplateValue = Single . timeToString "%H:%M:%S%Q%z"+instance ToTemplateValue Ordering -instance ToTemplateValue TimeOfDay where-  toTemplateValue = Single . formatTime defaultTimeLocale "%H:%M:%S%Q" -instance ToTemplateValue Day where-  toTemplateValue = Single . show+instance ToTemplateValue Natural -instance ToTemplateValue Version where-  toTemplateValue = Single . showVersion -instance ToTemplateValue Ordering where-  toTemplateValue = Single . show+instance ToTemplateValue Word -instance (ToTemplateValue a, ToTemplateValue b, TemplateRep a ~ Single, TemplateRep b ~ Single) => ToTemplateValue (Either a b) where-  toTemplateValue = either toTemplateValue toTemplateValue -instance (ToTemplateValue a, (TemplateRep a) ~ Single) => ToTemplateValue [a] where+instance ToTemplateValue Word8+++instance ToTemplateValue Word16+++instance ToTemplateValue Word32+++instance ToTemplateValue Word64+++instance ToTemplateValue ()+++instance ToTemplateValue T.Text+++instance ToTemplateValue TL.Text+++instance ToTemplateValue TemplateString+++instance ToTemplateValue Void+++instance ToTemplateValue Version+++instance ToTemplateValue All+++instance ToTemplateValue Any+++instance ToTemplateValue UTCTime+++instance ToTemplateValue SetCookie+++instance ToTemplateValue UUID.UUID+++-- TODO these can probably be provided for things where TemplateRep a isn't Single too...+instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Min a)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Max a)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (First a)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Last a)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Identity a)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Dual a)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Sum a)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Product a)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a, HasResolution a) => ToTemplateValue (Fixed a)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Const a b)+++instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Tagged b a) where+  toTemplateValue = toTemplateValue . unTagged+++instance ToTemplateValue ZonedTime+++instance ToTemplateValue LocalTime+++instance ToTemplateValue TimeOfDay+++instance ToTemplateValue NominalDiffTime+++instance ToTemplateValue DayOfWeek+++instance ToTemplateValue Day+++instance ToTemplateValue QuarterOfYear+++instance ToTemplateValue Quarter+++instance ToTemplateValue Month+++instance (ToTemplateValue a, ToTemplateValue b, TemplateRep a ~ Single, TemplateRep b ~ Single, ToHttpApiData a, ToHttpApiData b) => ToTemplateValue (Either a b)+++instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue [a] where   type TemplateRep [a] = List   toTemplateValue = List . map toTemplateValue + instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (NE.NonEmpty a) where   type TemplateRep (NE.NonEmpty a) = List   toTemplateValue = toTemplateValue . NE.toList -instance (ToTemplateValue k, (TemplateRep k) ~ Single, ToTemplateValue v, (TemplateRep v) ~ Single) => ToTemplateValue (AList k v) where++instance (ToTemplateValue k, TemplateRep k ~ Single, ToTemplateValue v, TemplateRep v ~ Single) => ToTemplateValue (AList k v) where   type TemplateRep (AList k v) = Associative   toTemplateValue = Associative . map (toTemplateValue *** toTemplateValue) . fromAList -instance (ToTemplateValue a, (TemplateRep a) ~ Single) => ToTemplateValue (V.Vector a) where++instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (V.Vector a) where   type TemplateRep (V.Vector a) = List   toTemplateValue = List . F.toList . fmap toTemplateValue -instance ToTemplateValue T.Text where-  toTemplateValue = Single . T.unpack -instance ToTemplateValue TL.Text where-  toTemplateValue = Single . TL.unpack+instance (ToTemplateValue a, TemplateRep a ~ Single, ToHttpApiData a) => ToTemplateValue (Maybe a) -instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Maybe a) where-  toTemplateValue = maybe (Single "") toTemplateValue -instance (ToTemplateValue k, (TemplateRep k) ~ Single, ToTemplateValue v, (TemplateRep v) ~ Single) => ToTemplateValue (HS.HashMap k v) where+instance (ToTemplateValue k, TemplateRep k ~ Single, ToTemplateValue v, TemplateRep v ~ Single) => ToTemplateValue (HS.HashMap k v) where   type TemplateRep (HS.HashMap k v) = Associative   toTemplateValue = toTemplateValue . AList . HS.toList -instance (ToTemplateValue k, (TemplateRep k) ~ Single, ToTemplateValue v, (TemplateRep v) ~ Single) => ToTemplateValue (MS.Map k v) where++instance (ToTemplateValue k, TemplateRep k ~ Single, ToTemplateValue v, TemplateRep v ~ Single) => ToTemplateValue (MS.Map k v) where   type TemplateRep (MS.Map k v) = Associative   toTemplateValue = toTemplateValue . AList . MS.toList -instance ToTemplateValue a => ToTemplateValue (Identity a) where-  type TemplateRep (Identity a) = TemplateRep a-  toTemplateValue = toTemplateValue . runIdentity  instance-  ( ToTemplateValue a, TemplateRep a ~ Single-  , ToTemplateValue b, TemplateRep b ~ Single+  ( ToTemplateValue a+  , TemplateRep a ~ Single+  , ToTemplateValue b+  , TemplateRep b ~ Single   ) =>-  ToTemplateValue (a, b) where+  ToTemplateValue (a, b)+  where   type TemplateRep (a, b) = List-  toTemplateValue (a, b) = List-    [ toTemplateValue a-    , toTemplateValue b-    ]+  toTemplateValue (a, b) =+    List+      [ toTemplateValue a+      , toTemplateValue b+      ] + instance-  ( ToTemplateValue a, TemplateRep a ~ Single-  , ToTemplateValue b, TemplateRep b ~ Single-  , ToTemplateValue c, TemplateRep c ~ Single+  ( ToTemplateValue a+  , TemplateRep a ~ Single+  , ToTemplateValue b+  , TemplateRep b ~ Single+  , ToTemplateValue c+  , TemplateRep c ~ Single   ) =>-  ToTemplateValue (a, b, c) where+  ToTemplateValue (a, b, c)+  where   type TemplateRep (a, b, c) = List-  toTemplateValue (a, b, c) = List-    [ toTemplateValue a-    , toTemplateValue b-    , toTemplateValue c-    ]+  toTemplateValue (a, b, c) =+    List+      [ toTemplateValue a+      , toTemplateValue b+      , toTemplateValue c+      ] + instance-  ( ToTemplateValue a, TemplateRep a ~ Single-  , ToTemplateValue b, TemplateRep b ~ Single-  , ToTemplateValue c, TemplateRep c ~ Single-  , ToTemplateValue d, TemplateRep d ~ Single+  ( ToTemplateValue a+  , TemplateRep a ~ Single+  , ToTemplateValue b+  , TemplateRep b ~ Single+  , ToTemplateValue c+  , TemplateRep c ~ Single+  , ToTemplateValue d+  , TemplateRep d ~ Single   ) =>-  ToTemplateValue (a, b, c, d) where+  ToTemplateValue (a, b, c, d)+  where   type TemplateRep (a, b, c, d) = List-  toTemplateValue (a, b, c, d) = List-    [ toTemplateValue a-    , toTemplateValue b-    , toTemplateValue c-    , toTemplateValue d-    ]+  toTemplateValue (a, b, c, d) =+    List+      [ toTemplateValue a+      , toTemplateValue b+      , toTemplateValue c+      , toTemplateValue d+      ] + instance-  ( ToTemplateValue a, TemplateRep a ~ Single-  , ToTemplateValue b, TemplateRep b ~ Single-  , ToTemplateValue c, TemplateRep c ~ Single-  , ToTemplateValue d, TemplateRep d ~ Single-  , ToTemplateValue e, TemplateRep e ~ Single+  ( ToTemplateValue a+  , TemplateRep a ~ Single+  , ToTemplateValue b+  , TemplateRep b ~ Single+  , ToTemplateValue c+  , TemplateRep c ~ Single+  , ToTemplateValue d+  , TemplateRep d ~ Single+  , ToTemplateValue e+  , TemplateRep e ~ Single   ) =>-  ToTemplateValue (a, b, c, d, e) where+  ToTemplateValue (a, b, c, d, e)+  where   type TemplateRep (a, b, c, d, e) = List-  toTemplateValue (a, b, c, d, e) = List-    [ toTemplateValue a-    , toTemplateValue b-    , toTemplateValue c-    , toTemplateValue d-    , toTemplateValue e-    ]+  toTemplateValue (a, b, c, d, e) =+    List+      [ toTemplateValue a+      , toTemplateValue b+      , toTemplateValue c+      , toTemplateValue d+      , toTemplateValue e+      ] + instance-  ( ToTemplateValue a, TemplateRep a ~ Single-  , ToTemplateValue b, TemplateRep b ~ Single-  , ToTemplateValue c, TemplateRep c ~ Single-  , ToTemplateValue d, TemplateRep d ~ Single-  , ToTemplateValue e, TemplateRep e ~ Single-  , ToTemplateValue f, TemplateRep f ~ Single+  ( ToTemplateValue a+  , TemplateRep a ~ Single+  , ToTemplateValue b+  , TemplateRep b ~ Single+  , ToTemplateValue c+  , TemplateRep c ~ Single+  , ToTemplateValue d+  , TemplateRep d ~ Single+  , ToTemplateValue e+  , TemplateRep e ~ Single+  , ToTemplateValue f+  , TemplateRep f ~ Single   ) =>-  ToTemplateValue (a, b, c, d, e, f) where+  ToTemplateValue (a, b, c, d, e, f)+  where   type TemplateRep (a, b, c, d, e, f) = List-  toTemplateValue (a, b, c, d, e, f) = List-    [ toTemplateValue a-    , toTemplateValue b-    , toTemplateValue c-    , toTemplateValue d-    , toTemplateValue e-    , toTemplateValue f-    ]+  toTemplateValue (a, b, c, d, e, f) =+    List+      [ toTemplateValue a+      , toTemplateValue b+      , toTemplateValue c+      , toTemplateValue d+      , toTemplateValue e+      , toTemplateValue f+      ] + instance-  ( ToTemplateValue a, TemplateRep a ~ Single-  , ToTemplateValue b, TemplateRep b ~ Single-  , ToTemplateValue c, TemplateRep c ~ Single-  , ToTemplateValue d, TemplateRep d ~ Single-  , ToTemplateValue e, TemplateRep e ~ Single-  , ToTemplateValue f, TemplateRep f ~ Single-  , ToTemplateValue g, TemplateRep g ~ Single+  ( ToTemplateValue a+  , TemplateRep a ~ Single+  , ToTemplateValue b+  , TemplateRep b ~ Single+  , ToTemplateValue c+  , TemplateRep c ~ Single+  , ToTemplateValue d+  , TemplateRep d ~ Single+  , ToTemplateValue e+  , TemplateRep e ~ Single+  , ToTemplateValue f+  , TemplateRep f ~ Single+  , ToTemplateValue g+  , TemplateRep g ~ Single   ) =>-  ToTemplateValue (a, b, c, d, e, f, g) where+  ToTemplateValue (a, b, c, d, e, f, g)+  where   type TemplateRep (a, b, c, d, e, f, g) = List-  toTemplateValue (a, b, c, d, e, f, g) = List-    [ toTemplateValue a-    , toTemplateValue b-    , toTemplateValue c-    , toTemplateValue d-    , toTemplateValue e-    , toTemplateValue f-    , toTemplateValue g-    ]+  toTemplateValue (a, b, c, d, e, f, g) =+    List+      [ toTemplateValue a+      , toTemplateValue b+      , toTemplateValue c+      , toTemplateValue d+      , toTemplateValue e+      , toTemplateValue f+      , toTemplateValue g+      ] ++instance+  ( ToTemplateValue a+  , TemplateRep a ~ Single+  , ToTemplateValue b+  , TemplateRep b ~ Single+  , ToTemplateValue c+  , TemplateRep c ~ Single+  , ToTemplateValue d+  , TemplateRep d ~ Single+  , ToTemplateValue e+  , TemplateRep e ~ Single+  , ToTemplateValue f+  , TemplateRep f ~ Single+  , ToTemplateValue g+  , TemplateRep g ~ Single+  , ToTemplateValue h+  , TemplateRep h ~ Single+  ) =>+  ToTemplateValue (a, b, c, d, e, f, g, h)+  where+  type TemplateRep (a, b, c, d, e, f, g, h) = List+  toTemplateValue (a, b, c, d, e, f, g, h) =+    List+      [ toTemplateValue a+      , toTemplateValue b+      , toTemplateValue c+      , toTemplateValue d+      , toTemplateValue e+      , toTemplateValue f+      , toTemplateValue g+      , toTemplateValue h+      ]+++instance+  ( ToTemplateValue a+  , TemplateRep a ~ Single+  , ToTemplateValue b+  , TemplateRep b ~ Single+  , ToTemplateValue c+  , TemplateRep c ~ Single+  , ToTemplateValue d+  , TemplateRep d ~ Single+  , ToTemplateValue e+  , TemplateRep e ~ Single+  , ToTemplateValue f+  , TemplateRep f ~ Single+  , ToTemplateValue g+  , TemplateRep g ~ Single+  , ToTemplateValue h+  , TemplateRep h ~ Single+  , ToTemplateValue i+  , TemplateRep i ~ Single+  ) =>+  ToTemplateValue (a, b, c, d, e, f, g, h, i)+  where+  type TemplateRep (a, b, c, d, e, f, g, h, i) = List+  toTemplateValue (a, b, c, d, e, f, g, h, i) =+    List+      [ toTemplateValue a+      , toTemplateValue b+      , toTemplateValue c+      , toTemplateValue d+      , toTemplateValue e+      , toTemplateValue f+      , toTemplateValue g+      , toTemplateValue h+      , toTemplateValue i+      ]++ data ValueModifier   = Normal   | Explode   | MaxLength Int   deriving (Read, Show, Eq) + data Variable = Variable-  { variableName :: String+  { variableName :: T.Text   , variableValueModifier :: ValueModifier-  } deriving (Read, Show, Eq)+  }+  deriving (Read, Show, Eq) + data TemplateSegment-  = Literal String -- ^ A literal string. No URI escaping will be performed-  | Embed Modifier [Variable] -- ^ An interpolation can have multiple variables (separated by commas in the textual format)-  deriving (Read, Show, Eq)+  = -- | A literal string. No URI escaping will be performed+    Literal T.Text+  | -- | An interpolation can have multiple variables (separated by commas in the textual format)+    Embed Modifier [Variable]+  deriving (Read, Eq) --- | A URI template is fundamentally a bunch of segments that are either constants--- or else an interpolation-type UriTemplate = [TemplateSegment] +instance Show TemplateSegment where+  show (Literal t) = T.unpack t+  show (Embed mod vars) = "{" ++ modifierPrefix mod ++ intercalate "," (map showVariable vars) ++ "}"+    where+      showVariable (Variable name valueMod) = T.unpack name ++ showValueModifier valueMod+      showValueModifier Normal = ""+      showValueModifier Explode = "*"+      showValueModifier (MaxLength n) = ":" ++ show n+      modifierPrefix Simple = ""+      modifierPrefix Reserved = "+"+      modifierPrefix Fragment = "#"+      modifierPrefix Label = "."+      modifierPrefix PathSegment = "/"+      modifierPrefix PathParameter = ";"+      modifierPrefix Query = "?"+      modifierPrefix QueryContinuation = "&"+++{- | A URI template is fundamentally a bunch of segments that are either constants+ or else an interpolation+-}+newtype UriTemplate = UriTemplate+  { uriTemplateSegments :: V.Vector TemplateSegment+  }+  deriving (Read, Eq)+++instance Show UriTemplate where+  show = renderTemplate+++-- | Render a 'UriTemplate' back to its RFC 6570 string representation.+--+-- This is useful for debugging, logging, or storing templates as strings.+--+-- >>> import qualified Data.Vector as V+-- >>> renderTemplate (UriTemplate (V.fromList [Literal "http://example.com/", Embed PathSegment [Variable "path" Normal]]))+-- "http://example.com/{/path}"+renderTemplate :: UriTemplate -> String+renderTemplate = V.foldMap show . uriTemplateSegments++ -- | How an interpolated value should be rendered data Modifier-  = Simple -- ^ No prefix-  | Reserved -- ^ Prefixed by @+@-  | Fragment -- ^ Prefixed by @#@-  | Label -- ^ Prefixed by @.@-  | PathSegment -- ^ Prefixed by @/@-  | PathParameter -- ^ Prefixed by @;@-  | Query -- ^ Prefixed by @?@-  | QueryContinuation -- ^ Prefixed by @&@+  = -- | No prefix+    Simple+  | -- | Prefixed by @+@+    Reserved+  | -- | Prefixed by @#@+    Fragment+  | -- | Prefixed by @.@+    Label+  | -- | Prefixed by @/@+    PathSegment+  | -- | Prefixed by @;@+    PathParameter+  | -- | Prefixed by @?@+    Query+  | -- | Prefixed by @&@+    QueryContinuation   deriving (Read, Show, Eq)  +-------------------------------------------------------------------------------+-- Generics-based derivation+-------------------------------------------------------------------------------++-- | Options for generic derivation, matching the TH Options+data GenericOptions = GenericOptions+  { genericFieldLabelModifier :: String -> String+  , genericConstructorTagModifier :: String -> String+  , genericOmitNothingFields :: Bool+  , genericUnwrapUnaryRecords :: Bool+  }++-- | Default options for generic derivation+defaultGenericOptions :: GenericOptions+defaultGenericOptions = GenericOptions+  { genericFieldLabelModifier = id+  , genericConstructorTagModifier = id+  , genericOmitNothingFields = False+  , genericUnwrapUnaryRecords = False+  }++-- | Helper to convert camelCase to snake_case (for use in default options)+camelTo2Generic :: Char -> String -> String+camelTo2Generic _ "" = ""+camelTo2Generic c (x:xs) = toLower x : go xs+  where+    go "" = ""+    go (u:l:rest) | isUpper u && isUpper l = c : toLower u : toLower l : go rest+    go (u:rest) | isUpper u = c : toLower u : go rest+    go (l:rest) = toLower l : go rest++-- | Generic implementation class (only works with record types)+class GToTemplateValue f where+  type GTemplateRep f :: Type+  gToTemplateValue' :: GenericOptions -> f a -> TemplateValue (GTemplateRep f)++-- | Metadata: datatype name+instance (GToTemplateValue f) => GToTemplateValue (D1 c f) where+  type GTemplateRep (D1 c f) = GTemplateRep f+  gToTemplateValue' opts (M1 x) = gToTemplateValue' opts x++-- | Constructor with record fields - always produces Associative+instance (GToTemplateValueRecord f) => GToTemplateValue (C1 c f) where+  type GTemplateRep (C1 c f) = Associative+  gToTemplateValue' opts (M1 x) =+    let pairs = gToTemplateValueRecord opts x+    in Associative pairs++-- | Helper class for record fields+class GToTemplateValueRecord f where+  gToTemplateValueRecord :: GenericOptions -> f a -> [(TemplateValue Single, TemplateValue Single)]++-- | Single field selector+instance (Selector s, ToTemplateValue a, TemplateRep a ~ Single) => GToTemplateValueRecord (S1 s (K1 i a)) where+  gToTemplateValueRecord opts m@(M1 (K1 x)) =+    let fieldName = selName m+        modifiedName = genericFieldLabelModifier opts fieldName+        key = Single (T.pack modifiedName)+        value = toTemplateValue x+    in [(key, value)]++-- | Product of fields (multiple fields)+instance (GToTemplateValueRecord f, GToTemplateValueRecord g) => GToTemplateValueRecord (f :*: g) where+  gToTemplateValueRecord opts (f :*: g) =+    gToTemplateValueRecord opts f ++ gToTemplateValueRecord opts g++-- | Generic to TemplateValue with default options+gToTemplateValue :: (Generic a, GToTemplateValue (Rep a)) => a -> TemplateValue (GTemplateRep (Rep a))+gToTemplateValue = gToTemplateValueWith defaultGenericOptions++-- | Generic to TemplateValue with custom options+gToTemplateValueWith :: (Generic a, GToTemplateValue (Rep a)) => GenericOptions -> a -> TemplateValue (GTemplateRep (Rep a))+gToTemplateValueWith opts = gToTemplateValue' opts . from

@@ -0,0 +1,4 @@+import Test.DocTest+++main = doctest ["-isrc", "src/"]

@@ -1,181 +1,1112 @@-{-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeApplications #-}-module Main where-import Control.Arrow-import Control.Monad.Writer.Strict-import Data.String-import Network.URI.Template.Parser-import Network.URI.Template-import Network.URI.Template.TH-import Network.URI.Template.Types-import System.Exit-import Text.PrettyPrint.ANSI.Leijen (Doc, renderCompact, displayS)-import Test.HUnit hiding (test, path, Label)---- Just being lazy here-instance Eq Doc where-  (==) d1 d2 = show d1 == show d2--type TestRegistry = Writer [Test]--test :: Assertion -> TestRegistry ()-test t = tell [TestCase t]--suite :: TestRegistry () -> TestRegistry ()-suite t = tell [TestList $ execWriter t]--label :: String -> TestRegistry () -> TestRegistry ()-label n = censor (\l -> [TestLabel n $ TestList l])--runTestRegistry :: TestRegistry () -> IO Counts-runTestRegistry = runTestTT . TestList . execWriter--main = do-  counts <- testRun-  let statusCode = errors counts + failures counts-  if statusCode > 0-    then exitFailure-    else exitSuccess-  where-    strEq = (@?=) @String-    testRun = runTestRegistry $ do-      parserTests-      quasiQuoterTests strEq-      embedTests-      label "RFC example cases" $ suite $ do-        label "unescaped" $ test $ unescaped strEq-        label "fragment" $ test $ fragment strEq-        label "label tests" $ test $ labelTests strEq-        label "path tests" $ test $ pathTests strEq-        label "path params" $ test $ pathParams strEq-        label "query params" $ test $ queryParams strEq-        label "continued query params" $ test $ queryParams strEq--parserTests = label "Parser Tests" $ suite $ do-  let foo = Variable "foo" Normal-  label "Literal" $ parserTest "foo" $ Literal "foo"-  label "Simple" $ parserTest "{foo}" $ Embed Simple [foo]-  label "Reserved" $ parserTest "{+foo}" $ Embed Reserved [foo]-  label "Fragment" $ parserTest "{#foo}" $ Embed Fragment [foo]-  label "Label" $ parserTest "{.foo}" $ Embed Label [foo]-  label "Path Segment" $ parserTest "{/foo}" $ Embed PathSegment [foo]-  label "Path Parameter" $ parserTest "{;foo}" $ Embed PathParameter [foo]-  label "Query" $ parserTest "{?foo}" $ Embed Query [foo]-  label "Query Continuation" $ parserTest "{&foo}" $ Embed QueryContinuation [foo]-  label "Explode" $ parserTest "{foo*}" $ Embed Simple [Variable "foo" Explode]-  label "Max Length" $ parserTest "{foo:1}" $ Embed Simple [Variable "foo" $ MaxLength 1]-  label "Multiple Variables" $ parserTest "{foo,bar}" $ Embed Simple [Variable "foo" Normal, Variable "bar" Normal]--parserTest :: String -> TemplateSegment -> TestRegistry ()-parserTest t e = test $ parseTemplate t @?= Right [e]--embedTests = label "Embed Tests" $ suite $ do-  label "Literal" $ embedTest "foo" "foo"-  label "Simple" $ embedTest "{foo}" "bar"-  label "Reserved" $ embedTest "{+foo}" "bar"-  label "Fragment" $ embedTest "{#foo}" "#bar"-  label "Label" $ embedTest "{.foo}" ".bar"-  label "Path Segment" $ embedTest "{/foo}" "/bar"-  label "Path Parameter" $ embedTest "{;foo}" ";foo=bar"-  label "Query" $ embedTest "{?foo}" "?foo=bar"-  label "Query Continuation" $ embedTest "{&foo}" "&foo=bar"-  label "Explode" $ embedTest "{foo*}" "bar"-  label "Max Length" $ embedTest "{foo:1}" "b"--embedTestEnv = [("foo", WrappedValue $ Single "bar")]--embedTest :: String -> String -> TestRegistry ()-embedTest t expect = test $ do-  let (Right tpl) = parseTemplate t-  let rendered = render tpl embedTestEnv-  rendered @?= expect--var :: TemplateString-var = "value"--semi :: TemplateString-semi = ";"--hello :: TemplateString-hello = "Hello World!"--path :: TemplateString-path = "/foo/bar"--list :: [TemplateString]-list = ["red", "green", "blue"]--keys :: AList TemplateString TemplateString-keys = AList [("semi", ";"), ("dot", "."), ("comma", ",")]--quasiQuoterTests :: (Eq s, IsString s, Buildable s) => (s -> s -> Assertion) -> TestRegistry ()-quasiQuoterTests (@?=) = label "QuasiQuoter Tests" $ suite $ do-  label "Simple" $ test ([uri|{var}|] @?= "value")-  label "Simple with sufficient length" $ test ([uri|{var:20}|] @?= "value")-  label "Simple with insufficient length" $ test ([uri|{var:3}|] @?= "val")-  label "Escape" $ test ([uri|{semi}|] @?= "%3B")-  label "Escape" $ test ([uri|{semi:2}|] @?= "%3B")-  label "Multiple" $ test ([uri|{var,hello}|] @?= "value,Hello%20World%21")-  label "Length Constraint" $ test ([uri|{var:3}|] @?= "val")-  label "Sufficiently large length constraint" $ test ([uri|{var:10}|] @?= "value")-  label "List" $ test ([uri|{list}|] @?= "red,green,blue")-  label "Explode List" $ test ([uri|{list*}|] @?= "red,green,blue")-  label "Associative List" $ test ([uri|{keys}|] @?= "semi,%3B,dot,.,comma,%2C")-  label "Explode Associative List" $ test ([uri|{keys*}|] @?= "semi=%3B,dot=.,comma=%2C")-  label "Explode Associative List Query Params" $ test ([uri|{?keys*}|] @?= "?semi=%3B&dot=.&comma=%2C")--unescaped :: (Eq s, IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion-unescaped (@?=) = do-  [uri|{+path:6}/here|] @?= "/foo/b/here"-  [uri|{+list}|] @?= "red,green,blue"-  [uri|{+list*}|] @?= "red,green,blue"-  [uri|{+keys}|] @?= "semi,;,dot,.,comma,,"-  [uri|{+keys*}|] @?= "semi=;,dot=.,comma=,"--fragment :: (Eq s, IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion-fragment (@?=) = do-  [uri|{#path:6}/here|] @?= "#/foo/b/here"-  [uri|{#list}|] @?= "#red,green,blue"-  [uri|{#list*}|] @?= "#red,green,blue"-  [uri|{#keys}|] @?= "#semi,;,dot,.,comma,,"-  [uri|{#keys*}|] @?= "#semi=;,dot=.,comma=,"--labelTests :: (Eq s, IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion-labelTests (@?=) = do-  [uri|X{.var:3}|] @?= "X.val"-  [uri|X{.list}|] @?= "X.red,green,blue"-  [uri|X{.list*}|] @?= "X.red.green.blue"-  [uri|X{.keys}|] @?= "X.semi,%3B,dot,.,comma,%2C"-  [uri|X{.keys*}|] @?= "X.semi=%3B.dot=..comma=%2C"--pathTests :: (Eq s, IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion-pathTests (@?=) = do-  [uri|{/var:1,var}|] @?= "/v/value"-  [uri|{/list}|] @?= "/red,green,blue"-  [uri|{/list*}|] @?= "/red/green/blue"-  [uri|{/list*,path:4}|] @?= "/red/green/blue/%2Ffoo"-  [uri|{/keys}|] @?= "/semi,%3B,dot,.,comma,%2C"-  [uri|{/keys*}|] @?= "/semi=%3B/dot=./comma=%2C"--pathParams :: (Eq s, IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion-pathParams (@?=) = do-  [uri|{;hello:5}|] @?= ";hello=Hello"-  [uri|{;list}|] @?= ";list=red,green,blue"-  [uri|{;list*}|] @?= ";list=red;list=green;list=blue"-  [uri|{;keys}|] @?= ";keys=semi,%3B,dot,.,comma,%2C"-  [uri|{;keys*}|] @?= ";semi=%3B;dot=.;comma=%2C"--queryParams :: (Eq s, IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion-queryParams (@?=) = do-  [uri|{?var:3}|] @?= "?var=val"-  [uri|{?list}|] @?= "?list=red,green,blue"-  [uri|{?list*}|] @?= "?list=red&list=green&list=blue"-  [uri|{?keys}|] @?= "?keys=semi,%3B,dot,.,comma,%2C"-  [uri|{?keys*}|] @?= "?semi=%3B&dot=.&comma=%2C"--continuedQueryParams :: (Eq s, IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion-continuedQueryParams (@?=) = do-  [uri|{&var:3}|] @?= "&var=val"-  [uri|{&list}|] @?= "&list=red,green,blue"-  [uri|{&list*}|] @?= "&list=red&list=green&list=blue"-  [uri|{&keys}|] @?= "&keys=semi,%3B,dot,.,comma,%2C"-  [uri|{&keys*}|] @?= "&semi=%3B&dot=.&comma=%2C"+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++module Main where++import Control.Arrow+import Control.Monad.Writer.Strict+import qualified Data.String as S+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import GHC.Generics (Generic, Rep)+import Network.URI.Template+import Network.URI.Template.Parser+import Network.URI.Template.TH+import Network.URI.Template.Types+import System.Exit+import Test.HUnit hiding (Label, path, test)+import Web.HttpApiData (toUrlPiece)+++type TestRegistry = Writer [Test]+++test :: Assertion -> TestRegistry ()+test t = tell [TestCase t]+++suite :: TestRegistry () -> TestRegistry ()+suite t = tell [TestList $ execWriter t]+++label :: String -> TestRegistry () -> TestRegistry ()+label n = censor (\l -> [TestLabel n $ TestList l])+++runTestRegistry :: TestRegistry () -> IO Counts+runTestRegistry = runTestTT . TestList . execWriter+++-------------------------------------------------------------------------------+-- Template Haskell Derivation Tests+-------------------------------------------------------------------------------++-- Test basic record type with default options+data Person = Person+  { personName :: Text+  , personAge :: Int+  }++$(deriveToTemplateValue ''Person)++-- Test record with field label modifier+data User = User+  { userName :: Text+  , userEmail :: Text+  }++$(deriveToTemplateValueWith defaultOptions { fieldLabelModifier = drop 4 } ''User)++-- Test record with snake_case conversion+data Product = Product+  { productName :: Text+  , productPrice :: Int+  }++$(deriveToTemplateValueWith defaultOptions { fieldLabelModifier = camelTo2 '_' } ''Product)++-- Test unary record with unwrapUnaryRecords+newtype UserId = UserId { getUserId :: Int }++$(deriveToTemplateValueWith defaultOptions { unwrapUnaryRecords = True } ''UserId)++-- Test nullary constructor+data Status = Active++$(deriveToTemplateValue ''Status)++thDerivationTests :: TestRegistry ()+thDerivationTests = label "Template Haskell Derivation Tests" $+  suite $ do+    label "Basic record with default options" $ test $ do+      let person = Person "Alice" 30+      let val = toTemplateValue person+      case val of+        Associative pairs -> do+          length pairs @?= 2+          -- Check that we have the right keys+          let keys = [toUrlPiece k | (Single k, _) <- pairs]+          keys @?= (["personName", "personAge"] :: [Text])+        _ -> assertFailure "Expected Associative value"++    label "Record with fieldLabelModifier (drop prefix)" $ test $ do+      let user = User "Bob" "bob@example.com"+      let val = toTemplateValue user+      case val of+        Associative pairs -> do+          let keys = [toUrlPiece k | (Single k, _) <- pairs]+          keys @?= (["Name", "Email"] :: [Text])+        _ -> assertFailure "Expected Associative value"++    label "Record with snake_case conversion" $ test $ do+      let product = Product "Widget" 100+      let val = toTemplateValue product+      case val of+        Associative pairs -> do+          let keys = [toUrlPiece k | (Single k, _) <- pairs]+          keys @?= (["product_name", "product_price"] :: [Text])+        _ -> assertFailure "Expected Associative value"++    label "Unary record with unwrapUnaryRecords" $ test $ do+      let userId = UserId 42+      let val = toTemplateValue userId+      case val of+        Single i -> toUrlPiece i @?= ("42" :: Text)+        _ -> assertFailure "Expected Single value"++    label "Nullary constructor" $ test $ do+      let status = Active+      let val = toTemplateValue status+      case val of+        Single s -> toUrlPiece s @?= ("Active" :: Text)+        _ -> assertFailure "Expected Single value"++    label "Use derived instance in URI template" $ test $ do+      let product = Product "Widget" 100+      let rendered = render (UriTemplate $ V.fromList [Embed Query [Variable "product" Explode]]) [("product", WrappedValue $ toTemplateValue product)]+      rendered @?= ("?product_name=Widget&product_price=100" :: Text)+++-------------------------------------------------------------------------------+-- Generics Derivation Tests+-------------------------------------------------------------------------------++-- Test basic record type with generics and default options+data GenPerson = GenPerson+  { genPersonName :: Text+  , genPersonAge :: Int+  }+  deriving (Generic)++instance ToTemplateValue GenPerson where+  type TemplateRep GenPerson = GTemplateRep (Rep GenPerson)+  toTemplateValue = gToTemplateValue++-- Test record with custom generic options+data GenProduct = GenProduct+  { genProductName :: Text+  , genProductPrice :: Int+  }+  deriving (Generic)++instance ToTemplateValue GenProduct where+  type TemplateRep GenProduct = GTemplateRep (Rep GenProduct)+  toTemplateValue = gToTemplateValueWith defaultGenericOptions+    { genericFieldLabelModifier = camelTo2Generic '_'+    }++genericsDerivationTests :: TestRegistry ()+genericsDerivationTests = label "Generics Derivation Tests" $+  suite $ do+    label "Basic record with default generics" $ test $ do+      let person = GenPerson "Bob" 25+      let val = toTemplateValue person+      case val of+        Associative pairs -> do+          length pairs @?= 2+          let keys = [toUrlPiece k | (Single k, _) <- pairs]+          keys @?= (["genPersonName", "genPersonAge"] :: [Text])+        _ -> assertFailure "Expected Associative value"++    label "Record with custom field modifier (snake_case)" $ test $ do+      let product = GenProduct "Gadget" 200+      let val = toTemplateValue product+      case val of+        Associative pairs -> do+          let keys = [toUrlPiece k | (Single k, _) <- pairs]+          keys @?= (["gen_product_name", "gen_product_price"] :: [Text])+        _ -> assertFailure "Expected Associative value"++    label "Use generic instance in URI template" $ test $ do+      let product = GenProduct "Gadget" 200+      let rendered = render (UriTemplate $ V.fromList [Embed Query [Variable "product" Explode]]) [("product", WrappedValue $ toTemplateValue product)]+      rendered @?= ("?gen_product_name=Gadget&gen_product_price=200" :: Text)+++main :: IO ()+main = do+  counts <- testRun+  let statusCode = errors counts + failures counts+  if statusCode > 0+    then exitFailure+    else exitSuccess+ where+  strEq = (@?=) :: Text -> Text -> Assertion+  testRun = runTestRegistry $ do+    parserTests+    showInstanceTests+    isStringInstanceTests+    quasiQuoterTests strEq+    quasiQuoterPatternTests+    embedTests+    thDerivationTests+    genericsDerivationTests+    percentEncodingTests+    label "RFC 6570 Core Examples" $+      suite $ do+        label "unescaped" $ test $ unescaped strEq+        label "fragment" $ test $ fragment strEq+        label "label tests" $ test $ labelTests strEq+        label "path tests" $ test $ pathTests strEq+        label "path params" $ test $ pathParams strEq+        label "query params" $ test $ queryParams strEq+        label "continued query params" $ test $ continuedQueryParams strEq+    label "RFC 6570 Section 3.2 - Comprehensive Tests" $+      suite $ do+        label "3.2.2 Simple String Expansion" $ test $ simpleExpansionTests strEq+        label "3.2.3 Reserved Expansion" $ test $ reservedExpansionTests strEq+        label "3.2.4 Fragment Expansion" $ test $ fragmentExpansionTests strEq+        label "3.2.5 Label Expansion with Dot-Prefix" $ test $ labelExpansionTests strEq+        label "3.2.6 Path Segment Expansion" $ test $ pathSegmentExpansionTests strEq+        label "3.2.7 Path-Style Parameter Expansion" $ test $ pathParameterExpansionTests strEq+        label "3.2.8 Form-Style Query Expansion" $ test $ queryExpansionTests strEq+        label "3.2.9 Form-Style Query Continuation" $ test $ queryContinuationTests strEq+    label "Edge Cases and Special Scenarios" $+      suite $ do+        label "Empty Value Handling" $ test $ emptyValueTests strEq+        label "Complex Multi-Variable Combinations" $ test $ complexCombinationTests strEq+        label "Special Character Encoding" $ test $ specialCharacterTests strEq+        label "Prefix Modifier (Length Constraints)" $ test $ prefixModifierTests strEq+++parserTests :: TestRegistry ()+parserTests = label "Parser Tests" $+  suite $ do+    let foo = Variable "foo" Normal+    label "Literal" $ parserTest "foo" $ Literal "foo"+    label "Simple" $ parserTest "{foo}" $ Embed Simple [foo]+    label "Reserved" $ parserTest "{+foo}" $ Embed Reserved [foo]+    label "Fragment" $ parserTest "{#foo}" $ Embed Fragment [foo]+    label "Label" $ parserTest "{.foo}" $ Embed Label [foo]+    label "Path Segment" $ parserTest "{/foo}" $ Embed PathSegment [foo]+    label "Path Parameter" $ parserTest "{;foo}" $ Embed PathParameter [foo]+    label "Query" $ parserTest "{?foo}" $ Embed Query [foo]+    label "Query Continuation" $ parserTest "{&foo}" $ Embed QueryContinuation [foo]+    label "Explode" $ parserTest "{foo*}" $ Embed Simple [Variable "foo" Explode]+    label "Max Length" $ parserTest "{foo:1}" $ Embed Simple [Variable "foo" $ MaxLength 1]+    label "Multiple Variables" $ parserTest "{foo,bar}" $ Embed Simple [Variable "foo" Normal, Variable "bar" Normal]+++parserTest :: String -> TemplateSegment -> TestRegistry ()+parserTest t e = test $ parseTemplate t @?= Right (UriTemplate (V.singleton e))+++showInstanceTests :: TestRegistry ()+showInstanceTests = label "Show Instance Tests" $+  suite $ do+    label "Literal segments" $ test $ do+      show (Literal "foo") @?= "foo"+      show (Literal "/users/") @?= "/users/"++    label "Simple expansion" $ test $+      show (Embed Simple [Variable "var" Normal]) @?= "{var}"++    label "Reserved expansion" $ test $+      show (Embed Reserved [Variable "path" Normal]) @?= "{+path}"++    label "Fragment expansion" $ test $+      show (Embed Fragment [Variable "section" Normal]) @?= "{#section}"++    label "Label expansion" $ test $+      show (Embed Label [Variable "domain" Normal]) @?= "{.domain}"++    label "Path segment expansion" $ test $+      show (Embed PathSegment [Variable "segments" Normal]) @?= "{/segments}"++    label "Path parameter expansion" $ test $+      show (Embed PathParameter [Variable "params" Normal]) @?= "{;params}"++    label "Query expansion" $ test $+      show (Embed Query [Variable "filter" Normal]) @?= "{?filter}"++    label "Query continuation expansion" $ test $+      show (Embed QueryContinuation [Variable "page" Normal]) @?= "{&page}"++    label "Explode modifier" $ test $+      show (Embed Simple [Variable "list" Explode]) @?= "{list*}"++    label "MaxLength modifier" $ test $ do+      show (Embed Simple [Variable "var" (MaxLength 3)]) @?= "{var:3}"+      show (Embed Simple [Variable "var" (MaxLength 10)]) @?= "{var:10}"++    label "Multiple variables" $ test $+      show (Embed Simple [Variable "x" Normal, Variable "y" Normal]) @?= "{x,y}"++    label "Multiple variables with modifiers" $ test $ do+      show (Embed Simple [Variable "x" (MaxLength 5), Variable "y" Explode]) @?= "{x:5,y*}"+      show (Embed Query [Variable "filter" Explode, Variable "sort" Normal]) @?= "{?filter*,sort}"++    label "renderTemplate full templates" $ test $ do+      let template1 = UriTemplate (V.fromList [Literal "/users/", Embed Simple [Variable "userId" Normal]])+      renderTemplate template1 @?= "/users/{userId}"++      let template2 = UriTemplate (V.fromList [Literal "/api", Embed Query [Variable "page" Normal], Embed QueryContinuation [Variable "limit" Normal]])+      renderTemplate template2 @?= "/api{?page}{&limit}"++      let template3 = UriTemplate (V.fromList [Embed PathSegment [Variable "path" Explode], Literal "/file.txt"])+      renderTemplate template3 @?= "{/path*}/file.txt"++    label "Round-trip: parse then show" $ test $ do+      let testRoundTrip input = do+            case parseTemplate input of+              Right template -> renderTemplate template @?= input+              Left err -> assertFailure $ "Parse failed: " ++ show err++      testRoundTrip "{var}"+      testRoundTrip "{+path}"+      testRoundTrip "{#section}"+      testRoundTrip "{.domain}"+      testRoundTrip "{/segments*}"+      testRoundTrip "{;params}"+      testRoundTrip "{?query*}"+      testRoundTrip "{&continuation}"+      testRoundTrip "/users/{userId}/posts{?status,limit}"+      testRoundTrip "http://example.com{/path*}{?query*}"+++isStringInstanceTests :: TestRegistry ()+isStringInstanceTests = label "IsString Instance Tests" $+  suite $ do+    label "Simple template literal" $ test $ do+      let template = S.fromString "/users/{userId}" :: UriTemplate+      renderTemplate template @?= "/users/{userId}"++    label "Template with query params" $ test $ do+      let template = S.fromString "/api{?page,limit}" :: UriTemplate+      renderTemplate template @?= "/api{?page,limit}"++    label "Complex template" $ test $ do+      let template = S.fromString "http://example.com{/path*}{?query*}{#fragment}" :: UriTemplate+      renderTemplate template @?= "http://example.com{/path*}{?query*}{#fragment}"++    label "Template with all modifier types" $ test $ do+      let template = S.fromString "{var}{+reserved}{#fragment}{.label}{/path}{;params}{?query}{&cont}" :: UriTemplate+      renderTemplate template @?= "{var}{+reserved}{#fragment}{.label}{/path}{;params}{?query}{&cont}"++    label "Template with value modifiers" $ test $ do+      let template = S.fromString "{var:3}{list*}{name:10}" :: UriTemplate+      renderTemplate template @?= "{var:3}{list*}{name:10}"++    label "Plain literal without variables" $ test $ do+      let template = S.fromString "/static/path" :: UriTemplate+      renderTemplate template @?= "/static/path"++    label "Empty template" $ test $ do+      let template = S.fromString "" :: UriTemplate+      renderTemplate template @?= ""++    label "Template can be used with render" $ test $ do+      let template = S.fromString "/users/{userId}" :: UriTemplate+      let rendered = render template [("userId", WrappedValue $ Single (123 :: Int))] :: String+      rendered @?= "/users/123"+++embedTests = label "Embed Tests" $+  suite $ do+    label "Literal" $ embedTest "foo" "foo"+    label "Simple" $ embedTest "{foo}" "bar"+    label "Reserved" $ embedTest "{+foo}" "bar"+    label "Fragment" $ embedTest "{#foo}" "#bar"+    label "Label" $ embedTest "{.foo}" ".bar"+    label "Path Segment" $ embedTest "{/foo}" "/bar"+    label "Path Parameter" $ embedTest "{;foo}" ";foo=bar"+    label "Query" $ embedTest "{?foo}" "?foo=bar"+    label "Query Continuation" $ embedTest "{&foo}" "&foo=bar"+    label "Explode" $ embedTest "{foo*}" "bar"+    label "Max Length" $ embedTest "{foo:1}" "b"+++embedTestEnv = [("foo", WrappedValue $ Single ("bar" :: Text))]+++embedTest :: String -> String -> TestRegistry ()+embedTest t expect = test $ do+  let (Right tpl) = parseTemplate t+  let rendered = render tpl embedTestEnv+  rendered @?= expect+++var :: TemplateString+var = "value"+++semi :: TemplateString+semi = ";"+++hello :: TemplateString+hello = "Hello World!"+++path :: TemplateString+path = "/foo/bar"+++list :: [TemplateString]+list = ["red", "green", "blue"]+++keys :: AList TemplateString TemplateString+keys = AList [("semi", ";"), ("dot", "."), ("comma", ",")]+++-- Additional RFC 6570 variables for comprehensive testing+x :: TemplateString+x = "1024"+++y :: TemplateString+y = "768"+++emptyStr :: TemplateString+emptyStr = ""+++emptyList :: [TemplateString]+emptyList = []+++emptyKeys :: AList TemplateString TemplateString+emptyKeys = AList []+++who :: TemplateString+who = "fred"+++base :: TemplateString+base = "http://example.com/home/"+++v :: TemplateString+v = "6"+++half :: TemplateString+half = "50%"+++dub :: TemplateString+dub = "me/too"+++count :: [TemplateString]+count = ["one", "two", "three"]+++dom :: [TemplateString]+dom = ["example", "com"]+++quasiQuoterTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> TestRegistry ()+quasiQuoterTests (@?=) = label "QuasiQuoter Tests" $+  suite $ do+    label "Simple" $ test ([uri|{var}|] @?= "value")+    label "Simple with sufficient length" $ test ([uri|{var:20}|] @?= "value")+    label "Simple with insufficient length" $ test ([uri|{var:3}|] @?= "val")+    label "Escape" $ test ([uri|{semi}|] @?= "%3B")+    label "Escape" $ test ([uri|{semi:2}|] @?= "%3B")+    label "Multiple" $ test ([uri|{var,hello}|] @?= "value,Hello%20World%21")+    label "Length Constraint" $ test ([uri|{var:3}|] @?= "val")+    label "Sufficiently large length constraint" $ test ([uri|{var:10}|] @?= "value")+    label "List" $ test ([uri|{list}|] @?= "red,green,blue")+    label "Explode List" $ test ([uri|{list*}|] @?= "red,green,blue")+    label "Associative List" $ test ([uri|{keys}|] @?= "semi,%3B,dot,.,comma,%2C")+    label "Explode Associative List" $ test ([uri|{keys*}|] @?= "semi=%3B,dot=.,comma=%2C")+    label "Explode Associative List Query Params" $ test ([uri|{?keys*}|] @?= "?semi=%3B&dot=.&comma=%2C")+++unescaped :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+unescaped (@?=) = do+  [uri|{+path:6}/here|] @?= "/foo/b/here"+  [uri|{+list}|] @?= "red,green,blue"+  [uri|{+list*}|] @?= "red,green,blue"+  [uri|{+keys}|] @?= "semi,;,dot,.,comma,,"+  [uri|{+keys*}|] @?= "semi=;,dot=.,comma=,"+++fragment :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+fragment (@?=) = do+  [uri|{#path:6}/here|] @?= "#/foo/b/here"+  [uri|{#list}|] @?= "#red,green,blue"+  [uri|{#list*}|] @?= "#red,green,blue"+  [uri|{#keys}|] @?= "#semi,;,dot,.,comma,,"+  [uri|{#keys*}|] @?= "#semi=;,dot=.,comma=,"+++labelTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+labelTests (@?=) = do+  [uri|X{.var:3}|] @?= "X.val"+  [uri|X{.list}|] @?= "X.red,green,blue"+  [uri|X{.list*}|] @?= "X.red.green.blue"+  [uri|X{.keys}|] @?= "X.semi,%3B,dot,.,comma,%2C"+  [uri|X{.keys*}|] @?= "X.semi=%3B.dot=..comma=%2C"+++pathTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+pathTests (@?=) = do+  [uri|{/var:1,var}|] @?= "/v/value"+  [uri|{/list}|] @?= "/red,green,blue"+  [uri|{/list*}|] @?= "/red/green/blue"+  [uri|{/list*,path:4}|] @?= "/red/green/blue/%2Ffoo"+  [uri|{/keys}|] @?= "/semi,%3B,dot,.,comma,%2C"+  [uri|{/keys*}|] @?= "/semi=%3B/dot=./comma=%2C"+++pathParams :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+pathParams (@?=) = do+  [uri|{;hello:5}|] @?= ";hello=Hello"+  [uri|{;list}|] @?= ";list=red,green,blue"+  [uri|{;list*}|] @?= ";list=red;list=green;list=blue"+  [uri|{;keys}|] @?= ";keys=semi,%3B,dot,.,comma,%2C"+  [uri|{;keys*}|] @?= ";semi=%3B;dot=.;comma=%2C"+++queryParams :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+queryParams (@?=) = do+  [uri|{?var:3}|] @?= "?var=val"+  [uri|{?list}|] @?= "?list=red,green,blue"+  [uri|{?list*}|] @?= "?list=red&list=green&list=blue"+  [uri|{?keys}|] @?= "?keys=semi,%3B,dot,.,comma,%2C"+  [uri|{?keys*}|] @?= "?semi=%3B&dot=.&comma=%2C"+++continuedQueryParams :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+continuedQueryParams (@?=) = do+  [uri|{&var:3}|] @?= "&var=val"+  [uri|{&list}|] @?= "&list=red,green,blue"+  [uri|{&list*}|] @?= "&list=red&list=green&list=blue"+  [uri|{&keys}|] @?= "&keys=semi,%3B,dot,.,comma,%2C"+  [uri|{&keys*}|] @?= "&semi=%3B&dot=.&comma=%2C"+++-- Edge case tests for empty values+emptyValueTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+emptyValueTests (@?=) = do+  -- Empty string variable+  [uri|{emptyStr}|] @?= ""+  [uri|{?emptyStr}|] @?= "?emptyStr="+  [uri|{&emptyStr}|] @?= "&emptyStr="+  [uri|{/emptyStr}|] @?= "/"+  [uri|{;emptyStr}|] @?= ";emptyStr"+  [uri|{.emptyStr}|] @?= "."+  [uri|{#emptyStr}|] @?= "#"+  [uri|{+emptyStr}|] @?= ""+  -- Empty list+  [uri|{emptyList}|] @?= ""+  [uri|{emptyList*}|] @?= ""+  [uri|{?emptyList}|] @?= "?emptyList="+  [uri|{?emptyList*}|] @?= "?"+  [uri|{&emptyList}|] @?= "&emptyList="+  [uri|{&emptyList*}|] @?= "&"+  [uri|{/emptyList}|] @?= "/"+  [uri|{/emptyList*}|] @?= "/"+  -- Empty associative array+  [uri|{emptyKeys}|] @?= ""+  [uri|{emptyKeys*}|] @?= ""+  [uri|{?emptyKeys}|] @?= "?emptyKeys="+  [uri|{?emptyKeys*}|] @?= "?"+  [uri|{&emptyKeys}|] @?= "&emptyKeys="+  [uri|{&emptyKeys*}|] @?= "&"+  [uri|{;emptyKeys}|] @?= ";emptyKeys"+  [uri|{;emptyKeys*}|] @?= ";"+  [uri|{.emptyKeys}|] @?= "."+  [uri|{.emptyKeys*}|] @?= "."+  [uri|{/emptyKeys}|] @?= "/"+  [uri|{/emptyKeys*}|] @?= "/"+++-- RFC 6570 Section 3.2.2 - Simple String Expansion+simpleExpansionTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+simpleExpansionTests (@?=) = do+  [uri|{var}|] @?= "value"+  [uri|{hello}|] @?= "Hello%20World%21"+  [uri|{half}|] @?= "50%25"+  [uri|O{emptyStr}X|] @?= "OX"+  [uri|{x,y}|] @?= "1024,768"+  [uri|{x,hello,y}|] @?= "1024,Hello%20World%21,768"+  [uri|?{x,emptyStr}|] @?= "?1024,"+  [uri|?{x,emptyStr,y}|] @?= "?1024,,768"+  [uri|{var:3}|] @?= "val"+  [uri|{var:30}|] @?= "value"+  [uri|{list}|] @?= "red,green,blue"+  [uri|{list*}|] @?= "red,green,blue"+  [uri|{keys}|] @?= "semi,%3B,dot,.,comma,%2C"+  [uri|{keys*}|] @?= "semi=%3B,dot=.,comma=%2C"+++-- RFC 6570 Section 3.2.3 - Reserved Expansion+reservedExpansionTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+reservedExpansionTests (@?=) = do+  [uri|{+var}|] @?= "value"+  [uri|{+hello}|] @?= "Hello World!"+  [uri|{+half}|] @?= "50%"+  [uri|{base}index|] @?= "http%3A%2F%2Fexample.com%2Fhome%2Findex"+  [uri|{+base}index|] @?= "http://example.com/home/index"+  [uri|O{+emptyStr}X|] @?= "OX"+  [uri|{+path}/here|] @?= "/foo/bar/here"+  [uri|here?ref={+path}|] @?= "here?ref=/foo/bar"+  [uri|up{+path}{var}/here|] @?= "up/foo/barvalue/here"+  [uri|{+x,hello,y}|] @?= "1024,Hello World!,768"+  [uri|{+path,x}/here|] @?= "/foo/bar,1024/here"+  [uri|{+path:6}/here|] @?= "/foo/b/here"+  [uri|{+list}|] @?= "red,green,blue"+  [uri|{+list*}|] @?= "red,green,blue"+  [uri|{+keys}|] @?= "semi,;,dot,.,comma,,"+  [uri|{+keys*}|] @?= "semi=;,dot=.,comma=,"+++-- RFC 6570 Section 3.2.4 - Fragment Expansion+fragmentExpansionTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+fragmentExpansionTests (@?=) = do+  [uri|{#var}|] @?= "#value"+  [uri|{#hello}|] @?= "#Hello World!"+  [uri|{#half}|] @?= "#50%"+  [uri|foo{#emptyStr}|] @?= "foo#"+  [uri|foo{#emptyStr,x}|] @?= "foo#,1024"+  [uri|{#x,hello,y}|] @?= "#1024,Hello World!,768"+  [uri|{#path,x}/here|] @?= "#/foo/bar,1024/here"+  [uri|{#path:6}/here|] @?= "#/foo/b/here"+  [uri|{#list}|] @?= "#red,green,blue"+  [uri|{#list*}|] @?= "#red,green,blue"+  [uri|{#keys}|] @?= "#semi,;,dot,.,comma,,"+  [uri|{#keys*}|] @?= "#semi=;,dot=.,comma=,"+++-- RFC 6570 Section 3.2.5 - Label Expansion with Dot-Prefix+labelExpansionTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+labelExpansionTests (@?=) = do+  [uri|{.who}|] @?= ".fred"+  [uri|{.who,who}|] @?= ".fred.fred"+  [uri|{.half,who}|] @?= ".50%25.fred"+  [uri|www{.dom*}|] @?= "www.example.com"+  [uri|X{.var}|] @?= "X.value"+  [uri|X{.emptyStr}|] @?= "X."+  [uri|X{.x,y}|] @?= "X.1024.768"+  [uri|{.var:3}|] @?= ".val"+  [uri|{.list}|] @?= ".red,green,blue"+  [uri|{.list*}|] @?= ".red.green.blue"+  [uri|{.keys}|] @?= ".semi,%3B,dot,.,comma,%2C"+  [uri|{.keys*}|] @?= ".semi=%3B.dot=..comma=%2C"+++-- RFC 6570 Section 3.2.6 - Path Segment Expansion+pathSegmentExpansionTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+pathSegmentExpansionTests (@?=) = do+  [uri|{/who}|] @?= "/fred"+  [uri|{/who,who}|] @?= "/fred/fred"+  [uri|{/half,who}|] @?= "/50%25/fred"+  [uri|{/who,dub}|] @?= "/fred/me%2Ftoo"+  [uri|{/var}|] @?= "/value"+  [uri|{/var,emptyStr}|] @?= "/value/"+  [uri|{/var,x}/here|] @?= "/value/1024/here"+  [uri|{/var:1,var}|] @?= "/v/value"+  [uri|{/list}|] @?= "/red,green,blue"+  [uri|{/list*}|] @?= "/red/green/blue"+  [uri|{/list*,path:4}|] @?= "/red/green/blue/%2Ffoo"+  [uri|{/keys}|] @?= "/semi,%3B,dot,.,comma,%2C"+  [uri|{/keys*}|] @?= "/semi=%3B/dot=./comma=%2C"+++-- RFC 6570 Section 3.2.7 - Path-Style Parameter Expansion+pathParameterExpansionTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+pathParameterExpansionTests (@?=) = do+  [uri|{;who}|] @?= ";who=fred"+  [uri|{;half}|] @?= ";half=50%25"+  [uri|{;emptyStr}|] @?= ";emptyStr"+  [uri|{;v,emptyStr,who}|] @?= ";v=6;emptyStr;who=fred"+  [uri|{;x,y}|] @?= ";x=1024;y=768"+  [uri|{;x,y,emptyStr}|] @?= ";x=1024;y=768;emptyStr"+  [uri|{;hello:5}|] @?= ";hello=Hello"+  [uri|{;list}|] @?= ";list=red,green,blue"+  [uri|{;list*}|] @?= ";list=red;list=green;list=blue"+  [uri|{;keys}|] @?= ";keys=semi,%3B,dot,.,comma,%2C"+  [uri|{;keys*}|] @?= ";semi=%3B;dot=.;comma=%2C"+++-- RFC 6570 Section 3.2.8 - Form-Style Query Expansion+queryExpansionTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+queryExpansionTests (@?=) = do+  [uri|{?who}|] @?= "?who=fred"+  [uri|{?half}|] @?= "?half=50%25"+  [uri|{?x,y}|] @?= "?x=1024&y=768"+  [uri|{?x,y,emptyStr}|] @?= "?x=1024&y=768&emptyStr="+  [uri|{?var:3}|] @?= "?var=val"+  [uri|{?list}|] @?= "?list=red,green,blue"+  [uri|{?list*}|] @?= "?list=red&list=green&list=blue"+  [uri|{?keys}|] @?= "?keys=semi,%3B,dot,.,comma,%2C"+  [uri|{?keys*}|] @?= "?semi=%3B&dot=.&comma=%2C"+++-- RFC 6570 Section 3.2.9 - Form-Style Query Continuation+queryContinuationTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+queryContinuationTests (@?=) = do+  [uri|{&who}|] @?= "&who=fred"+  [uri|{&half}|] @?= "&half=50%25"+  [uri|?fixed=yes{&x}|] @?= "?fixed=yes&x=1024"+  [uri|{&x,y,emptyStr}|] @?= "&x=1024&y=768&emptyStr="+  [uri|{&var:3}|] @?= "&var=val"+  [uri|{&list}|] @?= "&list=red,green,blue"+  [uri|{&list*}|] @?= "&list=red&list=green&list=blue"+  [uri|{&keys}|] @?= "&keys=semi,%3B,dot,.,comma,%2C"+  [uri|{&keys*}|] @?= "&semi=%3B&dot=.&comma=%2C"+++-- Complex combinations and edge cases+complexCombinationTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+complexCombinationTests (@?=) = do+  -- Multiple expansions in one template+  [uri|{var}{hello}|] @?= "valueHello%20World%21"+  [uri|{+base}{var}|] @?= "http://example.com/home/value"+  [uri|map?{x,y}&{who}|] @?= "map?1024,768&fred"+  [uri|{x,y,list}|] @?= "1024,768,red,green,blue"+  [uri|{x,y,list*}|] @?= "1024,768,red,green,blue"+  [uri|{?x,y,list}|] @?= "?x=1024&y=768&list=red,green,blue"+  [uri|{?x,y,list*}|] @?= "?x=1024&y=768&list=red&list=green&list=blue"+  -- Literals mixed with expansions+  [uri|/path/{var}/to/{who}|] @?= "/path/value/to/fred"+  [uri|{/var}{?x,y}|] @?= "/value?x=1024&y=768"+  [uri|{/var,x}{?y,who}|] @?= "/value/1024?y=768&who=fred"+++-- Special character encoding tests+specialCharacterTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+specialCharacterTests (@?=) = do+  -- Special characters that need encoding in simple expansion+  [uri|{hello}|] @?= "Hello%20World%21"+  [uri|{half}|] @?= "50%25"+  [uri|{semi}|] @?= "%3B"+  [uri|{dub}|] @?= "me%2Ftoo"+  -- Same characters should be less encoded in reserved expansion+  [uri|{+hello}|] @?= "Hello World!"+  [uri|{+half}|] @?= "50%"+  [uri|{+dub}|] @?= "me/too"+++-- Prefix modifier tests (length constraints)+prefixModifierTests :: (Eq s, S.IsString s, Buildable s) => (s -> s -> Assertion) -> Assertion+prefixModifierTests (@?=) = do+  -- Simple expansion+  [uri|{var:1}|] @?= "v"+  [uri|{var:3}|] @?= "val"+  [uri|{var:5}|] @?= "value"+  [uri|{var:10}|] @?= "value"+  [uri|{hello:5}|] @?= "Hello"+  [uri|{hello:15}|] @?= "Hello%20World%21"+  -- With different operators+  [uri|{+path:4}|] @?= "/foo"+  [uri|{+path:6}|] @?= "/foo/b"+  [uri|{#path:6}|] @?= "#/foo/b"+  [uri|{.var:3}|] @?= ".val"+  [uri|{/var:1,var}|] @?= "/v/value"+  [uri|{;hello:5}|] @?= ";hello=Hello"+  [uri|{?var:3}|] @?= "?var=val"+  [uri|{&var:3}|] @?= "&var=val"++-- Test quasiquoter pattern matching+quasiQuoterPatternTests :: TestRegistry ()+quasiQuoterPatternTests = label "QuasiQuoter Pattern Tests" $+  suite $ do+    label "Simple literal pattern match" $ test $ do+      let tpl = parseTemplate "/static/path"+      case tpl of+        Right [uri|/static/path|] -> return ()+        _ -> assertFailure "Pattern should match /static/path"++    label "Simple variable pattern match and binding" $ test $ do+      let tpl = parseTemplate "{userId}"+      case tpl of+        Right [uri|{userId}|] -> do+          -- userId is now bound to "userId" :: Text+          userId @?= "userId"+        _ -> assertFailure "Pattern should match {userId}"++    label "Complex pattern match with multiple bindings" $ test $ do+      let tpl = parseTemplate "/users/{userId}/posts/{postId}"+      case tpl of+        Right [uri|/users/{userId}/posts/{postId}|] -> do+          -- Both variables are bound+          userId @?= "userId"+          postId @?= "postId"+        _ -> assertFailure "Pattern should match complex template"++    label "Pattern with modifiers binds variables" $ test $ do+      let tpl = parseTemplate "{+path}{?query*}{#fragment}"+      case tpl of+        Right [uri|{+path}{?query*}{#fragment}|] -> do+          path @?= "path"+          query @?= "query"+          fragment @?= "fragment"+        _ -> assertFailure "Pattern should match template with modifiers"++    label "Pattern with max length binds variable" $ test $ do+      let tpl = parseTemplate "{var:3}"+      case tpl of+        Right [uri|{var:3}|] -> do+          var @?= "var"+        _ -> assertFailure "Pattern should match template with max length"++    label "Pattern should not match different template" $ test $ do+      let tpl = parseTemplate "/users/{userId}"+      case tpl of+        Right [uri|/posts/{postId}|] -> assertFailure "Pattern should not match different template"+        Right _ -> return ()+        Left _ -> assertFailure "Parse should succeed"++    label "Multiple variables with same modifier" $ test $ do+      let tpl = parseTemplate "{x,y,z}"+      case tpl of+        Right [uri|{x,y,z}|] -> do+          x @?= "x"+          y @?= "y"+          z @?= "z"+        _ -> assertFailure "Should match and bind all three variables"++    label "Binding with mixed literal and variable segments" $ test $ do+      let tpl = parseTemplate "/api/v1/users/{userId}/posts/{postId}/comments"+      case tpl of+        Right [uri|/api/v1/users/{userId}/posts/{postId}/comments|] -> do+          userId @?= "userId"+          postId @?= "postId"+        _ -> assertFailure "Should match complex template with mixed segments"++    label "Binding variables with all modifier types" $ test $ do+      let tpl = parseTemplate "{simple}{+reserved}{#fragment}{.label}{/path}{;param}{?query}{&cont}"+      case tpl of+        Right [uri|{simple}{+reserved}{#fragment}{.label}{/path}{;param}{?query}{&cont}|] -> do+          simple @?= "simple"+          reserved @?= "reserved"+          fragment @?= "fragment"+          label @?= "label"+          path @?= "path"+          param @?= "param"+          query @?= "query"+          cont @?= "cont"+        _ -> assertFailure "Should bind variables with all modifier types"++    label "Binding with explode modifier on different operators" $ test $ do+      let tpl = parseTemplate "{list1*}{+list2*}{#list3*}{.list4*}{/list5*}{;list6*}{?list7*}{&list8*}"+      case tpl of+        Right [uri|{list1*}{+list2*}{#list3*}{.list4*}{/list5*}{;list6*}{?list7*}{&list8*}|] -> do+          list1 @?= "list1"+          list2 @?= "list2"+          list3 @?= "list3"+          list4 @?= "list4"+          list5 @?= "list5"+          list6 @?= "list6"+          list7 @?= "list7"+          list8 @?= "list8"+        _ -> assertFailure "Should bind exploded variables"++    label "Binding with length constraints" $ test $ do+      let tpl = parseTemplate "{short:3}{medium:10}{long:100}"+      case tpl of+        Right [uri|{short:3}{medium:10}{long:100}|] -> do+          short @?= "short"+          medium @?= "medium"+          long @?= "long"+        _ -> assertFailure "Should bind variables with length constraints"++    label "Multiple variables in single expression with different modifiers" $ test $ do+      let tpl = parseTemplate "{a,b:5,c*}"+      case tpl of+        Right [uri|{a,b:5,c*}|] -> do+          a @?= "a"+          b @?= "b"+          c @?= "c"+        _ -> assertFailure "Should bind all variables despite different modifiers"++    label "Binding preserves variable name exactly" $ test $ do+      let tpl = parseTemplate "{userId123}{user_id}{camelCase}"+      case tpl of+        Right [uri|{userId123}{user_id}{camelCase}|] -> do+          userId123 @?= "userId123"+          user_id @?= "user_id"+          camelCase @?= "camelCase"+        _ -> assertFailure "Should preserve exact variable names"++    label "Pattern with only literals (no variables)" $ test $ do+      let tpl = parseTemplate "/static/path/to/resource"+      case tpl of+        Right [uri|/static/path/to/resource|] -> return ()+        _ -> assertFailure "Should match literal-only template"++    label "Empty template pattern" $ test $ do+      let tpl = parseTemplate ""+      case tpl of+        Right [uri||] -> return ()+        _ -> assertFailure "Should match empty template"++    label "Pattern with repeated variable names causes conflict (documented limitation)" $ test $ do+      -- Note: This test documents that repeated variable names in a single pattern+      -- will cause a compile error due to conflicting definitions. This is expected+      -- Haskell behavior for pattern matching.+      let tpl = parseTemplate "{id1}/{id2}"+      case tpl of+        Right [uri|{id1}/{id2}|] -> do+          id1 @?= "id1"+          id2 @?= "id2"+        _ -> assertFailure "Should bind unique variable names"++    label "Complex real-world API pattern" $ test $ do+      let tpl = parseTemplate "/api/v2/organizations/{orgId}/projects/{projectId}/issues{?status,assignee,page,limit}"+      case tpl of+        Right [uri|/api/v2/organizations/{orgId}/projects/{projectId}/issues{?status,assignee,page,limit}|] -> do+          orgId @?= "orgId"+          projectId @?= "projectId"+          status @?= "status"+          assignee @?= "assignee"+          page @?= "page"+          limit @?= "limit"+        _ -> assertFailure "Should handle complex real-world template"++    label "Pattern match failure doesn't bind variables" $ test $ do+      let tpl = parseTemplate "/users/{userId}"+      let result = case tpl of+            Right [uri|/posts/{postId}|] -> Just "matched"+            Right _ -> Nothing+            Left _ -> Nothing+      result @?= Nothing++    label "Nested pattern matching" $ test $ do+      let tpl1 = parseTemplate "/users/{userId}"+      let tpl2 = parseTemplate "/posts/{postId}"+      case (tpl1, tpl2) of+        (Right [uri|/users/{userId}|], Right [uri|/posts/{postId}|]) -> do+          userId @?= "userId"+          postId @?= "postId"+        _ -> assertFailure "Should handle nested pattern matches"++    label "Pattern with percent-encoded literals" $ test $ do+      let tpl = parseTemplate "/path%20with%20spaces/{var}"+      case tpl of+        Right [uri|/path%20with%20spaces/{var}|] -> do+          var @?= "var"+        _ -> assertFailure "Should handle percent-encoded literals"++    label "Variable bindings are type Text" $ test $ do+      let tpl = parseTemplate "{userId}"+      case tpl of+        Right [uri|{userId}|] -> do+          -- Verify it's Text by using Text operations+          let _ = T.length userId+          let _ = T.toUpper userId+          userId @?= "userId"+        _ -> assertFailure "Variables should be Text type"++    label "Multiple query parameters with continuation" $ test $ do+      let tpl = parseTemplate "/search{?q,kind,sort}{&page,limit}"+      case tpl of+        Right [uri|/search{?q,kind,sort}{&page,limit}|] -> do+          q @?= "q"+          kind @?= "kind"  -- Changed from 'type' which is a keyword+          sort @?= "sort"+          page @?= "page"+          limit @?= "limit"+        _ -> assertFailure "Should handle query parameters with continuation"++    label "Guards can use bound variables" $ test $ do+      let tpl = parseTemplate "/api/{version}/users"+      let result = case tpl of+            Right [uri|/api/{version}/users|] | version == "version" -> True+            _ -> False+      result @?= True++    label "Pattern matching in function arguments" $ test $ do+      let checkTemplate [uri|/users/{userId}|] = userId+          checkTemplate _ = "no match"+      case parseTemplate "/users/{userId}" of+        Right tpl -> checkTemplate tpl @?= "userId"+        Left _ -> assertFailure "Parse should succeed"+++percentEncodingTests :: TestRegistry ()+percentEncodingTests = label "Percent Encoding Tests" $ suite $ do+  -- Tests for percent-encoded sequences in literal parts of templates+  label "Percent-encoded space in literal" $ test $ do+    case parseTemplate "/path%20with%20spaces" of+      Right tpl -> renderTemplate tpl @?= "/path%20with%20spaces"+      Left _ -> assertFailure "Should parse percent-encoded spaces"++  label "Percent-encoded special chars in literal" $ test $ do+    case parseTemplate "/api%2Fv1%2Fresource" of+      Right tpl -> renderTemplate tpl @?= "/api%2Fv1%2Fresource"+      Left _ -> assertFailure "Should parse percent-encoded slashes"++  label "Mixed literal and percent-encoded in literal" $ test $ do+    case parseTemplate "/hello%20world/test" of+      Right tpl -> renderTemplate tpl @?= "/hello%20world/test"+      Left _ -> assertFailure "Should parse mixed content"++  label "Percent-encoded literal with variable" $ test $ do+    case parseTemplate "/path%20with%20spaces/{var}" of+      Right tpl -> do+        renderTemplate tpl @?= "/path%20with%20spaces/{var}"+        let result = render tpl [("var", WrappedValue $ Single ("test" :: T.Text))]+        result @?= ("/path%20with%20spaces/test" :: T.Text)+      Left _ -> assertFailure "Should parse percent-encoded literal with variable"++  label "Multiple percent-encoded sequences in literal" $ test $ do+    case parseTemplate "/a%20b%20c%20d" of+      Right tpl -> renderTemplate tpl @?= "/a%20b%20c%20d"+      Left _ -> assertFailure "Should parse multiple percent-encoded sequences"++  -- Tests for percent-encoded sequences in variable names+  label "Percent-encoded char in variable name" $ test $ do+    case parseTemplate "{user%5Fid}" of+      Right tpl -> do+        renderTemplate tpl @?= "{user%5Fid}"+        let result = render tpl [("user%5Fid", WrappedValue $ Single ("123" :: T.Text))]+        result @?= ("123" :: T.Text)+      Left _ -> assertFailure "Should parse percent-encoded underscore in variable name"++  label "Variable with percent-encoded name in query" $ test $ do+    case parseTemplate "{?user%5Fname}" of+      Right tpl -> do+        let result = render tpl [("user%5Fname", WrappedValue $ Single ("alice" :: T.Text))]+        result @?= ("?user%5Fname=alice" :: T.Text)+      Left _ -> assertFailure "Should parse percent-encoded variable name in query"++  -- Tests for rendering with values that need encoding+  label "Render space in simple expansion" $ test $ do+    case parseTemplate "{value}" of+      Right tpl -> do+        let result = render tpl [("value", WrappedValue $ Single ("hello world" :: T.Text))]+        result @?= ("hello%20world" :: T.Text)+      Left _ -> assertFailure "Should parse simple template"++  label "Render special chars in simple expansion" $ test $ do+    case parseTemplate "{value}" of+      Right tpl -> do+        let result = render tpl [("value", WrappedValue $ Single ("a/b?c=d" :: T.Text))]+        result @?= ("a%2Fb%3Fc%3Dd" :: T.Text)+      Left _ -> assertFailure "Should parse simple template"++  label "Render reserved expansion does not encode" $ test $ do+    case parseTemplate "{+value}" of+      Right tpl -> do+        let result = render tpl [("value", WrappedValue $ Single ("hello world" :: T.Text))]+        result @?= ("hello world" :: T.Text)+      Left _ -> assertFailure "Should parse reserved template"++  label "Render path with encoding" $ test $ do+    case parseTemplate "{/path}" of+      Right tpl -> do+        let result = render tpl [("path", WrappedValue $ Single ("hello world" :: T.Text))]+        result @?= ("/hello%20world" :: T.Text)+      Left _ -> assertFailure "Should parse path template"++  label "Percent in value gets encoded" $ test $ do+    case parseTemplate "{value}" of+      Right tpl -> do+        let result = render tpl [("value", WrappedValue $ Single ("100%" :: T.Text))]+        result @?= ("100%25" :: T.Text)+      Left _ -> assertFailure "Should parse simple template"++  label "Already percent-encoded value gets double-encoded" $ test $ do+    case parseTemplate "{value}" of+      Right tpl -> do+        let result = render tpl [("value", WrappedValue $ Single ("hello%20world" :: T.Text))]+        -- The %20 in the value should be encoded to %2520+        result @?= ("hello%2520world" :: T.Text)+      Left _ -> assertFailure "Should parse simple template"++  -- Edge cases+  label "Percent at end of literal" $ test $ do+    case parseTemplate "/path%20" of+      Right tpl -> renderTemplate tpl @?= "/path%20"+      Left _ -> assertFailure "Should parse percent-encoded sequence at end"++  label "Multiple variables with percent-encoded names" $ test $ do+    case parseTemplate "{user%5Fid}/{post%5Fid}" of+      Right tpl -> do+        let result = render tpl+              [ ("user%5Fid", WrappedValue $ Single ("u123" :: T.Text))+              , ("post%5Fid", WrappedValue $ Single ("p456" :: T.Text))+              ]+        result @?= ("u123/p456" :: T.Text)+      Left _ -> assertFailure "Should parse multiple percent-encoded variable names"++  label "Case sensitivity in percent encoding" $ test $ do+    -- Both %2f and %2F should work (lowercase and uppercase hex)+    case parseTemplate "/path%2Fwith%2fslashes" of+      Right tpl -> renderTemplate tpl @?= "/path%2Fwith%2fslashes"+      Left _ -> assertFailure "Should accept both uppercase and lowercase hex digits"++  label "Unicode char gets properly encoded in output" $ test $ do+    case parseTemplate "{value}" of+      Right tpl -> do+        let result = render tpl [("value", WrappedValue $ Single ("hello\x2665world" :: T.Text))]+        -- Heart symbol should be UTF-8 encoded then percent-encoded+        result @?= ("hello%E2%99%A5world" :: T.Text)+      Left _ -> assertFailure "Should parse simple template"+

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                uri-templater-version:             0.3.1.0+version:             1.0.0 synopsis:            Parsing & Quasiquoting for RFC 6570 URI Templates description:         Parsing & Quasiquoting for RFC 6570 URI Templates homepage:            https://github.com/iand675/uri-templater@@ -13,7 +13,7 @@ copyright:           Ian Duncan category:            Network build-type:          Simple-cabal-version:       >=1.8+cabal-version:       >=1.10 source-repository    head   type:                git   location:            https://github.com/iand675/uri-templater@@ -23,32 +23,51 @@                      Network.URI.Template.TH,                      Network.URI.Template.Types,                      Network.URI.Template.Parser,-                     Network.URI.Template.Internal-  build-depends:     base <5,-                     trifecta >=1.6,-                     charset,-                     parsers,+                     Network.URI.Template.Internal,+                     Network.URI.Template.Error,+                     Network.URI.Template.Render+  build-depends:     base >= 4.9 && <5,+                     flatparse >= 0.5,                      template-haskell,-                     HTTP,                      dlist,                      mtl,-                     ansi-wl-pprint,+                     prettyprinter,+                     prettyprinter-ansi-terminal,                      vector,                      containers,                      unordered-containers,                      text,                      bytestring,                      uuid-types,-                     time+                     cookie,+                     tagged,+                     time,+                     time-compat,+                     http-types,+                     http-api-data >= 0.4.3   hs-source-dirs:    src+  default-language:  Haskell2010  test-suite test-uri-templates-   type:             exitcode-stdio-1.0-   main-is:          Test.hs-   hs-source-dirs:   test-   build-depends:    base,+  type:              exitcode-stdio-1.0+  main-is:           Test.hs+  hs-source-dirs:    test+  build-depends:     base >= 4.9 && <5,                      mtl,                      uri-templater,+                     text,                      template-haskell,                      HUnit,-                     ansi-wl-pprint+                     prettyprinter,+                     http-api-data,+                     vector+  default-language:  Haskell2010++test-suite doctests+  type:              exitcode-stdio-1.0+  ghc-options:       -threaded+  main-is:           Doctests.hs+  hs-source-dirs:    test+  build-depends:     base >= 4.9 && <5,+                     doctest >= 0.8+  default-language:  Haskell2010