-- |
-- 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))]