prettyprinter-combinators 0.1.3 → 0.1.4

raw patch · 6 files changed

+409/−84 lines, 6 filesdep +os-stringdep +timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: os-string, time

API changes (from Hackage documentation)

Files

• Changelog.md +12/−0
• prettyprinter-combinators.cabal +11/−6
• src/Prettyprinter/Combinators.hs +67/−10
• src/Prettyprinter/Generics.hs +151/−67
• src/Prettyprinter/Instances.hs +166/−0
• src/Prettyprinter/MetaDoc.hs +2/−1

@@ -1,3 +1,15 @@+# 0.1.4++- Add `hPutDocLn`+- Add `ppUTCTimeISO8601`. Add dependency on `time` boot package.+- Add `ppOsString` from `os-string` package+- Add reasonable default implementation for methods for `ppGenericOverride` class method+- Add generic deriving for more types from `base` package like `Data.Functor.Compose`+- Add opt-in `Pretty.Instances` module with orphan instances. Other+  modules don’t reexport it, intended for quick(er) debugging sessions+  where we don’t care about orphans and want to print something on the+  screen as soon as possible.+ # 0.1.3  - Add functions for rendering with specified layout options

@@ -3,7 +3,7 @@ name:   prettyprinter-combinators version:-  0.1.3+  0.1.4 synopsis:   Some useful combinators for the prettyprinter package description:@@ -25,11 +25,13 @@   Sergey Vinokurov <serg.foo@gmail.com>  tested-with:-  , GHC == 9.2.8-  , GHC == 9.4.7-  , GHC == 9.6.3-  , GHC == 9.8.1-  , GHC == 9.10.1+  , GHC == 9.2+  , GHC == 9.4+  , GHC == 9.6+  , GHC == 9.8+  , GHC == 9.10+  , GHC == 9.12+  , GHC == 9.14  build-type:   Simple@@ -86,6 +88,7 @@     Prettyprinter.Combinators     Prettyprinter.Data     Prettyprinter.Generics+    Prettyprinter.Instances     Prettyprinter.MetaDoc     Prettyprinter.Show   other-modules:@@ -98,11 +101,13 @@     , bytestring     , containers     , dlist+    , os-string     , pretty-show >= 1.6     , prettyprinter >= 1.7     , syb     , template-haskell >= 2.18     , text+    , time     , unordered-containers     , vector 

@@ -13,6 +13,7 @@   ( Pretty(..)   , PP.Doc   , putDocLn+  , hPutDocLn   , render   , renderLazy   , renderString@@ -61,6 +62,8 @@   , ppVectorWith   , ppDList   , ppDListWith+  , ppSeq+  , ppSeqWith   , ppListWithDelim   , ppAssocList   , ppAssocListWith@@ -70,6 +73,12 @@   , ppShortByteString   , ppCallStack   , ppCallStackGHC+  , ppUTCTimeISO8601+  , ppOsString+  , ppRatio+  , ppRatioWith+  , ppComplex+  , ppComplexWith  #ifdef HAVE_ENUMMAPSET   , ppEnumSet@@ -84,6 +93,7 @@ import Data.ByteString.Char8 qualified as C8 import Data.ByteString.Lazy.Char8 qualified as CL8 import Data.ByteString.Short qualified as ShortBS+import Data.Complex (Complex(..)) import Data.DList (DList) import Data.DList qualified as DL import Data.Foldable@@ -98,16 +108,24 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Map.Strict (Map) import Data.Map.Strict qualified as M+import Data.Sequence (Seq) import Data.Set (Set) import Data.Text qualified as T import Data.Text.Lazy qualified as TL+import Data.Time (UTCTime)+import Data.Time.Format.ISO8601 qualified as ISO8601 import Data.Vector.Generic qualified as G+import GHC.Real (Ratio(..)) import GHC.Stack (CallStack, SrcLoc(..), getCallStack, prettySrcLoc) import Prettyprinter (Pretty(..), Doc, (<+>)) import Prettyprinter qualified as PP import Prettyprinter.Combinators.Basic import Prettyprinter.MetaDoc import Prettyprinter.Render.Text qualified as PP.Render+import Prettyprinter.Symbols.Ascii qualified as PPAscii+import System.IO (Handle, hPutStrLn, stdout)+import System.OsString (OsString)+import System.OsString qualified as OsString  #ifdef HAVE_ENUMMAPSET import Data.EnumMap (EnumMap)@@ -117,16 +135,22 @@ #endif  putDocLn :: Doc ann -> IO ()-putDocLn x = do-  PP.Render.putDoc x-  putStrLn ""+putDocLn = hPutDocLn stdout +hPutDocLn :: Handle -> Doc ann -> IO ()+hPutDocLn h x = do+  PP.Render.hPutDoc h x+  hPutStrLn h ""++-- @since 0.1.1 render :: Doc ann -> T.Text render = renderWith PP.defaultLayoutOptions +-- @since 0.1.1 renderLazy :: Doc ann -> TL.Text renderLazy = renderLazyWith PP.defaultLayoutOptions +-- @since 0.1.1 renderString :: Doc ann -> String renderString = renderStringWith PP.defaultLayoutOptions @@ -279,16 +303,21 @@ ppDListWith :: (a -> Doc ann) -> DList a -> Doc ann ppDListWith f = ppListWith f . DL.toList +-- @since 0.1.4+ppSeq :: Pretty a => Seq a -> Doc ann+ppSeq = ppSeqWith pretty++-- @since 0.1.4+ppSeqWith :: (a -> Doc ann) -> Seq a -> Doc ann+ppSeqWith f = ppListWith f . toList+ ppListWithDelim   :: forall f ann. Foldable f   => Doc ann   -> Doc ann   -> f (Doc ann)   -> Doc ann-ppListWithDelim = ppListWithDelimSep separator-  where-    separator :: Doc ann-    separator = ","+ppListWithDelim = ppListWithDelimSep PPAscii.comma  ppAssocList :: (Pretty k, Pretty v) => [(k, v)] -> Doc ann ppAssocList =@@ -321,11 +350,11 @@   PP.vcat .   map (\(name, loc) -> PP.hcat         [ docFromString (srcLocModule loc)-        , "."+        , PPAscii.dot         , docFromString name-        , ":"+        , PPAscii.colon         , pretty (srcLocStartLine loc)-        , ":"+        , PPAscii.colon         , pretty (srcLocStartCol loc)         ]         ) .@@ -338,3 +367,31 @@   map (\(name, loc) ->         docFromString name <> ", called at" <+> docFromString (prettySrcLoc loc)) .   getCallStack++-- @since 0.1.4+ppUTCTimeISO8601 :: UTCTime -> Doc ann+ppUTCTimeISO8601 x = case ISO8601.formatShowM ISO8601.iso8601Format x of+  Nothing -> pretty $ show x+  Just y  -> pretty y++-- @since 0.1.4+ppOsString :: OsString -> Doc ann+ppOsString x = case OsString.decodeUtf x of+  Nothing -> pretty $ show x+  Just y  -> pretty y++-- @since 0.1.4+ppRatio :: Pretty a => Ratio a -> Doc ann+ppRatio = ppRatioWith pretty++-- @since 0.1.4+ppRatioWith :: (a -> Doc ann) -> Ratio a -> Doc ann+ppRatioWith f (x :% y) = f x <> PPAscii.slash <> f y++-- @since 0.1.4+ppComplex :: Pretty a => Complex a -> Doc ann+ppComplex = ppComplexWith pretty++-- @since 0.1.4+ppComplexWith :: (a -> Doc ann) -> Complex a -> Doc ann+ppComplexWith f (x :+ y) = f x <+> ":+" <+> f y

@@ -8,6 +8,7 @@  {-# LANGUAGE CPP                  #-} {-# LANGUAGE DataKinds            #-}+{-# LANGUAGE DefaultSignatures    #-} {-# LANGUAGE LambdaCase           #-} {-# LANGUAGE OverloadedStrings    #-} {-# LANGUAGE TypeApplications     #-}@@ -23,18 +24,20 @@   , Generic   ) where +import Control.Applicative (ZipList(..)) import Data.Bimap (Bimap)+import Data.Bits qualified as Bits import Data.ByteString.Char8 qualified as C8 import Data.ByteString.Lazy.Char8 qualified as CL8 import Data.ByteString.Short qualified as ShortBS+import Data.Coerce+import Data.Complex (Complex(..)) import Data.DList (DList) import Data.DList qualified as DL-#ifdef HAVE_ENUMMAPSET-import Data.EnumMap (EnumMap)-import Data.EnumSet (EnumSet)-#endif+import Data.Fixed (Fixed(..)) import Data.Foldable import Data.Functor.Compose+import Data.Functor.Identity (Identity(..)) import Data.HashMap.Strict (HashMap) import Data.HashSet (HashSet) import Data.Int@@ -43,11 +46,17 @@ import Data.Kind import Data.List.NonEmpty (NonEmpty) import Data.Map (Map)+import Data.Monoid as Monoid+import Data.Ord import Data.Proxy+import Data.Semigroup as Semigroup+import Data.Sequence (Seq) import Data.Set (Set) import Data.Text (Text) import Data.Text qualified as T import Data.Text.Lazy qualified as TL+import Data.Time (UTCTime)+import Data.Tuple (Solo(..)) import Data.Vector (Vector) import Data.Void import Data.Word@@ -57,7 +66,13 @@ import GHC.Stack (CallStack) import GHC.TypeLits +#ifdef HAVE_ENUMMAPSET+import Data.EnumMap (EnumMap)+import Data.EnumSet (EnumSet)+#endif+ import Prettyprinter+import Prettyprinter qualified as PP import Prettyprinter.Combinators import Prettyprinter.MetaDoc @@ -107,6 +122,17 @@ --   deriving Pretty via PPGeneric (TestWithDeriving a b) -- :} --+-- With -XDerivingVia+-- >>> :{+-- data TestWithDeriving a b = TestWithDeriving+--   { testSet         :: Maybe (Set a)+--   , testB           :: b+--   , testIntMap      :: IntMap String+--   , testComplexMap  :: Map (Maybe (Set Int)) (IntMap (Set String))+--   }+--   deriving (Generic)+-- deriving via PPGeneric (TestWithDeriving a b) instance (Pretty a, Pretty b) => Pretty (TestWithDeriving a b)+-- :} newtype PPGeneric a = PPGeneric { unPPGeneric :: a }  instance (Generic a, GPretty (Rep a)) => Pretty (PPGeneric a) where@@ -193,6 +219,7 @@  -- 'PPGenericDeriving' to give it a chance to fire before standard 'Pretty'. instance PPGenericOverride a => GPretty (K1 i a) where+  {-# INLINE gpretty #-}   gpretty = ppGenericOverride . unK1  @@ -200,6 +227,8 @@ -- orphans for standard types. class PPGenericOverride a where   ppGenericOverride :: a -> MetaDoc ann+  default ppGenericOverride :: (Generic a, GPretty (Rep a)) => a -> MetaDoc ann+  ppGenericOverride = gpretty . from  ppGenericOverrideDoc :: PPGenericOverride a => a -> Doc ann ppGenericOverrideDoc = mdPayload . ppGenericOverride@@ -207,7 +236,7 @@ newtype PPGenericOverrideToPretty a = PPGenericOverrideToPretty { unPPGenericOverrideToPretty :: a }  instance PPGenericOverride a => Pretty (PPGenericOverrideToPretty a) where-  pretty = mdPayload . ppGenericOverride . unPPGenericOverrideToPretty+  pretty = ppGenericOverrideDoc . unPPGenericOverrideToPretty   -- | Fall back to standard 'Pretty' instance when no override is available.@@ -288,6 +317,14 @@   ppGenericOverride (x :% y) =     ppGenericOverride x <> atomicMetaDoc "/" <> ppGenericOverride y +(<++>) :: MetaDoc ann -> MetaDoc ann -> MetaDoc ann+(<++>) x y = x <> atomicMetaDoc PP.space <> y++instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Complex a) where+  {-# INLINABLE ppGenericOverride #-}+  ppGenericOverride (x :+ y) =+    ppGenericOverride x <++> atomicMetaDoc ":+" <++> ppGenericOverride y+ instance {-# OVERLAPS #-} PPGenericOverride CallStack where   {-# INLINE ppGenericOverride #-}   ppGenericOverride =@@ -323,66 +360,107 @@   {-# INLINE ppGenericOverride #-}   ppGenericOverride = shortByteStringMetaDoc -instance {-# OVERLAPS #-} PPGenericOverride (ForeignPtr a)        where ppGenericOverride = atomicMetaDoc . pretty . show+instance {-# OVERLAPS #-} PPGenericOverride (ForeignPtr a) where+  ppGenericOverride = atomicMetaDoc . pretty . show -instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (TH.TyVarBndr a) where ppGenericOverride = gpretty . from+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (TH.TyVarBndr a) -instance {-# OVERLAPS #-} PPGenericOverride TH.OccName            where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.NameFlavour        where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.PkgName            where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.NameSpace          where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.ModName            where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Name               where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.TyLit              where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Type               where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.SourceUnpackedness where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.SourceStrictness   where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Bang               where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Con                where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Lit                where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Bytes              where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Stmt               where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Guard              where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Body               where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Match              where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Range              where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Exp                where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Pat                where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Clause             where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.DerivStrategy      where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.DerivClause        where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.FunDep             where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Overlap            where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Callconv           where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Safety             where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Foreign            where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.FixityDirection    where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Fixity             where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Inline             where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.RuleMatch          where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Phases             where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.RuleBndr           where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.AnnTarget          where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Pragma             where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.TySynEqn           where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.FamilyResultSig    where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.InjectivityAnn     where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.TypeFamilyHead     where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Role               where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.PatSynArgs         where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.PatSynDir          where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Dec                where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Info               where ppGenericOverride = gpretty . from-instance {-# OVERLAPS #-} PPGenericOverride TH.Specificity        where ppGenericOverride = gpretty . from+instance {-# OVERLAPS #-} PPGenericOverride TH.OccName+instance {-# OVERLAPS #-} PPGenericOverride TH.NameFlavour+instance {-# OVERLAPS #-} PPGenericOverride TH.PkgName+instance {-# OVERLAPS #-} PPGenericOverride TH.NameSpace+instance {-# OVERLAPS #-} PPGenericOverride TH.ModName+instance {-# OVERLAPS #-} PPGenericOverride TH.Name+instance {-# OVERLAPS #-} PPGenericOverride TH.TyLit+instance {-# OVERLAPS #-} PPGenericOverride TH.Type+instance {-# OVERLAPS #-} PPGenericOverride TH.SourceUnpackedness+instance {-# OVERLAPS #-} PPGenericOverride TH.SourceStrictness+instance {-# OVERLAPS #-} PPGenericOverride TH.Bang+instance {-# OVERLAPS #-} PPGenericOverride TH.Con+instance {-# OVERLAPS #-} PPGenericOverride TH.Lit+instance {-# OVERLAPS #-} PPGenericOverride TH.Bytes+instance {-# OVERLAPS #-} PPGenericOverride TH.Stmt+instance {-# OVERLAPS #-} PPGenericOverride TH.Guard+instance {-# OVERLAPS #-} PPGenericOverride TH.Body+instance {-# OVERLAPS #-} PPGenericOverride TH.Match+instance {-# OVERLAPS #-} PPGenericOverride TH.Range+instance {-# OVERLAPS #-} PPGenericOverride TH.Exp+instance {-# OVERLAPS #-} PPGenericOverride TH.Pat+instance {-# OVERLAPS #-} PPGenericOverride TH.Clause+instance {-# OVERLAPS #-} PPGenericOverride TH.DerivStrategy+instance {-# OVERLAPS #-} PPGenericOverride TH.DerivClause+instance {-# OVERLAPS #-} PPGenericOverride TH.FunDep+instance {-# OVERLAPS #-} PPGenericOverride TH.Overlap+instance {-# OVERLAPS #-} PPGenericOverride TH.Callconv+instance {-# OVERLAPS #-} PPGenericOverride TH.Safety+instance {-# OVERLAPS #-} PPGenericOverride TH.Foreign+instance {-# OVERLAPS #-} PPGenericOverride TH.FixityDirection+instance {-# OVERLAPS #-} PPGenericOverride TH.Fixity+instance {-# OVERLAPS #-} PPGenericOverride TH.Inline+instance {-# OVERLAPS #-} PPGenericOverride TH.RuleMatch+instance {-# OVERLAPS #-} PPGenericOverride TH.Phases+instance {-# OVERLAPS #-} PPGenericOverride TH.RuleBndr+instance {-# OVERLAPS #-} PPGenericOverride TH.AnnTarget+instance {-# OVERLAPS #-} PPGenericOverride TH.Pragma+instance {-# OVERLAPS #-} PPGenericOverride TH.TySynEqn+instance {-# OVERLAPS #-} PPGenericOverride TH.FamilyResultSig+instance {-# OVERLAPS #-} PPGenericOverride TH.InjectivityAnn+instance {-# OVERLAPS #-} PPGenericOverride TH.TypeFamilyHead+instance {-# OVERLAPS #-} PPGenericOverride TH.Role+instance {-# OVERLAPS #-} PPGenericOverride TH.PatSynArgs+instance {-# OVERLAPS #-} PPGenericOverride TH.PatSynDir+instance {-# OVERLAPS #-} PPGenericOverride TH.Dec+instance {-# OVERLAPS #-} PPGenericOverride TH.Info+instance {-# OVERLAPS #-} PPGenericOverride TH.Specificity  #if MIN_VERSION_template_haskell(2, 21, 0)-instance {-# OVERLAPS #-} PPGenericOverride TH.BndrVis            where ppGenericOverride = gpretty . from+instance {-# OVERLAPS #-} PPGenericOverride TH.BndrVis #endif  #if MIN_VERSION_template_haskell(2, 22, 0)-instance {-# OVERLAPS #-} PPGenericOverride TH.NamespaceSpecifier where ppGenericOverride = gpretty . from+instance {-# OVERLAPS #-} PPGenericOverride TH.NamespaceSpecifier #endif +ppConstructorApp :: forall proxy b a ann. (Coercible a b, PPGenericOverride b) => proxy b -> Doc ann -> a -> MetaDoc ann+ppConstructorApp _ constructor x = constructorAppMetaDoc (atomicMetaDoc constructor) [ppGenericOverride @b (coerce x)]++instance {-# OVERLAPS #-} PPGenericOverride (Proxy a)++instance {-# OVERLAPS #-} PPGenericOverride (Fixed n)     where ppGenericOverride = ppConstructorApp (Proxy @Integer) "Fixed"+instance {-# OVERLAPS #-} PPGenericOverride Semigroup.Any where ppGenericOverride = ppConstructorApp (Proxy @Bool) "Any"+instance {-# OVERLAPS #-} PPGenericOverride Semigroup.All where ppGenericOverride = ppConstructorApp (Proxy @Bool) "All"++instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Bits.And a)                where ppGenericOverride = ppConstructorApp (Proxy @a) "And"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Bits.Iff a)                where ppGenericOverride = ppConstructorApp (Proxy @a) "Iff"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Bits.Ior a)                where ppGenericOverride = ppConstructorApp (Proxy @a) "Ior"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Bits.Xor a)                where ppGenericOverride = ppConstructorApp (Proxy @a) "Xor"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Down a)                    where ppGenericOverride = ppConstructorApp (Proxy @a) "Down"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Identity a)                where ppGenericOverride = ppConstructorApp (Proxy @a) "Identity"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Monoid.Dual a)             where ppGenericOverride = ppConstructorApp (Proxy @a) "Dual"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Monoid.First a)            where ppGenericOverride = ppConstructorApp (Proxy @(Maybe a)) "First"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Monoid.Last a)             where ppGenericOverride = ppConstructorApp (Proxy @(Maybe a)) "Last"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Monoid.Product a)          where ppGenericOverride = ppConstructorApp (Proxy @a) "Product"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Monoid.Sum a)              where ppGenericOverride = ppConstructorApp (Proxy @a) "Sum"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Semigroup.First a)         where ppGenericOverride = ppConstructorApp (Proxy @a) "First"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Semigroup.Last a)          where ppGenericOverride = ppConstructorApp (Proxy @a) "Last"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Semigroup.Max a)           where ppGenericOverride = ppConstructorApp (Proxy @a) "Max"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Semigroup.Min a)           where ppGenericOverride = ppConstructorApp (Proxy @a) "Min"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Semigroup.WrappedMonoid a) where ppGenericOverride = ppConstructorApp (Proxy @a) "WrappedMonoid"+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (ZipList a)                 where ppGenericOverride = ppConstructorApp (Proxy @[a]) "ZipList"++instance {-# OVERLAPS #-} PPGenericOverride (f a) => PPGenericOverride (Monoid.Alt f a) where ppGenericOverride = ppConstructorApp (Proxy @(f a)) "Alt"+instance {-# OVERLAPS #-} PPGenericOverride (f a) => PPGenericOverride (Monoid.Ap f a)  where ppGenericOverride = ppConstructorApp (Proxy @(f a)) "Ap"++instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Solo a) where+  ppGenericOverride = ppConstructorApp (Proxy @a) "Solo" . unpackSolo+    where+#if MIN_VERSION_base(4, 18, 0)+      unpackSolo (MkSolo x) = x+#endif+#if !MIN_VERSION_base(4, 18, 0)+      unpackSolo (Solo x) = x+#endif+ instance {-# OVERLAPS #-}   ( PPGenericOverride a   , PPGenericOverride b@@ -403,11 +481,11 @@     , PPGenericOverrideToPretty c     ) -instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (Maybe v) where+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Maybe a) where   ppGenericOverride =     gpretty . from . fmap PPGenericOverrideToPretty -instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride [v] where+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride [a] where   ppGenericOverride =     atomicMetaDoc . ppListWith ppGenericOverrideDoc @@ -419,16 +497,23 @@   ppGenericOverride =     atomicMetaDoc . ppNEWith ppGenericOverrideDoc -instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (Vector v) where+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Vector a) where   ppGenericOverride =     atomicMetaDoc . ppVectorWith ppGenericOverrideDoc +instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (DList a) where+  ppGenericOverride =+    atomicMetaDoc . ppDListWith ppGenericOverrideDoc +instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Seq a) where+  ppGenericOverride =+    atomicMetaDoc . ppSeqWith ppGenericOverrideDoc+ instance {-# OVERLAPS #-} (PPGenericOverride k, PPGenericOverride v) => PPGenericOverride (Map k v) where   ppGenericOverride =     atomicMetaDoc . ppMapWith ppGenericOverrideDoc ppGenericOverrideDoc -instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (Set v) where+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (Set a) where   ppGenericOverride =     atomicMetaDoc . ppSetWith ppGenericOverrideDoc @@ -440,7 +525,7 @@   ppGenericOverride =     atomicMetaDoc . ppIntSetWith ppGenericOverrideDoc -instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (IntMap v) where+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (IntMap a) where   ppGenericOverride =     atomicMetaDoc . ppIntMapWith ppGenericOverrideDoc ppGenericOverrideDoc @@ -454,7 +539,7 @@     atomicMetaDoc . ppEnumMapWith ppGenericOverrideDoc ppGenericOverrideDoc #endif -instance {-# OVERLAPS #-} PPGenericOverride v => PPGenericOverride (HashSet v) where+instance {-# OVERLAPS #-} PPGenericOverride a => PPGenericOverride (HashSet a) where   ppGenericOverride =     atomicMetaDoc . ppHashSetWith ppGenericOverrideDoc @@ -466,6 +551,9 @@   ppGenericOverride =     ppGenericOverride . getCompose +instance {-# OVERLAPS #-} PPGenericOverride UTCTime where+  ppGenericOverride =+    atomicMetaDoc . ppUTCTimeISO8601  instance (GPretty f, GPretty g) => GPretty (f :*: g) where   gpretty (x :*: y) =@@ -497,11 +585,9 @@   gfields = const mempty  instance GPretty x => GFields (M1 S ('MetaSel a b c d) x) where-  {-# INLINABLE gfields #-}   gfields = DL.singleton . gpretty . unM1  instance (GFields f, GFields g) => GFields (f :*: g) where-  {-# INLINABLE gfields #-}   gfields (f :*: g) = gfields f <> gfields g  @@ -516,14 +602,12 @@   gcollectRecord :: a ix -> DList (MapEntry Text (MetaDoc ann))  instance (KnownSymbol name, GPretty a) => GCollectRecord (M1 S ('MetaSel ('Just name) su ss ds) a) where-  {-# INLINABLE gcollectRecord #-}   gcollectRecord (M1 x) =     DL.singleton (T.pack (symbolVal (Proxy @name)) :-> gpretty x)  instance (GCollectRecord f, GCollectRecord g) => GCollectRecord (f :*: g) where-  {-# INLINABLE gcollectRecord #-}   gcollectRecord (f :*: g) = gcollectRecord f <> gcollectRecord g  instance GCollectRecord U1 where-  {-# INLINABLE gcollectRecord #-}+  {-# INLINE gcollectRecord #-}   gcollectRecord = const mempty

@@ -0,0 +1,166 @@+-- |+-- Module:     Prettyprinter.Instances+-- Copyright:  (c) Sergey Vinokurov 2026+-- License:    Apache-2.0 (see LICENSE)+-- Maintainer: serg.foo@gmail.com++{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}++{-# OPTIONS_GHC -Wno-orphans #-}++module Prettyprinter.Instances () where++import Control.Applicative (ZipList(..))+import Data.Bimap (Bimap)+import Data.Bits qualified as Bits+import Data.ByteString.Char8 qualified as C8+import Data.ByteString.Lazy.Char8 qualified as CL8+import Data.ByteString.Short qualified as ShortBS+import Data.Coerce+import Data.Complex (Complex)+import Data.DList (DList)+import Data.Fixed (Fixed(..))+import Data.Functor.Compose (Compose(..))+import Data.HashMap.Strict (HashMap)+import Data.HashSet (HashSet)+import Data.IntMap (IntMap)+import Data.IntSet (IntSet)+import Data.Map.Strict (Map)+import Data.Monoid as Monoid+import Data.Ord+import Data.Proxy+import Data.Semigroup as Semigroup+import Data.Sequence (Seq)+import Data.Set (Set)+import Data.Time (UTCTime)+import Data.Tuple (Solo(..))+import GHC.Real (Ratio)+import GHC.Stack (CallStack)+import System.OsString (OsString)++import Data.Vector qualified as V+import Data.Vector.Primitive qualified as VP+import Data.Vector.Storable qualified as VS+import Data.Vector.Unboxed qualified as U++#ifdef HAVE_ENUMMAPSET+import Data.EnumMap (EnumMap)+import Data.EnumSet (EnumSet)+#endif++import Prettyprinter.Combinators+import Prettyprinter.MetaDoc++instance (Pretty k, Pretty v) => Pretty (Map k v) where+  pretty = ppMap++instance Pretty a => Pretty (Set a) where+  pretty = ppSet++instance (Pretty k, Pretty v) => Pretty (Bimap k v) where+  pretty = ppBimap++instance Pretty a => Pretty (IntMap a) where+  pretty = ppIntMap++instance Pretty IntSet where+  pretty = ppIntSet++#ifdef HAVE_ENUMMAPSET+instance (Enum a, Pretty a) => Pretty (EnumSet a) where+  pretty = ppEnumSet++instance (Enum k, Pretty k, Pretty v) => Pretty (EnumMap k v) where+  pretty = ppEnumMap+#endif++instance Pretty a => Pretty (HashSet a) where+  pretty = ppHashSet++instance (Pretty k, Pretty v) => Pretty (HashMap k v) where+  pretty = ppHashMap++instance Pretty a => Pretty (V.Vector a) where+  pretty = ppVector++instance (VP.Prim a, Pretty a) => Pretty (VP.Vector a) where+  pretty = ppVector++instance (VS.Storable a, Pretty a) => Pretty (VS.Vector a) where+  pretty = ppVector++instance (U.Unbox a, Pretty a) => Pretty (U.Vector a) where+  pretty = ppVector++instance Pretty a => Pretty (DList a) where+  pretty = ppDList++instance Pretty a => Pretty (Seq a) where+  pretty = ppSeq++instance Pretty C8.ByteString where+  pretty = ppByteString++instance Pretty CL8.ByteString where+  pretty = ppByteStringLazy++instance Pretty ShortBS.ShortByteString where+  pretty = ppShortByteString++instance Pretty a => Pretty (Ratio a) where+  pretty = ppRatio++instance Pretty a => Pretty (Complex a) where+  pretty = ppComplex++instance Pretty CallStack where+  pretty = ppCallStackGHC++instance Pretty (f (g a)) => Pretty (Compose f g a) where+  pretty = pretty . getCompose++instance Pretty UTCTime where+  pretty = ppUTCTimeISO8601++instance Pretty OsString where+  pretty = ppOsString++instance Pretty (Fixed a)     where pretty = ppConstructorApp (Proxy @Integer) "Fixed"+instance Pretty Semigroup.Any where pretty = ppConstructorApp (Proxy @Bool) "Any"+instance Pretty Semigroup.All where pretty = ppConstructorApp (Proxy @Bool) "All"++instance Pretty a => Pretty (Bits.And a)                where pretty = ppConstructorApp (Proxy @a) "And"+instance Pretty a => Pretty (Bits.Iff a)                where pretty = ppConstructorApp (Proxy @a) "Iff"+instance Pretty a => Pretty (Bits.Ior a)                where pretty = ppConstructorApp (Proxy @a) "Ior"+instance Pretty a => Pretty (Bits.Xor a)                where pretty = ppConstructorApp (Proxy @a) "Xor"+instance Pretty a => Pretty (Down a)                    where pretty = ppConstructorApp (Proxy @a) "Down"+instance Pretty a => Pretty (Monoid.Dual a)             where pretty = ppConstructorApp (Proxy @a) "Dual"+instance Pretty a => Pretty (Monoid.First a)            where pretty = ppConstructorApp (Proxy @(Maybe a)) "First"+instance Pretty a => Pretty (Monoid.Last a)             where pretty = ppConstructorApp (Proxy @(Maybe a)) "Last"+instance Pretty a => Pretty (Monoid.Product a)          where pretty = ppConstructorApp (Proxy @a) "Product"+instance Pretty a => Pretty (Monoid.Sum a)              where pretty = ppConstructorApp (Proxy @a) "Sum"+instance Pretty a => Pretty (Semigroup.First a)         where pretty = ppConstructorApp (Proxy @a) "First"+instance Pretty a => Pretty (Semigroup.Last a)          where pretty = ppConstructorApp (Proxy @a) "Last"+instance Pretty a => Pretty (Semigroup.Max a)           where pretty = ppConstructorApp (Proxy @a) "Max"+instance Pretty a => Pretty (Semigroup.Min a)           where pretty = ppConstructorApp (Proxy @a) "Min"+instance Pretty a => Pretty (Semigroup.WrappedMonoid a) where pretty = ppConstructorApp (Proxy @a) "WrappedMonoid"+instance Pretty a => Pretty (ZipList a)                 where pretty = ppConstructorApp (Proxy @[a]) "ZipList"++instance Pretty (f a) => Pretty (Monoid.Alt f a) where pretty = ppConstructorApp (Proxy @(f a)) "Alt"+instance Pretty (f a) => Pretty (Monoid.Ap f a)  where pretty = ppConstructorApp (Proxy @(f a)) "Ap"++instance Pretty a => Pretty (Solo a) where+  pretty = ppConstructorApp (Proxy @a) "Solo" . unpackSolo+    where+#if MIN_VERSION_base(4, 18, 0)+      unpackSolo (MkSolo x) = x+#endif+#if !MIN_VERSION_base(4, 18, 0)+      unpackSolo (Solo x) = x+#endif++ppConstructorApp :: forall proxy b a ann. (Coercible a b, Pretty b) => proxy b -> Doc ann -> a -> Doc ann+ppConstructorApp _ constructor x =+  mdPayload $+    constructorAppMetaDoc (atomicMetaDoc constructor) [atomicMetaDoc (pretty @b (coerce x))]

@@ -54,6 +54,7 @@ import Prettyprinter qualified as PP import Prettyprinter.Combinators.Basic +-- Constructor order is significant. data DocKind = Atomic | Composite   deriving (Eq, Ord, Enum, Bounded) @@ -186,7 +187,7 @@ constructorAppMetaDoc constructor args =   case map field args of     []  -> constructor-    [f] -> compositeMetaDoc $ mdPayload constructor <+> group (mdPayload f)+    [f] -> compositeMetaDoc $ mdPayload constructor PP.<+> group (mdPayload f)     fs  -> compositeMetaDoc $ PP.align $ mdPayload constructor ## PP.vsep (map mdPayload fs)   where     field :: MetaDoc ann -> MetaDoc ann