From 438ac2d45d6543f6e616840b72605d162b6a19f6 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Mon, 4 Nov 2024 08:32:36 +0100 Subject: [PATCH 1/5] Added PrettyAnn class (#222) --- prettyprinter/src/Prettyprinter.hs | 2 +- prettyprinter/src/Prettyprinter/Internal.hs | 112 ++++++++++++++++++-- 2 files changed, 102 insertions(+), 12 deletions(-) diff --git a/prettyprinter/src/Prettyprinter.hs b/prettyprinter/src/Prettyprinter.hs index bf44528e..1b24209f 100644 --- a/prettyprinter/src/Prettyprinter.hs +++ b/prettyprinter/src/Prettyprinter.hs @@ -198,7 +198,7 @@ module Prettyprinter ( Doc, -- * Basic functionality - Pretty(..), + Pretty(..), PrettyAnn(..), viaShow, unsafeViaShow, emptyDoc, nest, line, line', softline, softline', hardline, diff --git a/prettyprinter/src/Prettyprinter/Internal.hs b/prettyprinter/src/Prettyprinter/Internal.hs index 27f02c8d..95dc4790 100755 --- a/prettyprinter/src/Prettyprinter/Internal.hs +++ b/prettyprinter/src/Prettyprinter/Internal.hs @@ -1,11 +1,14 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} {-# OPTIONS_HADDOCK not-home #-} @@ -23,7 +26,7 @@ module Prettyprinter.Internal ( Doc(..), -- * Basic functionality - Pretty(..), + Pretty(..), PrettyAnn(..), viaShow, unsafeViaShow, unsafeTextWithoutNewlines, emptyDoc, nest, line, line', softline, softline', hardline, @@ -347,6 +350,54 @@ instance Pretty Char where prettyList = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" #endif +-- | This class is similar to 'Pretty', but allows you to embed annotations in +-- the 'Doc'. +-- +-- @since 1.7.1 +class PrettyAnn a ann where + + prettyAnn :: a -> Doc ann + + default prettyAnn :: Show a => a -> Doc ann + prettyAnn = viaShow + + prettyAnnList :: [a] -> Doc ann + prettyAnnList = align . list . map prettyAnn + +instance PrettyAnn (Doc ann) ann where + prettyAnn = id + +instance PrettyAnn a ann => PrettyAnn (Const a b) ann where + prettyAnn = prettyAnn . getConst + +#if FUNCTOR_IDENTITY_IN_BASE +instance PrettyAnn a ann => PrettyAnn (Identity a) ann where + prettyAnn = prettyAnn . runIdentity +#endif + +instance PrettyAnn a ann => PrettyAnn [a] ann where + prettyAnn = prettyAnnList + +instance PrettyAnn a ann => PrettyAnn (NonEmpty a) ann where + prettyAnn (x:|xs) = prettyAnnList (x:xs) + +instance PrettyAnn () ann where + prettyAnn _ = "()" + +instance PrettyAnn Bool ann where + prettyAnn True = "True" + prettyAnn False = "False" + +instance PrettyAnn Char ann where + prettyAnn '\n' = line + prettyAnn c = Char c + +#ifdef MIN_VERSION_text + prettyAnnList = pretty . (id :: Text -> Text) . fromString +#else + prettyAnnList = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" +#endif + -- | Convenience function to convert a 'Show'able value to a 'Doc'. If the -- 'String' does not contain newlines, consider using the more performant -- 'unsafeViaShow'. @@ -467,6 +518,45 @@ instance Pretty Lazy.Text where pretty = pretty . Lazy.toStrict -- [] instance Pretty Void where pretty = absurd +instance PrettyAnn Int ann where prettyAnn = unsafeViaShow +instance PrettyAnn Int8 ann where prettyAnn = unsafeViaShow +instance PrettyAnn Int16 ann where prettyAnn = unsafeViaShow +instance PrettyAnn Int32 ann where prettyAnn = unsafeViaShow +instance PrettyAnn Int64 ann where prettyAnn = unsafeViaShow +instance PrettyAnn Word ann where prettyAnn = unsafeViaShow +instance PrettyAnn Word8 ann where prettyAnn = unsafeViaShow +instance PrettyAnn Word16 ann where prettyAnn = unsafeViaShow +instance PrettyAnn Word32 ann where prettyAnn = unsafeViaShow +instance PrettyAnn Word64 ann where prettyAnn = unsafeViaShow + +instance PrettyAnn Integer ann where prettyAnn = unsafeViaShow + +#if NATURAL_IN_BASE +instance PrettyAnn Natural ann where prettyAnn = unsafeViaShow +#endif + +instance PrettyAnn Float ann where prettyAnn = unsafeViaShow + +instance PrettyAnn Double ann where prettyAnn = unsafeViaShow + +instance (PrettyAnn a1 ann, PrettyAnn a2 ann) => PrettyAnn (a1,a2) ann where + prettyAnn (x1,x2) = tupled [prettyAnn x1, prettyAnn x2] + +instance (PrettyAnn a1 ann, PrettyAnn a2 ann, PrettyAnn a3 ann) => PrettyAnn (a1,a2,a3) ann where + prettyAnn (x1,x2,x3) = tupled [prettyAnn x1, prettyAnn x2, prettyAnn x3] + +instance PrettyAnn a ann => PrettyAnn (Maybe a) ann where + prettyAnn = maybe mempty prettyAnn + prettyAnnList = prettyAnnList . catMaybes + +#ifdef MIN_VERSION_text +instance PrettyAnn Text ann where prettyAnn = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" + +instance PrettyAnn Lazy.Text ann where prettyAnn = prettyAnn . Lazy.toStrict +#endif + +instance PrettyAnn Void ann where prettyAnn = absurd + -- | @(unsafeTextWithoutNewlines s)@ contains the literal string @s@. @@ -1810,8 +1900,8 @@ defaultLayoutOptions = LayoutOptions { layoutPageWidth = defaultPageWidth } -- | This is the default layout algorithm, and it is used by 'show', 'putDoc' -- and 'hPutDoc'. -- --- @'layoutPretty'@ commits to rendering something in a certain way if the --- remainder of the current line fits the layout constraints; in other words, +-- @'layoutPretty'@ commits to rendering something in a certain way if the +-- remainder of the current line fits the layout constraints; in other words, -- it has up to one line of lookahead when rendering. Consider using the -- smarter, but a bit less performant, @'layoutSmart'@ algorithm if the results -- seem to run off to the right before having lots of line breaks. From 0e3a364f5b75f4e30563a60ea3f32606aea2eb32 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 10 Dec 2024 23:06:56 +0100 Subject: [PATCH 2/5] Swapped positions of the type parameters of PrettyAnn --- prettyprinter/src/Prettyprinter/Internal.hs | 58 ++++++++++----------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/prettyprinter/src/Prettyprinter/Internal.hs b/prettyprinter/src/Prettyprinter/Internal.hs index 95dc4790..7e3bd77e 100755 --- a/prettyprinter/src/Prettyprinter/Internal.hs +++ b/prettyprinter/src/Prettyprinter/Internal.hs @@ -354,7 +354,7 @@ instance Pretty Char where -- the 'Doc'. -- -- @since 1.7.1 -class PrettyAnn a ann where +class PrettyAnn ann a where prettyAnn :: a -> Doc ann @@ -364,31 +364,31 @@ class PrettyAnn a ann where prettyAnnList :: [a] -> Doc ann prettyAnnList = align . list . map prettyAnn -instance PrettyAnn (Doc ann) ann where +instance PrettyAnn ann (Doc ann) where prettyAnn = id -instance PrettyAnn a ann => PrettyAnn (Const a b) ann where +instance PrettyAnn ann a => PrettyAnn ann (Const a b) where prettyAnn = prettyAnn . getConst #if FUNCTOR_IDENTITY_IN_BASE -instance PrettyAnn a ann => PrettyAnn (Identity a) ann where +instance PrettyAnn ann a => PrettyAnn ann (Identity a) where prettyAnn = prettyAnn . runIdentity #endif -instance PrettyAnn a ann => PrettyAnn [a] ann where +instance PrettyAnn ann a => PrettyAnn ann [a] where prettyAnn = prettyAnnList -instance PrettyAnn a ann => PrettyAnn (NonEmpty a) ann where +instance PrettyAnn ann a => PrettyAnn ann (NonEmpty a) where prettyAnn (x:|xs) = prettyAnnList (x:xs) -instance PrettyAnn () ann where +instance PrettyAnn ann () where prettyAnn _ = "()" -instance PrettyAnn Bool ann where +instance PrettyAnn ann Bool where prettyAnn True = "True" prettyAnn False = "False" -instance PrettyAnn Char ann where +instance PrettyAnn ann Char where prettyAnn '\n' = line prettyAnn c = Char c @@ -518,44 +518,44 @@ instance Pretty Lazy.Text where pretty = pretty . Lazy.toStrict -- [] instance Pretty Void where pretty = absurd -instance PrettyAnn Int ann where prettyAnn = unsafeViaShow -instance PrettyAnn Int8 ann where prettyAnn = unsafeViaShow -instance PrettyAnn Int16 ann where prettyAnn = unsafeViaShow -instance PrettyAnn Int32 ann where prettyAnn = unsafeViaShow -instance PrettyAnn Int64 ann where prettyAnn = unsafeViaShow -instance PrettyAnn Word ann where prettyAnn = unsafeViaShow -instance PrettyAnn Word8 ann where prettyAnn = unsafeViaShow -instance PrettyAnn Word16 ann where prettyAnn = unsafeViaShow -instance PrettyAnn Word32 ann where prettyAnn = unsafeViaShow -instance PrettyAnn Word64 ann where prettyAnn = unsafeViaShow +instance PrettyAnn ann Int where prettyAnn = unsafeViaShow +instance PrettyAnn ann Int8 where prettyAnn = unsafeViaShow +instance PrettyAnn ann Int16 where prettyAnn = unsafeViaShow +instance PrettyAnn ann Int32 where prettyAnn = unsafeViaShow +instance PrettyAnn ann Int64 where prettyAnn = unsafeViaShow +instance PrettyAnn ann Word where prettyAnn = unsafeViaShow +instance PrettyAnn ann Word8 where prettyAnn = unsafeViaShow +instance PrettyAnn ann Word16 where prettyAnn = unsafeViaShow +instance PrettyAnn ann Word32 where prettyAnn = unsafeViaShow +instance PrettyAnn ann Word64 where prettyAnn = unsafeViaShow -instance PrettyAnn Integer ann where prettyAnn = unsafeViaShow +instance PrettyAnn ann Integer where prettyAnn = unsafeViaShow #if NATURAL_IN_BASE -instance PrettyAnn Natural ann where prettyAnn = unsafeViaShow +instance PrettyAnn ann Natural where prettyAnn = unsafeViaShow #endif -instance PrettyAnn Float ann where prettyAnn = unsafeViaShow +instance PrettyAnn ann Float where prettyAnn = unsafeViaShow -instance PrettyAnn Double ann where prettyAnn = unsafeViaShow +instance PrettyAnn ann Double where prettyAnn = unsafeViaShow -instance (PrettyAnn a1 ann, PrettyAnn a2 ann) => PrettyAnn (a1,a2) ann where +instance (PrettyAnn ann a1, PrettyAnn ann a2) => PrettyAnn ann (a1,a2) where prettyAnn (x1,x2) = tupled [prettyAnn x1, prettyAnn x2] -instance (PrettyAnn a1 ann, PrettyAnn a2 ann, PrettyAnn a3 ann) => PrettyAnn (a1,a2,a3) ann where +instance (PrettyAnn ann a1, PrettyAnn ann a2, PrettyAnn ann a3) => PrettyAnn ann (a1,a2,a3) where prettyAnn (x1,x2,x3) = tupled [prettyAnn x1, prettyAnn x2, prettyAnn x3] -instance PrettyAnn a ann => PrettyAnn (Maybe a) ann where +instance PrettyAnn ann a => PrettyAnn ann (Maybe a) where prettyAnn = maybe mempty prettyAnn prettyAnnList = prettyAnnList . catMaybes #ifdef MIN_VERSION_text -instance PrettyAnn Text ann where prettyAnn = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" +instance PrettyAnn ann Text where prettyAnn = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" -instance PrettyAnn Lazy.Text ann where prettyAnn = prettyAnn . Lazy.toStrict +instance PrettyAnn ann Lazy.Text where prettyAnn = prettyAnn . Lazy.toStrict #endif -instance PrettyAnn Void ann where prettyAnn = absurd +instance PrettyAnn ann Void where prettyAnn = absurd From 10817802335319cc4a20af6e6c77b56e3cc48867 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 2 Dec 2025 22:21:32 +0100 Subject: [PATCH 3/5] Update prettyprinter/src/Prettyprinter/Internal.hs Co-authored-by: Simon Jakobi --- prettyprinter/src/Prettyprinter/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/src/Prettyprinter/Internal.hs b/prettyprinter/src/Prettyprinter/Internal.hs index 7e3bd77e..64dfbd25 100755 --- a/prettyprinter/src/Prettyprinter/Internal.hs +++ b/prettyprinter/src/Prettyprinter/Internal.hs @@ -393,7 +393,7 @@ instance PrettyAnn ann Char where prettyAnn c = Char c #ifdef MIN_VERSION_text - prettyAnnList = pretty . (id :: Text -> Text) . fromString + prettyAnnList = prettyAnn . (id :: Text -> Text) . fromString #else prettyAnnList = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" #endif From 0f48ef7627c69e3e05f2d2028f1bc93cfa8417d2 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 2 Dec 2025 22:21:41 +0100 Subject: [PATCH 4/5] Update prettyprinter/src/Prettyprinter/Internal.hs Co-authored-by: Simon Jakobi --- prettyprinter/src/Prettyprinter/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/src/Prettyprinter/Internal.hs b/prettyprinter/src/Prettyprinter/Internal.hs index 64dfbd25..35639cf3 100755 --- a/prettyprinter/src/Prettyprinter/Internal.hs +++ b/prettyprinter/src/Prettyprinter/Internal.hs @@ -353,7 +353,7 @@ instance Pretty Char where -- | This class is similar to 'Pretty', but allows you to embed annotations in -- the 'Doc'. -- --- @since 1.7.1 +-- @since FIXME class PrettyAnn ann a where prettyAnn :: a -> Doc ann From 93c2b08a3bf8646628f22fac9f06675918af82e2 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Wed, 3 Dec 2025 11:18:57 +1300 Subject: [PATCH 5/5] Define `prettyAnn` in terms of `pretty` where possible --- prettyprinter/src/Prettyprinter/Internal.hs | 55 +++++++++------------ 1 file changed, 24 insertions(+), 31 deletions(-) diff --git a/prettyprinter/src/Prettyprinter/Internal.hs b/prettyprinter/src/Prettyprinter/Internal.hs index 35639cf3..44ad0e02 100755 --- a/prettyprinter/src/Prettyprinter/Internal.hs +++ b/prettyprinter/src/Prettyprinter/Internal.hs @@ -381,22 +381,13 @@ instance PrettyAnn ann a => PrettyAnn ann [a] where instance PrettyAnn ann a => PrettyAnn ann (NonEmpty a) where prettyAnn (x:|xs) = prettyAnnList (x:xs) -instance PrettyAnn ann () where - prettyAnn _ = "()" +instance PrettyAnn ann () where prettyAnn = pretty -instance PrettyAnn ann Bool where - prettyAnn True = "True" - prettyAnn False = "False" +instance PrettyAnn ann Bool where prettyAnn = pretty instance PrettyAnn ann Char where - prettyAnn '\n' = line - prettyAnn c = Char c - -#ifdef MIN_VERSION_text - prettyAnnList = prettyAnn . (id :: Text -> Text) . fromString -#else - prettyAnnList = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" -#endif + prettyAnn = pretty + prettyAnnList = prettyList -- | Convenience function to convert a 'Show'able value to a 'Doc'. If the -- 'String' does not contain newlines, consider using the more performant @@ -505,10 +496,12 @@ instance Pretty a => Pretty (Maybe a) where -- hello world -- -- Manually use @'hardline'@ if you /definitely/ want newlines. -instance Pretty Text where pretty = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" +instance Pretty Text where + pretty = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" -- | (lazy 'Text' instance, identical to the strict version) -instance Pretty Lazy.Text where pretty = pretty . Lazy.toStrict +instance Pretty Lazy.Text + where pretty = pretty . Lazy.toStrict #endif -- | Finding a good example for printing something that does not exist is hard, @@ -518,26 +511,26 @@ instance Pretty Lazy.Text where pretty = pretty . Lazy.toStrict -- [] instance Pretty Void where pretty = absurd -instance PrettyAnn ann Int where prettyAnn = unsafeViaShow -instance PrettyAnn ann Int8 where prettyAnn = unsafeViaShow -instance PrettyAnn ann Int16 where prettyAnn = unsafeViaShow -instance PrettyAnn ann Int32 where prettyAnn = unsafeViaShow -instance PrettyAnn ann Int64 where prettyAnn = unsafeViaShow -instance PrettyAnn ann Word where prettyAnn = unsafeViaShow -instance PrettyAnn ann Word8 where prettyAnn = unsafeViaShow -instance PrettyAnn ann Word16 where prettyAnn = unsafeViaShow -instance PrettyAnn ann Word32 where prettyAnn = unsafeViaShow -instance PrettyAnn ann Word64 where prettyAnn = unsafeViaShow +instance PrettyAnn ann Int where prettyAnn = pretty +instance PrettyAnn ann Int8 where prettyAnn = pretty +instance PrettyAnn ann Int16 where prettyAnn = pretty +instance PrettyAnn ann Int32 where prettyAnn = pretty +instance PrettyAnn ann Int64 where prettyAnn = pretty +instance PrettyAnn ann Word where prettyAnn = pretty +instance PrettyAnn ann Word8 where prettyAnn = pretty +instance PrettyAnn ann Word16 where prettyAnn = pretty +instance PrettyAnn ann Word32 where prettyAnn = pretty +instance PrettyAnn ann Word64 where prettyAnn = pretty -instance PrettyAnn ann Integer where prettyAnn = unsafeViaShow +instance PrettyAnn ann Integer where prettyAnn = pretty #if NATURAL_IN_BASE -instance PrettyAnn ann Natural where prettyAnn = unsafeViaShow +instance PrettyAnn ann Natural where prettyAnn = pretty #endif -instance PrettyAnn ann Float where prettyAnn = unsafeViaShow +instance PrettyAnn ann Float where prettyAnn = pretty -instance PrettyAnn ann Double where prettyAnn = unsafeViaShow +instance PrettyAnn ann Double where prettyAnn = pretty instance (PrettyAnn ann a1, PrettyAnn ann a2) => PrettyAnn ann (a1,a2) where prettyAnn (x1,x2) = tupled [prettyAnn x1, prettyAnn x2] @@ -550,9 +543,9 @@ instance PrettyAnn ann a => PrettyAnn ann (Maybe a) where prettyAnnList = prettyAnnList . catMaybes #ifdef MIN_VERSION_text -instance PrettyAnn ann Text where prettyAnn = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n" +instance PrettyAnn ann Text where prettyAnn = pretty -instance PrettyAnn ann Lazy.Text where prettyAnn = prettyAnn . Lazy.toStrict +instance PrettyAnn ann Lazy.Text where prettyAnn = pretty #endif instance PrettyAnn ann Void where prettyAnn = absurd