From 6f8da2e3a1ed6cd748cc12189738ce98717792a0 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Tue, 21 Jan 2020 02:36:19 +0100 Subject: [PATCH 1/8] Change group to reveal failing Union alternatives more prominently Addresses one idea from #112. --- .../src/Data/Text/Prettyprint/Doc/Internal.hs | 49 ++++++++++++------- 1 file changed, 31 insertions(+), 18 deletions(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index 9552ff50..c9ecab97 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -524,8 +524,9 @@ hardline = Line group :: Doc ann -> Doc ann -- See note [Group: special flattening] group x = case changesUponFlattening x of - Nothing -> x - Just x' -> Union x' x + Flattened x' -> Union x' x + Flat -> x + Unflattenable -> Union Fail x -- Note [Group: special flattening] -- @@ -540,6 +541,16 @@ group x = case changesUponFlattening x of -- See https://github.com/quchen/prettyprinter/issues/22 for the corresponding -- ticket. +data FlattenResult a + = Flattened a + | Flat + | Unflattenable + +instance Functor FlattenResult where + fmap f (Flattened a) = Flattened (f a) + fmap _ Flat = Flat + fmap _ Unflattenable = Unflattenable + -- | Choose the first element of each @Union@, and discard the first field of -- all @FlatAlt@s. -- @@ -547,28 +558,30 @@ group x = case changesUponFlattening x of -- algorithm (i.e. contains differently renderable sub-documents), and 'Nothing' -- if the document is static (e.g. contains only a plain 'Empty' node). See -- [Group: special flattening] for further explanations. -changesUponFlattening :: Doc ann -> Maybe (Doc ann) +changesUponFlattening :: Doc ann -> FlattenResult (Doc ann) changesUponFlattening = \doc -> case doc of - FlatAlt _ y -> Just (flatten y) - Line -> Just Fail - Union x _ -> changesUponFlattening x <|> Just x + FlatAlt _ y -> Flattened (flatten y) + Line -> Unflattenable + Union x _ -> Flattened x Nest i x -> fmap (Nest i) (changesUponFlattening x) Annotated ann x -> fmap (Annotated ann) (changesUponFlattening x) - Column f -> Just (Column (flatten . f)) - Nesting f -> Just (Nesting (flatten . f)) - WithPageWidth f -> Just (WithPageWidth (flatten . f)) + Column f -> Flattened (Column (flatten . f)) + Nesting f -> Flattened (Nesting (flatten . f)) + WithPageWidth f -> Flattened (WithPageWidth (flatten . f)) Cat x y -> case (changesUponFlattening x, changesUponFlattening y) of - (Nothing, Nothing) -> Nothing - (Just x', Nothing) -> Just (Cat x' y ) - (Nothing, Just y') -> Just (Cat x y') - (Just x', Just y') -> Just (Cat x' y') - - Empty -> Nothing - Char{} -> Nothing - Text{} -> Nothing - Fail -> Nothing + (Unflattenable, _ ) -> Unflattenable + (_ , Unflattenable) -> Unflattenable + (Flattened x' , Flattened y') -> Flattened (Cat x' y') + (Flattened x' , Flat) -> Flattened (Cat x' y) + (Flat , Flattened y') -> Flattened (Cat x y') + (Flat , Flat) -> Flat + + Empty -> Flat + Char{} -> Flat + Text{} -> Flat + Fail -> Flat -- TODO: Or Unflattenable?! where -- Flatten, but don’t report whether anything changes. flatten :: Doc ann -> Doc ann From cad6a232c6c784828419ab09cba8abec84f7dc0d Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Tue, 21 Jan 2020 02:39:00 +0100 Subject: [PATCH 2/8] Fail is Unflattenable --- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index c9ecab97..87fb26ce 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -581,7 +581,7 @@ changesUponFlattening = \doc -> case doc of Empty -> Flat Char{} -> Flat Text{} -> Flat - Fail -> Flat -- TODO: Or Unflattenable?! + Fail -> Unflattenable where -- Flatten, but don’t report whether anything changes. flatten :: Doc ann -> Doc ann From f5362d4a24175eb567eb971be32ea4e7591022ba Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Tue, 21 Jan 2020 02:39:59 +0100 Subject: [PATCH 3/8] Better names? --- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index 87fb26ce..31ab39f8 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -543,8 +543,8 @@ group x = case changesUponFlattening x of data FlattenResult a = Flattened a - | Flat - | Unflattenable + | Flat -- TODO: AlreadyFlat!? + | Unflattenable -- TODO: NeverFlat!? instance Functor FlattenResult where fmap f (Flattened a) = Flattened (f a) From 821f2864748a863d5260c9351709f89d6043f8c2 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Tue, 21 Jan 2020 02:41:23 +0100 Subject: [PATCH 4/8] Return x instead of (Union Fail x) This addresses https://github.com/quchen/prettyprinter/issues/112#issuecomment-576477507. --- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index 31ab39f8..c0f237ff 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -526,7 +526,7 @@ group :: Doc ann -> Doc ann group x = case changesUponFlattening x of Flattened x' -> Union x' x Flat -> x - Unflattenable -> Union Fail x + Unflattenable -> x -- Note [Group: special flattening] -- From 7c4551a2c5e3baf75fa98b80059d66e751f4d2d0 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Tue, 21 Jan 2020 03:49:12 +0100 Subject: [PATCH 5/8] Better names, docs --- .../src/Data/Text/Prettyprint/Doc/Internal.hs | 54 +++++++++++-------- 1 file changed, 31 insertions(+), 23 deletions(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index c0f237ff..b04510cd 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -524,9 +524,9 @@ hardline = Line group :: Doc ann -> Doc ann -- See note [Group: special flattening] group x = case changesUponFlattening x of - Flattened x' -> Union x' x - Flat -> x - Unflattenable -> x + Flattened x' -> Union x' x + AlreadyFlat -> x + NeverFlat -> x -- Note [Group: special flattening] -- @@ -542,26 +542,34 @@ group x = case changesUponFlattening x of -- ticket. data FlattenResult a + + -- | a is likely flatter than the input. = Flattened a - | Flat -- TODO: AlreadyFlat!? - | Unflattenable -- TODO: NeverFlat!? + + -- | The input was already flat, e.g. a 'Text'. + | AlreadyFlat + + -- | The input couldn't be flattened: It contained a 'Line' or 'Fail'. + | NeverFlat instance Functor FlattenResult where fmap f (Flattened a) = Flattened (f a) - fmap _ Flat = Flat - fmap _ Unflattenable = Unflattenable + fmap _ AlreadyFlat = AlreadyFlat + fmap _ NeverFlat = NeverFlat -- | Choose the first element of each @Union@, and discard the first field of -- all @FlatAlt@s. -- --- The result is 'Just' if the element might change depending on the layout --- algorithm (i.e. contains differently renderable sub-documents), and 'Nothing' --- if the document is static (e.g. contains only a plain 'Empty' node). See --- [Group: special flattening] for further explanations. +-- The result is 'Flattened' if the element might change depending on the layout +-- algorithm (i.e. contains differently renderable sub-documents), and 'AlreadyFlat' +-- if the document is static (e.g. contains only a plain 'Empty' node). +-- 'NeverFlat' is returned when the document cannot be flattened because it +-- contains a 'Line' or 'Fail'. +-- See [Group: special flattening] for further explanations. changesUponFlattening :: Doc ann -> FlattenResult (Doc ann) changesUponFlattening = \doc -> case doc of FlatAlt _ y -> Flattened (flatten y) - Line -> Unflattenable + Line -> NeverFlat Union x _ -> Flattened x Nest i x -> fmap (Nest i) (changesUponFlattening x) Annotated ann x -> fmap (Annotated ann) (changesUponFlattening x) @@ -571,17 +579,17 @@ changesUponFlattening = \doc -> case doc of WithPageWidth f -> Flattened (WithPageWidth (flatten . f)) Cat x y -> case (changesUponFlattening x, changesUponFlattening y) of - (Unflattenable, _ ) -> Unflattenable - (_ , Unflattenable) -> Unflattenable - (Flattened x' , Flattened y') -> Flattened (Cat x' y') - (Flattened x' , Flat) -> Flattened (Cat x' y) - (Flat , Flattened y') -> Flattened (Cat x y') - (Flat , Flat) -> Flat - - Empty -> Flat - Char{} -> Flat - Text{} -> Flat - Fail -> Unflattenable + (NeverFlat , _ ) -> NeverFlat + (_ , NeverFlat ) -> NeverFlat + (Flattened x' , Flattened y') -> Flattened (Cat x' y') + (Flattened x' , AlreadyFlat ) -> Flattened (Cat x' y) + (AlreadyFlat , Flattened y') -> Flattened (Cat x y') + (AlreadyFlat , AlreadyFlat ) -> AlreadyFlat + + Empty -> AlreadyFlat + Char{} -> AlreadyFlat + Text{} -> AlreadyFlat + Fail -> NeverFlat where -- Flatten, but don’t report whether anything changes. flatten :: Doc ann -> Doc ann From 5a40e84093b828ed23ab3ed346d0ed8c7402a2fd Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Tue, 21 Jan 2020 03:53:35 +0100 Subject: [PATCH 6/8] Wibble --- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index b04510cd..5a63b5f6 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -564,7 +564,7 @@ instance Functor FlattenResult where -- algorithm (i.e. contains differently renderable sub-documents), and 'AlreadyFlat' -- if the document is static (e.g. contains only a plain 'Empty' node). -- 'NeverFlat' is returned when the document cannot be flattened because it --- contains a 'Line' or 'Fail'. +-- contains a hard 'Line' or 'Fail'. -- See [Group: special flattening] for further explanations. changesUponFlattening :: Doc ann -> FlattenResult (Doc ann) changesUponFlattening = \doc -> case doc of From b1d20da5e81937458a3ad021b95640bf25474fbb Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Tue, 21 Jan 2020 03:56:24 +0100 Subject: [PATCH 7/8] Save space --- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index 5a63b5f6..9644de7a 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -542,15 +542,12 @@ group x = case changesUponFlattening x of -- ticket. data FlattenResult a - - -- | a is likely flatter than the input. = Flattened a - - -- | The input was already flat, e.g. a 'Text'. + -- ^ a is likely flatter than the input. | AlreadyFlat - - -- | The input couldn't be flattened: It contained a 'Line' or 'Fail'. + -- ^ The input was already flat, e.g. a 'Text'. | NeverFlat + -- ^ The input couldn't be flattened: It contained a 'Line' or 'Fail'. instance Functor FlattenResult where fmap f (Flattened a) = Flattened (f a) From 5531a77b54f6c11a7c536c5bda870f97299174b6 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Tue, 21 Jan 2020 05:56:14 +0100 Subject: [PATCH 8/8] Markup --- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index 9644de7a..3af0b5fa 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -543,7 +543,7 @@ group x = case changesUponFlattening x of data FlattenResult a = Flattened a - -- ^ a is likely flatter than the input. + -- ^ @a@ is likely flatter than the input. | AlreadyFlat -- ^ The input was already flat, e.g. a 'Text'. | NeverFlat