burrito (empty) → 1.0.0.0

raw patch · 5 files changed

+2266/−0 lines, 5 filesdep +HUnitdep +basedep +burrito

Dependencies added: HUnit, base, burrito, transformers

Files

LICENSE.markdown +15/−0
README.markdown +17/−0
burrito.cabal +59/−0
src/lib/Burrito.hs +944/−0
src/test/Main.hs +1231/−0

+ LICENSE.markdown view

@@ -0,0 +1,15 @@+ISC License (ISC)++Copyright 2020 Taylor Fausak++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM+LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR+PERFORMANCE OF THIS SOFTWARE.

+ README.markdown view

@@ -0,0 +1,17 @@+# Burrito++Burrito is a Haskell library for parsing and rendering URI templates.++According to [RFC 6570](https://tools.ietf.org/html/rfc6570): "A URI Template+is a compact sequence of characters for describing a range of Uniform Resource+Identifiers through variable expansion." Burrito implements URI templates+according to the specification in that RFC.++The term "uniform resource identifiers" (URI) is often used interchangeably+with other related terms like "internationalized resource identifier" (IRI),+"uniform resource locator" (URL), and "uniform resource name" (URN). Burrito+can be used for all of these. If you want to get technical, its input must be a+valid IRI and its output will be a valid URI or URN.++Although Burrito is primarily intended to be used with HTTP and HTTPS URIs, it+should work with other schemes as well.

+ burrito.cabal view

@@ -0,0 +1,59 @@+name: burrito+version: 1.0.0.0++synopsis: Parse and render URI templates.+description:+  Burrito is a Haskell library for parsing and rendering URI templates.+  .+  According to [RFC 6570](https://tools.ietf.org/html/rfc6570): "A URI Template+  is a compact sequence of characters for describing a range of Uniform+  Resource Identifiers through variable expansion." Burrito implements URI+  templates according to the specification in that RFC.+  .+  The term "uniform resource identifiers" (URI) is often used interchangeably+  with other related terms like "internationalized resource identifier" (IRI),+  "uniform resource locator" (URL), and "uniform resource name" (URN). Burrito+  can be used for all of these. If you want to get technical, its input must be+  a valid IRI and its output will be a valid URI or URN.+  .+  Although Burrito is primarily intended to be used with HTTP and HTTPS URIs,+  it should work with other schemes as well.++build-type: Simple+cabal-version: >= 1.8+category: Network+extra-source-files: README.markdown+license-file: LICENSE.markdown+license: ISC+maintainer: Taylor Fausak++library+  build-depends:+    base >= 4.12.0 && < 4.15+  exposed-modules: Burrito+  ghc-options:+    -Weverything+    -Wno-all-missed-specialisations+    -Wno-implicit-prelude+    -Wno-missing-exported-signatures+    -Wno-safe+  hs-source-dirs: src/lib++  if impl(ghc >= 8.8.1)+    ghc-options:+      -Wno-missing-deriving-strategies++  if impl(ghc >= 8.10.1)+    ghc-options:+      -Wno-missing-safe-haskell-mode+      -Wno-prepositive-qualified-module++test-suite test+  build-depends:+    base -any+    , burrito -any+    , HUnit >= 1.6.0 && < 1.7+    , transformers >= 0.5.6 && < 0.6+  hs-source-dirs: src/test+  main-is: Main.hs+  type: exitcode-stdio-1.0

+ src/lib/Burrito.hs view

@@ -0,0 +1,944 @@+-- | Burrito is a Haskell library for parsing and rendering URI templates.+--+-- According to [RFC 6570](https://tools.ietf.org/html/rfc6570): "A URI+-- Template is a compact sequence of characters for describing a range of+-- Uniform Resource Identifiers through variable expansion." Burrito implements+-- URI templates according to the specification in that RFC.+--+-- The term "uniform resource identifiers" (URI) is often used interchangeably+-- with other related terms like "internationalized resource identifier" (IRI),+-- "uniform resource locator" (URL), and "uniform resource name" (URN). Burrito+-- can be used for all of these. If you want to get technical, its input must+-- be a valid IRI and its output will be a valid URI or URN.+--+-- Although Burrito is primarily intended to be used with HTTP and HTTPS URIs,+-- it should work with other schemes as well.+--+-- If you're not already familiar with URI templates, I recommend reading the+-- overview of the RFC. It's short, to the point, and easy to understand.+--+-- Assuming you're familiar with URI templates, here's a simple example to show+-- you how Burrito works:+--+-- > import Burrito+-- > let Just template = parse "http://example.com/search{?query}"+-- > expand [ ( "query", stringValue "bikes" ) ] template+-- > "http://example.com/search?query=bikes"+--+-- In short, use 'parse' to parse templates and 'expand' to render them.+module Burrito+  ( parse+  , expand+  , Template+  , Value+  , stringValue+  , listValue+  , dictionaryValue+  )+where++import qualified Control.Applicative as Applicative+import qualified Control.Monad as Monad+import qualified Data.Bits as Bits+import qualified Data.Char as Char+import qualified Data.Functor.Identity as Identity+import qualified Data.List as List+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Maybe as Maybe+import qualified Data.Word as Word+import qualified Text.Printf as Printf+++-- | Attempts to parse a string as a URI template. If parsing fails, this will+-- return 'Nothing'. Otherwise it will return 'Just' the parsed template.+--+-- Parsing will usually succeed, but it can fail if the input string contains+-- characters that are not valid in IRIs (like @^@) or if the input string+-- contains an invalid template expression (like @{!}@). To include characters+-- that aren't valid in IRIs, percent encode them (like @%5E@).+parse :: String -> Maybe Template+parse string = case runParser parseTemplate string of+  Just (template, "") -> Just template+  _ -> Nothing+++-- | Expands a template using the given values. Unlike parsing, expansion+-- always succeeds. If no value is given for a variable, it will simply not+-- appear in the output.+expand :: [(String, Value)] -> Template -> String+expand values = Identity.runIdentity+  . expandTemplate (pure . flip lookup values . nameToString)+++-- | Represents a URI template. Use 'parse' to create a template and 'expand'+-- to render one.+newtype Template = Template+  { template_tokens :: [Token]+  } deriving (Eq, Show)+++-- | Represents a token in a template.+data Token+  = Token_Expression Expression+  | Token_Literal Literal+  deriving (Eq, Show)+++-- | Represents a literal in a token.+newtype Literal = Literal+  { literal_characters :: NonEmpty.NonEmpty Character+  } deriving (Eq, Show)+++-- | Represents a character in a literal. Although encoded characters are+-- allowed to have any value, typically they will not include most ASCII+-- printable characters. In other words @A@ is more likely than @%41@.+data Character+  = Character_Encoded Word.Word8+  | Character_Unencoded Char+  deriving (Eq, Show)+++-- | Represents an expression in a token.+data Expression = Expression+  { expression_operator :: Operator+  , expression_variables :: NonEmpty.NonEmpty Variable+  } deriving (Eq, Show)+++-- | Represents an operator in an expression.+data Operator+  = Operator_Ampersand+  | Operator_FullStop+  | Operator_None+  | Operator_NumberSign+  | Operator_PlusSign+  | Operator_QuestionMark+  | Operator_Semicolon+  | Operator_Solidus+  deriving (Eq, Show)+++-- | Represents a variable in an expression.+data Variable = Variable+  { variable_modifier :: Modifier+  , variable_name :: Name+  } deriving (Eq, Show)+++-- | Represents a modifier on a variable. The number associated with a prefix+-- modifier will be between 1 and 9999 inclusive.+data Modifier+  = Modifier_Asterisk+  | Modifier_Colon Int+  | Modifier_None+  deriving (Eq, Show)+++-- | Represents a variable name, which is required to be non-empty. Variable+-- names allow ASCII letters and numbers, underscores, percent encoded triples,+-- and periods. However the periods cannot appear at the beginning or end, and+-- there can't be more than one of them in a row.+newtype Name = Name+  { name_chars :: NonEmpty.NonEmpty Char+  } deriving (Eq, Show)+++-- | Represents a value that can be substituted into a template. Can be a+-- string, a list, or dictionary (which is called an associative array in the+-- RFC). Use 'stringValue', 'listValue', and 'dictionaryValue' to construct+-- values.+data Value+  = Value_Dictionary [(String, String)]+  | Value_List [String]+  | Value_String String+  deriving (Eq, Show)+++-- | Constructs a string 'Value'.+stringValue :: String -> Value+stringValue = Value_String+++-- | Constructs a list 'Value'.+listValue :: [String] -> Value+listValue = Value_List+++-- | Constructs a dictionary 'Value'.+dictionaryValue :: [(String, String)] -> Value+dictionaryValue = Value_Dictionary+++-- | Expands a template for output according to section 3 of the RFC, using the+-- given function to resolve variable values.+expandTemplate+  :: Applicative m => (Name -> m (Maybe Value)) -> Template -> m String+expandTemplate f = expandTokens f . template_tokens+++-- | Expands tokens for output according to section 3 of the RFC, using the+-- given function to resolve variable values.+expandTokens+  :: Applicative m => (Name -> m (Maybe Value)) -> [Token] -> m String+expandTokens f = fmap concat . traverse (expandToken f)+++-- | Expands a token for output according to section 3 of the RFC, using the+-- given function to resolve variable values.+expandToken :: Applicative m => (Name -> m (Maybe Value)) -> Token -> m String+expandToken f token = case token of+  Token_Literal literal -> pure $ expandLiteral literal+  Token_Expression expression -> expandExpression f expression+++-- | Expands a literal token for output according to section 3.1 of the RFC.+expandLiteral :: Literal -> String+expandLiteral = concatMap expandCharacter . literal_characters+++-- | Expands a single literal character for output. This is necessary to+-- normalize percent encodings and to encode characters that aren't allowed to+-- appear in URIs.+expandCharacter :: Character -> String+expandCharacter character = case character of+  Character_Encoded word8 -> percentEncodeWord8 word8+  Character_Unencoded char -> escapeChar Operator_PlusSign char+++-- | If necessary, escapes a character for output with the given operator.+-- Otherwise returns the character unchanged as a string.+escapeChar :: Operator -> Char -> String+escapeChar operator char =+  if isAllowed operator char then [char] else percentEncodeChar char+++-- | Returns true if the given character is allowed unescaped in the output for+-- the given operator.+isAllowed :: Operator -> Char -> Bool+isAllowed operator char = case operator of+  Operator_NumberSign -> isUnreserved char || isReserved char+  Operator_PlusSign -> isUnreserved char || isReserved char+  _ -> isUnreserved char+++-- | Percent encodes a character by UTF-8 encoding it and then percent encoding+-- the resulting octets.+percentEncodeChar :: Char -> String+percentEncodeChar = concatMap percentEncodeWord8 . encodeUtf8+++-- | Percent encodes an octet by converting it into uppercase hexadecimal+-- digits and prepending a percent sign. For example @12@ becomes @"%0C"@.+percentEncodeWord8 :: Word.Word8 -> String+percentEncodeWord8 = Printf.printf "%%%02X"+++-- | Expands an expression for output according to section 3.2 of the RFC,+-- using the given function to resolve variable values.+expandExpression+  :: Applicative m => (Name -> m (Maybe Value)) -> Expression -> m String+expandExpression f expression =+  let+    operator = expression_operator expression+    prefix = prefixFor operator+    separator = separatorFor operator+    finalize expansions =+      (if null expansions then "" else prefix)+        <> List.intercalate separator expansions+  in fmap finalize . expandVariables f operator $ expression_variables+    expression+++-- | Returns the prefix to use before an expression for the given operator.+prefixFor :: Operator -> String+prefixFor operator = case operator of+  Operator_Ampersand -> "&"+  Operator_FullStop -> "."+  Operator_None -> ""+  Operator_NumberSign -> "#"+  Operator_PlusSign -> ""+  Operator_QuestionMark -> "?"+  Operator_Semicolon -> ";"+  Operator_Solidus -> "/"+++-- | Returns the separator to use between values for the given operator.+separatorFor :: Operator -> String+separatorFor operator = case operator of+  Operator_Ampersand -> "&"+  Operator_FullStop -> "."+  Operator_None -> ","+  Operator_NumberSign -> ","+  Operator_PlusSign -> ","+  Operator_QuestionMark -> "&"+  Operator_Semicolon -> ";"+  Operator_Solidus -> "/"+++-- | Expands variables for output according to section 3.2 of the RFC, using+-- the given function to resolve variable values.+expandVariables+  :: Applicative m+  => (Name -> m (Maybe Value))+  -> Operator+  -> NonEmpty.NonEmpty Variable+  -> m [String]+expandVariables f operator =+  fmap Maybe.catMaybes . traverse (expandVariable f operator) . NonEmpty.toList+++-- | Expands a variable for output according to section 3.2.1 of the RFC, using+-- the given function to resolve variable values.+expandVariable+  :: Applicative m+  => (Name -> m (Maybe Value))+  -> Operator+  -> Variable+  -> m (Maybe String)+expandVariable f operator variable =+  let+    name = variable_name variable+    modifier = variable_modifier variable+  in expandMaybeValue operator name modifier <$> f name+++-- | If the given value is not nothing, expand it according to section 3.2.1 of+-- the RFC.+expandMaybeValue :: Operator -> Name -> Modifier -> Maybe Value -> Maybe String+expandMaybeValue operator name modifier maybeValue = do+  value <- maybeValue+  expandValue operator name modifier value+++-- | Expands a value for output according to section 3.2.1 of the RFC. If the+-- value is undefined according to section 2.3, this returns nothing.+expandValue :: Operator -> Name -> Modifier -> Value -> Maybe String+expandValue operator name modifier value = case value of+  Value_Dictionary dictionary ->+    expandDictionary operator name modifier <$> NonEmpty.nonEmpty dictionary+  Value_List list ->+    expandList operator name modifier <$> NonEmpty.nonEmpty list+  Value_String string -> Just $ expandString operator name modifier string+++-- | Expands a dictionary (associative array) value for output.+expandDictionary+  :: Operator+  -> Name+  -> Modifier+  -> NonEmpty.NonEmpty (String, String)+  -> String+expandDictionary = expandElements+  $ \operator _ modifier -> expandDictionaryElement operator modifier+++-- | Expands one element of a dictionary value for output.+expandDictionaryElement :: Operator -> Modifier -> (String, String) -> [String]+expandDictionaryElement operator modifier (name, value) =+  let escape = escapeString operator Modifier_None+  in+    case modifier of+      Modifier_Asterisk -> [escape name <> "=" <> escape value]+      _ -> [escape name, escape value]+++-- | Expands a list value for output.+expandList+  :: Operator -> Name -> Modifier -> NonEmpty.NonEmpty String -> String+expandList = expandElements $ \operator name modifier ->+  pure . expandListElement operator name modifier+++-- | Expands one element of a list value for output.+expandListElement :: Operator -> Name -> Modifier -> String -> String+expandListElement operator name modifier = case modifier of+  Modifier_Asterisk -> expandString operator name Modifier_None+  _ -> expandString Operator_None name Modifier_None+++-- | Expands a collection of elements for output. This is used for both+-- dictionaries and lists.+expandElements+  :: (Operator -> Name -> Modifier -> a -> [String])+  -> Operator+  -> Name+  -> Modifier+  -> NonEmpty.NonEmpty a+  -> String+expandElements f operator name modifier =+  let+    showPrefix = case modifier of+      Modifier_Asterisk -> False+      _ -> case operator of+        Operator_Ampersand -> True+        Operator_QuestionMark -> True+        Operator_Semicolon -> True+        _ -> False+    prefix = if showPrefix then nameToString name <> "=" else ""+    separator = case modifier of+      Modifier_Asterisk -> separatorFor operator+      _ -> ","+  in mappend prefix . List.intercalate separator . concatMap+    (f operator name modifier)+++-- | Expands a string value for output.+expandString :: Operator -> Name -> Modifier -> String -> String+expandString operator name modifier s =+  let+    prefix = case operator of+      Operator_Ampersand -> nameToString name <> "="+      Operator_QuestionMark -> nameToString name <> "="+      Operator_Semicolon -> nameToString name <> if null s then "" else "="+      _ -> ""+  in prefix <> escapeString operator modifier s+++-- | Escapes a string value for output. This handles encoding characters as+-- necessary for the given oeprator, as well as taking the prefix as necessary+-- for the given modifier.+escapeString :: Operator -> Modifier -> String -> String+escapeString operator modifier string =+  concatMap (escapeChar operator) $ case modifier of+    Modifier_Colon size -> take size string+    _ -> string+++-- | Converts a name into a regular string.+nameToString :: Name -> String+nameToString = NonEmpty.toList . name_chars+++-- | Encodes a character as a series of UTF-8 octets. The resulting list will+-- have between one and four elements.+encodeUtf8 :: Char -> [Word.Word8]+encodeUtf8 char =+  let+    oneByte x = [intToWord8 $ bitAnd 0x7f x]+    twoBytes x =+      [ bitOr 0xc0 . intToWord8 . bitAnd 0x3f $ bitShiftR 6 x+      , bitOr 0x80 . intToWord8 $ bitAnd 0x3f x+      ]+    threeBytes x =+      [ bitOr 0xe0 . intToWord8 . bitAnd 0x0f $ bitShiftR 12 x+      , bitOr 0x80 . intToWord8 . bitAnd 0x3f $ bitShiftR 6 x+      , bitOr 0x80 . intToWord8 $ bitAnd 0x3f x+      ]+    fourBytes x =+      [ bitOr 0xf0 . intToWord8 . bitAnd 0x07 $ bitShiftR 18 x+      , bitOr 0x80 . intToWord8 . bitAnd 0x3f $ bitShiftR 12 x+      , bitOr 0x80 . intToWord8 . bitAnd 0x3f $ bitShiftR 6 x+      , bitOr 0x80 . intToWord8 $ bitAnd 0x3f x+      ]+  in case Char.ord char of+    int+      | int <= 0x7f -> oneByte int+      | int <= 0x7ff -> twoBytes int+      | int <= 0xffff -> threeBytes int+      | otherwise -> fourBytes int+++-- | Computes the bitwise AND of the two parameters.+bitAnd :: Bits.Bits a => a -> a -> a+bitAnd = (Bits..&.)+++-- | Computes the bitwise OR of the two parameters.+bitOr :: Bits.Bits a => a -> a -> a+bitOr = (Bits..|.)+++-- | Shifts the given value to the right by the specified number of bits. If+-- the shift amount is negative, an exception will be thrown.+bitShiftR :: Bits.Bits a => Int -> a -> a+bitShiftR = flip Bits.shiftR+++-- | Converts a machine-sized signed integer into an eight-bit unsigned+-- integer. If the input is out of bounds, an exception will be thrown.+intToWord8 :: Int -> Word.Word8+intToWord8 x =+  let+    lo = word8ToInt (minBound :: Word.Word8)+    hi = word8ToInt (maxBound :: Word.Word8)+  in if x < lo+    then error $ "intToWord8: " <> show x <> " < " <> show lo+    else if x > hi+      then error $ "intToWord8: " <> show x <> " > " <> show hi+      else fromIntegral x+++-- | Converts an eight-bit unsigned integer into a machine-sized signed+-- integer. This conversion cannot fail.+word8ToInt :: Word.Word8 -> Int+word8ToInt = fromIntegral+++-- | A simple type to handle parsing.+newtype Parser a = Parser+  { runParser :: String -> Maybe (a, String)+  }+++instance Functor Parser where+  -- | Applies the given function to the result of a successful parse.+  fmap f p = Parser $ \s -> case runParser p s of+    Nothing -> Nothing+    Just (x, t) -> Just (f x, t)+++instance Applicative Parser where+  -- | Produces a parser that always succeeds by returning the given value.+  pure x = Parser $ \s -> Just (x, s)++  -- | Uses the first parser to get a function, then uses the second parser to+  -- get a value, then calls the function with the value.+  p <*> q = Parser $ \s -> case runParser p s of+    Nothing -> Nothing+    Just (f, t) -> case runParser q t of+      Nothing -> Nothing+      Just (x, u) -> Just (f x, u)+++instance Monad Parser where+  -- | Feeds the output of a successful parse into the given function. If+  -- parsing fails, doesn't call the function.+  p >>= f = Parser $ \s -> case runParser p s of+    Nothing -> Nothing+    Just (x, t) -> runParser (f x) t+++instance Applicative.Alternative Parser where+  -- | Fails without consuming any input.+  empty = Parser $ const Nothing++  -- | Returns the first parser if it succeeds. Otherwise returns the second+  -- parser.+  p <|> q = Parser $ \s -> case runParser p s of+    Nothing -> runParser q s+    Just (x, t) -> Just (x, t)+++-- | Parses any one character. This is used as the basis for all other parsers.+parseAny :: Parser Char+parseAny = Parser $ \string -> case string of+  "" -> Nothing+  first : rest -> Just (first, rest)+++-- | Runs the given parser between the other parsers. Useful for wrapping a+-- parser in quotes or parentheses.+parseBetween :: Parser before -> Parser after -> Parser a -> Parser a+parseBetween before after parser = before *> parser <* after+++-- | Parses the given character and returns it.+parseChar :: Char -> Parser Char+parseChar = parseIf . (==)+++-- | Parses the given character and throws it away. See 'parseChar'+parseChar_ :: Char -> Parser ()+parseChar_ = Monad.void . parseChar+++-- | Tries to parse the first thing. If that fails, tries to parse the second+-- thing.+parseEither :: Parser a -> Parser a -> Parser a+parseEither = (Applicative.<|>)+++-- | Parses one character if it passes the given predicate function.+parseIf :: (Char -> Bool) -> Parser Char+parseIf predicate = do+  char <- parseAny+  if predicate char then pure char else Applicative.empty+++-- | Runs the given parser at least once.+parseNonEmpty :: Parser a -> Parser (NonEmpty.NonEmpty a)+parseNonEmpty parser = nonEmpty <$> parser <*> Applicative.many parser+++-- | Runs the given parser separated by the other parser. Requires at least one+-- occurrence of the non-separator parser.+parseSepBy1 :: Parser separator -> Parser a -> Parser (NonEmpty.NonEmpty a)+parseSepBy1 separator parser =+  nonEmpty <$> parser <*> Applicative.many (separator *> parser)+++-- | Parses a @URI-Template@ as defined by section 2 of the RFC.+parseTemplate :: Parser Template+parseTemplate = Template <$> Applicative.many parseToken+++-- | Parses a token, which we define as part of a URI template.+parseToken :: Parser Token+parseToken = parseEither+  (Token_Literal <$> parseLiteral)+  (Token_Expression <$> parseExpression)+++-- | Parses a @literals@ value as defined by section 2.1 of the RFC.+parseLiteral :: Parser Literal+parseLiteral = Literal <$> parseNonEmpty parseCharacter+++-- | Parses a character in a literal.+parseCharacter :: Parser Character+parseCharacter = parseEither parseCharacterUnencoded parseCharacterEncoded+++-- | Parses an unencoded character in a literal.+parseCharacterUnencoded :: Parser Character+parseCharacterUnencoded = Character_Unencoded <$> parseIf isLiteral+++-- | Parses a percent-encoded character in a literal.+parseCharacterEncoded :: Parser Character+parseCharacterEncoded = do+  (hi, lo) <- parsePercentEncoded+  pure . Character_Encoded $ intToWord8+    (Char.digitToInt hi * 16 + Char.digitToInt lo)+++-- | Parses an @expression@ as defined by section 2.2 of the RFC.+parseExpression :: Parser Expression+parseExpression =+  parseBetween (parseChar_ '{') (parseChar_ '}')+    $ Expression+    <$> parseOperator+    <*> parseVariableList+++-- | Parses a @variable-list@ as defined by sections 2.3 of the RFC.+parseVariableList :: Parser (NonEmpty.NonEmpty Variable)+parseVariableList = parseSepBy1 (parseChar_ ',') parseVarspec+++-- | Parses a @varspec@ as defined by section 2.3 of the RFC.+parseVarspec :: Parser Variable+parseVarspec = do+  name <- parseVarname+  modifier <- parseModifier+  pure $ Variable { variable_name = name, variable_modifier = modifier }+++-- | Parses a @varname@ as defined by section 2.3 of the RFC.+parseVarname :: Parser Name+parseVarname = do+  first <- parseVarcharFirst+  rest <- Applicative.many parseVarcharRest+  pure . Name $ combine first rest+++-- | Parses the first character in a variable name, which excludes periods.+parseVarcharFirst :: Parser (NonEmpty.NonEmpty Char)+parseVarcharFirst = parseEither parseVarcharUnencoded parseVarcharEncoded+++-- | Parses an unencoded character in a variable name.+parseVarcharUnencoded :: Parser (NonEmpty.NonEmpty Char)+parseVarcharUnencoded = pure <$> parseIf isVarchar+++-- | Parses a percent-encoded character in a variable name.+parseVarcharEncoded :: Parser (NonEmpty.NonEmpty Char)+parseVarcharEncoded = do+  (hi, lo) <- parsePercentEncoded+  pure $ nonEmpty '%' [hi, lo]+++-- | Parses a non-first character in a variable name. This is like+-- 'parseVarcharFirst' except it allows periods.+parseVarcharRest :: Parser (NonEmpty.NonEmpty Char)+parseVarcharRest = parseEither+  (nonEmpty <$> parseChar '.' <*> fmap NonEmpty.toList parseVarcharFirst)+  parseVarcharFirst+++-- | Returns true if the given character is in the @varchar@ range defined by+-- section 2.3 of the RFC. Note that this does not include the @pct-encoded@+-- part of the grammar because that requires multiple characters to match.+isVarchar :: Char -> Bool+isVarchar x = case x of+  '_' -> True+  _ -> isAlpha x || Char.isDigit x+++-- | Adds a bunch of non-empty lists to the end of one non-empty list, while+-- keeping the non-emptiness around.+combine :: NonEmpty.NonEmpty a -> [NonEmpty.NonEmpty a] -> NonEmpty.NonEmpty a+combine xs =+  nonEmpty (NonEmpty.head xs)+    . mappend (NonEmpty.tail xs)+    . concatMap NonEmpty.toList+++-- | Constructs a non-empty list without using an operator.+nonEmpty :: a -> [a] -> NonEmpty.NonEmpty a+nonEmpty = (NonEmpty.:|)+++-- | Parses a @pct-encoded@ as defined by section 1.5 of the RFC. Returns both+-- hexadecimal digits as they appeared in the input without doing any case+-- normalization.+parsePercentEncoded :: Parser (Char, Char)+parsePercentEncoded = do+  parseChar_ '%'+  (,) <$> parseIf Char.isHexDigit <*> parseIf Char.isHexDigit+++-- | Parses an @operator@ as defined by section 2.2 of the RFC.+parseOperator :: Parser Operator+parseOperator =+  Maybe.fromMaybe Operator_None <$> Applicative.optional parseRequiredOperator+++-- | Parses a required, non-reserved operator as defined by section 2.2 of the+-- RFC. See 'parseOperator'.+parseRequiredOperator :: Parser Operator+parseRequiredOperator = do+  operator <- parseIf isOperator+  maybe Applicative.empty pure $ toOperator operator+++-- | Converts an operator character into its respective 'Operator' type.+-- Returns nothing for characters that are not valid operators.+toOperator :: Char -> Maybe Operator+toOperator x = case x of+  '+' -> Just Operator_PlusSign+  '#' -> Just Operator_NumberSign+  '.' -> Just Operator_FullStop+  '/' -> Just Operator_Solidus+  ';' -> Just Operator_Semicolon+  '?' -> Just Operator_QuestionMark+  '&' -> Just Operator_Ampersand+  _ -> Nothing+++-- | Returns true if the given character is in the @operator@ range defined by+-- section 2.2 of the RFC.+isOperator :: Char -> Bool+isOperator x = isOpLevel2 x || isOpLevel3 x || isOpReserve x+++-- | Returns true if the given character is in the @op-level2@ range defined by+-- section 2.2 of the RFC.+isOpLevel2 :: Char -> Bool+isOpLevel2 x = case x of+  '+' -> True+  '#' -> True+  _ -> False+++-- | Returns true if the given character is in the @op-level3@ range defined by+-- section 2.2 of the RFC.+isOpLevel3 :: Char -> Bool+isOpLevel3 x = case x of+  '.' -> True+  '/' -> True+  ';' -> True+  '?' -> True+  '&' -> True+  _ -> False+++-- | Returns true if the given character is in the @op-reserve@ range defined+-- by section 2.2 of the RFC.+isOpReserve :: Char -> Bool+isOpReserve x = case x of+  '=' -> True+  ',' -> True+  '!' -> True+  '@' -> True+  '|' -> True+  _ -> False+++-- | Parses a @modifier-level4@ as defined by section 2.4 of the RFC.+parseModifier :: Parser Modifier+parseModifier =+  fmap (Maybe.fromMaybe Modifier_None) . Applicative.optional $ parseEither+    parsePrefixModifier+    parseExplodeModifier+++-- | Parses a @prefix@ as defined by section 2.4.1 of the RFC.+parsePrefixModifier :: Parser Modifier+parsePrefixModifier = do+  parseChar_ ':'+  Modifier_Colon <$> parseMaxLength+++-- | Parses a @max-length@ as defined by section 2.4.1 of the RFC.+parseMaxLength :: Parser Int+parseMaxLength = do+  first <- parseNonZeroDigit+  rest <- parseUpTo 3 parseDigit+  pure . fromDigits $ nonEmpty first rest+++-- | Converts a list of digits into the number that they represent. For example+-- @[1, 2]@ becomes @12@.+fromDigits :: NonEmpty.NonEmpty Int -> Int+fromDigits = foldr1 ((+) . (10 *))+++-- | Parses up to the given number of occurrences of the given parser. If the+-- number is less than one, this will always succeed by returning the empty+-- list.+parseUpTo :: Int -> Parser a -> Parser [a]+parseUpTo = parseUpToWith []+++-- | Like 'parseUpTo' but with an explicit accumulator.+parseUpToWith :: [a] -> Int -> Parser a -> Parser [a]+parseUpToWith accumulator remaining parser = if remaining < 1+  then pure accumulator+  else do+    result <- Applicative.optional parser+    case result of+      Nothing -> pure accumulator+      Just value -> parseUpToWith (value : accumulator) (remaining - 1) parser+++-- | Parses a single non-zero decimal digit and returns that digit's value. See+-- 'isNonZeroDigit'.+parseNonZeroDigit :: Parser Int+parseNonZeroDigit = Char.digitToInt <$> parseIf isNonZeroDigit+++-- | Returns true if the given character is a non-zero decimal digit. This+-- range isn't explicitly named by the RFC, but it's given in section 2.4.1.+isNonZeroDigit :: Char -> Bool+isNonZeroDigit x = case x of+  '0' -> False+  _ -> Char.isDigit x+++-- | Parses a single decimal digit and returns that digit's value.+parseDigit :: Parser Int+parseDigit = Char.digitToInt <$> parseIf Char.isDigit+++-- | Returns true if the given character is in the @ALPHA@ range defined by+-- section 1.5 of the RFC.+isAlpha :: Char -> Bool+isAlpha x = Char.isAsciiUpper x || Char.isAsciiLower x+++-- | Parses an @explode@ as defined by section 2.4.2 of the RFC.+parseExplodeModifier :: Parser Modifier+parseExplodeModifier = Modifier_Asterisk <$ parseChar_ '*'+++-- | Returns true if the given character is in the @reserved@ range defined by+-- section 1.5 of the RFC.+isReserved :: Char -> Bool+isReserved x = isGenDelim x || isSubDelim x+++-- | Returns true if the given character is in the @gen-delims@ range defined+-- by section 1.5 of the RFC.+isGenDelim :: Char -> Bool+isGenDelim x = case x of+  ':' -> True+  '/' -> True+  '?' -> True+  '#' -> True+  '[' -> True+  ']' -> True+  '@' -> True+  _ -> False+++-- | Returns true if the given character is in the @sub-delims@ range defined+-- by section 1.5 of the RFC.+isSubDelim :: Char -> Bool+isSubDelim x = case x of+  '!' -> True+  '$' -> True+  '&' -> True+  '\'' -> True+  '(' -> True+  ')' -> True+  '*' -> True+  '+' -> True+  ',' -> True+  ';' -> True+  '=' -> True+  _ -> False+++-- | Returns true if the given character is in the @unreserved@ range defined+-- by section 1.5 of the RFC.+isUnreserved :: Char -> Bool+isUnreserved x = case x of+  '-' -> True+  '.' -> True+  '_' -> True+  '~' -> True+  _ -> isAlpha x || Char.isDigit x+++-- | Returns true if the given character is in the @literal@ range defined by+-- section 2.1 of the RFC.+isLiteral :: Char -> Bool+isLiteral x = case x of+  ' ' -> False+  '"' -> False+  '\'' -> False+  '%' -> False+  '<' -> False+  '>' -> False+  '\\' -> False+  '^' -> False+  '`' -> False+  '{' -> False+  '|' -> False+  '}' -> False+  _ -> between '\x20' '\x7e' x || isUcschar x || isIprivate x+++-- | Returns true if the given character is in the @ucschar@ range defined by+-- section 1.5 of the RFC.+isUcschar :: Char -> Bool+isUcschar x =+  between '\xa0' '\xd7ff' x+    || between '\xf900' '\xfdcf' x+    || between '\xfdf0' '\xffef' x+    || between '\x10000' '\x1fffd' x+    || between '\x20000' '\x2fffd' x+    || between '\x30000' '\x3fffd' x+    || between '\x40000' '\x4fffd' x+    || between '\x50000' '\x5fffd' x+    || between '\x60000' '\x6fffd' x+    || between '\x70000' '\x7fffd' x+    || between '\x80000' '\x8fffd' x+    || between '\x90000' '\x9fffd' x+    || between '\xa0000' '\xafffd' x+    || between '\xb0000' '\xbfffd' x+    || between '\xc0000' '\xcfffd' x+    || between '\xd0000' '\xdfffd' x+    || between '\xe1000' '\xefffd' x+++-- | Returns true if the given character is in the @iprivate@ range defined by+-- section 1.5 of the RFC.+isIprivate :: Char -> Bool+isIprivate x =+  between '\xe000' '\xf8ff' x+    || between '\xf0000' '\xffffd' x+    || between '\x100000' '\x10fffd' x+++-- | Returns true if the value is between the given inclusive bounds.+between+  :: Ord a+  => a -- ^ lower bound+  -> a -- ^ upper bound+  -> a+  -> Bool+between lo hi x = lo <= x && x <= hi

+ src/test/Main.hs view

@@ -0,0 +1,1231 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++module Main+  ( main+  )+where++import qualified Burrito+import qualified Control.Monad as Monad+import qualified Control.Monad.Trans.Writer as Writer+import qualified Data.Either as Either+import qualified Data.String as String+import qualified GHC.Exts as Exts+import qualified GHC.Stack as Stack+import qualified System.Exit as Exit+import qualified Test.HUnit as Test++main :: IO ()+main = runTests $ do++  label "accepts empty templates" $ do+    test "" [] ""++  label "ignores extra variables" $ do+    test "" ["extra" =: "ignored"] ""++  label "accepts ascii literals" $ do+    test "!" [] "!"+    test "#" [] "#"+    test "$" [] "$"+    test "&" [] "&"+    test "(" [] "("+    test ")" [] ")"+    test "*" [] "*"+    test "+" [] "+"+    test "," [] ","+    test "-" [] "-"+    test "." [] "."+    test "/" [] "/"+    test "0" [] "0"+    test "9" [] "9"+    test ":" [] ":"+    test ";" [] ";"+    test "=" [] "="+    test "?" [] "?"+    test "@" [] "@"+    test "A" [] "A"+    test "Z" [] "Z"+    test "[" [] "["+    test "]" [] "]"+    test "_" [] "_"+    test "a" [] "a"+    test "z" [] "z"+    test "~" [] "~"++  label "accepts unicode literals" $ do+    test "\xa0" [] "%C2%A0"+    test "\xd7ff" [] "%ED%9F%BF"+    test "\xf900" [] "%EF%A4%80"+    test "\xfdcf" [] "%EF%B7%8F"+    test "\xfdf0" [] "%EF%B7%B0"+    test "\xffef" [] "%EF%BF%AF"+    test "\x10000" [] "%F0%90%80%80"+    test "\x1fffd" [] "%F0%9F%BF%BD"+    test "\x20000" [] "%F0%A0%80%80"+    test "\x2fffd" [] "%F0%AF%BF%BD"+    test "\x30000" [] "%F0%B0%80%80"+    test "\x3fffd" [] "%F0%BF%BF%BD"+    test "\x40000" [] "%F1%80%80%80"+    test "\x4fffd" [] "%F1%8F%BF%BD"+    test "\x50000" [] "%F1%90%80%80"+    test "\x5fffd" [] "%F1%9F%BF%BD"+    test "\x60000" [] "%F1%A0%80%80"+    test "\x6fffd" [] "%F1%AF%BF%BD"+    test "\x70000" [] "%F1%B0%80%80"+    test "\x7fffd" [] "%F1%BF%BF%BD"+    test "\x80000" [] "%F2%80%80%80"+    test "\x8fffd" [] "%F2%8F%BF%BD"+    test "\x90000" [] "%F2%90%80%80"+    test "\x9fffd" [] "%F2%9F%BF%BD"+    test "\xa0000" [] "%F2%A0%80%80"+    test "\xafffd" [] "%F2%AF%BF%BD"+    test "\xb0000" [] "%F2%B0%80%80"+    test "\xbfffd" [] "%F2%BF%BF%BD"+    test "\xc0000" [] "%F3%80%80%80"+    test "\xcfffd" [] "%F3%8F%BF%BD"+    test "\xd0000" [] "%F3%90%80%80"+    test "\xdfffd" [] "%F3%9F%BF%BD"+    test "\xe1000" [] "%F3%A1%80%80"+    test "\xefffd" [] "%F3%AF%BF%BD"++  label "accepts private literals" $ do+    test "\xe000" [] "%EE%80%80"+    test "\xf8ff" [] "%EF%A3%BF"+    test "\xf0000" [] "%F3%B0%80%80"+    test "\xffffd" [] "%F3%BF%BF%BD"+    test "\x100000" [] "%F4%80%80%80"+    test "\x10fffd" [] "%F4%8F%BF%BD"++  label "passes percent encoded literals through" $ do+    test "%00" [] "%00"++  label "normalizes percent encodings to uppercase" $ do+    test "%AA" [] "%AA"+    test "%Aa" [] "%AA"+    test "%aA" [] "%AA"+    test "%aa" [] "%AA"++  label "rejects invalid percent encodings" $ do+    test "%" [] Failure+    test "%0" [] Failure+    test "%0z" [] Failure+    test "%z" [] Failure++  label "does not decode percent encoded literals" $ do+    test "%30" [] "%30"++  label "rejects invalid literals" $ do+    test " " [] Failure+    test "\"" [] Failure+    test "'" [] Failure+    test "%" [] Failure+    test "<" [] Failure+    test ">" [] Failure+    test "\\" [] Failure+    test "^" [] Failure+    test "`" [] Failure+    test "{" [] Failure+    test "|" [] Failure+    test "}" [] Failure++  label "rejects empty variable names" $ do+    test "{}" [] Failure+    test "{,}" [] Failure+    test "{a,,b}" [] Failure+    test "{+}" [] Failure+    test "{:1}" [] Failure+    test "{*}" [] Failure++  label "accepts uppercase variable names" $ do+    test "{AZ}" [] ""++  label "accepts lowercase variable names" $ do+    test "{az}" [] ""++  label "accepts decimal variable names" $ do+    test "{09}" [] ""++  label "accepts underscores in variable names" $ do+    test "{_a}" [] ""+    test "{a_}" [] ""+    test "{_}" [] ""++  label "accepts dots in variable names" $ do+    test "{A.A}" [] ""+    test "{a.a}" [] ""+    test "{0.0}" [] ""+    test "{_._}" [] ""+    test "{%aa.%aa}" [] ""++  label "rejects invalid dots in variable names" $ do+    test "{.}" [] Failure+    test "{a.}" [] Failure+    test "{+.a}" [] Failure+    test "{a..b}" [] Failure++  label "accepts percent encoded variable names" $ do+    test "{%00}" [] ""++  -- It's unclear if percent encoded triplets in variable names should be case+  -- sensitive or not. Section 2.3 says: "Variable names are case-sensitive+  -- because the name might be expanded within a case-sensitive URI component."+  -- But the HEXDIG rule in section 1.5 says: "; case-insensitive". I think+  -- it's safe to assume they are case sensitive because they can appear in an+  -- expansion. For example:+  --+  --    render "{;%aa}" [("%aa", "A")] ==> ";%aa=A"+  --+  -- However percent encoded triplets that only differ by case would be decoded+  -- into the same octet anyway.+  label "does not normalize percent encoded variable names" $ do+    test "{%AA}" ["%AA" =: "upper-upper"] "upper-upper"+    test "{%Aa}" ["%Aa" =: "upper-lower"] "upper-lower"+    test "{%aA}" ["%aA" =: "lower-upper"] "lower-upper"+    test "{%aa}" ["%aa" =: "lower-lower"] "lower-lower"++  label "rejects invalid percent encoded variable names" $ do+    test "{%}" [] Failure+    test "{%0}" [] Failure+    test "{%0z}" [] Failure+    test "{%z}" [] Failure++  label "rejects invalid variable names" $ do+    test "{!}" [] Failure++  label "rejects invalid expressions" $ do+    test "{" [] Failure+    test "{{}" [] Failure+    test "}" [] Failure+    test "{}}" [] Failure++  label "accepts multiple variables in one expression" $ do+    test "{a,b}" [] ""+    test "{a,b,c,d}" [] ""+    test "{a,a}" [] ""++  label "accepts prefix modifiers" $ do+    test "{a:5}" [] ""+    test "{a:67}" [] ""+    test "{a:801}" [] ""+    test "{a:234}" [] ""+    test "{a:9999}" [] ""++  label "applies prefix modifiers" $ do+    let values = ["a" =: "abcdefghijklmnopqrstuvwxyz"] :: Values+    test "{a:1}" values "a"+    test "{a:5}" values "abcde"+    test "{a:10}" values "abcdefghij"+    test "{a:15}" values "abcdefghijklmno"+    test "{a:20}" values "abcdefghijklmnopqrst"+    test "{a:25}" values "abcdefghijklmnopqrstuvwxy"+    test "{a:30}" values "abcdefghijklmnopqrstuvwxyz"++  label "rejects invalid prefix modifiers" $ do+    test "{a:}" [] Failure+    test "{a:0}" [] Failure+    test "{a:10000}" [] Failure+    test "{a:-1}" [] Failure++  label "accepts explode modifiers" $ do+    test "{a*}" [] ""++  label "rejects both prefix and explode modifiers" $ do+    test "{a:1*}" [] Failure+    test "{a*:1}" [] Failure++  label "accepts different modifiers on different variables" $ do+    test "{a,b:1,c*}" [] ""++  label "accepts allowed operators" $ do+    test "{+a}" [] ""+    test "{#a}" [] ""+    test "{.a}" [] ""+    test "{/a}" [] ""+    test "{;a}" [] ""+    test "{?a}" [] ""+    test "{&a}" [] ""++  label "rejects reserved operators" $ do+    test "{=a}" [] Failure+    test "{,a}" [] Failure+    test "{!a}" [] Failure+    test "{@a}" [] Failure+    test "{|a}" [] Failure++  label "rejects multiple operators" $ do+    test "{+#a}" [] Failure++  label "rejects different operators for different variables" $ do+    test "{+a,#b}" [] Failure++  label "accepts operators and modifiers" $ do+    test "{+a:1}" [] ""+    test "{#a*}" [] ""++  label "accepts multiple variables with an operator" $ do+    test "{+a,b}" [] ""+    test "{#a,b}" [] ""+    test "{.a,b}" [] ""+    test "{/a,b}" [] ""+    test "{;a,b}" [] ""+    test "{?a,b}" [] ""+    test "{&a,b}" [] ""++  label "accepts multiple expressions" $ do+    test "{a}{b}" [] ""+    test "{a}{b}{c}{d}" [] ""+    test "{a}{a}" [] ""++  label "rejects nested expressions" $ do+    test "{{}}" [] Failure+    test "{a{b}}" [] Failure+    test "{{a}b}" [] Failure+    test "{a{b}c}" [] Failure++  label "accepts literals and expressions together" $ do+    test "a{b}" [] "a"+    test "{a}b" [] "b"+    test "a{b}c" [] "ac"+    test "{a}b{c}" [] "b"++  label "handles missing values" $ do+    test "{a}" [] ""+    test "{+a}" [] ""+    test "{#a}" [] ""+    test "{.a}" [] ""+    test "{/a}" [] ""+    test "{;a}" [] ""+    test "{?a}" [] ""+    test "{&a}" [] ""++  label "handles empty list values" $ do+    let values = ["a" =: emptyList] :: Values+    test "{a}" values ""+    test "{+a}" values ""+    test "{#a}" values ""+    test "{.a}" values ""+    test "{/a}" values ""+    test "{;a}" values ""+    test "{?a}" values ""+    test "{&a}" values ""++  label "handles empty dictionary values" $ do+    let values = ["a" =: emptyDictionary] :: Values+    test "{a}" values ""+    test "{+a}" values ""+    test "{#a}" values ""+    test "{.a}" values ""+    test "{/a}" values ""+    test "{;a}" values ""+    test "{?a}" values ""+    test "{&a}" values ""++  label "handles empty string values" $ do+    let values = ["a" =: ""] :: Values+    test "{a}" values ""+    test "{+a}" values ""+    test "{#a}" values "#"+    test "{.a}" values "."+    test "{/a}" values "/"+    test "{;a}" values ";a"+    test "{?a}" values "?a="+    test "{&a}" values "&a="++  label "handles nonempty string values" $ do+    let values = ["a" =: "A"] :: Values+    test "{a}" values "A"+    test "{+a}" values "A"+    test "{#a}" values "#A"+    test "{.a}" values ".A"+    test "{/a}" values "/A"+    test "{;a}" values ";a=A"+    test "{?a}" values "?a=A"+    test "{&a}" values "&a=A"++  label "handles a mix of defined and undefined values" $ do+    let values = ["b" =: "B"] :: Values+    test "{a,b}" values "B"+    test "{+a,b}" values "B"+    test "{#a,b}" values "#B"+    test "{.a,b}" values ".B"+    test "{/a,b}" values "/B"+    test "{;a,b}" values ";b=B"+    test "{?a,b}" values "?b=B"+    test "{&a,b}" values "&b=B"++  label "handles multiple empty string values" $ do+    let values = ["a" =: ""] :: Values+    test "{a,a}" values ","+    test "{+a,a}" values ","+    test "{#a,a}" values "#,"+    test "{.a,a}" values ".."+    test "{/a,a}" values "//"+    test "{;a,a}" values ";a;a"+    test "{?a,a}" values "?a=&a="+    test "{&a,a}" values "&a=&a="++  label "handles multiple non-empty string values" $ do+    let values = ["a" =: "A", "b" =: "B"] :: Values+    test "{a,b}" values "A,B"+    test "{+a,b}" values "A,B"+    test "{#a,b}" values "#A,B"+    test "{.a,b}" values ".A.B"+    test "{/a,b}" values "/A/B"+    test "{;a,b}" values ";a=A;b=B"+    test "{?a,b}" values "?a=A&b=B"+    test "{&a,b}" values "&a=A&b=B"++  label "escapes characters in composite dictionaries" $ do+    let values = ["a" =: ["K! \xa0\xd7ff\x10000" =: "V! \xa0\xd7ff\x10000"]] :: Values+    test "{a*}" values "K%21%20%C2%A0%ED%9F%BF%F0%90%80%80=V%21%20%C2%A0%ED%9F%BF%F0%90%80%80"+    test "{+a*}" values "K!%20%C2%A0%ED%9F%BF%F0%90%80%80=V!%20%C2%A0%ED%9F%BF%F0%90%80%80"+    test "{#a*}" values "#K!%20%C2%A0%ED%9F%BF%F0%90%80%80=V!%20%C2%A0%ED%9F%BF%F0%90%80%80"+    test "{.a*}" values ".K%21%20%C2%A0%ED%9F%BF%F0%90%80%80=V%21%20%C2%A0%ED%9F%BF%F0%90%80%80"+    test "{/a*}" values "/K%21%20%C2%A0%ED%9F%BF%F0%90%80%80=V%21%20%C2%A0%ED%9F%BF%F0%90%80%80"+    test "{;a*}" values ";K%21%20%C2%A0%ED%9F%BF%F0%90%80%80=V%21%20%C2%A0%ED%9F%BF%F0%90%80%80"+    test "{?a*}" values "?K%21%20%C2%A0%ED%9F%BF%F0%90%80%80=V%21%20%C2%A0%ED%9F%BF%F0%90%80%80"+    test "{&a*}" values "&K%21%20%C2%A0%ED%9F%BF%F0%90%80%80=V%21%20%C2%A0%ED%9F%BF%F0%90%80%80"++  label "prefers the first variable" $ do+    test "{a}" ["a" =: "A", "a" =: "B"] "A"+    test "{a}" ["a" =: "B", "a" =: "A"] "B"++  label "passes test from rfc" $ do++    label "section 1.1" $ do+      test "http://example.com/~{username}/" ["username" =: "fred"] "http://example.com/~fred/"+      test "http://example.com/~{username}/" ["username" =: "mark"] "http://example.com/~mark/"+      test "http://example.com/dictionary/{term:1}/{term}" ["term" =: "cat"] "http://example.com/dictionary/c/cat"+      test "http://example.com/dictionary/{term:1}/{term}" ["term" =: "dog"] "http://example.com/dictionary/d/dog"+      test "http://example.com/search{?q,lang}" ["q" =: "cat", "lang" =: "en"] "http://example.com/search?q=cat&lang=en"+      test "http://example.com/search{?q,lang}" ["q" =: "chien", "lang" =: "fr"] "http://example.com/search?q=chien&lang=fr"+      test "http://www.example.com/foo{?query,number}" ["query" =: "mycelium", "number" =: "100"] "http://www.example.com/foo?query=mycelium&number=100"+      test "http://www.example.com/foo{?query,number}" ["number" =: "100"] "http://www.example.com/foo?number=100"+      test "http://www.example.com/foo{?query,number}" [] "http://www.example.com/foo"++    label "section 1.2" $ do+      let+        values =+          [ "empty" =: ""+          , "hello" =: "Hello World!"+          , "keys" =: ["semi" =: ";", "dot" =: ".", "comma" =: ","]+          , "list" =: ["red", "green", "blue"]+          , "path" =: "/foo/bar"+          , "var" =: "value"+          , "x" =: "1024"+          , "y" =: "768"+          ] :: Values++      label "level 1" $ do+        test "{var}" values "value"+        test "{hello}" values "Hello%20World%21"++      label "level 2" $ do+        test "{+var}" values "value"+        test "{+hello}" values "Hello%20World!"+        test "{+path}/here" values "/foo/bar/here"+        test "here?ref={+path}" values "here?ref=/foo/bar"+        test "X{#var}" values "X#value"+        test "X{#hello}" values "X#Hello%20World!"++      label "level 3" $ do+        test "map?{x,y}" values "map?1024,768"+        test "{x,hello,y}" values "1024,Hello%20World%21,768"+        test "{+x,hello,y}" values "1024,Hello%20World!,768"+        test "{+path,x}/here" values "/foo/bar,1024/here"+        test "{#x,hello,y}" values "#1024,Hello%20World!,768"+        test "{#path,x}/here" values "#/foo/bar,1024/here"+        test "X{.var}" values "X.value"+        test "X{.x,y}" values "X.1024.768"+        test "{/var}" values "/value"+        test "{/var,x}/here" values "/value/1024/here"+        test "{;x,y}" values ";x=1024;y=768"+        test "{;x,y,empty}" values ";x=1024;y=768;empty"+        test "{?x,y}" values "?x=1024&y=768"+        test "{?x,y,empty}" values "?x=1024&y=768&empty="+        test "?fixed=yes{&x}" values "?fixed=yes&x=1024"+        test "{&x,y,empty}" values "&x=1024&y=768&empty="++      label "level 4" $ do+        test "{var:3}" values "val"+        test "{var:30}" values "value"+        test "{list}" values "red,green,blue"+        test "{list*}" values "red,green,blue"+        test "{keys}" values "semi,%3B,dot,.,comma,%2C"+        test "{keys*}" values "semi=%3B,dot=.,comma=%2C"+        test "{+path:6}/here" values "/foo/b/here"+        test "{+list}" values "red,green,blue"+        test "{+list*}" values "red,green,blue"+        test "{+keys}" values "semi,;,dot,.,comma,,"+        test "{+keys*}" values "semi=;,dot=.,comma=,"+        test "{#path:6}/here" values "#/foo/b/here"+        test "{#list}" values "#red,green,blue"+        test "{#list*}" values "#red,green,blue"+        test "{#keys}" values "#semi,;,dot,.,comma,,"+        test "{#keys*}" values "#semi=;,dot=.,comma=,"+        test "X{.var:3}" values "X.val"+        test "X{.list}" values "X.red,green,blue"+        test "X{.list*}" values "X.red.green.blue"+        test "X{.keys}" values "X.semi,%3B,dot,.,comma,%2C"+        test "X{.keys*}" values "X.semi=%3B.dot=..comma=%2C"+        test "{/var:1,var}" values "/v/value"+        test "{/list}" values "/red,green,blue"+        test "{/list*}" values "/red/green/blue"+        test "{/list*,path:4}" values "/red/green/blue/%2Ffoo"+        test "{/keys}" values "/semi,%3B,dot,.,comma,%2C"+        test "{/keys*}" values "/semi=%3B/dot=./comma=%2C"+        test "{;hello:5}" values ";hello=Hello"+        test "{;list}" values ";list=red,green,blue"+        test "{;list*}" values ";list=red;list=green;list=blue"+        test "{;keys}" values ";keys=semi,%3B,dot,.,comma,%2C"+        test "{;keys*}" values ";semi=%3B;dot=.;comma=%2C"+        test "{?var:3}" values "?var=val"+        test "{?list}" values "?list=red,green,blue"+        test "{?list*}" values "?list=red&list=green&list=blue"+        test "{?keys}" values "?keys=semi,%3B,dot,.,comma,%2C"+        test "{?keys*}" values "?semi=%3B&dot=.&comma=%2C"+        test "{&var:3}" values "&var=val"+        test "{&list}" values "&list=red,green,blue"+        test "{&list*}" values "&list=red&list=green&list=blue"+        test "{&keys}" values "&keys=semi,%3B,dot,.,comma,%2C"+        test "{&keys*}" values "&semi=%3B&dot=.&comma=%2C"++    label "section 2.4.1" $ do+      let values = ["var" =: "value", "semi" =: ";"] :: Values+      test "{var}" values "value"+      test "{var:20}" values "value"+      test "{var:3}" values "val"+      test "{semi}" values "%3B"+      test "{semi:2}" values "%3B"++    label "section 2.4.2" $ do+      let values = ["year" =: ["1965", "2000", "2012"], "dom" =: ["example", "com"]] :: Values+      test "find{?year*}" values "find?year=1965&year=2000&year=2012"+      test "www{.dom*}" values "www.example.com"++    label "section 3.1" $ do+      let+        values =+          [ "base" =: "http://example.com/home/"+          , "count" =: ["one", "two", "three"]+          , "dom" =: ["example", "com"]+          , "dub" =: "me/too"+          , "empty_keys" =: emptyDictionary+          , "empty" =: ""+          , "half" =: "50%"+          , "hello" =: "Hello World!"+          , "keys" =: ["semi" =: ";", "dot" =: ".", "comma" =: ","]+          , "list" =: ["red", "green", "blue"]+          , "path" =: "/foo/bar"+          , "v" =: "6"+          , "var" =: "value"+          , "who" =: "fred"+          , "x" =: "1024"+          , "y" =: "768"+          ] :: Values++      label "subsection 1" $ do+        test "{count}" values "one,two,three"+        test "{count*}" values "one,two,three"+        test "{/count}" values "/one,two,three"+        test "{/count*}" values "/one/two/three"+        test "{;count}" values ";count=one,two,three"+        test "{;count*}" values ";count=one;count=two;count=three"+        test "{?count}" values "?count=one,two,three"+        test "{?count*}" values "?count=one&count=two&count=three"+        test "{&count*}" values "&count=one&count=two&count=three"++      label "subsection 2" $ do+        test "{var}" values "value"+        test "{hello}" values "Hello%20World%21"+        test "{half}" values "50%25"+        test "O{empty}X" values "OX"+        test "O{undef}X" values "OX"+        test "{x,y}" values "1024,768"+        test "{x,hello,y}" values "1024,Hello%20World%21,768"+        test "?{x,empty}" values "?1024,"+        test "?{x,undef}" values "?1024"+        test "?{undef,y}" values "?768"+        test "{var:3}" values "val"+        test "{var:30}" values "value"+        test "{list}" values "red,green,blue"+        test "{list*}" values "red,green,blue"+        test "{keys}" values "semi,%3B,dot,.,comma,%2C"+        test "{keys*}" values "semi=%3B,dot=.,comma=%2C"++      label "subsection 3" $ do+        test "{+var}" values "value"+        test "{+hello}" values "Hello%20World!"+        test "{+half}" values "50%25"+        test "{base}index" values "http%3A%2F%2Fexample.com%2Fhome%2Findex"+        test "{+base}index" values "http://example.com/home/index"+        test "O{+empty}X" values "OX"+        test "O{+undef}X" values "OX"+        test "{+path}/here" values "/foo/bar/here"+        test "here?ref={+path}" values "here?ref=/foo/bar"+        test "up{+path}{var}/here" values "up/foo/barvalue/here"+        test "{+x,hello,y}" values "1024,Hello%20World!,768"+        test "{+path,x}/here" values "/foo/bar,1024/here"+        test "{+path:6}/here" values "/foo/b/here"+        test "{+list}" values "red,green,blue"+        test "{+list*}" values "red,green,blue"+        test "{+keys}" values "semi,;,dot,.,comma,,"+        test "{+keys*}" values "semi=;,dot=.,comma=,"++      label "subsection 4" $ do+        test "{#var}" values "#value"+        test "{#hello}" values "#Hello%20World!"+        test "{#half}" values "#50%25"+        test "foo{#empty}" values "foo#"+        test "foo{#undef}" values "foo"+        test "{#x,hello,y}" values "#1024,Hello%20World!,768"+        test "{#path,x}/here" values "#/foo/bar,1024/here"+        test "{#path:6}/here" values "#/foo/b/here"+        test "{#list}" values "#red,green,blue"+        test "{#list*}" values "#red,green,blue"+        test "{#keys}" values "#semi,;,dot,.,comma,,"+        test "{#keys*}" values "#semi=;,dot=.,comma=,"++      label "subsection 5" $ do+        test "{.who}" values ".fred"+        test "{.who,who}" values ".fred.fred"+        test "{.half,who}" values ".50%25.fred"+        test "www{.dom*}" values "www.example.com"+        test "X{.var}" values "X.value"+        test "X{.empty}" values "X."+        test "X{.undef}" values "X"+        test "X{.var:3}" values "X.val"+        test "X{.list}" values "X.red,green,blue"+        test "X{.list*}" values "X.red.green.blue"+        test "X{.keys}" values "X.semi,%3B,dot,.,comma,%2C"+        test "X{.keys*}" values "X.semi=%3B.dot=..comma=%2C"+        test "X{.empty_keys}" values "X"+        test "X{.empty_keys*}" values "X"++      label "subsection 6" $ do+        test "{/who}" values "/fred"+        test "{/who,who}" values "/fred/fred"+        test "{/half,who}" values "/50%25/fred"+        test "{/who,dub}" values "/fred/me%2Ftoo"+        test "{/var}" values "/value"+        test "{/var,empty}" values "/value/"+        test "{/var,undef}" values "/value"+        test "{/var,x}/here" values "/value/1024/here"+        test "{/var:1,var}" values "/v/value"+        test "{/list}" values "/red,green,blue"+        test "{/list*}" values "/red/green/blue"+        test "{/list*,path:4}" values "/red/green/blue/%2Ffoo"+        test "{/keys}" values "/semi,%3B,dot,.,comma,%2C"+        test "{/keys*}" values "/semi=%3B/dot=./comma=%2C"++      label "subsection 7" $ do+        test "{;who}" values ";who=fred"+        test "{;half}" values ";half=50%25"+        test "{;empty}" values ";empty"+        test "{;v,empty,who}" values ";v=6;empty;who=fred"+        test "{;v,bar,who}" values ";v=6;who=fred"+        test "{;x,y}" values ";x=1024;y=768"+        test "{;x,y,empty}" values ";x=1024;y=768;empty"+        test "{;x,y,undef}" values ";x=1024;y=768"+        test "{;hello:5}" values ";hello=Hello"+        test "{;list}" values ";list=red,green,blue"+        test "{;list*}" values ";list=red;list=green;list=blue"+        test "{;keys}" values ";keys=semi,%3B,dot,.,comma,%2C"+        test "{;keys*}" values ";semi=%3B;dot=.;comma=%2C"++      label "subsection 8" $ do+        test "{?who}" values "?who=fred"+        test "{?half}" values "?half=50%25"+        test "{?x,y}" values "?x=1024&y=768"+        test "{?x,y,empty}" values "?x=1024&y=768&empty="+        test "{?x,y,undef}" values "?x=1024&y=768"+        test "{?var:3}" values "?var=val"+        test "{?list}" values "?list=red,green,blue"+        test "{?list*}" values "?list=red&list=green&list=blue"+        test "{?keys}" values "?keys=semi,%3B,dot,.,comma,%2C"+        test "{?keys*}" values "?semi=%3B&dot=.&comma=%2C"++      label "subsection 9" $ do+        test "{&who}" values "&who=fred"+        test "{&half}" values "&half=50%25"+        test "?fixed=yes{&x}" values "?fixed=yes&x=1024"+        test "{&x,y,empty}" values "&x=1024&y=768&empty="+        test "{&x,y,undef}" values "&x=1024&y=768"+        test "{&var:3}" values "&var=val"+        test "{&list}" values "&list=red,green,blue"+        test "{&list*}" values "&list=red&list=green&list=blue"+        test "{&keys}" values "&keys=semi,%3B,dot,.,comma,%2C"+        test "{&keys*}" values "&semi=%3B&dot=.&comma=%2C"++  label "handles simple expansion" $ do+    test "{a}" [] ""+    test "{a}" ["a" =: emptyList] ""+    test "{a}" ["a" =: emptyDictionary] ""+    test "{a}" ["a" =: ""] ""+    test "{a}" ["a" =: "A"] "A"+    test "{a}" ["a" =: "~"] "~"+    test "{a}" ["a" =: "%"] "%25"+    test "{a}" ["a" =: "?"] "%3F"+    test "{a}" ["a" =: "&"] "%26"+    test "{a}" ["a" =: "\xa0"] "%C2%A0"+    test "{a}" ["a" =: "\xd7ff"] "%ED%9F%BF"+    test "{a}" ["a" =: "\x10000"] "%F0%90%80%80"+    test "{a}" ["a" =: ["A"]] "A"+    test "{a}" ["a" =: ["A", "B"]] "A,B"+    test "{a}" ["a" =: ["%"]] "%25"+    test "{a}" ["a" =: ["\xa0"]] "%C2%A0"+    test "{a}" ["a" =: ["A" =: "1"]] "A,1"+    test "{a}" ["a" =: ["A" =: "1", "B" =: "2"]] "A,1,B,2"+    test "{a}" ["a" =: ["A" =: "%"]] "A,%25"+    test "{a}" ["a" =: ["A" =: "\xa0"]] "A,%C2%A0"+    test "{a}" ["a" =: ["%" =: "1"]] "%25,1"+    test "{a*}" [] ""+    test "{a*}" ["a" =: ""] ""+    test "{a*}" ["a" =: "A"] "A"+    test "{a*}" ["a" =: emptyList] ""+    test "{a*}" ["a" =: ["A"]] "A"+    test "{a*}" ["a" =: ["A", "B"]] "A,B"+    test "{a*}" ["a" =: emptyDictionary] ""+    test "{a*}" ["a" =: ["A" =: "1"]] "A=1"+    test "{a*}" ["a" =: ["A" =: "1", "B" =: "2"]] "A=1,B=2"+    test "{a:1}" [] ""+    test "{a:1}" ["a" =: ""] ""+    test "{a:1}" ["a" =: "A"] "A"+    test "{a:1}" ["a" =: "AB"] "A"+    test "{a:1}" ["a" =: "%B"] "%25"+    test "{a:1}" ["a" =: "\xa0\&B"] "%C2%A0"+    test "{a:1}" ["a" =: "\xd7ff\&B"] "%ED%9F%BF"+    test "{a:1}" ["a" =: "\x10000\&B"] "%F0%90%80%80"+    test "{a:1}" ["a" =: emptyList] ""+    test "{a:1}" ["a" =: ["AB"]] "AB"+    test "{a:1}" ["a" =: ["AB", "CD"]] "AB,CD"+    test "{a:1}" ["a" =: emptyDictionary] ""+    test "{a:1}" ["a" =: ["AB" =: "12"]] "AB,12"+    test "{a:1}" ["a" =: ["AB" =: "12", "CD" =: "34"]] "AB,12,CD,34"+    test "{a,a}" [] ""+    test "{a,a}" ["a" =: emptyList] ""+    test "{a,a}" ["a" =: emptyDictionary] ""+    test "{a,a}" ["a" =: ""] ","+    test "{a,b}" ["a" =: ""] ""+    test "{a,b}" ["b" =: ""] ""+    test "{%aa}" ["%aa" =: "A"] "A"+    test "{%aa}" ["%aa" =: ["A", "B"]] "A,B"+    test "{%aa}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "A,1,B,2"+    test "{%aa*}" ["%aa" =: "A"] "A"+    test "{%aa*}" ["%aa" =: ["A", "B"]] "A,B"+    test "{%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "A=1,B=2"++  label "handles reserved expansion" $ do+    test "{+a}" [] ""+    test "{+a}" ["a" =: emptyList] ""+    test "{+a}" ["a" =: emptyDictionary] ""+    test "{+a}" ["a" =: ""] ""+    test "{+a}" ["a" =: "A"] "A"+    test "{+a}" ["a" =: "~"] "~"+    test "{+a}" ["a" =: "%"] "%25"+    test "{+a}" ["a" =: "?"] "?"+    test "{+a}" ["a" =: "&"] "&"+    test "{+a}" ["a" =: "\xa0"] "%C2%A0"+    test "{+a}" ["a" =: "\xd7ff"] "%ED%9F%BF"+    test "{+a}" ["a" =: "\x10000"] "%F0%90%80%80"+    test "{+a}" ["a" =: ["A"]] "A"+    test "{+a}" ["a" =: ["A", "B"]] "A,B"+    test "{+a}" ["a" =: ["%"]] "%25"+    test "{+a}" ["a" =: ["\xa0"]] "%C2%A0"+    test "{+a}" ["a" =: ["A" =: "1"]] "A,1"+    test "{+a}" ["a" =: ["A" =: "1", "B" =: "2"]] "A,1,B,2"+    test "{+a}" ["a" =: ["A" =: "%"]] "A,%25"+    test "{+a}" ["a" =: ["A" =: "\xa0"]] "A,%C2%A0"+    test "{+a}" ["a" =: ["%" =: "1"]] "%25,1"+    test "{+a*}" [] ""+    test "{+a*}" ["a" =: ""] ""+    test "{+a*}" ["a" =: "A"] "A"+    test "{+a*}" ["a" =: emptyList] ""+    test "{+a*}" ["a" =: ["A"]] "A"+    test "{+a*}" ["a" =: ["A", "B"]] "A,B"+    test "{+a*}" ["a" =: emptyDictionary] ""+    test "{+a*}" ["a" =: ["A" =: "1"]] "A=1"+    test "{+a*}" ["a" =: ["A" =: "1", "B" =: "2"]] "A=1,B=2"+    test "{+a:1}" [] ""+    test "{+a:1}" ["a" =: ""] ""+    test "{+a:1}" ["a" =: "A"] "A"+    test "{+a:1}" ["a" =: "AB"] "A"+    test "{+a:1}" ["a" =: "%B"] "%25"+    test "{+a:1}" ["a" =: "\xa0\&B"] "%C2%A0"+    test "{+a:1}" ["a" =: "\xd7ff\&B"] "%ED%9F%BF"+    test "{+a:1}" ["a" =: "\x10000\&B"] "%F0%90%80%80"+    test "{+a:1}" ["a" =: emptyList] ""+    test "{+a:1}" ["a" =: ["AB"]] "AB"+    test "{+a:1}" ["a" =: ["AB", "CD"]] "AB,CD"+    test "{+a:1}" ["a" =: emptyDictionary] ""+    test "{+a:1}" ["a" =: ["AB" =: "12"]] "AB,12"+    test "{+a:1}" ["a" =: ["AB" =: "12", "CD" =: "34"]] "AB,12,CD,34"+    test "{+a,a}" [] ""+    test "{+a,a}" ["a" =: emptyList] ""+    test "{+a,a}" ["a" =: emptyDictionary] ""+    test "{+a,a}" ["a" =: ""] ","+    test "{+a,b}" ["a" =: ""] ""+    test "{+a,b}" ["b" =: ""] ""+    test "{+%aa}" ["%aa" =: "A"] "A"+    test "{+%aa}" ["%aa" =: ["A", "B"]] "A,B"+    test "{+%aa}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "A,1,B,2"+    test "{+%aa*}" ["%aa" =: "A"] "A"+    test "{+%aa*}" ["%aa" =: ["A", "B"]] "A,B"+    test "{+%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "A=1,B=2"++  label "handles fragment expansion" $ do+    test "{#a}" [] ""+    test "{#a}" ["a" =: emptyList] ""+    test "{#a}" ["a" =: emptyDictionary] ""+    test "{#a}" ["a" =: ""] "#"+    test "{#a}" ["a" =: "A"] "#A"+    test "{#a}" ["a" =: "~"] "#~"+    test "{#a}" ["a" =: "%"] "#%25"+    test "{#a}" ["a" =: "?"] "#?"+    test "{#a}" ["a" =: "&"] "#&"+    test "{#a}" ["a" =: "\xa0"] "#%C2%A0"+    test "{#a}" ["a" =: "\xd7ff"] "#%ED%9F%BF"+    test "{#a}" ["a" =: "\x10000"] "#%F0%90%80%80"+    test "{#a}" ["a" =: ["A"]] "#A"+    test "{#a}" ["a" =: ["A", "B"]] "#A,B"+    test "{#a}" ["a" =: ["%"]] "#%25"+    test "{#a}" ["a" =: ["\xa0"]] "#%C2%A0"+    test "{#a}" ["a" =: ["A" =: "1"]] "#A,1"+    test "{#a}" ["a" =: ["A" =: "1", "B" =: "2"]] "#A,1,B,2"+    test "{#a}" ["a" =: ["A" =: "%"]] "#A,%25"+    test "{#a}" ["a" =: ["A" =: "\xa0"]] "#A,%C2%A0"+    test "{#a}" ["a" =: ["%" =: "1"]] "#%25,1"+    test "{#a*}" [] ""+    test "{#a*}" ["a" =: ""] "#"+    test "{#a*}" ["a" =: "A"] "#A"+    test "{#a*}" ["a" =: emptyList] ""+    test "{#a*}" ["a" =: ["A"]] "#A"+    test "{#a*}" ["a" =: ["A", "B"]] "#A,B"+    test "{#a*}" ["a" =: emptyDictionary] ""+    test "{#a*}" ["a" =: ["A" =: "1"]] "#A=1"+    test "{#a*}" ["a" =: ["A" =: "1", "B" =: "2"]] "#A=1,B=2"+    test "{#a:1}" [] ""+    test "{#a:1}" ["a" =: ""] "#"+    test "{#a:1}" ["a" =: "A"] "#A"+    test "{#a:1}" ["a" =: "AB"] "#A"+    test "{#a:1}" ["a" =: "%B"] "#%25"+    test "{#a:1}" ["a" =: "\xa0\&B"] "#%C2%A0"+    test "{#a:1}" ["a" =: "\xd7ff\&B"] "#%ED%9F%BF"+    test "{#a:1}" ["a" =: "\x10000\&B"] "#%F0%90%80%80"+    test "{#a:1}" ["a" =: emptyList] ""+    test "{#a:1}" ["a" =: ["AB"]] "#AB"+    test "{#a:1}" ["a" =: ["AB", "CD"]] "#AB,CD"+    test "{#a:1}" ["a" =: emptyDictionary] ""+    test "{#a:1}" ["a" =: ["AB" =: "12"]] "#AB,12"+    test "{#a:1}" ["a" =: ["AB" =: "12", "CD" =: "34"]] "#AB,12,CD,34"+    test "{#a,a}" [] ""+    test "{#a,a}" ["a" =: emptyList] ""+    test "{#a,a}" ["a" =: emptyDictionary] ""+    test "{#a,a}" ["a" =: ""] "#,"+    test "{#a,b}" ["a" =: ""] "#"+    test "{#a,b}" ["b" =: ""] "#"+    test "{#%aa}" ["%aa" =: "A"] "#A"+    test "{#%aa}" ["%aa" =: ["A", "B"]] "#A,B"+    test "{#%aa}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "#A,1,B,2"+    test "{#%aa*}" ["%aa" =: "A"] "#A"+    test "{#%aa*}" ["%aa" =: ["A", "B"]] "#A,B"+    test "{#%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "#A=1,B=2"++  label "handles label expansion" $ do+    test "{.a}" [] ""+    test "{.a}" ["a" =: emptyList] ""+    test "{.a}" ["a" =: emptyDictionary] ""+    test "{.a}" ["a" =: ""] "."+    test "{.a}" ["a" =: "A"] ".A"+    test "{.a}" ["a" =: "~"] ".~"+    test "{.a}" ["a" =: "%"] ".%25"+    test "{.a}" ["a" =: "?"] ".%3F"+    test "{.a}" ["a" =: "&"] ".%26"+    test "{.a}" ["a" =: "\xa0"] ".%C2%A0"+    test "{.a}" ["a" =: "\xd7ff"] ".%ED%9F%BF"+    test "{.a}" ["a" =: "\x10000"] ".%F0%90%80%80"+    test "{.a}" ["a" =: ["A"]] ".A"+    test "{.a}" ["a" =: ["A", "B"]] ".A,B"+    test "{.a}" ["a" =: ["%"]] ".%25"+    test "{.a}" ["a" =: ["\xa0"]] ".%C2%A0"+    test "{.a}" ["a" =: ["A" =: "1"]] ".A,1"+    test "{.a}" ["a" =: ["A" =: "1", "B" =: "2"]] ".A,1,B,2"+    test "{.a}" ["a" =: ["A" =: "%"]] ".A,%25"+    test "{.a}" ["a" =: ["A" =: "\xa0"]] ".A,%C2%A0"+    test "{.a}" ["a" =: ["%" =: "1"]] ".%25,1"+    test "{.a*}" [] ""+    test "{.a*}" ["a" =: ""] "."+    test "{.a*}" ["a" =: "A"] ".A"+    test "{.a*}" ["a" =: emptyList] ""+    test "{.a*}" ["a" =: ["A"]] ".A"+    test "{.a*}" ["a" =: ["A", "B"]] ".A.B"+    test "{.a*}" ["a" =: emptyDictionary] ""+    test "{.a*}" ["a" =: ["A" =: "1"]] ".A=1"+    test "{.a*}" ["a" =: ["A" =: "1", "B" =: "2"]] ".A=1.B=2"+    test "{.a:1}" [] ""+    test "{.a:1}" ["a" =: ""] "."+    test "{.a:1}" ["a" =: "A"] ".A"+    test "{.a:1}" ["a" =: "AB"] ".A"+    test "{.a:1}" ["a" =: "%B"] ".%25"+    test "{.a:1}" ["a" =: "\xa0\&B"] ".%C2%A0"+    test "{.a:1}" ["a" =: "\xd7ff\&B"] ".%ED%9F%BF"+    test "{.a:1}" ["a" =: "\x10000\&B"] ".%F0%90%80%80"+    test "{.a:1}" ["a" =: emptyList] ""+    test "{.a:1}" ["a" =: ["AB"]] ".AB"+    test "{.a:1}" ["a" =: ["AB", "CD"]] ".AB,CD"+    test "{.a:1}" ["a" =: emptyDictionary] ""+    test "{.a:1}" ["a" =: ["AB" =: "12"]] ".AB,12"+    test "{.a:1}" ["a" =: ["AB" =: "12", "CD" =: "34"]] ".AB,12,CD,34"+    test "{.a,a}" [] ""+    test "{.a,a}" ["a" =: emptyList] ""+    test "{.a,a}" ["a" =: emptyDictionary] ""+    test "{.a,a}" ["a" =: ""] ".."+    test "{.a,b}" ["a" =: ""] "."+    test "{.a,b}" ["b" =: ""] "."+    test "{.%aa}" ["%aa" =: "A"] ".A"+    test "{.%aa}" ["%aa" =: ["A", "B"]] ".A,B"+    test "{.%aa}" ["%aa" =: ["A" =: "1", "B" =: "2"]] ".A,1,B,2"+    test "{.%aa*}" ["%aa" =: "A"] ".A"+    test "{.%aa*}" ["%aa" =: ["A", "B"]] ".A.B"+    test "{.%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] ".A=1.B=2"++  label "handles segment expansion" $ do+    test "{/a}" [] ""+    test "{/a}" ["a" =: emptyList] ""+    test "{/a}" ["a" =: emptyDictionary] ""+    test "{/a}" ["a" =: ""] "/"+    test "{/a}" ["a" =: "A"] "/A"+    test "{/a}" ["a" =: "~"] "/~"+    test "{/a}" ["a" =: "%"] "/%25"+    test "{/a}" ["a" =: "?"] "/%3F"+    test "{/a}" ["a" =: "&"] "/%26"+    test "{/a}" ["a" =: "\xa0"] "/%C2%A0"+    test "{/a}" ["a" =: "\xd7ff"] "/%ED%9F%BF"+    test "{/a}" ["a" =: "\x10000"] "/%F0%90%80%80"+    test "{/a}" ["a" =: ["A"]] "/A"+    test "{/a}" ["a" =: ["A", "B"]] "/A,B"+    test "{/a}" ["a" =: ["%"]] "/%25"+    test "{/a}" ["a" =: ["\xa0"]] "/%C2%A0"+    test "{/a}" ["a" =: ["A" =: "1"]] "/A,1"+    test "{/a}" ["a" =: ["A" =: "1", "B" =: "2"]] "/A,1,B,2"+    test "{/a}" ["a" =: ["A" =: "%"]] "/A,%25"+    test "{/a}" ["a" =: ["A" =: "\xa0"]] "/A,%C2%A0"+    test "{/a}" ["a" =: ["%" =: "1"]] "/%25,1"+    test "{/a*}" [] ""+    test "{/a*}" ["a" =: ""] "/"+    test "{/a*}" ["a" =: "A"] "/A"+    test "{/a*}" ["a" =: emptyList] ""+    test "{/a*}" ["a" =: ["A"]] "/A"+    test "{/a*}" ["a" =: ["A", "B"]] "/A/B"+    test "{/a*}" ["a" =: emptyDictionary] ""+    test "{/a*}" ["a" =: ["A" =: "1"]] "/A=1"+    test "{/a*}" ["a" =: ["A" =: "1", "B" =: "2"]] "/A=1/B=2"+    test "{/a:1}" [] ""+    test "{/a:1}" ["a" =: ""] "/"+    test "{/a:1}" ["a" =: "A"] "/A"+    test "{/a:1}" ["a" =: "AB"] "/A"+    test "{/a:1}" ["a" =: "%B"] "/%25"+    test "{/a:1}" ["a" =: "\xa0\&B"] "/%C2%A0"+    test "{/a:1}" ["a" =: "\xd7ff\&B"] "/%ED%9F%BF"+    test "{/a:1}" ["a" =: "\x10000\&B"] "/%F0%90%80%80"+    test "{/a:1}" ["a" =: emptyList] ""+    test "{/a:1}" ["a" =: ["AB"]] "/AB"+    test "{/a:1}" ["a" =: ["AB", "CD"]] "/AB,CD"+    test "{/a:1}" ["a" =: emptyDictionary] ""+    test "{/a:1}" ["a" =: ["AB" =: "12"]] "/AB,12"+    test "{/a:1}" ["a" =: ["AB" =: "12", "CD" =: "34"]] "/AB,12,CD,34"+    test "{/a,a}" [] ""+    test "{/a,a}" ["a" =: emptyList] ""+    test "{/a,a}" ["a" =: emptyDictionary] ""+    test "{/a,a}" ["a" =: ""] "//"+    test "{/a,b}" ["a" =: ""] "/"+    test "{/a,b}" ["b" =: ""] "/"+    test "{/%aa}" ["%aa" =: "A"] "/A"+    test "{/%aa}" ["%aa" =: ["A", "B"]] "/A,B"+    test "{/%aa}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "/A,1,B,2"+    test "{/%aa*}" ["%aa" =: "A"] "/A"+    test "{/%aa*}" ["%aa" =: ["A", "B"]] "/A/B"+    test "{/%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "/A=1/B=2"++  label "handles parameter expansion" $ do+    test "{;a}" [] ""+    test "{;a}" ["a" =: emptyList] ""+    test "{;a}" ["a" =: emptyDictionary] ""+    test "{;a}" ["a" =: ""] ";a"+    test "{;a}" ["a" =: "A"] ";a=A"+    test "{;a}" ["a" =: "~"] ";a=~"+    test "{;a}" ["a" =: "%"] ";a=%25"+    test "{;a}" ["a" =: "?"] ";a=%3F"+    test "{;a}" ["a" =: "&"] ";a=%26"+    test "{;a}" ["a" =: "\xa0"] ";a=%C2%A0"+    test "{;a}" ["a" =: "\xd7ff"] ";a=%ED%9F%BF"+    test "{;a}" ["a" =: "\x10000"] ";a=%F0%90%80%80"+    test "{;a}" ["a" =: ["A"]] ";a=A"+    test "{;a}" ["a" =: ["A", "B"]] ";a=A,B"+    test "{;a}" ["a" =: ["%"]] ";a=%25"+    test "{;a}" ["a" =: ["\xa0"]] ";a=%C2%A0"+    test "{;a}" ["a" =: ["A" =: "1"]] ";a=A,1"+    test "{;a}" ["a" =: ["A" =: "1", "B" =: "2"]] ";a=A,1,B,2"+    test "{;a}" ["a" =: ["A" =: "%"]] ";a=A,%25"+    test "{;a}" ["a" =: ["A" =: "\xa0"]] ";a=A,%C2%A0"+    test "{;a}" ["a" =: ["%" =: "1"]] ";a=%25,1"+    test "{;a*}" [] ""+    test "{;a*}" ["a" =: ""] ";a"+    test "{;a*}" ["a" =: "A"] ";a=A"+    test "{;a*}" ["a" =: emptyList] ""+    test "{;a*}" ["a" =: ["A"]] ";a=A"+    test "{;a*}" ["a" =: ["A", "B"]] ";a=A;a=B"+    test "{;a*}" ["a" =: emptyDictionary] ""+    test "{;a*}" ["a" =: ["A" =: "1"]] ";A=1"+    test "{;a*}" ["a" =: ["A" =: "1", "B" =: "2"]] ";A=1;B=2"+    test "{;a:1}" [] ""+    test "{;a:1}" ["a" =: ""] ";a"+    test "{;a:1}" ["a" =: "A"] ";a=A"+    test "{;a:1}" ["a" =: "AB"] ";a=A"+    test "{;a:1}" ["a" =: "%B"] ";a=%25"+    test "{;a:1}" ["a" =: "\xa0\&B"] ";a=%C2%A0"+    test "{;a:1}" ["a" =: "\xd7ff\&B"] ";a=%ED%9F%BF"+    test "{;a:1}" ["a" =: "\x10000\&B"] ";a=%F0%90%80%80"+    test "{;a:1}" ["a" =: emptyList] ""+    test "{;a:1}" ["a" =: ["AB"]] ";a=AB"+    test "{;a:1}" ["a" =: ["AB", "CD"]] ";a=AB,CD"+    test "{;a:1}" ["a" =: emptyDictionary] ""+    test "{;a:1}" ["a" =: ["AB" =: "12"]] ";a=AB,12"+    test "{;a:1}" ["a" =: ["AB" =: "12", "CD" =: "34"]] ";a=AB,12,CD,34"+    test "{;a,a}" [] ""+    test "{;a,a}" ["a" =: emptyList] ""+    test "{;a,a}" ["a" =: emptyDictionary] ""+    test "{;a,a}" ["a" =: ""] ";a;a"+    test "{;a,b}" ["a" =: ""] ";a"+    test "{;a,b}" ["b" =: ""] ";b"+    test "{;%aa}" ["%aa" =: "A"] ";%aa=A"+    test "{;%aa}" ["%aa" =: ["A", "B"]] ";%aa=A,B"+    test "{;%aa}" ["%aa" =: ["A" =: "1", "B" =: "2"]] ";%aa=A,1,B,2"+    test "{;%aa*}" ["%aa" =: "A"] ";%aa=A"+    test "{;%aa*}" ["%aa" =: ["A", "B"]] ";%aa=A;%aa=B"+    test "{;%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] ";A=1;B=2"++  label "handles query expansion" $ do+    test "{?a}" [] ""+    test "{?a}" ["a" =: emptyList] ""+    test "{?a}" ["a" =: emptyDictionary] ""+    test "{?a}" ["a" =: ""] "?a="+    test "{?a}" ["a" =: "A"] "?a=A"+    test "{?a}" ["a" =: "~"] "?a=~"+    test "{?a}" ["a" =: "%"] "?a=%25"+    test "{?a}" ["a" =: "?"] "?a=%3F"+    test "{?a}" ["a" =: "&"] "?a=%26"+    test "{?a}" ["a" =: "\xa0"] "?a=%C2%A0"+    test "{?a}" ["a" =: "\xd7ff"] "?a=%ED%9F%BF"+    test "{?a}" ["a" =: "\x10000"] "?a=%F0%90%80%80"+    test "{?a}" ["a" =: ["A"]] "?a=A"+    test "{?a}" ["a" =: ["A", "B"]] "?a=A,B"+    test "{?a}" ["a" =: ["%"]] "?a=%25"+    test "{?a}" ["a" =: ["\xa0"]] "?a=%C2%A0"+    test "{?a}" ["a" =: ["A" =: "1"]] "?a=A,1"+    test "{?a}" ["a" =: ["A" =: "1", "B" =: "2"]] "?a=A,1,B,2"+    test "{?a}" ["a" =: ["A" =: "%"]] "?a=A,%25"+    test "{?a}" ["a" =: ["A" =: "\xa0"]] "?a=A,%C2%A0"+    test "{?a}" ["a" =: ["%" =: "1"]] "?a=%25,1"+    test "{?a*}" [] ""+    test "{?a*}" ["a" =: ""] "?a="+    test "{?a*}" ["a" =: "A"] "?a=A"+    test "{?a*}" ["a" =: emptyList] ""+    test "{?a*}" ["a" =: ["A"]] "?a=A"+    test "{?a*}" ["a" =: ["A", "B"]] "?a=A&a=B"+    test "{?a*}" ["a" =: emptyDictionary] ""+    test "{?a*}" ["a" =: ["A" =: "1"]] "?A=1"+    test "{?a*}" ["a" =: ["A" =: "1", "B" =: "2"]] "?A=1&B=2"+    test "{?a:1}" [] ""+    test "{?a:1}" ["a" =: ""] "?a="+    test "{?a:1}" ["a" =: "A"] "?a=A"+    test "{?a:1}" ["a" =: "AB"] "?a=A"+    test "{?a:1}" ["a" =: "%B"] "?a=%25"+    test "{?a:1}" ["a" =: "\xa0\&B"] "?a=%C2%A0"+    test "{?a:1}" ["a" =: "\xd7ff\&B"] "?a=%ED%9F%BF"+    test "{?a:1}" ["a" =: "\x10000\&B"] "?a=%F0%90%80%80"+    test "{?a:1}" ["a" =: emptyList] ""+    test "{?a:1}" ["a" =: ["AB"]] "?a=AB"+    test "{?a:1}" ["a" =: ["AB", "CD"]] "?a=AB,CD"+    test "{?a:1}" ["a" =: emptyDictionary] ""+    test "{?a:1}" ["a" =: ["AB" =: "12"]] "?a=AB,12"+    test "{?a:1}" ["a" =: ["AB" =: "12", "CD" =: "34"]] "?a=AB,12,CD,34"+    test "{?a,a}" [] ""+    test "{?a,a}" ["a" =: emptyList] ""+    test "{?a,a}" ["a" =: emptyDictionary] ""+    test "{?a,a}" ["a" =: ""] "?a=&a="+    test "{?a,b}" ["a" =: ""] "?a="+    test "{?a,b}" ["b" =: ""] "?b="+    test "{?%aa}" ["%aa" =: "A"] "?%aa=A"+    test "{?%aa}" ["%aa" =: ["A", "B"]] "?%aa=A,B"+    test "{?%aa}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "?%aa=A,1,B,2"+    test "{?%aa*}" ["%aa" =: "A"] "?%aa=A"+    test "{?%aa*}" ["%aa" =: ["A", "B"]] "?%aa=A&%aa=B"+    test "{?%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "?A=1&B=2"++  label "handles continuation expansion" $ do+    test "{&a}" [] ""+    test "{&a}" ["a" =: emptyList] ""+    test "{&a}" ["a" =: emptyDictionary] ""+    test "{&a}" ["a" =: ""] "&a="+    test "{&a}" ["a" =: "A"] "&a=A"+    test "{&a}" ["a" =: "~"] "&a=~"+    test "{&a}" ["a" =: "%"] "&a=%25"+    test "{&a}" ["a" =: "?"] "&a=%3F"+    test "{&a}" ["a" =: "&"] "&a=%26"+    test "{&a}" ["a" =: "\xa0"] "&a=%C2%A0"+    test "{&a}" ["a" =: "\xd7ff"] "&a=%ED%9F%BF"+    test "{&a}" ["a" =: "\x10000"] "&a=%F0%90%80%80"+    test "{&a}" ["a" =: ["A"]] "&a=A"+    test "{&a}" ["a" =: ["A", "B"]] "&a=A,B"+    test "{&a}" ["a" =: ["%"]] "&a=%25"+    test "{&a}" ["a" =: ["\xa0"]] "&a=%C2%A0"+    test "{&a}" ["a" =: ["A" =: "1"]] "&a=A,1"+    test "{&a}" ["a" =: ["A" =: "1", "B" =: "2"]] "&a=A,1,B,2"+    test "{&a}" ["a" =: ["A" =: "%"]] "&a=A,%25"+    test "{&a}" ["a" =: ["A" =: "\xa0"]] "&a=A,%C2%A0"+    test "{&a}" ["a" =: ["%" =: "1"]] "&a=%25,1"+    test "{&a*}" [] ""+    test "{&a*}" ["a" =: ""] "&a="+    test "{&a*}" ["a" =: "A"] "&a=A"+    test "{&a*}" ["a" =: emptyList] ""+    test "{&a*}" ["a" =: ["A"]] "&a=A"+    test "{&a*}" ["a" =: ["A", "B"]] "&a=A&a=B"+    test "{&a*}" ["a" =: emptyDictionary] ""+    test "{&a*}" ["a" =: ["A" =: "1"]] "&A=1"+    test "{&a*}" ["a" =: ["A" =: "1", "B" =: "2"]] "&A=1&B=2"+    test "{&a:1}" [] ""+    test "{&a:1}" ["a" =: ""] "&a="+    test "{&a:1}" ["a" =: "A"] "&a=A"+    test "{&a:1}" ["a" =: "AB"] "&a=A"+    test "{&a:1}" ["a" =: "%B"] "&a=%25"+    test "{&a:1}" ["a" =: "\xa0\&B"] "&a=%C2%A0"+    test "{&a:1}" ["a" =: "\xd7ff\&B"] "&a=%ED%9F%BF"+    test "{&a:1}" ["a" =: "\x10000\&B"] "&a=%F0%90%80%80"+    test "{&a:1}" ["a" =: emptyList] ""+    test "{&a:1}" ["a" =: ["AB"]] "&a=AB"+    test "{&a:1}" ["a" =: ["AB", "CD"]] "&a=AB,CD"+    test "{&a:1}" ["a" =: emptyDictionary] ""+    test "{&a:1}" ["a" =: ["AB" =: "12"]] "&a=AB,12"+    test "{&a:1}" ["a" =: ["AB" =: "12", "CD" =: "34"]] "&a=AB,12,CD,34"+    test "{&a,a}" [] ""+    test "{&a,a}" ["a" =: emptyList] ""+    test "{&a,a}" ["a" =: emptyDictionary] ""+    test "{&a,a}" ["a" =: ""] "&a=&a="+    test "{&a,b}" ["a" =: ""] "&a="+    test "{&a,b}" ["b" =: ""] "&b="+    test "{&%aa}" ["%aa" =: "A"] "&%aa=A"+    test "{&%aa}" ["%aa" =: ["A", "B"]] "&%aa=A,B"+    test "{&%aa}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "&%aa=A,1,B,2"+    test "{&%aa*}" ["%aa" =: "A"] "&%aa=A"+    test "{&%aa*}" ["%aa" =: ["A", "B"]] "&%aa=A&%aa=B"+    test "{&%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "&A=1&B=2"++runTests :: Writer.WriterT Test IO a -> IO ()+runTests writer = do+  tests <- Writer.execWriterT writer+  counts <- Test.runTestTT $ unwrapTest tests+  let+    hasErrors = Test.errors counts /= 0+    hasFailures = Test.failures counts /= 0+  Monad.when (hasErrors || hasFailures) Exit.exitFailure++label+  :: Monad m+  => String+  -> Writer.WriterT Test m a+  -> Writer.WriterT Test m a+label string = Writer.censor $ \tests -> Test $ string Test.~: tests++test+  :: (Stack.HasCallStack, Monad m)+  => String+  -> Values+  -> Expected+  -> Writer.WriterT Test m ()+test input values output = do+  let expand = Burrito.expand $ fmap (fmap unwrapValue) values+  Writer.tell+    . Test+    $ input+    Test.~: fmap expand (Burrito.parse input)+    Test.~?= expectedToMaybe output++newtype Test = Test+  { unwrapTest :: Test.Test+  } deriving (Show)++instance Monoid Test where+  mempty = Test $ Test.TestList []++instance Semigroup Test where+  x <> y = Test . Test.TestList $ case (unwrapTest x, unwrapTest y) of+    (Test.TestList t, Test.TestList u) -> t <> u+    (Test.TestList t, u) -> t <> [u]+    (t, Test.TestList u) -> t : u+    (t, u) -> [t, u]++instance Test.Testable Test where+  test = unwrapTest++data Expected+  = Failure+  | Success String+  deriving (Eq, Show)++instance String.IsString Expected where+  fromString = Success++expectedToMaybe :: Expected -> Maybe String+expectedToMaybe expected = case expected of+  Failure -> Nothing+  Success string -> Just string++type Values = [(String, Value)]++newtype Value = Value+  { unwrapValue :: Burrito.Value+  } deriving (Eq, Show)++instance Exts.IsList Value where+  type Item Value = Item+  fromList items =+    Value $ case Either.partitionEithers $ fmap unwrapItem items of+      (strings, []) -> Burrito.listValue strings+      ([], tuples) -> Burrito.dictionaryValue tuples+      (_, _) -> error $ "fromList " <> show items <> " :: Value"+  toList value = error $ "toList " <> show value++instance String.IsString Value where+  fromString = Value . Burrito.stringValue++emptyList :: Value+emptyList = Value $ Burrito.listValue []++emptyDictionary :: Value+emptyDictionary = Value $ Burrito.dictionaryValue []++newtype Item = Item+  { unwrapItem :: Either String (String, String)+  } deriving (Eq, Show)++instance String.IsString Item where+  fromString = Item . Left++class Pair a where+  type K a+  type V a+  (=:) :: K a -> V a -> a++instance Pair (a, b) where+  type K (a, b) = a+  type V (a, b) = b+  (=:) = (,)++instance Pair Item where+  type K Item = String+  type V Item = String+  key =: value = Item $ Right (key, value)