forms-data-format 0.2.0.1 → 0.2.1
raw patch · 3 files changed
+56/−13 lines, 3 filesdep ~textPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: text
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- forms-data-format.cabal +2/−2
- src/Text/FDF.hs +50/−11
CHANGELOG.md view
@@ -11,3 +11,7 @@ ## 0.2.0.1 -- 2023-11-25 * Bumped the upper bound of the `bytestring` dependency.++## 0.2.1 -- 2024-02-29++* Properly parse and serialize special and Unicode characters
forms-data-format.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: forms-data-format-version: 0.2.0.1+version: 0.2.1 synopsis: Parse and serialize FDF, the Forms Data Format @@ -29,7 +29,7 @@ -- Modules included in this library but not exported. -- other-modules: other-extensions: ImportQualifiedPost NamedFieldPuns OverloadedStrings- build-depends: base == 4.*, bytestring >=0.9 && < 0.13, text,+ build-depends: base == 4.*, bytestring >=0.9 && < 0.13, text >= 1.0 && < 2.2, monoid-subclasses == 1.*, rank2classes >= 1 && < 1.6, parsers < 0.13, grammatical-parsers >= 0.5 && < 0.8 hs-source-dirs: src
src/Text/FDF.hs view
@@ -14,15 +14,18 @@ import Control.Applicative ((<*), (<*>), (<|>), many, some, optional) import Data.Bifunctor (bimap) import Data.ByteString (ByteString)-import Data.Char (isSpace)+import Data.ByteString qualified as ByteString+import Data.Char (chr, digitToInt, isAscii, isSpace, ord) import Data.Monoid.Instances.ByteString.UTF8 (ByteStringUTF8 (ByteStringUTF8))-import Data.Monoid.Textual (toString, toText)+import Data.Monoid.Textual (singleton, toString, toText) import Data.Text (Text) import Data.Text qualified as Text-import Data.Text.Encoding (encodeUtf8)+import Data.Text.Encoding (decodeUtf16BE, encodeUtf8, encodeUtf16BE)+import Numeric (showOct) import Rank2 qualified import Text.Grampa import Text.Grampa.Combinators+import Text.Parser.Char (octDigit) import Text.Parser.Combinators (manyTill) import Text.Grampa.PEG.Backtrack qualified as PEG @@ -72,21 +75,38 @@ <> "/FDF\n" <> "<<\n" <> "/Fields [\n"- <> encodeUtf8 (serializeField body) <> "\n"+ <> serializeField body <> "\n" <> "]\n" <> ">>\n" <> ">>\n" <> trailer <> "%%EOF\n" -serializeField :: Field -> Text+serializeField :: Field -> ByteString serializeField Field{name, value, kids} = "<<\n"- <> "/T (" <> name <> ")\n"- <> foldMap (\v-> "/V (" <> v <> ")\n") value- <> (if null kids then "" else "/Kids [\n" <> Text.intercalate "\n" (serializeField <$> kids) <> "]\n")+ <> "/T (" <> encodeUtf8 name <> ")\n"+ <> foldMap (\v-> "/V (" <> serializeValue v <> ")\n") value+ <> (if null kids then "" else "/Kids [\n" <> ByteString.intercalate "\n" (serializeField <$> kids) <> "]\n") <> ">>" +serializeValue :: Text -> ByteString+serializeValue t+ | Text.isAscii t = encodeUtf8 (plain <> escaped)+ | otherwise = utf16beBOM <> encodeUtf16BE t+ where (plain, special) = Text.span (\c -> c >= ' ' && c `notElem` ['(', ')', '\\']) t+ escaped = Text.concatMap escape special+ escape '(' = Text.pack "\\("+ escape ')' = "\\)"+ escape '\\' = "\\\\"+ escape '\n' = "\\n"+ escape '\r' = "\\r"+ escape '\t' = "\\t"+ escape '\b' = "\\b"+ escape c+ | c < ' ' = "\\" <> Text.justifyRight 3 '0' (Text.pack $ showOct (ord c) "")+ | otherwise = Text.singleton c+ parse :: ByteString -> Either String FDF parse input = bimap (\failure-> toString (const "<?>") $ failureDescription s failure 4) id $ simply parseComplete parser s@@ -114,12 +134,28 @@ field :: Parser ByteStringUTF8 Field field = Field <$ begin <*> strictText (string "/T (" *> takeCharsWhile (`notElem` [')', '\r', '\n']) <* string ")" <* lineEnd <?> "name")- <*> optional (strictText $ admit (string "/V (" *> commit (takeCharsWhile (`notElem` [')', '\r', '\n']) <* string ")" <* lineEnd)- <|> string "/V /" *> commit (takeCharsWhile (`notElem` ['\r', '\n']) <* lineEnd)- <?> "value"))+ <*> optional (strictText $+ admit (string "/V ("+ *> commit ((string (ByteStringUTF8 utf16beBOM) *> (utf8from16 <$> Text.Grampa.takeWhile (/= ")"))+ <|> concatMany (takeCharsWhile1 (`notElem` [')', '\r', '\n', '\\']) <|> escape))+ <* string ")" <* lineEnd)+ <|> string "/V /" *> commit (takeCharsWhile (`notElem` ['\r', '\n']) <* lineEnd)+ <?> "value")) <*> admit (string "/Kids [" *> commit (lineEnd *> takeSome field <* string "]" <* lineEnd <?> "kids") <|> commit mempty) <* end+ where escape = char '\\'+ *> (singleton <$> (char 'n' *> pure '\n'+ <|> char 'r' *> pure '\r'+ <|> char 't' *> pure '\t'+ <|> char 'b' *> pure '\b'+ <|> char 'f' *> pure '\f'+ <|> char '(' *> pure '('+ <|> char ')' *> pure ')'+ <|> char '\\' *> pure '\\'+ <|> chr . sum <$> sequenceA [(64 *) <$> octalDigit, (8 *) <$> octalDigit, octalDigit]))+ octalDigit = digitToInt <$> octDigit+ utf8from16 (ByteStringUTF8 bs) = ByteStringUTF8 (encodeUtf8 $ decodeUtf16BE bs) begin :: Parser ByteStringUTF8 ByteStringUTF8 begin = string "<<" *> lineEnd <?> "<<"@@ -138,3 +174,6 @@ extract :: Parser ByteStringUTF8 ByteStringUTF8 -> Parser ByteStringUTF8 ByteString extract = fmap $ \(ByteStringUTF8 bs) -> bs++utf16beBOM :: ByteString+utf16beBOM = "\xFE\xFF"