diff --git a/proto-lens.cabal b/proto-lens.cabal --- a/proto-lens.cabal +++ b/proto-lens.cabal @@ -1,5 +1,5 @@ name: proto-lens -version: 0.1.0.2 +version: 0.1.0.3 synopsis: A lens-based implementation of protocol buffers in Haskell. description: The proto-lens library provides to protocol buffers using modern diff --git a/src/Data/ProtoLens/Encoding.hs b/src/Data/ProtoLens/Encoding.hs --- a/src/Data/ProtoLens/Encoding.hs +++ b/src/Data/ProtoLens/Encoding.hs @@ -223,4 +223,3 @@ stringizeError :: Either UnicodeException a -> Either String a stringizeError (Left e) = Left (show e) stringizeError (Right a) = Right a - diff --git a/src/Data/ProtoLens/TextFormat.hs b/src/Data/ProtoLens/TextFormat.hs --- a/src/Data/ProtoLens/TextFormat.hs +++ b/src/Data/ProtoLens/TextFormat.hs @@ -20,13 +20,15 @@ import Lens.Family2 ((&),(^.),(.~), set, over) import Control.Applicative ((<$>)) import Control.Arrow (left) -import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString +import Data.Char (isPrint, isAscii, chr) import Data.Foldable (foldlM, foldl') import Data.Maybe (catMaybes) import qualified Data.Map as Map import qualified Data.Set as Set -import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as Lazy +import Numeric (showOct) import Text.Parsec (parse) import Text.PrettyPrint @@ -102,11 +104,35 @@ pprintFieldValue name FloatField x = primField name x pprintFieldValue name DoubleField x = primField name x pprintFieldValue name BoolField x = text name <> colon <+> boolValue x -pprintFieldValue name StringField x = primField name x -pprintFieldValue name BytesField x = primField name x +pprintFieldValue name StringField x = pprintByteString name (Text.encodeUtf8 x) +pprintFieldValue name BytesField x = pprintByteString name x pprintFieldValue name GroupField m = text name <+> lbrace $$ nest 2 (pprintMessage m) $$ rbrace +-- | Formats a string in a way that mostly matches the C-compatible escaping +-- used by the Protocol Buffer distribution. We depart a bit by escaping all +-- non-ASCII characters, which depending on the locale, the distribution might +-- not do. +-- +-- This uses three-digit octal escapes, e.g. "\011" plus \n, \r,, \t, \', \", +-- and \\ only. Note that Haskell string-literal syntax calls for "\011" to be +-- interpreted as decimal 11, rather than the decimal 9 it actually represent, +-- so you can't use Prelude.read to parse the strings created here. +pprintByteString :: String -> Data.ByteString.ByteString -> Doc +pprintByteString name x = text name <> colon <+> char '\"' + <> text (concatMap escape $ Data.ByteString.unpack x) <> char '\"' + where escape w8 | ch == '\n' = "\\n" + | ch == '\r' = "\\r" + | ch == '\t' = "\\t" + | ch == '\"' = "\\\"" + | ch == '\'' = "\\\'" + | ch == '\\' = "\\\\" + | isPrint ch && isAscii ch = ch : "" + | otherwise = "\\" ++ pad (showOct w8 "") + where + ch = chr $ fromIntegral w8 + pad str = replicate (3 - length str) '0' ++ str + primField :: Show value => String -> value -> Doc primField name x = text name <> colon <+> text (show x) @@ -202,8 +228,8 @@ | x == "true" = Right True | x == "false" = Right False | otherwise = Left $ "Unrecognized bool value " ++ show x -makeValue StringField (Parser.StringValue x) = Right (Text.pack x) -makeValue BytesField (Parser.StringValue x) = Right (B.pack x) +makeValue StringField (Parser.ByteStringValue x) = Right (Text.decodeUtf8 x) +makeValue BytesField (Parser.ByteStringValue x) = Right x makeValue EnumField (Parser.IntValue x) = maybe (Left $ "Unrecognized enum value " ++ show x) Right (maybeToEnum $ fromInteger x) diff --git a/src/Data/ProtoLens/TextFormat/Parser.hs b/src/Data/ProtoLens/TextFormat/Parser.hs --- a/src/Data/ProtoLens/TextFormat/Parser.hs +++ b/src/Data/ProtoLens/TextFormat/Parser.hs @@ -14,13 +14,19 @@ , parser ) where -import Data.List (intercalate) +import Data.ByteString (ByteString, pack) +import Data.Char (ord) import Data.Functor.Identity (Identity) +import Data.List (intercalate) +import Data.Maybe (catMaybes) import Data.Text.Lazy (Text) -import Text.Parsec.Char (alphaNum, char, letter, oneOf) +import Data.Word (Word8) +import Numeric (readOct, readHex) +import Text.Parsec.Char + (alphaNum, char, hexDigit, letter, octDigit, oneOf, satisfy) import Text.Parsec.Text.Lazy (Parser) -import Text.Parsec.Combinator (eof, sepBy1, many1, choice) -import Text.Parsec.Token +import Text.Parsec.Combinator (choice, eof, many1, optionMaybe, sepBy1) +import Text.Parsec.Token hiding (octal) import Control.Applicative ((<*), (<|>), (*>), many) import Control.Monad (liftM, liftM2, mzero) @@ -60,7 +66,7 @@ data Value = IntValue Integer -- ^ An integer | DoubleValue Double -- ^ Any floating point number - | StringValue String -- ^ A string literal + | ByteStringValue ByteString -- ^ A string or bytes literal | MessageValue Message -- ^ A sub message | EnumValue String -- ^ Any undelimited string (including false & true) deriving (Show,Ord,Eq) @@ -91,7 +97,8 @@ negative <- (symbol ptp "-" >> return True) <|> return False value <- naturalOrFloat ptp return $ makeNumberValue negative value - parseString = liftM (StringValue . concat) . many1 $ stringLiteral ptp + parseString = liftM (ByteStringValue . mconcat) + $ many1 $ lexeme ptp $ protoStringLiteral parseEnumValue = liftM EnumValue (identifier ptp) parseMessageValue = liftM MessageValue (braces ptp parseMessage <|> angles ptp parseMessage) @@ -101,3 +108,50 @@ makeNumberValue False (Left intValue) = IntValue intValue makeNumberValue True (Right doubleValue) = DoubleValue (negate doubleValue) makeNumberValue False (Right doubleValue) = DoubleValue doubleValue + +-- | Reads a literal string the way the Protocol Buffer distribution's +-- tokenizer.cc does. This differs from Haskell string literals in treating, +-- e.g. "\11" as octal instead of decimal, so reading as 9 instead of 11. Also, +-- like tokenizer.cc we assume octal and hex escapes can have at most three and +-- two digits, respectively. +-- +-- TODO: implement reading of Unicode escapes. +protoStringLiteral :: Parser ByteString +protoStringLiteral = do + initialQuoteChar <- char '\'' <|> char '\"' + word8s <- many stringChar + _ <- char initialQuoteChar + return $ pack word8s + where + stringChar :: Parser Word8 + stringChar = nonEscape <|> stringEscape + nonEscape = fmap (fromIntegral . ord) + $ satisfy (\c -> c `notElem` "\\\'\"" && ord c < 256) + stringEscape = char '\\' >> (octal <|> hex <|> unicode <|> simple) + octal = do d0 <- octDigit + d1 <- optionMaybe octDigit + d2 <- optionMaybe octDigit + readMaybeDigits readOct [Just d0, d1, d2] + readMaybeDigits :: ReadS Word8 -> [Maybe Char] -> Parser Word8 + readMaybeDigits reader + = return . (\str -> let [(v, "")] = reader str in v) . catMaybes + hex = do _ <- oneOf "xX" + d0 <- hexDigit + d1 <- optionMaybe hexDigit + readMaybeDigits readHex [Just d0, d1] + unicode = oneOf "uU" >> fail "Unicode in string literals not yet supported" + simple = choice $ map charRet [ ('a', '\a') + , ('b', '\b') + , ('f', '\f') + , ('n', '\n') + , ('r', '\r') + , ('t', '\t') + , ('v', '\v') + , ('\\', '\\') + , ('\'', '\'') + , ('\"', '\"') + ] + where + charRet :: (Char, Char) -> Parser Word8 + charRet (escapeCh, ch) = do _ <- char escapeCh + return $ fromIntegral $ ord ch