Fix the reading of Hexadecimal string objects detected by running the tests implemented from the spec

This commit is contained in:
Tissevert 2020-02-14 18:00:12 +01:00
parent a72d76e229
commit 1c457d71d8

View file

@ -37,7 +37,9 @@ import Control.Applicative ((<|>), many)
import Data.Attoparsec.ByteString.Char8 (choice, count, option, sepBy) import Data.Attoparsec.ByteString.Char8 (choice, count, option, sepBy)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (concat) import qualified Data.ByteString as BS (concat)
import qualified Data.ByteString.Char8 as Char8 (cons, pack, singleton, unpack) import qualified Data.ByteString.Char8 as Char8 (
cons, length, pack, singleton, snoc, unpack
)
import Data.ByteString.Char8.Util (B16Int(..), b16ToBytes, unescape) import Data.ByteString.Char8.Util (B16Int(..), b16ToBytes, unescape)
import Data.Map (Map, (!), mapWithKey) import Data.Map (Map, (!), mapWithKey)
import qualified Data.Map as Map ( import qualified Data.Map as Map (
@ -122,7 +124,7 @@ instance Output StringObject where
stringObject :: MonadParser m => m StringObject stringObject :: MonadParser m => m StringObject
stringObject = stringObject =
Literal <$> (char '(' *> (BS.concat <$> literalString) <* char ')') Literal <$> (char '(' *> (BS.concat <$> literalString) <* char ')')
<|> Hexadecimal <$> (char '<' *> hexNumber <* char '>') <|> Hexadecimal . roundBytes <$> (char '<' *> hexNumber <* char '>')
<?> "string object (literal or hexadecimal)" <?> "string object (literal or hexadecimal)"
where where
literalString = many literalStringBlock literalString = many literalStringBlock
@ -133,6 +135,9 @@ stringObject =
escapedChar = escapedChar =
Char8.cons <$> char '\\' <*> (Char8.singleton <$> oneOf "nrtbf()\\\n" <|> octalCode) Char8.cons <$> char '\\' <*> (Char8.singleton <$> oneOf "nrtbf()\\\n" <|> octalCode)
octalCode = choice $ (\n -> Char8.pack <$> count n octDigit) <$> [1..3] octalCode = choice $ (\n -> Char8.pack <$> count n octDigit) <$> [1..3]
roundBytes (B16Int bs)
| Char8.length bs `mod` 2 == 1 = B16Int (bs `Char8.snoc` '0')
| otherwise = B16Int bs
toByteString :: StringObject -> ByteString toByteString :: StringObject -> ByteString
toByteString (Hexadecimal h) = b16ToBytes h toByteString (Hexadecimal h) = b16ToBytes h