From 01154df2a7f2b9311595240c0ac351d4862220aa Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Wed, 6 Nov 2019 11:53:19 +0100 Subject: [PATCH 1/8] Run fusion property test with arbitrary layouters Context: #95 --- prettyprinter/test/Testsuite/Main.hs | 54 ++++++++++++++++++++++++---- 1 file changed, 48 insertions(+), 6 deletions(-) diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs index 97695e0f..9600f323 100644 --- a/prettyprinter/test/Testsuite/Main.hs +++ b/prettyprinter/test/Testsuite/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} #include "version-compatibility-macros.h" @@ -13,9 +14,11 @@ import qualified Data.Text as T import Data.Text.PgpWordlist import Data.Word import System.Timeout (timeout) +import Text.Show.Functions () -import Data.Text.Prettyprint.Doc -import Data.Text.Prettyprint.Doc.Render.Text +import Data.Text.Prettyprint.Doc +import qualified Data.Text.Prettyprint.Doc.Internal as Internal +import Data.Text.Prettyprint.Doc.Render.Text import Test.Tasty import Test.Tasty.HUnit @@ -86,20 +89,59 @@ tests = testGroup "Tests" fusionDoesNotChangeRendering :: FusionDepth -> Property fusionDoesNotChangeRendering depth = forAll document (\doc -> - let rendered = render doc + forAll (layouter :: Gen (LayoutOptions -> Doc Int -> SimpleDocStream Int)) (\layouter_ -> + forAll arbitrary (\layoutOptions -> + let render = renderStrict . layouter_ layoutOptions + rendered = render doc renderedFused = render (fuse depth doc) in counterexample (mkCounterexample rendered renderedFused) - (render doc == render (fuse depth doc)) ) + (render doc == render (fuse depth doc)) ))) where - render = renderStrict . layoutPretty defaultLayoutOptions mkCounterexample rendered renderedFused - = (T.unpack . render . vsep) + = (T.unpack . renderStrict . layoutPretty defaultLayoutOptions . vsep) [ "Unfused and fused documents render differently!" , "Unfused:" , indent 4 (pretty rendered) , "Fused:" , indent 4 (pretty renderedFused) ] +layouter :: CoArbitrary ann => Gen (LayoutOptions -> Doc ann -> SimpleDocStream ann) +layouter = oneof + [ pure layoutPretty + , pure layoutSmart + , pure (const layoutCompact) + -- , Internal.layoutWadlerLeijen <$> arbitrary -- too inconsistent for fusionDoesNotChangeRendering + ] + +instance Arbitrary LayoutOptions where + arbitrary = LayoutOptions <$> oneof + [ AvailablePerLine <$> arbitrary <*> arbitrary + -- , pure Unbounded -- https://github.com/quchen/prettyprinter/issues/91 + ] + +instance CoArbitrary ann => Arbitrary (Internal.FittingPredicate ann) where + arbitrary = Internal.FittingPredicate <$> arbitrary + +instance CoArbitrary ann => CoArbitrary (SimpleDocStream ann) where + -- TODO: It might be more realistic to ignore the 'Char', 'Text' and 'ann' + -- values in the fitting predicate + coarbitrary s0 = case s0 of + SFail -> variant' 0 + SEmpty -> variant' 1 + SChar c s -> variant' 2 . coarbitrary (c, s) + SText l t s -> variant' 3 . coarbitrary (l, T.unpack t, s) + SLine i s -> variant' 4 . coarbitrary (i, s) + SAnnPush a s -> variant' 5 . coarbitrary (a, s) + SAnnPop s -> variant' 6 . coarbitrary s + +instance CoArbitrary PageWidth where + coarbitrary (AvailablePerLine a b) = variant' 0 . coarbitrary (a, b) + coarbitrary Unbounded = variant' 1 + +-- | Silences type defaulting warnings for 'variant' +variant' :: Int -> Gen a -> Gen a +variant' = variant + newtype RandomDoc ann = RandomDoc (Doc ann) instance Arbitrary (RandomDoc ann) where From 8809f58847b44a7ba891133d120c335931b815d6 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 20 Jan 2020 03:30:28 +0100 Subject: [PATCH 2/8] Move code around, comment out unneeded instances --- prettyprinter/test/Testsuite/Main.hs | 77 ++++++++++++++-------------- 1 file changed, 39 insertions(+), 38 deletions(-) diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs index 9600f323..4aaf99c4 100644 --- a/prettyprinter/test/Testsuite/Main.hs +++ b/prettyprinter/test/Testsuite/Main.hs @@ -17,7 +17,6 @@ import System.Timeout (timeout) import Text.Show.Functions () import Data.Text.Prettyprint.Doc -import qualified Data.Text.Prettyprint.Doc.Internal as Internal import Data.Text.Prettyprint.Doc.Render.Text import Test.Tasty @@ -105,43 +104,6 @@ fusionDoesNotChangeRendering depth , "Fused:" , indent 4 (pretty renderedFused) ] -layouter :: CoArbitrary ann => Gen (LayoutOptions -> Doc ann -> SimpleDocStream ann) -layouter = oneof - [ pure layoutPretty - , pure layoutSmart - , pure (const layoutCompact) - -- , Internal.layoutWadlerLeijen <$> arbitrary -- too inconsistent for fusionDoesNotChangeRendering - ] - -instance Arbitrary LayoutOptions where - arbitrary = LayoutOptions <$> oneof - [ AvailablePerLine <$> arbitrary <*> arbitrary - -- , pure Unbounded -- https://github.com/quchen/prettyprinter/issues/91 - ] - -instance CoArbitrary ann => Arbitrary (Internal.FittingPredicate ann) where - arbitrary = Internal.FittingPredicate <$> arbitrary - -instance CoArbitrary ann => CoArbitrary (SimpleDocStream ann) where - -- TODO: It might be more realistic to ignore the 'Char', 'Text' and 'ann' - -- values in the fitting predicate - coarbitrary s0 = case s0 of - SFail -> variant' 0 - SEmpty -> variant' 1 - SChar c s -> variant' 2 . coarbitrary (c, s) - SText l t s -> variant' 3 . coarbitrary (l, T.unpack t, s) - SLine i s -> variant' 4 . coarbitrary (i, s) - SAnnPush a s -> variant' 5 . coarbitrary (a, s) - SAnnPop s -> variant' 6 . coarbitrary s - -instance CoArbitrary PageWidth where - coarbitrary (AvailablePerLine a b) = variant' 0 . coarbitrary (a, b) - coarbitrary Unbounded = variant' 1 - --- | Silences type defaulting warnings for 'variant' -variant' :: Int -> Gen a -> Gen a -variant' = variant - newtype RandomDoc ann = RandomDoc (Doc ann) instance Arbitrary (RandomDoc ann) where @@ -222,6 +184,45 @@ enclosingOfMany = frequency , (1, list <$> listOf document) , (1, tupled <$> listOf document) ] +layouter :: CoArbitrary ann => Gen (LayoutOptions -> Doc ann -> SimpleDocStream ann) +layouter = oneof + [ pure layoutPretty + , pure layoutSmart + , pure (const layoutCompact) + -- , Internal.layoutWadlerLeijen <$> arbitrary -- too inconsistent for fusionDoesNotChangeRendering + ] + +instance Arbitrary LayoutOptions where + arbitrary = LayoutOptions <$> oneof + [ AvailablePerLine <$> arbitrary <*> arbitrary + -- , pure Unbounded -- https://github.com/quchen/prettyprinter/issues/91 + ] + +{- +instance CoArbitrary ann => Arbitrary (Internal.FittingPredicate ann) where + arbitrary = Internal.FittingPredicate <$> arbitrary + +instance CoArbitrary ann => CoArbitrary (SimpleDocStream ann) where + -- TODO: It might be more realistic to ignore the 'Char', 'Text' and 'ann' + -- values in the fitting predicate + coarbitrary s0 = case s0 of + SFail -> variant' 0 + SEmpty -> variant' 1 + SChar c s -> variant' 2 . coarbitrary (c, s) + SText l t s -> variant' 3 . coarbitrary (l, T.unpack t, s) + SLine i s -> variant' 4 . coarbitrary (i, s) + SAnnPush a s -> variant' 5 . coarbitrary (a, s) + SAnnPop s -> variant' 6 . coarbitrary s + +instance CoArbitrary PageWidth where + coarbitrary (AvailablePerLine a b) = variant' 0 . coarbitrary (a, b) + coarbitrary Unbounded = variant' 1 + +-- | Silences type defaulting warnings for 'variant' +variant' :: Int -> Gen a -> Gen a +variant' = variant +-} + -- QuickCheck 2.8 does not have 'scale' yet, so for compatibility with older -- releases we hand-code it here dampen :: Gen a -> Gen a From 4cd68f6cb30101590400599f4291996c6de9a122 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 20 Jan 2020 03:52:49 +0100 Subject: [PATCH 3/8] Generate 'show'able data, then interpret it --- prettyprinter/test/Testsuite/Main.hs | 33 ++++++++++++++++++---------- 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs index 4aaf99c4..0367ea34 100644 --- a/prettyprinter/test/Testsuite/Main.hs +++ b/prettyprinter/test/Testsuite/Main.hs @@ -14,7 +14,6 @@ import qualified Data.Text as T import Data.Text.PgpWordlist import Data.Word import System.Timeout (timeout) -import Text.Show.Functions () import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Render.Text @@ -88,13 +87,12 @@ tests = testGroup "Tests" fusionDoesNotChangeRendering :: FusionDepth -> Property fusionDoesNotChangeRendering depth = forAll document (\doc -> - forAll (layouter :: Gen (LayoutOptions -> Doc Int -> SimpleDocStream Int)) (\layouter_ -> - forAll arbitrary (\layoutOptions -> - let render = renderStrict . layouter_ layoutOptions + forAll arbitrary (\layouter -> + let render = renderStrict . layout layouter rendered = render doc renderedFused = render (fuse depth doc) in counterexample (mkCounterexample rendered renderedFused) - (render doc == render (fuse depth doc)) ))) + (render doc == render (fuse depth doc)) )) where mkCounterexample rendered renderedFused = (T.unpack . renderStrict . layoutPretty defaultLayoutOptions . vsep) @@ -184,13 +182,24 @@ enclosingOfMany = frequency , (1, list <$> listOf document) , (1, tupled <$> listOf document) ] -layouter :: CoArbitrary ann => Gen (LayoutOptions -> Doc ann -> SimpleDocStream ann) -layouter = oneof - [ pure layoutPretty - , pure layoutSmart - , pure (const layoutCompact) - -- , Internal.layoutWadlerLeijen <$> arbitrary -- too inconsistent for fusionDoesNotChangeRendering - ] +data Layouter + = LayoutPretty LayoutOptions + | LayoutSmart LayoutOptions + | LayoutCompact + -- LayoutWadlerLeijen FittingPredicate + deriving Show + +instance Arbitrary Layouter where + arbitrary = oneof + [ LayoutPretty <$> arbitrary + , LayoutSmart <$> arbitrary + , pure LayoutCompact + ] + +layout :: Layouter -> Doc ann -> SimpleDocStream ann +layout (LayoutPretty opts) = layoutPretty opts +layout (LayoutSmart opts) = layoutSmart opts +layout LayoutCompact = layoutCompact instance Arbitrary LayoutOptions where arbitrary = LayoutOptions <$> oneof From ab7e9bbb6ad3f555ba341d7df37f9284d7305a6d Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 20 Jan 2020 04:21:33 +0100 Subject: [PATCH 4/8] Show property test failures via diag, add shrinking --- prettyprinter/prettyprinter.cabal | 1 + prettyprinter/test/Testsuite/Main.hs | 13 +++++++------ 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/prettyprinter/prettyprinter.cabal b/prettyprinter/prettyprinter.cabal index 609c8441..31aed816 100644 --- a/prettyprinter/prettyprinter.cabal +++ b/prettyprinter/prettyprinter.cabal @@ -124,6 +124,7 @@ test-suite testsuite , pgp-wordlist >= 0.1 , bytestring >= 0.10 + , quickcheck-instances >= 0.3 , tasty >= 0.10 , tasty-hunit >= 0.9 , tasty-quickcheck >= 0.8 diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs index 0367ea34..89db2929 100644 --- a/prettyprinter/test/Testsuite/Main.hs +++ b/prettyprinter/test/Testsuite/Main.hs @@ -16,8 +16,10 @@ import Data.Word import System.Timeout (timeout) import Data.Text.Prettyprint.Doc +import Data.Text.Prettyprint.Doc.Internal.Debug import Data.Text.Prettyprint.Doc.Render.Text +import Test.QuickCheck.Instances.Text () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck @@ -86,7 +88,7 @@ tests = testGroup "Tests" fusionDoesNotChangeRendering :: FusionDepth -> Property fusionDoesNotChangeRendering depth - = forAll document (\doc -> + = forAllShrinkShow (arbitrary :: Gen (Doc Int)) shrink (show . diag) (\doc -> forAll arbitrary (\layouter -> let render = renderStrict . layout layouter rendered = render doc @@ -102,10 +104,9 @@ fusionDoesNotChangeRendering depth , "Fused:" , indent 4 (pretty renderedFused) ] -newtype RandomDoc ann = RandomDoc (Doc ann) - -instance Arbitrary (RandomDoc ann) where - arbitrary = fmap RandomDoc document +instance Arbitrary ann => Arbitrary (Doc ann) where + arbitrary = document + shrink = genericShrink document :: Gen (Doc ann) document = (dampen . frequency) @@ -222,6 +223,7 @@ instance CoArbitrary ann => CoArbitrary (SimpleDocStream ann) where SLine i s -> variant' 4 . coarbitrary (i, s) SAnnPush a s -> variant' 5 . coarbitrary (a, s) SAnnPop s -> variant' 6 . coarbitrary s +-} instance CoArbitrary PageWidth where coarbitrary (AvailablePerLine a b) = variant' 0 . coarbitrary (a, b) @@ -230,7 +232,6 @@ instance CoArbitrary PageWidth where -- | Silences type defaulting warnings for 'variant' variant' :: Int -> Gen a -> Gen a variant' = variant --} -- QuickCheck 2.8 does not have 'scale' yet, so for compatibility with older -- releases we hand-code it here From 8cec68c279741d9cc64261984ba813fb54fe473e Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 20 Jan 2020 04:25:28 +0100 Subject: [PATCH 5/8] Document Layouter --- prettyprinter/test/Testsuite/Main.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs index 89db2929..7ce581cf 100644 --- a/prettyprinter/test/Testsuite/Main.hs +++ b/prettyprinter/test/Testsuite/Main.hs @@ -183,6 +183,7 @@ enclosingOfMany = frequency , (1, list <$> listOf document) , (1, tupled <$> listOf document) ] +-- A 'show'able type representing a layout algorithm. data Layouter = LayoutPretty LayoutOptions | LayoutSmart LayoutOptions From c67006db5bce52329c2b8fbef6c4bc827defd9fd Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 20 Jan 2020 05:41:32 +0100 Subject: [PATCH 6/8] Some work on layoutWadlerLeijen, still too broken --- prettyprinter/test/Testsuite/Main.hs | 39 +++++++++++++++------------- 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs index 7ce581cf..08f43e2f 100644 --- a/prettyprinter/test/Testsuite/Main.hs +++ b/prettyprinter/test/Testsuite/Main.hs @@ -16,6 +16,7 @@ import Data.Word import System.Timeout (timeout) import Data.Text.Prettyprint.Doc +import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Internal.Debug import Data.Text.Prettyprint.Doc.Render.Text @@ -88,7 +89,7 @@ tests = testGroup "Tests" fusionDoesNotChangeRendering :: FusionDepth -> Property fusionDoesNotChangeRendering depth - = forAllShrinkShow (arbitrary :: Gen (Doc Int)) shrink (show . diag) (\doc -> + = forAllShow (arbitrary :: Gen (Doc Int)) (show . diag) (\doc -> forAll arbitrary (\layouter -> let render = renderStrict . layout layouter rendered = render doc @@ -184,24 +185,30 @@ enclosingOfMany = frequency , (1, tupled <$> listOf document) ] -- A 'show'able type representing a layout algorithm. -data Layouter +data Layouter ann = LayoutPretty LayoutOptions | LayoutSmart LayoutOptions | LayoutCompact - -- LayoutWadlerLeijen FittingPredicate + | LayoutWadlerLeijen (FittingPredicate ann) LayoutOptions deriving Show -instance Arbitrary Layouter where +instance Show (FittingPredicate ann) where + show _ = "" + +instance CoArbitrary ann => Arbitrary (Layouter ann) where arbitrary = oneof [ LayoutPretty <$> arbitrary , LayoutSmart <$> arbitrary , pure LayoutCompact + -- This produces inconsistent layouts that break the fusionDoesNotChangeRendering test + -- , LayoutWadlerLeijen <$> arbitrary <*> arbitrary ] -layout :: Layouter -> Doc ann -> SimpleDocStream ann +layout :: Layouter ann -> Doc ann -> SimpleDocStream ann layout (LayoutPretty opts) = layoutPretty opts layout (LayoutSmart opts) = layoutSmart opts layout LayoutCompact = layoutCompact +layout (LayoutWadlerLeijen fp opts) = layoutWadlerLeijen fp opts instance Arbitrary LayoutOptions where arbitrary = LayoutOptions <$> oneof @@ -209,22 +216,18 @@ instance Arbitrary LayoutOptions where -- , pure Unbounded -- https://github.com/quchen/prettyprinter/issues/91 ] -{- -instance CoArbitrary ann => Arbitrary (Internal.FittingPredicate ann) where - arbitrary = Internal.FittingPredicate <$> arbitrary +instance CoArbitrary ann => Arbitrary (FittingPredicate ann) where + arbitrary = FittingPredicate <$> arbitrary instance CoArbitrary ann => CoArbitrary (SimpleDocStream ann) where - -- TODO: It might be more realistic to ignore the 'Char', 'Text' and 'ann' - -- values in the fitting predicate coarbitrary s0 = case s0 of - SFail -> variant' 0 - SEmpty -> variant' 1 - SChar c s -> variant' 2 . coarbitrary (c, s) - SText l t s -> variant' 3 . coarbitrary (l, T.unpack t, s) - SLine i s -> variant' 4 . coarbitrary (i, s) - SAnnPush a s -> variant' 5 . coarbitrary (a, s) - SAnnPop s -> variant' 6 . coarbitrary s --} + SFail -> variant' 0 + SEmpty -> variant' 1 + SChar _c s -> variant' 2 . coarbitrary s + SText l _t s -> variant' 3 . coarbitrary (l, s) + SLine i s -> variant' 4 . coarbitrary (i, s) + SAnnPush _a s -> variant' 5 . coarbitrary s + SAnnPop s -> variant' 6 . coarbitrary s instance CoArbitrary PageWidth where coarbitrary (AvailablePerLine a b) = variant' 0 . coarbitrary (a, b) From 12918c92dd868ab6551d837292ce81e43966e3b8 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 20 Jan 2020 05:43:10 +0100 Subject: [PATCH 7/8] Comment --- prettyprinter/test/Testsuite/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs index 08f43e2f..dfdbedba 100644 --- a/prettyprinter/test/Testsuite/Main.hs +++ b/prettyprinter/test/Testsuite/Main.hs @@ -107,7 +107,7 @@ fusionDoesNotChangeRendering depth instance Arbitrary ann => Arbitrary (Doc ann) where arbitrary = document - shrink = genericShrink + shrink = genericShrink -- Possibly not a good idea, may break invariants document :: Gen (Doc ann) document = (dampen . frequency) From ee16b7b974b60543898058cf69f95e42eeef8fb7 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 20 Jan 2020 05:44:38 +0100 Subject: [PATCH 8/8] Remove redundant constraints --- prettyprinter/test/Testsuite/Main.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs index dfdbedba..4fb9497b 100644 --- a/prettyprinter/test/Testsuite/Main.hs +++ b/prettyprinter/test/Testsuite/Main.hs @@ -195,7 +195,7 @@ data Layouter ann instance Show (FittingPredicate ann) where show _ = "" -instance CoArbitrary ann => Arbitrary (Layouter ann) where +instance Arbitrary (Layouter ann) where arbitrary = oneof [ LayoutPretty <$> arbitrary , LayoutSmart <$> arbitrary @@ -216,10 +216,10 @@ instance Arbitrary LayoutOptions where -- , pure Unbounded -- https://github.com/quchen/prettyprinter/issues/91 ] -instance CoArbitrary ann => Arbitrary (FittingPredicate ann) where +instance Arbitrary (FittingPredicate ann) where arbitrary = FittingPredicate <$> arbitrary -instance CoArbitrary ann => CoArbitrary (SimpleDocStream ann) where +instance CoArbitrary (SimpleDocStream ann) where coarbitrary s0 = case s0 of SFail -> variant' 0 SEmpty -> variant' 1