diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,10 @@ All notable changes to this project will be documented in this file. This project adheres to [Semantic Versioning](http://semver.org/). +## [0.3.0.5] - 2026-09-20 + +- Escape \ in printer. + ## [0.3.0.4] - 2021-11-13 - Compatiblity with prettyprinter-1.7.1 deprecactions. diff --git a/hedn.cabal b/hedn.cabal --- a/hedn.cabal +++ b/hedn.cabal @@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack --- --- hash: 784b8e18f38a2e70046c5ec03603dd229e8486d61fad1a326af0f647adfa1102 name: hedn -version: 0.3.0.4 +version: 0.3.0.5 synopsis: EDN parsing and encoding description: A EDN parsing and encoding library. . @@ -18,9 +16,9 @@ copyright: (c) 2019 Alexander Bondarenko license: BSD3 license-file: LICENSE -tested-with: - GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC==8.10.4, GHC==9.0.1, GHC==9.2.1 build-type: Simple +tested-with: + GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC==8.10.4, GHC==9.0.1, GHC==9.2.1, GHC==9.10.3 extra-source-files: CHANGELOG.md LICENSE @@ -49,7 +47,7 @@ ghc-options: -Wall build-depends: base >=4.9 && <5 - , containers >=0.5.7 && <0.7 + , containers >=0.5.7 && <0.9 , deepseq >=1.4 && <2 , deriving-compat >=0.3.6 && <0.7 , megaparsec >=7.0 && <10 @@ -57,7 +55,7 @@ , prettyprinter >=1.2 && <2 , scientific ==0.3.* , template-haskell >=2.11 && <3 - , text >=1.2 && <2 + , text >=2.0 && <3 , time >=1.6 && <2 , uuid-types >=1.0 && <2 , vector >=0.11 && <1 @@ -78,11 +76,11 @@ ghc-options: -Wall build-depends: base >=4.9 && <5 - , containers >=0.5.7 && <0.7 + , containers >=0.5.7 && <0.9 , hedgehog >=0.6 && <2 , hedn , megaparsec >=7.0 && <10 - , text >=1.2 && <2 + , text >=2.0 && <3 , time >=1.6 && <2 , uuid-types >=1.0 && <2 , vector >=0.11 && <1 diff --git a/lib/Data/EDN/AST/Printer.hs b/lib/Data/EDN/AST/Printer.hs --- a/lib/Data/EDN/AST/Printer.hs +++ b/lib/Data/EDN/AST/Printer.hs @@ -4,6 +4,7 @@ module Data.EDN.AST.Printer ( renderText + , prettyText , prettyTaggedValue , prettyValue ) where @@ -36,6 +37,13 @@ renderText = PP.renderStrict . PP.layoutPretty options . prettyTaggedValue where + options = PP.defaultLayoutOptions{PP.layoutPageWidth = PP.Unbounded} + +-- | Render EDN document to 'Text' +prettyText :: EDN.TaggedValue -> Text +prettyText = + PP.renderStrict . PP.layoutPretty options . prettyTaggedValue + where options = PP.defaultLayoutOptions -- | Prepare 'EDN.TaggedValue' @@ -80,16 +88,16 @@ EDN.String str -> PP.enclose "\"" "\"" . pretty $ escapeText str EDN.List items -> - PP.parens . PP.hsep $ + PP.parens . PP.align . PP.sep $ map prettyTaggedValue items EDN.Vec items -> - PP.brackets . PP.hsep $ + PP.brackets . PP.align . PP.sep $ map prettyTaggedValue (toList items) EDN.Set items -> - mappend "#" . PP.braces . PP.hsep $ + mappend "#" . PP.braces . PP.align . PP.sep $ map prettyTaggedValue (toList items) EDN.Map pairs -> - PP.braces . PP.hsep $ + PP.braces . PP.align . PP.sep $ [ prettyTaggedValue k <+> prettyTaggedValue v | (k, v) <- Map.toList pairs ] @@ -98,6 +106,7 @@ escapeText = Text.concatMap escape where escape = \case + '\\' -> "\\\\" '\n' -> "\\n" '\r' -> "\\r" '\t' -> "\\t" diff --git a/tests/Data/EDN/AST/Gen.hs b/tests/Data/EDN/AST/Gen.hs --- a/tests/Data/EDN/AST/Gen.hs +++ b/tests/Data/EDN/AST/Gen.hs @@ -50,6 +50,7 @@ [ genNil , genBool , genString + , genStringEscapes , genChar , genInteger , genFloating @@ -75,6 +76,15 @@ genString :: Gen EDN.Value genString = EDN.String <$> Gen.text (Range.exponential 4 16) Gen.unicode + +genStringEscapes :: Gen EDN.Value +genStringEscapes = EDN.String + <$> Gen.text (Range.exponential 4 16) (Gen.frequency withEscapes) + where + withEscapes = + [ (16, Gen.unicode) + , (1, Gen.element ['\\', '\n', '\r', '\t', '"']) + ] genChar :: Gen EDN.Value genChar = EDN.Character diff --git a/tests/Data/EDN/AST/Test.hs b/tests/Data/EDN/AST/Test.hs --- a/tests/Data/EDN/AST/Test.hs +++ b/tests/Data/EDN/AST/Test.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module Data.EDN.AST.Test @@ -12,6 +13,7 @@ ) import Data.Text (Text) +import qualified Data.Text as Text import qualified Data.EDN.AST.Types as EDN import qualified Data.EDN.AST.Gen as EDN @@ -23,11 +25,16 @@ type ASTParser = Text -> Either String EDN.TaggedValue -prop_generated :: Property -prop_generated = property $ do +prop_rendered_can_parse_back :: Property +prop_rendered_can_parse_back = property $ do tv <- forAll EDN.genTaggedValue tripping tv EDN.renderText (EDN.parseText "" :: ASTParser) +prop_pretty_can_parse_back :: Property +prop_pretty_can_parse_back = property $ do + tv <- forAll EDN.genTaggedValue + tripping tv EDN.prettyText (EDN.parseText "" :: ASTParser) + prop_regr_empty_containers :: Property prop_regr_empty_containers = withTests 1 . property $ do emptyList <- either fail pure $ EDN.parseText "" "( )" @@ -41,3 +48,63 @@ emptyMap <- either fail pure $ EDN.parseText "" "{ }" emptyMap === EDN.NoTag (EDN.Map mempty) + +propPretty :: Text -> [Text] -> Property +propPretty plain prettyLines = + withTests 1 . property $ do + value <- either fail pure $ EDN.parseText "" plain + EDN.renderText value === plain + Text.lines (EDN.prettyText value) === prettyLines + +prop_pretty_examples :: Property +prop_pretty_examples = + propPretty + "{list (volume own would using shown small pound lady fill luck we flat education)\ + \ map {company grabbed dress fully excited enter goose forth require see sport studied}\ + \ set #{below best clearly explanation laid quiet race ring stopped street various}\ + \ vec [right square or seed thumb catch lose sold you talk combine troops steel vessels]}" + [ "{list (volume" + , " own" + , " would" + , " using" + , " shown" + , " small" + , " pound" + , " lady" + , " fill" + , " luck" + , " we" + , " flat" + , " education)" + , " map {company grabbed" + , " dress fully" + , " excited enter" + , " goose forth" + , " require see" + , " sport studied}" + , " set #{below" + , " best" + , " clearly" + , " explanation" + , " laid" + , " quiet" + , " race" + , " ring" + , " stopped" + , " street" + , " various}" + , " vec [right" + , " square" + , " or" + , " seed" + , " thumb" + , " catch" + , " lose" + , " sold" + , " you" + , " talk" + , " combine" + , " troops" + , " steel" + , " vessels]}" + ]