burrito 1.0.1.0 → 1.0.2.0

raw patch · 20 files changed

+687/−312 lines, 20 filesdep +QuickCheckdep +hspecdep −HUnitdep −transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, hspec

Dependencies removed: HUnit, transformers

API changes (from Hackage documentation)

Files

• burrito.cabal +15/−13
• src/lib/Burrito.hs +2/−0
• src/lib/Burrito/Expand.hs +78/−26
• src/lib/Burrito/Parse.hs +40/−109
• src/lib/Burrito/Render.hs +121/−0
• src/lib/Burrito/TH.hs +4/−1
• src/lib/Burrito/Type/Character.hs +0/−17
• src/lib/Burrito/Type/Expression.hs +4/−1
• src/lib/Burrito/Type/LitChar.hs +93/−0
• src/lib/Burrito/Type/Literal.hs +6/−3
• src/lib/Burrito/Type/Modifier.hs +21/−3
• src/lib/Burrito/Type/Name.hs +13/−4
• src/lib/Burrito/Type/NonEmpty.hs +4/−1
• src/lib/Burrito/Type/Operator.hs +4/−1
• src/lib/Burrito/Type/Template.hs +4/−1
• src/lib/Burrito/Type/Token.hs +4/−1
• src/lib/Burrito/Type/Value.hs +4/−1
• src/lib/Burrito/Type/VarChar.hs +58/−0
• src/lib/Burrito/Type/Variable.hs +4/−1
• src/test/Main.hs +208/−129

@@ -1,5 +1,5 @@ name: burrito-version: 1.0.1.0+version: 1.0.2.0  synopsis: Parse and render URI templates. description:@@ -36,20 +36,14 @@     base >= 4.12.0 && < 4.15     , template-haskell >= 2.14.0 && < 2.17   default-language: Haskell98-  exposed-modules: Burrito-  ghc-options:-    -Weverything-    -Wno-all-missed-specialisations-    -Wno-implicit-prelude-    -Wno-missing-exported-signatures-    -Wno-safe-  hs-source-dirs: src/lib-  other-modules:+  exposed-modules:+    Burrito     Burrito.Expand     Burrito.Parse+    Burrito.Render     Burrito.TH-    Burrito.Type.Character     Burrito.Type.Expression+    Burrito.Type.LitChar     Burrito.Type.Literal     Burrito.Type.Modifier     Burrito.Type.Name@@ -58,7 +52,15 @@     Burrito.Type.Template     Burrito.Type.Token     Burrito.Type.Value+    Burrito.Type.VarChar     Burrito.Type.Variable+  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)     ghc-options:@@ -73,8 +75,8 @@   build-depends:     base -any     , burrito -any-    , HUnit >= 1.6.0 && < 1.7-    , transformers >= 0.5.6 && < 0.6+    , hspec >= 2.7.1 && < 2.8+    , QuickCheck >= 2.13.2 && < 2.14   default-language: Haskell98   hs-source-dirs: src/test   main-is: Main.hs

@@ -28,6 +28,7 @@ -- In short, use @parse@ to parse templates and @expand@ to render them. module Burrito   ( Parse.parse+  , Render.render   , Expand.expand   , TH.uriTemplate   , Template.Template@@ -40,6 +41,7 @@  import qualified Burrito.Expand as Expand import qualified Burrito.Parse as Parse+import qualified Burrito.Render as Render import qualified Burrito.TH as TH import qualified Burrito.Type.Template as Template import qualified Burrito.Type.Value as Value

@@ -1,9 +1,12 @@+-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Expand   ( expand-  ) where+  )+where -import qualified Burrito.Type.Character as Character import qualified Burrito.Type.Expression as Expression+import qualified Burrito.Type.LitChar as LitChar import qualified Burrito.Type.Literal as Literal import qualified Burrito.Type.Modifier as Modifier import qualified Burrito.Type.Name as Name@@ -12,6 +15,7 @@ import qualified Burrito.Type.Template as Template import qualified Burrito.Type.Token as Token import qualified Burrito.Type.Value as Value+import qualified Burrito.Type.VarChar as VarChar import qualified Burrito.Type.Variable as Variable import qualified Data.Bits as Bits import qualified Data.Char as Char@@ -27,26 +31,36 @@ -- appear in the output. expand :: [(String, Value.Value)] -> Template.Template -> String expand values = Identity.runIdentity-  . expandTemplate (pure . flip lookup values . nameToString)+  . expandTemplate (pure . flip lookup values . expandName)   -- | Expands a template for output according to section 3 of the RFC, using the -- given function to resolve variable values. expandTemplate-  :: Applicative m => (Name.Name -> m (Maybe Value.Value)) -> Template.Template -> m String+  :: Applicative m+  => (Name.Name -> m (Maybe Value.Value))+  -> Template.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.Name -> m (Maybe Value.Value)) -> [Token.Token] -> m String+  :: Applicative m+  => (Name.Name -> m (Maybe Value.Value))+  -> [Token.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.Name -> m (Maybe Value.Value)) -> Token.Token -> m String+expandToken+  :: Applicative m+  => (Name.Name -> m (Maybe Value.Value))+  -> Token.Token+  -> m String expandToken f token = case token of   Token.Literal literal -> pure $ expandLiteral literal   Token.Expression expression -> expandExpression f expression@@ -54,16 +68,17 @@  -- | Expands a literal token for output according to section 3.1 of the RFC. expandLiteral :: Literal.Literal -> String-expandLiteral = concatMap expandCharacter . NonEmpty.toList . Literal.characters+expandLiteral =+  concatMap expandCharacter . NonEmpty.toList . 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.Character -> String+expandCharacter :: LitChar.LitChar -> String expandCharacter character = case character of-  Character.Encoded word8 -> percentEncodeWord8 word8-  Character.Unencoded char -> escapeChar Operator.PlusSign char+  LitChar.Encoded word8 -> percentEncodeWord8 word8+  LitChar.Unencoded char -> escapeChar Operator.PlusSign char   -- | If necessary, escapes a character for output with the given operator.@@ -97,7 +112,10 @@ -- | 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.Name -> m (Maybe Value.Value)) -> Expression.Expression -> m String+  :: Applicative m+  => (Name.Name -> m (Maybe Value.Value))+  -> Expression.Expression+  -> m String expandExpression f expression =   let     operator = Expression.operator expression@@ -165,7 +183,12 @@  -- | If the given value is not nothing, expand it according to section 3.2.1 of -- the RFC.-expandMaybeValue :: Operator.Operator -> Name.Name -> Modifier.Modifier -> Maybe Value.Value -> Maybe String+expandMaybeValue+  :: Operator.Operator+  -> Name.Name+  -> Modifier.Modifier+  -> Maybe Value.Value+  -> Maybe String expandMaybeValue operator name modifier maybeValue = do   value <- maybeValue   expandValue operator name modifier value@@ -173,7 +196,12 @@  -- | 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.Operator -> Name.Name -> Modifier.Modifier -> Value.Value -> Maybe String+expandValue+  :: Operator.Operator+  -> Name.Name+  -> Modifier.Modifier+  -> Value.Value+  -> Maybe String expandValue operator name modifier value = case value of   Value.Dictionary dictionary ->     expandDictionary operator name modifier <$> NonEmpty.fromList dictionary@@ -194,7 +222,8 @@   -- | Expands one element of a dictionary value for output.-expandDictionaryElement :: Operator.Operator -> Modifier.Modifier -> (String, String) -> [String]+expandDictionaryElement+  :: Operator.Operator -> Modifier.Modifier -> (String, String) -> [String] expandDictionaryElement operator modifier (name, value) =   let escape = escapeString operator Modifier.None   in@@ -205,13 +234,18 @@  -- | Expands a list value for output. expandList-  :: Operator.Operator -> Name.Name -> Modifier.Modifier -> NonEmpty.NonEmpty String -> String+  :: Operator.Operator+  -> Name.Name+  -> Modifier.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.Operator -> Name.Name -> Modifier.Modifier -> String -> String+expandListElement+  :: Operator.Operator -> Name.Name -> Modifier.Modifier -> String -> String expandListElement operator name modifier = case modifier of   Modifier.Asterisk -> expandString operator name Modifier.None   _ -> expandString Operator.None name Modifier.None@@ -235,22 +269,26 @@         Operator.QuestionMark -> True         Operator.Semicolon -> True         _ -> False-    prefix = if showPrefix then nameToString name <> "=" else ""+    prefix = if showPrefix then expandName name <> "=" else ""     separator = case modifier of       Modifier.Asterisk -> separatorFor operator       _ -> ","-  in mappend prefix . List.intercalate separator . concatMap-    (f operator name modifier) . NonEmpty.toList+  in+    mappend prefix+    . List.intercalate separator+    . concatMap (f operator name modifier)+    . NonEmpty.toList   -- | Expands a string value for output.-expandString :: Operator.Operator -> Name.Name -> Modifier.Modifier -> String -> String+expandString+  :: Operator.Operator -> Name.Name -> Modifier.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 "="+      Operator.Ampersand -> expandName name <> "="+      Operator.QuestionMark -> expandName name <> "="+      Operator.Semicolon -> expandName name <> if null s then "" else "="       _ -> ""   in prefix <> escapeString operator modifier s @@ -265,9 +303,23 @@     _ -> string  --- | Converts a name into a regular string.-nameToString :: Name.Name -> String-nameToString = NonEmpty.toList . Name.chars+-- | Expands a variable name for output.+expandName :: Name.Name -> String+expandName name = mconcat+  [ expandVarChar $ Name.first name+  , concatMap+      (\(fullStop, varChar) ->+        (if fullStop then "." else "") <> expandVarChar varChar+      )+    $ Name.rest name+  ]+++-- | Expands a single logical character of a variable name for output.+expandVarChar :: VarChar.VarChar -> String+expandVarChar varChar = case varChar of+  VarChar.Encoded hi lo -> ['%', hi, lo]+  VarChar.Unencoded char -> [char]   -- | Encodes a character as a series of UTF-8 octets. The resulting list will

@@ -1,9 +1,12 @@+-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Parse   ( parse-  ) where+  )+where -import qualified Burrito.Type.Character as Character import qualified Burrito.Type.Expression as Expression+import qualified Burrito.Type.LitChar as LitChar import qualified Burrito.Type.Literal as Literal import qualified Burrito.Type.Modifier as Modifier import qualified Burrito.Type.Name as Name@@ -11,6 +14,7 @@ import qualified Burrito.Type.Operator as Operator import qualified Burrito.Type.Template as Template import qualified Burrito.Type.Token as Token+import qualified Burrito.Type.VarChar as VarChar import qualified Burrito.Type.Variable as Variable import qualified Control.Applicative as Applicative import qualified Control.Monad as Monad@@ -163,20 +167,22 @@   -- | Parses a character in a literal.-parseCharacter :: Parser Character.Character+parseCharacter :: Parser LitChar.LitChar parseCharacter = parseEither parseCharacterUnencoded parseCharacterEncoded   -- | Parses an unencoded character in a literal.-parseCharacterUnencoded :: Parser Character.Character-parseCharacterUnencoded = Character.Unencoded <$> parseIf isLiteral+parseCharacterUnencoded :: Parser LitChar.LitChar+parseCharacterUnencoded = do+  char <- parseIf LitChar.isLiteral+  maybe Applicative.empty pure $ LitChar.makeUnencoded char   -- | Parses a percent-encoded character in a literal.-parseCharacterEncoded :: Parser Character.Character+parseCharacterEncoded :: Parser LitChar.LitChar parseCharacterEncoded = do   (hi, lo) <- parsePercentEncoded-  pure . Character.Encoded $ intToWord8+  pure . LitChar.Encoded $ intToWord8     (Char.digitToInt hi * 16 + Char.digitToInt lo)  @@ -199,7 +205,10 @@ parseVarspec = do   name <- parseVarname   modifier <- parseModifier-  pure $ Variable.Variable { Variable.name = name, Variable.modifier = modifier }+  pure $ Variable.Variable+    { Variable.name = name+    , Variable.modifier = modifier+    }   -- | Parses a @varname@ as defined by section 2.3 of the RFC.@@ -207,50 +216,35 @@ parseVarname = do   first <- parseVarcharFirst   rest <- Applicative.many parseVarcharRest-  pure . Name.Name $ combine first rest+  pure Name.Name { Name.first = first, Name.rest = rest }   -- | Parses the first character in a variable name, which excludes periods.-parseVarcharFirst :: Parser (NonEmpty.NonEmpty Char)+parseVarcharFirst :: Parser VarChar.VarChar parseVarcharFirst = parseEither parseVarcharUnencoded parseVarcharEncoded   -- | Parses an unencoded character in a variable name.-parseVarcharUnencoded :: Parser (NonEmpty.NonEmpty Char)-parseVarcharUnencoded = NonEmpty.singleton <$> parseIf isVarchar+parseVarcharUnencoded :: Parser VarChar.VarChar+parseVarcharUnencoded = do+  char <- parseIf VarChar.isVarchar+  maybe Applicative.empty pure $ VarChar.makeUnencoded char   -- | Parses a percent-encoded character in a variable name.-parseVarcharEncoded :: Parser (NonEmpty.NonEmpty Char)+parseVarcharEncoded :: Parser VarChar.VarChar parseVarcharEncoded = do   (hi, lo) <- parsePercentEncoded-  pure $ nonEmpty '%' [hi, lo]+  maybe Applicative.empty pure $ VarChar.makeEncoded 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.first xs)-    . mappend (NonEmpty.rest xs)-    . concatMap NonEmpty.toList+parseVarcharRest :: Parser (Bool, VarChar.VarChar)+parseVarcharRest =+  (,)+    <$> parseEither (True <$ parseChar_ '.') (pure False)+    <*> parseVarcharFirst   -- | Constructs a non-empty list without using an operator.@@ -346,7 +340,8 @@ parsePrefixModifier :: Parser Modifier.Modifier parsePrefixModifier = do   parseChar_ ':'-  Modifier.Colon <$> parseMaxLength+  maxLength <- parseMaxLength+  maybe Applicative.empty pure $ Modifier.makeColon maxLength   -- | Parses a @max-length@ as defined by section 2.4.1 of the RFC.@@ -354,18 +349,21 @@ parseMaxLength = do   first <- parseNonZeroDigit   rest <- parseUpTo 3 parseDigit-  pure . fromDigits $ nonEmpty first rest+  pure . fromDigits $ rest <> [first]  --- | 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 *)) . NonEmpty.toList+-- | Converts a backwards list of digits into the number that they represent.+-- For example @[2, 1]@ becomes @12@.+fromDigits :: [Int] -> Int+fromDigits = foldr (\digit -> (+ digit) . (* 10)) 0   -- | 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.+--+-- Note that for performance reasons this returns the list in reverse order. If+-- you need it in the order it was present in the input, use @reverse@. parseUpTo :: Int -> Parser a -> Parser [a] parseUpTo = parseUpToWith [] @@ -400,73 +398,6 @@ 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.Modifier parseExplodeModifier = Modifier.Asterisk <$ parseChar_ '*'----- | 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

@@ -0,0 +1,121 @@+-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!.+module Burrito.Render+  ( render+  )+where++import qualified Burrito.Type.Expression as Expression+import qualified Burrito.Type.LitChar as LitChar+import qualified Burrito.Type.Literal as Literal+import qualified Burrito.Type.Modifier as Modifier+import qualified Burrito.Type.Name as Name+import qualified Burrito.Type.NonEmpty as NonEmpty+import qualified Burrito.Type.Operator as Operator+import qualified Burrito.Type.Template as Template+import qualified Burrito.Type.Token as Token+import qualified Burrito.Type.VarChar as VarChar+import qualified Burrito.Type.Variable as Variable+import qualified Data.List as List+import qualified Data.Word as Word+import qualified Text.Printf as Printf+++-- | Renders a template back into a string. This is essentially the opposite of+-- @parse@.+render :: Template.Template -> String+render = concatMap renderToken . Template.tokens+++-- | Renders a token in a template.+renderToken :: Token.Token -> String+renderToken token = case token of+  Token.Expression expression -> renderExpression expression+  Token.Literal literal -> renderLiteral literal+++-- | Renders an expression token.+renderExpression :: Expression.Expression -> String+renderExpression expression = mconcat+  [ "{"+  , renderOperator $ Expression.operator expression+  , renderVariables $ Expression.variables expression+  , "}"+  ]+++-- | Renders an operator in an expression.+renderOperator :: Operator.Operator -> String+renderOperator operator = case operator of+  Operator.Ampersand -> "&"+  Operator.FullStop -> "."+  Operator.None -> ""+  Operator.NumberSign -> "#"+  Operator.PlusSign -> "+"+  Operator.QuestionMark -> "?"+  Operator.Semicolon -> ";"+  Operator.Solidus -> "/"+++-- | Renders a bunch of variables in an expression.+renderVariables :: NonEmpty.NonEmpty Variable.Variable -> String+renderVariables = List.intercalate "," . fmap renderVariable . NonEmpty.toList+++-- | Renders a variable in an expression.+renderVariable :: Variable.Variable -> String+renderVariable variable = mconcat+  [ renderName $ Variable.name variable+  , renderModifier $ Variable.modifier variable+  ]+++-- | Renders a variable name.+renderName :: Name.Name -> String+renderName name = mconcat+  [ renderVarChar $ Name.first name+  , concatMap+      (\(fullStop, varChar) ->+        (if fullStop then "." else "") <> renderVarChar varChar+      )+    $ Name.rest name+  ]+++-- | Renders one logical character of a variable name.+renderVarChar :: VarChar.VarChar -> String+renderVarChar varChar = case varChar of+  VarChar.Encoded hi lo -> ['%', hi, lo]+  VarChar.Unencoded char -> [char]+++-- | Renders a variable modifier.+renderModifier :: Modifier.Modifier -> String+renderModifier modifier = case modifier of+  Modifier.Asterisk -> "*"+  Modifier.Colon int -> Printf.printf ":%d" int+  Modifier.None -> ""+++-- | Renders a literal token.+renderLiteral :: Literal.Literal -> String+renderLiteral =+  concatMap renderCharacter . NonEmpty.toList . Literal.characters+++-- | Renders a character in a literal token.+renderCharacter :: LitChar.LitChar -> String+renderCharacter character = case character of+  LitChar.Encoded word8 -> renderEncodedCharacter word8+  LitChar.Unencoded char -> renderUnencodedCharacter char+++-- | Renders an encoded character by percent encoding it with uppercase+-- hexadecimal digits.+renderEncodedCharacter :: Word.Word8 -> String+renderEncodedCharacter = Printf.printf "%%%02X"+++-- | Renders an unencoded character by simply turning it into a string.+renderUnencodedCharacter :: Char -> String+renderUnencodedCharacter = pure

@@ -1,6 +1,9 @@+-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.TH   ( uriTemplate-  ) where+  )+where  import qualified Burrito.Parse as Parse import qualified Language.Haskell.TH.Quote as TH

@@ -1,17 +0,0 @@-{-# LANGUAGE DeriveLift #-}--module Burrito.Type.Character-  ( Character(..)-  ) where--import qualified Data.Word as Word-import qualified Language.Haskell.TH.Syntax as TH----- | 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-  = Encoded Word.Word8-  | Unencoded Char-  deriving (Eq, TH.Lift, Show)

@@ -1,8 +1,11 @@ {-# LANGUAGE DeriveLift #-} +-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.Expression   ( Expression(..)-  ) where+  )+where  import qualified Burrito.Type.NonEmpty as NonEmpty import qualified Burrito.Type.Operator as Operator

@@ -0,0 +1,93 @@+{-# LANGUAGE DeriveLift #-}++-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!+module Burrito.Type.LitChar+  ( LitChar(..)+  , isLiteral+  , makeUnencoded+  )+where++import qualified Data.Word as Word+import qualified Language.Haskell.TH.Syntax as TH+++-- | 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 LitChar+  = Encoded Word.Word8+  -- ^ This deliberately is not case sensitive. The tokens @%aa@ and @%AA@ are+  -- both represented as @Encoded 0xAA@.+  | Unencoded Char+  -- ^ This assumes that the character passes the @isLiteral@ predicate. You+  -- should prefer using @makeUnencoded@ to create these values.+  deriving (Eq, TH.Lift, Show)+++-- | If the character passes @isLiteral@, returns an @Unencoded@ character.+-- Otherwise returns nothing.+makeUnencoded :: Char -> Maybe LitChar+makeUnencoded char = if isLiteral char then Just $ Unencoded char else Nothing+++-- | 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

@@ -1,15 +1,18 @@ {-# LANGUAGE DeriveLift #-} +-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.Literal   ( Literal(..)-  ) where+  )+where -import qualified Burrito.Type.Character as Character+import qualified Burrito.Type.LitChar as LitChar import qualified Burrito.Type.NonEmpty as NonEmpty import qualified Language.Haskell.TH.Syntax as TH   -- | Represents a literal in a token. newtype Literal = Literal-  { characters :: NonEmpty.NonEmpty Character.Character+  { characters :: NonEmpty.NonEmpty LitChar.LitChar   } deriving (Eq, TH.Lift, Show)

@@ -1,16 +1,34 @@ {-# LANGUAGE DeriveLift #-} +-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.Modifier   ( Modifier(..)-  ) where+  , makeColon+  )+where  import qualified Language.Haskell.TH.Syntax as TH  --- | Represents a modifier on a variable. The number associated with a prefix--- modifier will be between 1 and 9999 inclusive.+-- | Represents a modifier on a variable. data Modifier   = Asterisk   | Colon Int+  -- ^ This assumes that the number passes the @isValidMaxLength@ predicate.+  -- You should prefer using @makeColon@ to create these values.   | None   deriving (Eq, TH.Lift, Show)+++-- | If the number passes @isValidMaxLength@, returns a @Colon@ modifier.+-- Otherwise returns nothing.+makeColon :: Int -> Maybe Modifier+makeColon maxLength =+  if isValidMaxLength maxLength then Just $ Colon maxLength else Nothing+++-- | Returns true if the given number is a valid @max-length@ as defined by+-- section 2.4.1 of the RFC.+isValidMaxLength :: Int -> Bool+isValidMaxLength maxLength = 1 <= maxLength && maxLength <= 9999

@@ -1,10 +1,13 @@ {-# LANGUAGE DeriveLift #-} +-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.Name   ( Name(..)-  ) where+  )+where -import qualified Burrito.Type.NonEmpty as NonEmpty+import qualified Burrito.Type.VarChar as VarChar import qualified Language.Haskell.TH.Syntax as TH  @@ -12,6 +15,12 @@ -- 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-  { chars :: NonEmpty.NonEmpty Char+data Name = Name+  { first :: VarChar.VarChar+  -- ^ The first character is any valid @varchar@, including underscores and+  -- percent encoded triples.+  , rest :: [(Bool, VarChar.VarChar)]+  -- ^ Every other character has the same constraints, but they may also be+  -- preceeded by a full stop (period). That's what the @Bool@ represents:+  -- @True@ means there is a period.   } deriving (Eq, TH.Lift, Show)

@@ -1,11 +1,14 @@ {-# LANGUAGE DeriveLift #-} +-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.NonEmpty   ( NonEmpty(..)   , fromList   , singleton   , toList-  ) where+  )+where  import qualified Language.Haskell.TH.Syntax as TH 

@@ -1,8 +1,11 @@ {-# LANGUAGE DeriveLift #-} +-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.Operator   ( Operator(..)-  ) where+  )+where  import qualified Language.Haskell.TH.Syntax as TH 

@@ -1,8 +1,11 @@ {-# LANGUAGE DeriveLift #-} +-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.Template   ( Template(..)-  ) where+  )+where  import qualified Burrito.Type.Token as Token import qualified Language.Haskell.TH.Syntax as TH

@@ -1,8 +1,11 @@ {-# LANGUAGE DeriveLift #-} +-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.Token   ( Token(..)-  ) where+  )+where  import qualified Burrito.Type.Expression as Expression import qualified Burrito.Type.Literal as Literal

@@ -1,6 +1,9 @@+-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.Value   ( Value(..)-  ) where+  )+where   -- | Represents a value that can be substituted into a template. Can be a

@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveLift #-}++-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!.+module Burrito.Type.VarChar+  ( VarChar(..)+  , makeEncoded+  , makeUnencoded+  , isVarchar+  )+where++import qualified Data.Char as Char+import qualified Language.Haskell.TH.Syntax as TH+++-- | Represents a single logical character in a variable name.+data VarChar+  = Encoded Char Char+  -- ^ A percent encoded triple. Note that this represents three literal+  -- characters in the input, even though logically we always treat it as one+  -- character. The two arguments are the high and the low hexadecimal digits,+  -- respectively. This representation intentially keeps track of their case,+  -- so as to avoid confusing values like @%aa@ and @%AA@. You should use+  -- @makeEncoded@ to build these values.+  | Unencoded Char+  -- ^ A literal unencoded character. You should use @makeUnencoded@ to build+  -- these values.+  deriving (Eq, TH.Lift, Show)+++-- | Makes sure that both characters are valid hexadecimal digits. If they are,+-- returns an @Encoded@ character. Otherwise returns nothing.+makeEncoded :: Char -> Char -> Maybe VarChar+makeEncoded hi lo = if Char.isHexDigit hi && Char.isHexDigit lo+  then Just $ Encoded hi lo+  else Nothing+++-- | Makes sure that the character passes the @isVarchar@ predicate. If it+-- does, returns an @Unencoded@ character. Otherwise returns nothing.+makeUnencoded :: Char -> Maybe VarChar+makeUnencoded char = if isVarchar char then Just $ Unencoded char else Nothing+++-- | 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+++-- | 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

@@ -1,8 +1,11 @@ {-# LANGUAGE DeriveLift #-} +-- | Warning: This module is not considered part of Burrito's public API. As+-- such, it may change at any time. Use it with caution!. module Burrito.Type.Variable   ( Variable(..)-  ) where+  )+where  import qualified Burrito.Type.Modifier as Modifier import qualified Burrito.Type.Name as Name

@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-orphans #-}+ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}@@ -9,25 +11,36 @@ where  import qualified Burrito-import qualified Control.Monad as Monad-import qualified Control.Monad.Trans.Writer as Writer+import qualified Burrito.Type.LitChar as LitChar+import qualified Burrito.Type.Expression as Expression+import qualified Burrito.Type.Literal as Literal+import qualified Burrito.Type.Modifier as Modifier+import qualified Burrito.Type.Name as Name+import qualified Burrito.Type.NonEmpty as NonEmpty+import qualified Burrito.Type.Operator as Operator+import qualified Burrito.Type.Template as Template+import qualified Burrito.Type.Token as Token+import qualified Burrito.Type.VarChar as VarChar+import qualified Burrito.Type.Variable as Variable+import qualified Data.Char as Char import qualified Data.Either as Either+import qualified Data.Maybe as Maybe 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+import qualified Test.Hspec as Test+import qualified Test.QuickCheck as QC  main :: IO ()-main = runTests $ do+main = Test.hspec . Test.describe "Burrito" $ do -  label "accepts empty templates" $ do+  Test.it "accepts empty templates" $ do     test "" [] "" -  label "ignores extra variables" $ do+  Test.it "ignores extra variables" $ do     test "" ["extra" =: "ignored"] "" -  label "accepts ascii literals" $ do+  Test.it "accepts ascii literals" $ do     test "!" [] "!"     test "#" [] "#"     test "$" [] "$"@@ -56,7 +69,7 @@     test "z" [] "z"     test "~" [] "~" -  label "accepts unicode literals" $ do+  Test.it "accepts unicode literals" $ do     test "\xa0" [] "%C2%A0"     test "\xd7ff" [] "%ED%9F%BF"     test "\xf900" [] "%EF%A4%80"@@ -92,7 +105,7 @@     test "\xe1000" [] "%F3%A1%80%80"     test "\xefffd" [] "%F3%AF%BF%BD" -  label "accepts private literals" $ do+  Test.it "accepts private literals" $ do     test "\xe000" [] "%EE%80%80"     test "\xf8ff" [] "%EF%A3%BF"     test "\xf0000" [] "%F3%B0%80%80"@@ -100,25 +113,25 @@     test "\x100000" [] "%F4%80%80%80"     test "\x10fffd" [] "%F4%8F%BF%BD" -  label "passes percent encoded literals through" $ do+  Test.it "passes percent encoded literals through" $ do     test "%00" [] "%00" -  label "normalizes percent encodings to uppercase" $ do+  Test.it "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.it "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.it "does not decode percent encoded literals" $ do     test "%30" [] "%30" -  label "rejects invalid literals" $ do+  Test.it "rejects invalid literals" $ do     test " " [] Failure     test "\"" [] Failure     test "'" [] Failure@@ -132,7 +145,7 @@     test "|" [] Failure     test "}" [] Failure -  label "rejects empty variable names" $ do+  Test.it "rejects empty variable names" $ do     test "{}" [] Failure     test "{,}" [] Failure     test "{a,,b}" [] Failure@@ -140,34 +153,34 @@     test "{:1}" [] Failure     test "{*}" [] Failure -  label "accepts uppercase variable names" $ do+  Test.it "accepts uppercase variable names" $ do     test "{AZ}" [] "" -  label "accepts lowercase variable names" $ do+  Test.it "accepts lowercase variable names" $ do     test "{az}" [] "" -  label "accepts decimal variable names" $ do+  Test.it "accepts decimal variable names" $ do     test "{09}" [] "" -  label "accepts underscores in variable names" $ do+  Test.it "accepts underscores in variable names" $ do     test "{_a}" [] ""     test "{a_}" [] ""     test "{_}" [] "" -  label "accepts dots in variable names" $ do+  Test.it "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.it "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.it "accepts percent encoded variable names" $ do     test "{%00}" [] ""    -- It's unclear if percent encoded triplets in variable names should be case@@ -181,40 +194,40 @@   --   -- 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.it "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.it "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.it "rejects invalid variable names" $ do     test "{!}" [] Failure -  label "rejects invalid expressions" $ do+  Test.it "rejects invalid expressions" $ do     test "{" [] Failure     test "{{}" [] Failure     test "}" [] Failure     test "{}}" [] Failure -  label "accepts multiple variables in one expression" $ do+  Test.it "accepts multiple variables in one expression" $ do     test "{a,b}" [] ""     test "{a,b,c,d}" [] ""     test "{a,a}" [] "" -  label "accepts prefix modifiers" $ do+  Test.it "accepts prefix modifiers" $ do     test "{a:5}" [] ""     test "{a:67}" [] ""     test "{a:801}" [] ""     test "{a:234}" [] ""     test "{a:9999}" [] "" -  label "applies prefix modifiers" $ do+  Test.it "applies prefix modifiers" $ do     let values = ["a" =: "abcdefghijklmnopqrstuvwxyz"] :: Values     test "{a:1}" values "a"     test "{a:5}" values "abcde"@@ -224,23 +237,23 @@     test "{a:25}" values "abcdefghijklmnopqrstuvwxy"     test "{a:30}" values "abcdefghijklmnopqrstuvwxyz" -  label "rejects invalid prefix modifiers" $ do+  Test.it "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.it "accepts explode modifiers" $ do     test "{a*}" [] "" -  label "rejects both prefix and explode modifiers" $ do+  Test.it "rejects both prefix and explode modifiers" $ do     test "{a:1*}" [] Failure     test "{a*:1}" [] Failure -  label "accepts different modifiers on different variables" $ do+  Test.it "accepts different modifiers on different variables" $ do     test "{a,b:1,c*}" [] "" -  label "accepts allowed operators" $ do+  Test.it "accepts allowed operators" $ do     test "{+a}" [] ""     test "{#a}" [] ""     test "{.a}" [] ""@@ -249,24 +262,24 @@     test "{?a}" [] ""     test "{&a}" [] "" -  label "rejects reserved operators" $ do+  Test.it "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.it "rejects multiple operators" $ do     test "{+#a}" [] Failure -  label "rejects different operators for different variables" $ do+  Test.it "rejects different operators for different variables" $ do     test "{+a,#b}" [] Failure -  label "accepts operators and modifiers" $ do+  Test.it "accepts operators and modifiers" $ do     test "{+a:1}" [] ""     test "{#a*}" [] "" -  label "accepts multiple variables with an operator" $ do+  Test.it "accepts multiple variables with an operator" $ do     test "{+a,b}" [] ""     test "{#a,b}" [] ""     test "{.a,b}" [] ""@@ -275,24 +288,24 @@     test "{?a,b}" [] ""     test "{&a,b}" [] "" -  label "accepts multiple expressions" $ do+  Test.it "accepts multiple expressions" $ do     test "{a}{b}" [] ""     test "{a}{b}{c}{d}" [] ""     test "{a}{a}" [] "" -  label "rejects nested expressions" $ do+  Test.it "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.it "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.it "handles missing values" $ do     test "{a}" [] ""     test "{+a}" [] ""     test "{#a}" [] ""@@ -302,7 +315,7 @@     test "{?a}" [] ""     test "{&a}" [] "" -  label "handles empty list values" $ do+  Test.it "handles empty list values" $ do     let values = ["a" =: emptyList] :: Values     test "{a}" values ""     test "{+a}" values ""@@ -313,7 +326,7 @@     test "{?a}" values ""     test "{&a}" values "" -  label "handles empty dictionary values" $ do+  Test.it "handles empty dictionary values" $ do     let values = ["a" =: emptyDictionary] :: Values     test "{a}" values ""     test "{+a}" values ""@@ -324,7 +337,7 @@     test "{?a}" values ""     test "{&a}" values "" -  label "handles empty string values" $ do+  Test.it "handles empty string values" $ do     let values = ["a" =: ""] :: Values     test "{a}" values ""     test "{+a}" values ""@@ -335,7 +348,7 @@     test "{?a}" values "?a="     test "{&a}" values "&a=" -  label "handles nonempty string values" $ do+  Test.it "handles nonempty string values" $ do     let values = ["a" =: "A"] :: Values     test "{a}" values "A"     test "{+a}" values "A"@@ -346,7 +359,7 @@     test "{?a}" values "?a=A"     test "{&a}" values "&a=A" -  label "handles a mix of defined and undefined values" $ do+  Test.it "handles a mix of defined and undefined values" $ do     let values = ["b" =: "B"] :: Values     test "{a,b}" values "B"     test "{+a,b}" values "B"@@ -357,7 +370,7 @@     test "{?a,b}" values "?b=B"     test "{&a,b}" values "&b=B" -  label "handles multiple empty string values" $ do+  Test.it "handles multiple empty string values" $ do     let values = ["a" =: ""] :: Values     test "{a,a}" values ","     test "{+a,a}" values ","@@ -368,7 +381,7 @@     test "{?a,a}" values "?a=&a="     test "{&a,a}" values "&a=&a=" -  label "handles multiple non-empty string values" $ do+  Test.it "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"@@ -379,7 +392,7 @@     test "{?a,b}" values "?a=A&b=B"     test "{&a,b}" values "&a=A&b=B" -  label "escapes characters in composite dictionaries" $ do+  Test.it "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"@@ -390,13 +403,13 @@     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.it "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+  Test.describe "passes test from rfc" $ do -    label "section 1.1" $ do+    Test.it "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"@@ -407,7 +420,7 @@       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+    Test.describe "section 1.2" $ do       let         values =           [ "empty" =: ""@@ -420,11 +433,11 @@           , "y" =: "768"           ] :: Values -      label "level 1" $ do+      Test.it "level 1" $ do         test "{var}" values "value"         test "{hello}" values "Hello%20World%21" -      label "level 2" $ do+      Test.it "level 2" $ do         test "{+var}" values "value"         test "{+hello}" values "Hello%20World!"         test "{+path}/here" values "/foo/bar/here"@@ -432,7 +445,7 @@         test "X{#var}" values "X#value"         test "X{#hello}" values "X#Hello%20World!" -      label "level 3" $ do+      Test.it "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"@@ -450,7 +463,7 @@         test "?fixed=yes{&x}" values "?fixed=yes&x=1024"         test "{&x,y,empty}" values "&x=1024&y=768&empty=" -      label "level 4" $ do+      Test.it "level 4" $ do         test "{var:3}" values "val"         test "{var:30}" values "value"         test "{list}" values "red,green,blue"@@ -494,7 +507,7 @@         test "{&keys}" values "&keys=semi,%3B,dot,.,comma,%2C"         test "{&keys*}" values "&semi=%3B&dot=.&comma=%2C" -    label "section 2.4.1" $ do+    Test.it "section 2.4.1" $ do       let values = ["var" =: "value", "semi" =: ";"] :: Values       test "{var}" values "value"       test "{var:20}" values "value"@@ -502,12 +515,14 @@       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.it "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+    Test.describe "section 3.1" $ do       let         values =           [ "base" =: "http://example.com/home/"@@ -528,7 +543,7 @@           , "y" =: "768"           ] :: Values -      label "subsection 1" $ do+      Test.it "subsection 1" $ do         test "{count}" values "one,two,three"         test "{count*}" values "one,two,three"         test "{/count}" values "/one,two,three"@@ -539,7 +554,7 @@         test "{?count*}" values "?count=one&count=two&count=three"         test "{&count*}" values "&count=one&count=two&count=three" -      label "subsection 2" $ do+      Test.it "subsection 2" $ do         test "{var}" values "value"         test "{hello}" values "Hello%20World%21"         test "{half}" values "50%25"@@ -557,7 +572,7 @@         test "{keys}" values "semi,%3B,dot,.,comma,%2C"         test "{keys*}" values "semi=%3B,dot=.,comma=%2C" -      label "subsection 3" $ do+      Test.it "subsection 3" $ do         test "{+var}" values "value"         test "{+hello}" values "Hello%20World!"         test "{+half}" values "50%25"@@ -576,7 +591,7 @@         test "{+keys}" values "semi,;,dot,.,comma,,"         test "{+keys*}" values "semi=;,dot=.,comma=," -      label "subsection 4" $ do+      Test.it "subsection 4" $ do         test "{#var}" values "#value"         test "{#hello}" values "#Hello%20World!"         test "{#half}" values "#50%25"@@ -590,7 +605,7 @@         test "{#keys}" values "#semi,;,dot,.,comma,,"         test "{#keys*}" values "#semi=;,dot=.,comma=," -      label "subsection 5" $ do+      Test.it "subsection 5" $ do         test "{.who}" values ".fred"         test "{.who,who}" values ".fred.fred"         test "{.half,who}" values ".50%25.fred"@@ -606,7 +621,7 @@         test "X{.empty_keys}" values "X"         test "X{.empty_keys*}" values "X" -      label "subsection 6" $ do+      Test.it "subsection 6" $ do         test "{/who}" values "/fred"         test "{/who,who}" values "/fred/fred"         test "{/half,who}" values "/50%25/fred"@@ -622,7 +637,7 @@         test "{/keys}" values "/semi,%3B,dot,.,comma,%2C"         test "{/keys*}" values "/semi=%3B/dot=./comma=%2C" -      label "subsection 7" $ do+      Test.it "subsection 7" $ do         test "{;who}" values ";who=fred"         test "{;half}" values ";half=50%25"         test "{;empty}" values ";empty"@@ -637,7 +652,7 @@         test "{;keys}" values ";keys=semi,%3B,dot,.,comma,%2C"         test "{;keys*}" values ";semi=%3B;dot=.;comma=%2C" -      label "subsection 8" $ do+      Test.it "subsection 8" $ do         test "{?who}" values "?who=fred"         test "{?half}" values "?half=50%25"         test "{?x,y}" values "?x=1024&y=768"@@ -649,7 +664,7 @@         test "{?keys}" values "?keys=semi,%3B,dot,.,comma,%2C"         test "{?keys*}" values "?semi=%3B&dot=.&comma=%2C" -      label "subsection 9" $ do+      Test.it "subsection 9" $ do         test "{&who}" values "&who=fred"         test "{&half}" values "&half=50%25"         test "?fixed=yes{&x}" values "?fixed=yes&x=1024"@@ -661,7 +676,7 @@         test "{&keys}" values "&keys=semi,%3B,dot,.,comma,%2C"         test "{&keys*}" values "&semi=%3B&dot=.&comma=%2C" -  label "handles simple expansion" $ do+  Test.it "handles simple expansion" $ do     test "{a}" [] ""     test "{a}" ["a" =: emptyList] ""     test "{a}" ["a" =: emptyDictionary] ""@@ -719,7 +734,7 @@     test "{%aa*}" ["%aa" =: ["A", "B"]] "A,B"     test "{%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "A=1,B=2" -  label "handles reserved expansion" $ do+  Test.it "handles reserved expansion" $ do     test "{+a}" [] ""     test "{+a}" ["a" =: emptyList] ""     test "{+a}" ["a" =: emptyDictionary] ""@@ -777,7 +792,7 @@     test "{+%aa*}" ["%aa" =: ["A", "B"]] "A,B"     test "{+%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "A=1,B=2" -  label "handles fragment expansion" $ do+  Test.it "handles fragment expansion" $ do     test "{#a}" [] ""     test "{#a}" ["a" =: emptyList] ""     test "{#a}" ["a" =: emptyDictionary] ""@@ -835,7 +850,7 @@     test "{#%aa*}" ["%aa" =: ["A", "B"]] "#A,B"     test "{#%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "#A=1,B=2" -  label "handles label expansion" $ do+  Test.it "handles Test.it expansion" $ do     test "{.a}" [] ""     test "{.a}" ["a" =: emptyList] ""     test "{.a}" ["a" =: emptyDictionary] ""@@ -893,7 +908,7 @@     test "{.%aa*}" ["%aa" =: ["A", "B"]] ".A.B"     test "{.%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] ".A=1.B=2" -  label "handles segment expansion" $ do+  Test.it "handles segment expansion" $ do     test "{/a}" [] ""     test "{/a}" ["a" =: emptyList] ""     test "{/a}" ["a" =: emptyDictionary] ""@@ -951,7 +966,7 @@     test "{/%aa*}" ["%aa" =: ["A", "B"]] "/A/B"     test "{/%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "/A=1/B=2" -  label "handles parameter expansion" $ do+  Test.it "handles parameter expansion" $ do     test "{;a}" [] ""     test "{;a}" ["a" =: emptyList] ""     test "{;a}" ["a" =: emptyDictionary] ""@@ -1009,7 +1024,7 @@     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.it "handles query expansion" $ do     test "{?a}" [] ""     test "{?a}" ["a" =: emptyList] ""     test "{?a}" ["a" =: emptyDictionary] ""@@ -1067,7 +1082,7 @@     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.it "handles continuation expansion" $ do     test "{&a}" [] ""     test "{&a}" ["a" =: emptyList] ""     test "{&a}" ["a" =: emptyDictionary] ""@@ -1125,9 +1140,10 @@     test "{&%aa*}" ["%aa" =: ["A", "B"]] "&%aa=A&%aa=B"     test "{&%aa*}" ["%aa" =: ["A" =: "1", "B" =: "2"]] "&A=1&B=2" -  label "supports quasi quotes" $ do-    label "as expressions" $ do-      let qq x y = Writer.tell . Test $ Just x Test.~?= Burrito.parse y+  Test.describe "supports quasi quotes" $ do++    Test.it "as expressions" $ do+      let qq x y = Just x `Test.shouldBe` Burrito.parse y       qq [Burrito.uriTemplate||] ""       qq [Burrito.uriTemplate|a|] "a"       qq [Burrito.uriTemplate|%00|] "%00"@@ -1144,52 +1160,14 @@       qq [Burrito.uriTemplate|{?a}|] "{?a}"       qq [Burrito.uriTemplate|{&a}|] "{&a}" -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 -- ^ A string to parse as a URI template ('Burrito.parse')-  -> Values -- ^ Values to feed into the template ('Burrito.expand')-  -> Expected -- ^ The URI that should result-  -> 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]+  Test.it "round trips" . QC.property $ \template ->+    let rendered = Burrito.render $ unwrapTemplate template+    in fmap Burrito.render (Burrito.parse rendered) == Just rendered -instance Test.Testable Test where-  test = unwrapTest+test :: Stack.HasCallStack => String -> Values -> Expected -> IO ()+test input values output =+  fmap (Burrito.expand (fmap (fmap unwrapValue) values)) (Burrito.parse input)+    `Test.shouldBe` expectedToMaybe output  data Expected   = Failure@@ -1249,3 +1227,104 @@   type K Item = String   type V Item = String   key =: value = Item $ Right (key, value)++newtype Template = Template+  { unwrapTemplate :: Burrito.Template+  } deriving (Eq)++instance Show Template where+  show (Template t) = show (Burrito.render t, t)++instance QC.Arbitrary Template where+  arbitrary = Template <$> QC.arbitrary+  shrink = fmap Template . QC.shrink . unwrapTemplate++instance QC.Arbitrary Template.Template where+  arbitrary = Template.Template <$> QC.arbitrary+  shrink = fmap Template.Template . QC.shrink . Template.tokens++instance QC.Arbitrary Token.Token where+  arbitrary = QC.oneof+    [Token.Expression <$> QC.arbitrary, Token.Literal <$> QC.arbitrary]+  shrink token = case token of+    Token.Expression expression -> Token.Expression <$> QC.shrink expression+    Token.Literal literal -> Token.Literal <$> QC.shrink literal++instance QC.Arbitrary Expression.Expression where+  arbitrary = Expression.Expression <$> QC.arbitrary <*> QC.arbitrary+  shrink expression = uncurry Expression.Expression <$> QC.shrink+    (Expression.operator expression, Expression.variables expression)++instance QC.Arbitrary Operator.Operator where+  arbitrary = QC.elements+    [ Operator.Ampersand+    , Operator.FullStop+    , Operator.None+    , Operator.NumberSign+    , Operator.PlusSign+    , Operator.QuestionMark+    , Operator.Semicolon+    , Operator.Solidus+    ]+  shrink operator = case operator of+    Operator.None -> []+    _ -> [Operator.None]++instance (QC.Arbitrary a) => QC.Arbitrary (NonEmpty.NonEmpty a) where+  arbitrary = NonEmpty.NonEmpty <$> QC.arbitrary <*> QC.arbitrary+  shrink nonEmpty = uncurry NonEmpty.NonEmpty+    <$> QC.shrink (NonEmpty.first nonEmpty, NonEmpty.rest nonEmpty)++instance QC.Arbitrary Variable.Variable where+  arbitrary = Variable.Variable <$> QC.arbitrary <*> QC.arbitrary+  shrink variable = uncurry Variable.Variable+    <$> QC.shrink (Variable.modifier variable, Variable.name variable)++instance QC.Arbitrary Modifier.Modifier where+  arbitrary = QC.oneof+    [ pure Modifier.Asterisk+    , do+      maxLength <- QC.choose (1, 9999)+      maybe QC.discard pure $ Modifier.makeColon maxLength+    , pure Modifier.None+    ]+  shrink modifier = case modifier of+    Modifier.Asterisk -> [Modifier.None]+    Modifier.Colon int -> Maybe.mapMaybe Modifier.makeColon $ QC.shrink int+    Modifier.None -> []++instance QC.Arbitrary Name.Name where+  arbitrary = Name.Name <$> QC.arbitrary <*> QC.arbitrary+  shrink name =+    uncurry Name.Name <$> QC.shrink (Name.first name, Name.rest name)++instance QC.Arbitrary VarChar.VarChar where+  arbitrary = QC.oneof+    [ do+      hi <- QC.suchThat QC.arbitrary Char.isHexDigit+      lo <- QC.suchThat QC.arbitrary Char.isHexDigit+      maybe QC.discard pure $ VarChar.makeEncoded hi lo+    , do+      char <- QC.suchThat QC.arbitrary VarChar.isVarchar+      maybe QC.discard pure $ VarChar.makeUnencoded char+    ]+  shrink varChar = case varChar of+    VarChar.Encoded hi lo -> uncurry VarChar.Encoded <$> QC.shrink (hi, lo)+    VarChar.Unencoded char ->+      Maybe.mapMaybe VarChar.makeUnencoded $ QC.shrink char++instance QC.Arbitrary Literal.Literal where+  arbitrary = Literal.Literal <$> QC.arbitrary+  shrink = fmap Literal.Literal . QC.shrink . Literal.characters++instance QC.Arbitrary LitChar.LitChar where+  arbitrary = QC.oneof+    [ LitChar.Encoded <$> QC.arbitrary+    , do+      char <- QC.suchThat QC.arbitrary LitChar.isLiteral+      maybe QC.discard pure $ LitChar.makeUnencoded char+    ]+  shrink character = case character of+    LitChar.Encoded word8 -> LitChar.Encoded <$> QC.shrink word8+    LitChar.Unencoded char ->+      Maybe.mapMaybe LitChar.makeUnencoded $ QC.shrink char