{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-missing-import-lists #-}

-- |
-- Module      :   Grisette.Internal.Core.Data.Class.PPrint
-- Copyright   :   (c) Sirui Lu 2021-2024
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Internal.Core.Data.Class.PPrint
  ( -- * Pretty printing
    PPrint (..),
    docToTextWith,
    docToTextWithWidth,
    docToText,
    pformatTextWith,
    pformatTextWithWidth,
    pformatText,
    pprint,
    PPrint1 (..),
    pformatPrec1,
    pformatList1,
    PPrint2 (..),
    pformatPrec2,
    pformatList2,

    -- * Generic 'PPrint'
    genericPFormatPrec,
    genericLiftPFormatPrec,
    genericPFormatList,
    genericLiftPFormatList,
    PPrintArgs (..),
    GPPrint (..),
    PPrintType (..),

    -- * Helpers
    groupedEnclose,
    condEnclose,
    pformatWithConstructor,
    pformatWithConstructorNoAlign,
    viaShowsPrec,

    -- * Re-exports
    module Prettyprinter,
  )
where

#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter
import Prettyprinter.Render.String (renderString)
import Prettyprinter.Render.Text (renderStrict)
#else
import Data.Text.Prettyprint.Doc as Prettyprinter
import Data.Text.Prettyprint.Doc.Render.String (renderString)
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
#endif

import Control.Monad.Except (ExceptT (ExceptT))
import Control.Monad.Identity
  ( Identity (Identity),
    IdentityT (IdentityT),
  )
import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
import qualified Control.Monad.Writer.Lazy as WriterLazy
import qualified Control.Monad.Writer.Strict as WriterStrict
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Functor.Compose (Compose (Compose))
import Data.Functor.Const (Const)
import Data.Functor.Product (Product)
import Data.Functor.Sum (Sum)
import qualified Data.HashMap.Lazy as HM
import qualified Data.HashSet as HS
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind (Type)
import Data.Monoid (Alt, Ap)
import qualified Data.Monoid as Monoid
import Data.Ord (Down)
import Data.Ratio (Ratio, denominator, numerator)
import Data.String (IsString (fromString))
import qualified Data.Text as T
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Generics
  ( C1,
    Constructor (conFixity, conIsRecord, conName),
    D1,
    Fixity (Infix, Prefix),
    Generic (Rep, from),
    Generic1 (Rep1, from1),
    K1 (K1),
    M1 (M1),
    Par1 (Par1, unPar1),
    Rec1 (Rec1, unRec1),
    S1,
    Selector (selName),
    U1 (U1),
    V1,
    (:.:) (Comp1, unComp1),
    type (:*:) ((:*:)),
    type (:+:) (L1, R1),
  )
import GHC.Real (ratioPrec, ratioPrec1)
import GHC.Stack (HasCallStack)
import GHC.TypeLits (KnownNat, type (<=))
import Generics.Deriving
  ( Default (Default, unDefault),
    Default1 (Default1, unDefault1),
  )
import Grisette.Internal.Core.Control.Exception
  ( AssertionError,
    VerificationConditions,
  )
import Grisette.Internal.Core.Data.Symbol (Identifier, Symbol)
import Grisette.Internal.SymPrim.AlgReal (AlgReal)
import Grisette.Internal.SymPrim.BV (IntN, WordN)
import Grisette.Internal.SymPrim.FP
  ( FP,
    FPRoundingMode,
    NotRepresentableFPError,
    ValidFP,
  )
import Grisette.Internal.SymPrim.GeneralFun (type (-->))
import Grisette.Internal.SymPrim.Prim.Internal.Term ()
import Grisette.Internal.SymPrim.Prim.Model
  ( Model (Model),
    SymbolSet (SymbolSet),
  )
import Grisette.Internal.SymPrim.Prim.Term
  ( ModelValue,
    SomeTypedSymbol (SomeTypedSymbol),
    TypedSymbol (unTypedSymbol),
    prettyPrintTerm,
  )
import Grisette.Internal.SymPrim.SymAlgReal (SymAlgReal (SymAlgReal))
import Grisette.Internal.SymPrim.SymBV
  ( SymIntN (SymIntN),
    SymWordN (SymWordN),
  )
import Grisette.Internal.SymPrim.SymBool (SymBool (SymBool))
import Grisette.Internal.SymPrim.SymFP
  ( SymFP (SymFP),
    SymFPRoundingMode (SymFPRoundingMode),
  )
import Grisette.Internal.SymPrim.SymGeneralFun (type (-~>) (SymGeneralFun))
import Grisette.Internal.SymPrim.SymInteger (SymInteger (SymInteger))
import Grisette.Internal.SymPrim.SymTabularFun (type (=~>) (SymTabularFun))
import Grisette.Internal.SymPrim.TabularFun (type (=->))
import Grisette.Internal.TH.DeriveBuiltin (deriveBuiltins)
import Grisette.Internal.TH.DeriveInstanceProvider
  ( Strategy (ViaDefault, ViaDefault1),
  )
import Grisette.Internal.Utils.Derive (Arity0, Arity1)

-- | Pretty printing of values.
--
-- This class is similar to the 'Pretty' class from the "Prettyprinter" package,
-- but it also provides pretty printing with a given precedence level.
--
-- We are able to derive instances of this class for algebraic data types.
-- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
--
-- > data X = ... deriving Generic deriving PPrint via (Default X)
--
-- The derived instance will pretty print the value with a format similar to the
-- one used by ormolu.
class PPrint a where
  pformat :: a -> Doc ann
  pformatPrec :: Int -> a -> Doc ann
  pformatList :: [a] -> Doc ann
  pformatList = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> ([a] -> Doc ann) -> [a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyPrintList ([Doc ann] -> Doc ann) -> ([a] -> [Doc ann]) -> [a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc ann) -> [a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc ann
forall ann. a -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat

  pformat = Int -> a -> Doc ann
forall ann. Int -> a -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec Int
0
  pformatPrec Int
_ = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat

  {-# MINIMAL pformat | pformatPrec #-}

pformatListLike :: Doc ann -> Doc ann -> [Doc ann] -> Doc ann
pformatListLike :: forall ann. Doc ann -> Doc ann -> [Doc ann] -> Doc ann
pformatListLike Doc ann
ldelim Doc ann
rdelim [Doc ann]
l
  | [Doc ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc ann]
l = Doc ann
ldelim Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
rdelim
  | [Doc ann] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc ann]
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 =
      Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat [Doc ann
ldelim Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
" " Doc ann
"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall a. HasCallStack => [a] -> a
head [Doc ann]
l, Doc ann
rdelim]
  | Bool
otherwise =
      Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
groupedEnclose Doc ann
ldelim Doc ann
rdelim (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
        ((\Doc ann
v -> Doc ann
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"," Doc ann
", ") (Doc ann -> Doc ann) -> [Doc ann] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Doc ann] -> [Doc ann]
forall a. HasCallStack => [a] -> [a]
init [Doc ann]
l) [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [[Doc ann] -> Doc ann
forall a. HasCallStack => [a] -> a
last [Doc ann]
l]

prettyPrintList :: [Doc ann] -> Doc ann
prettyPrintList :: forall ann. [Doc ann] -> Doc ann
prettyPrintList = Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> [Doc ann] -> Doc ann
pformatListLike Doc ann
"[" Doc ann
"]"

prettyPrintTuple :: [Doc ann] -> Doc ann
prettyPrintTuple :: forall ann. [Doc ann] -> Doc ann
prettyPrintTuple [Doc ann]
l
  | [Doc ann] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc ann]
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 =
      Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
groupedEnclose Doc ann
"(" Doc ann
")" (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
        ((\Doc ann
v -> Doc ann
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"," Doc ann
", ") (Doc ann -> Doc ann) -> [Doc ann] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Doc ann] -> [Doc ann]
forall a. HasCallStack => [a] -> [a]
init [Doc ann]
l) [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [[Doc ann] -> Doc ann
forall a. HasCallStack => [a] -> a
last [Doc ann]
l]
  | Bool
otherwise = [Char] -> Doc ann
forall a. HasCallStack => [Char] -> a
error [Char]
"Tuple must have at least 2 elements"

instance PPrint Char where
  pformat :: forall ann. Char -> Doc ann
pformat = Char -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow
  pformatList :: forall ann. [Char] -> Doc ann
pformatList [Char]
v = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty ([Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
v :: T.Text)

instance (PPrint a) => PPrint [a] where
  pformat :: forall ann. [a] -> Doc ann
pformat = [a] -> Doc ann
forall ann. [a] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList

-- | Convenience function to layout and render a 'Doc' to 'T.Text'.
--
-- You can control the layout with t'LayoutOptions'.
docToTextWith :: LayoutOptions -> Doc ann -> T.Text
docToTextWith :: forall ann. LayoutOptions -> Doc ann -> Text
docToTextWith LayoutOptions
options = SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream ann -> Text)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
options

-- | Convenience function to layout and render a 'Doc' to 'T.Text'.
--
-- You can control the layout with a single number of the width limit.
docToTextWithWidth :: Int -> Doc ann -> T.Text
docToTextWithWidth :: forall ann. Int -> Doc ann -> Text
docToTextWithWidth Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = LayoutOptions -> Doc ann -> Text
forall ann. LayoutOptions -> Doc ann -> Text
docToTextWith (PageWidth -> LayoutOptions
LayoutOptions PageWidth
Unbounded)
  | Bool
otherwise = LayoutOptions -> Doc ann -> Text
forall ann. LayoutOptions -> Doc ann -> Text
docToTextWith (PageWidth -> LayoutOptions
LayoutOptions (PageWidth -> LayoutOptions) -> PageWidth -> LayoutOptions
forall a b. (a -> b) -> a -> b
$ Int -> Double -> PageWidth
AvailablePerLine Int
n Double
1.0)

-- | Convenience function to layout and render a 'Doc' to 'T.Text'.
--
-- The default layout options 'defaultLayoutOptions' are used.
docToText :: Doc ann -> T.Text
docToText :: forall ann. Doc ann -> Text
docToText = LayoutOptions -> Doc ann -> Text
forall ann. LayoutOptions -> Doc ann -> Text
docToTextWith LayoutOptions
defaultLayoutOptions

-- | Convenience function to format a value to 'T.Text'.
--
-- You can control the layout with t'LayoutOptions'.
pformatTextWith :: (PPrint a) => LayoutOptions -> a -> T.Text
pformatTextWith :: forall a. PPrint a => LayoutOptions -> a -> Text
pformatTextWith LayoutOptions
options = LayoutOptions -> Doc Any -> Text
forall ann. LayoutOptions -> Doc ann -> Text
docToTextWith LayoutOptions
options (Doc Any -> Text) -> (a -> Doc Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall ann. a -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat

-- | Convenience function to format a value to 'T.Text'.
--
-- You can control the layout with a single number of the width limit.
pformatTextWithWidth :: (PPrint a) => Int -> a -> T.Text
pformatTextWithWidth :: forall a. PPrint a => Int -> a -> Text
pformatTextWithWidth Int
n = Int -> Doc Any -> Text
forall ann. Int -> Doc ann -> Text
docToTextWithWidth Int
n (Doc Any -> Text) -> (a -> Doc Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall ann. a -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat

-- | Convenience function to format a value to 'T.Text'.
--
-- The default layout options 'defaultLayoutOptions' are used.
pformatText :: (PPrint a) => a -> T.Text
pformatText :: forall a. PPrint a => a -> Text
pformatText = Doc Any -> Text
forall ann. Doc ann -> Text
docToText (Doc Any -> Text) -> (a -> Doc Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall ann. a -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat

-- | Pretty print a value to the standard output.
pprint :: (PPrint a) => a -> IO ()
pprint :: forall a. PPrint a => a -> IO ()
pprint = [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (a -> [Char]) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Any -> [Char]
forall ann. SimpleDocStream ann -> [Char]
renderString (SimpleDocStream Any -> [Char])
-> (a -> SimpleDocStream Any) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> (a -> Doc Any) -> a -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall ann. a -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat

-- | Lifting of the 'PPrint' class to unary type constructors.
class (forall a. (PPrint a) => PPrint (f a)) => PPrint1 f where
  -- | Lift a pretty-printer to a unary type constructor.
  liftPFormatPrec ::
    (Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann

  -- | Lift a pretty-printer to list of values with unary type constructors.
  liftPFormatList ::
    (Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
  liftPFormatList Int -> a -> Doc ann
f [a] -> Doc ann
l = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> ([f a] -> Doc ann) -> [f a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyPrintList ([Doc ann] -> Doc ann) -> ([f a] -> [Doc ann]) -> [f a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> Doc ann) -> [f a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l Int
0)

instance PPrint1 [] where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> [a] -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
_ [a] -> Doc ann
l Int
_ = [a] -> Doc ann
l
  liftPFormatList :: forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [[a]] -> Doc ann
liftPFormatList Int -> a -> Doc ann
_ [a] -> Doc ann
l = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyPrintList ([Doc ann] -> Doc ann) -> ([[a]] -> [Doc ann]) -> [[a]] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Doc ann) -> [[a]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Doc ann
l

-- | Lift the standard pretty-printer ('pformatPrec', 'pformatList') to unary
-- type constructors.
pformatPrec1 :: (PPrint1 f, PPrint a) => Int -> f a -> Doc ann
pformatPrec1 :: forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1 = (Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
forall ann. Int -> a -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [a] -> Doc ann
forall ann. [a] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList
{-# INLINE pformatPrec1 #-}

-- | Lift the standard pretty-printer ('pformatPrec', 'pformatList') to list of
-- values with unary type constructors.
pformatList1 :: (PPrint1 f, PPrint a) => [f a] -> Doc ann
pformatList1 :: forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
[f a] -> Doc ann
pformatList1 = (Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
liftPFormatList Int -> a -> Doc ann
forall ann. Int -> a -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [a] -> Doc ann
forall ann. [a] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList
{-# INLINE pformatList1 #-}

-- | Lifting of the 'PPrint' class to binary type constructors.
class
  ( forall a. (PPrint a) => PPrint1 (f a),
    forall a b. (PPrint a, PPrint b) => PPrint (f a b)
  ) =>
  PPrint2 f
  where
  -- | Lift two pretty-printers to a binary type constructor.
  liftPFormatPrec2 ::
    (Int -> a -> Doc ann) ->
    ([a] -> Doc ann) ->
    (Int -> b -> Doc ann) ->
    ([b] -> Doc ann) ->
    Int ->
    f a b ->
    Doc ann

  -- | Lift two pretty-printers to list of values with binary type constructors.
  liftPFormatList2 ::
    (Int -> a -> Doc ann) ->
    ([a] -> Doc ann) ->
    (Int -> b -> Doc ann) ->
    ([b] -> Doc ann) ->
    [f a b] ->
    Doc ann
  liftPFormatList2 Int -> a -> Doc ann
fa [a] -> Doc ann
fb Int -> b -> Doc ann
la [b] -> Doc ann
lb =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> ([f a b] -> Doc ann) -> [f a b] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyPrintList ([Doc ann] -> Doc ann)
-> ([f a b] -> [Doc ann]) -> [f a b] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a b -> Doc ann) -> [f a b] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
fa [a] -> Doc ann
fb Int -> b -> Doc ann
la [b] -> Doc ann
lb Int
0)

-- | Lift the standard pretty-printer ('pformatPrec', 'pformatList') to binary
-- type constructors.
pformatPrec2 :: (PPrint2 f, PPrint a, PPrint b) => Int -> f a b -> Doc ann
pformatPrec2 :: forall (f :: * -> * -> *) a b ann.
(PPrint2 f, PPrint a, PPrint b) =>
Int -> f a b -> Doc ann
pformatPrec2 = (Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
forall ann. Int -> a -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [a] -> Doc ann
forall ann. [a] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList Int -> b -> Doc ann
forall ann. Int -> b -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [b] -> Doc ann
forall ann. [b] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList
{-# INLINE pformatPrec2 #-}

-- | Lift the standard pretty-printer ('pformatPrec', 'pformatList') to list of
-- values with binary type constructors.
pformatList2 :: (PPrint2 f, PPrint a, PPrint b) => [f a b] -> Doc ann
pformatList2 :: forall (f :: * -> * -> *) a b ann.
(PPrint2 f, PPrint a, PPrint b) =>
[f a b] -> Doc ann
pformatList2 = (Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [f a b]
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [f a b]
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [f a b]
-> Doc ann
liftPFormatList2 Int -> a -> Doc ann
forall ann. Int -> a -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [a] -> Doc ann
forall ann. [a] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList Int -> b -> Doc ann
forall ann. Int -> b -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [b] -> Doc ann
forall ann. [b] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList
{-# INLINE pformatList2 #-}

-- | The arguments to the generic 'PPrint' class.
data family PPrintArgs arity a ann :: Type

data instance PPrintArgs Arity0 _ _ = PPrintArgs0

data instance PPrintArgs Arity1 a ann
  = PPrintArgs1
      ((Int -> a -> Doc ann))
      (([a] -> Doc ann))

-- | Controls how to pretty-print a generic representation.
data PPrintType = Rec | Tup | Pref | Inf String Int
  deriving (Int -> PPrintType -> ShowS
[PPrintType] -> ShowS
PPrintType -> [Char]
(Int -> PPrintType -> ShowS)
-> (PPrintType -> [Char])
-> ([PPrintType] -> ShowS)
-> Show PPrintType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PPrintType -> ShowS
showsPrec :: Int -> PPrintType -> ShowS
$cshow :: PPrintType -> [Char]
show :: PPrintType -> [Char]
$cshowList :: [PPrintType] -> ShowS
showList :: [PPrintType] -> ShowS
Show, PPrintType -> PPrintType -> Bool
(PPrintType -> PPrintType -> Bool)
-> (PPrintType -> PPrintType -> Bool) -> Eq PPrintType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PPrintType -> PPrintType -> Bool
== :: PPrintType -> PPrintType -> Bool
$c/= :: PPrintType -> PPrintType -> Bool
/= :: PPrintType -> PPrintType -> Bool
Eq)

-- | Enclose a document with left and right documents.
--
-- The pretty printer will try to layout the document in a single line, but the
-- right document may be split to a newline.
groupedEnclose :: Doc ann -> Doc ann -> Doc ann -> Doc ann
groupedEnclose :: forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
groupedEnclose Doc ann
l Doc ann
r Doc ann
d = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat [Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
" " Doc ann
"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
d, Doc ann
r]

-- | Conditionally enclose a document with left and right documents.
--
-- If the condition is 'True', then this function is equivalent to
-- 'groupedEnclose'.
condEnclose :: Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
condEnclose :: forall ann. Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
condEnclose Bool
b = if Bool
b then Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
groupedEnclose else (Doc ann -> Doc ann -> Doc ann)
-> Doc ann -> Doc ann -> Doc ann -> Doc ann
forall a b. a -> b -> a
const ((Doc ann -> Doc ann -> Doc ann)
 -> Doc ann -> Doc ann -> Doc ann -> Doc ann)
-> (Doc ann -> Doc ann -> Doc ann)
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
forall a b. (a -> b) -> a -> b
$ (Doc ann -> Doc ann) -> Doc ann -> Doc ann -> Doc ann
forall a b. a -> b -> a
const Doc ann -> Doc ann
forall a. a -> a
id

-- | Pretty print a list of fields with a constructor.
--
-- Aligns the fields and nests them by 2 spaces.
pformatWithConstructor :: Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor :: forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor Int
n Doc ann
c [Doc ann]
l =
  Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
condEnclose (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) Doc ann
"(" Doc ann
")" (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
c Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
l)

-- | Pretty print a list of fields with a constructor without alignment.
pformatWithConstructorNoAlign :: Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructorNoAlign :: forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructorNoAlign Int
n Doc ann
c [Doc ann]
l =
  Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
condEnclose (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) Doc ann
"(" Doc ann
")" (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
c Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
l)

-- | Pretty print a value using 'showsPrec'.
viaShowsPrec :: (Int -> a -> ShowS) -> Int -> a -> Doc ann
viaShowsPrec :: forall a ann. (Int -> a -> ShowS) -> Int -> a -> Doc ann
viaShowsPrec Int -> a -> ShowS
f Int
n a
a = [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int -> a -> ShowS
f Int
n a
a [Char]
"")

-- | Generic 'PPrint' class.
class GPPrint arity f where
  gpformatPrec :: PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
  gpformatList :: (HasCallStack) => PPrintArgs arity a ann -> [f a] -> Doc ann
  gpformatList = [Char] -> PPrintArgs arity a ann -> [f a] -> Doc ann
forall a. HasCallStack => [Char] -> a
error [Char]
"generic format (gpformatList): unnecessary case"
  gisNullary :: (HasCallStack) => PPrintArgs arity a ann -> f a -> Bool
  gisNullary = [Char] -> PPrintArgs arity a ann -> f a -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"generic format (isNullary): unnecessary case"

instance GPPrint arity V1 where
  gpformatPrec :: forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> V1 a -> Doc ann
gpformatPrec PPrintArgs arity a ann
_ PPrintType
_ Int
_ V1 a
x = case V1 a
x of {}

instance GPPrint arity U1 where
  gpformatPrec :: forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> U1 a -> Doc ann
gpformatPrec PPrintArgs arity a ann
_ PPrintType
_ Int
_ U1 a
U1 = Doc ann
""
  gisNullary :: forall a ann.
HasCallStack =>
PPrintArgs arity a ann -> U1 a -> Bool
gisNullary PPrintArgs arity a ann
_ U1 a
_ = Bool
True

instance (PPrint c) => GPPrint arity (K1 i c) where
  gpformatPrec :: forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> K1 i c a -> Doc ann
gpformatPrec PPrintArgs arity a ann
_ PPrintType
_ Int
n (K1 c
a) = Int -> c -> Doc ann
forall ann. Int -> c -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec Int
n c
a
  gisNullary :: forall a ann.
HasCallStack =>
PPrintArgs arity a ann -> K1 i c a -> Bool
gisNullary PPrintArgs arity a ann
_ K1 i c a
_ = Bool
False

instance (GPPrint arity a, Constructor c) => GPPrint arity (C1 c a) where
  gpformatPrec :: forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> C1 c a a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
_ Int
n c :: C1 c a a
c@(M1 a a
x) =
    case PPrintType
t of
      PPrintType
Tup ->
        PPrintType -> Doc ann -> Doc ann
forall ann. PPrintType -> Doc ann -> Doc ann
prettyBraces PPrintType
t (PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
0 a a
x)
      Inf [Char]
_ Int
m ->
        Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
condEnclose (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m) Doc ann
"(" Doc ann
")" (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
m a a
x
      PPrintType
_ ->
        if PPrintArgs arity a ann -> a a -> Bool
forall a ann. HasCallStack => PPrintArgs arity a ann -> a a -> Bool
forall arity (f :: * -> *) a ann.
(GPPrint arity f, HasCallStack) =>
PPrintArgs arity a ann -> f a -> Bool
gisNullary PPrintArgs arity a ann
arg a a
x
          then [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat (C1 c a a -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName C1 c a a
c)
          else
            Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructorNoAlign
              Int
n
              ([Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat (C1 c a a -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName C1 c a a
c))
              [PPrintType -> Doc ann -> Doc ann
forall ann. PPrintType -> Doc ann -> Doc ann
prettyBraces PPrintType
t (PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
11 a a
x)]
    where
      prettyBraces :: PPrintType -> Doc ann -> Doc ann
      prettyBraces :: forall ann. PPrintType -> Doc ann -> Doc ann
prettyBraces PPrintType
Rec = Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
groupedEnclose Doc ann
"{" Doc ann
"}"
      prettyBraces PPrintType
Tup = Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
groupedEnclose Doc ann
"(" Doc ann
")"
      prettyBraces PPrintType
Pref = Doc ann -> Doc ann
forall a. a -> a
id
      prettyBraces (Inf [Char]
_ Int
_) = Doc ann -> Doc ann
forall a. a -> a
id
      fixity :: Fixity
fixity = C1 c a a -> Fixity
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Fixity
conFixity C1 c a a
c
      t :: PPrintType
t
        | C1 c a a -> Bool
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Bool
conIsRecord C1 c a a
c = PPrintType
Rec
        | C1 c a a -> Bool
forall (f :: * -> *) p. C1 c f p -> Bool
conIsTuple C1 c a a
c = PPrintType
Tup
        | Bool
otherwise = case Fixity
fixity of
            Fixity
Prefix -> PPrintType
Pref
            Infix Associativity
_ Int
i -> [Char] -> Int -> PPrintType
Inf (C1 c a a -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName C1 c a a
c) Int
i
      conIsTuple :: C1 c f p -> Bool
      conIsTuple :: forall (f :: * -> *) p. C1 c f p -> Bool
conIsTuple C1 c f p
y = [Char] -> Bool
tupleName (C1 c f p -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName C1 c f p
y)
        where
          tupleName :: [Char] -> Bool
tupleName (Char
'(' : Char
',' : [Char]
_) = Bool
True
          tupleName [Char]
_ = Bool
False

instance (Selector s, GPPrint arity a) => GPPrint arity (S1 s a) where
  gpformatPrec :: forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> S1 s a a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
n s :: S1 s a a
s@(M1 a a
x)
    | S1 s a a -> [Char]
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> [Char]
selName S1 s a a
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" =
        case PPrintType
t of
          PPrintType
Pref -> PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a a
x
          PPrintType
_ -> PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a a
x
    | Bool
otherwise =
        Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
          Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
            Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
              [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [[Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (S1 s a a -> [Char]
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> [Char]
selName S1 s a a
s) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=", PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
0 a a
x]
  gisNullary :: forall a ann.
HasCallStack =>
PPrintArgs arity a ann -> S1 s a a -> Bool
gisNullary PPrintArgs arity a ann
_ S1 s a a
_ = Bool
False

instance (GPPrint arity a) => GPPrint arity (D1 d a) where
  gpformatPrec :: forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> D1 d a a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
_ Int
n (M1 a a
x) = PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
Pref Int
n a a
x
  gpformatList :: forall a ann.
HasCallStack =>
PPrintArgs arity a ann -> [D1 d a a] -> Doc ann
gpformatList PPrintArgs arity a ann
arg = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([D1 d a a] -> Doc ann) -> [D1 d a a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyPrintList ([Doc ann] -> Doc ann)
-> ([D1 d a a] -> [Doc ann]) -> [D1 d a a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D1 d a a -> Doc ann) -> [D1 d a a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PPrintArgs arity a ann -> PPrintType -> Int -> D1 d a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> D1 d a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
Pref Int
0)

instance (GPPrint arity a, GPPrint arity b) => GPPrint arity (a :+: b) where
  gpformatPrec :: forall a ann.
PPrintArgs arity a ann
-> PPrintType -> Int -> (:+:) a b a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
n (L1 a a
x) = PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
n a a
x
  gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
n (R1 b a
x) = PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
n b a
x

instance (GPPrint arity a, GPPrint arity b) => GPPrint arity (a :*: b) where
  gpformatPrec :: forall a ann.
PPrintArgs arity a ann
-> PPrintType -> Int -> (:*:) a b a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg t :: PPrintType
t@PPrintType
Rec Int
n (a a
a :*: b a
b) =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
        [ PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
n a a
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"" Doc ann
" ",
          PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
n b a
b
        ]
  gpformatPrec PPrintArgs arity a ann
arg t :: PPrintType
t@(Inf [Char]
s Int
_) Int
n (a a
a :*: b a
b) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
        [ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
n a a
a,
          [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
s Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
n b a
b
        ]
  gpformatPrec PPrintArgs arity a ann
arg t :: PPrintType
t@PPrintType
Tup Int
_ (a a
a :*: b a
b) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
      [ PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
0 a a
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"" Doc ann
" ",
        PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t Int
0 b a
b
      ]
  gpformatPrec PPrintArgs arity a ann
arg t :: PPrintType
t@PPrintType
Pref Int
n (a a
a :*: b a
b) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a a
a,
        PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall a ann.
PPrintArgs arity a ann -> PPrintType -> Int -> b a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs arity a ann
arg PPrintType
t (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) b a
b
      ]
  gisNullary :: forall a ann.
HasCallStack =>
PPrintArgs arity a ann -> (:*:) a b a -> Bool
gisNullary PPrintArgs arity a ann
_ (:*:) a b a
_ = Bool
False

instance GPPrint Arity1 Par1 where
  gpformatPrec :: forall a ann.
PPrintArgs Arity1 a ann -> PPrintType -> Int -> Par1 a -> Doc ann
gpformatPrec (PPrintArgs1 Int -> a -> Doc ann
f [a] -> Doc ann
_) PPrintType
_ Int
n (Par1 a
a) = Int -> a -> Doc ann
f Int
n a
a
  gpformatList :: forall a ann.
HasCallStack =>
PPrintArgs Arity1 a ann -> [Par1 a] -> Doc ann
gpformatList (PPrintArgs1 Int -> a -> Doc ann
_ [a] -> Doc ann
g) [Par1 a]
l = [a] -> Doc ann
g ([a] -> Doc ann) -> [a] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Par1 a -> a
forall p. Par1 p -> p
unPar1 (Par1 a -> a) -> [Par1 a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Par1 a]
l

instance (PPrint1 f) => GPPrint Arity1 (Rec1 f) where
  gpformatPrec :: forall a ann.
PPrintArgs Arity1 a ann -> PPrintType -> Int -> Rec1 f a -> Doc ann
gpformatPrec (PPrintArgs1 Int -> a -> Doc ann
f [a] -> Doc ann
g) PPrintType
_ Int
n (Rec1 f a
x) = (Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
g Int
n f a
x
  gpformatList :: forall a ann.
HasCallStack =>
PPrintArgs Arity1 a ann -> [Rec1 f a] -> Doc ann
gpformatList (PPrintArgs1 Int -> a -> Doc ann
f [a] -> Doc ann
g) [Rec1 f a]
l = (Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
liftPFormatList Int -> a -> Doc ann
f [a] -> Doc ann
g ([f a] -> Doc ann) -> [f a] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1 (Rec1 f a -> f a) -> [Rec1 f a] -> [f a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rec1 f a]
l

instance
  (PPrint1 f, GPPrint Arity1 g) =>
  GPPrint Arity1 (f :.: g)
  where
  gpformatPrec :: forall a ann.
PPrintArgs Arity1 a ann
-> PPrintType -> Int -> (:.:) f g a -> Doc ann
gpformatPrec PPrintArgs Arity1 a ann
arg PPrintType
t Int
n (Comp1 f (g a)
x) =
    (Int -> g a -> Doc ann)
-> ([g a] -> Doc ann) -> Int -> f (g a) -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec (PPrintArgs Arity1 a ann -> PPrintType -> Int -> g a -> Doc ann
forall a ann.
PPrintArgs Arity1 a ann -> PPrintType -> Int -> g a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs Arity1 a ann
arg PPrintType
t) (PPrintArgs Arity1 a ann -> [g a] -> Doc ann
forall a ann.
HasCallStack =>
PPrintArgs Arity1 a ann -> [g a] -> Doc ann
forall arity (f :: * -> *) a ann.
(GPPrint arity f, HasCallStack) =>
PPrintArgs arity a ann -> [f a] -> Doc ann
gpformatList PPrintArgs Arity1 a ann
arg) Int
n f (g a)
x
  gpformatList :: forall a ann.
HasCallStack =>
PPrintArgs Arity1 a ann -> [(:.:) f g a] -> Doc ann
gpformatList PPrintArgs Arity1 a ann
arg [(:.:) f g a]
l =
    (Int -> g a -> Doc ann)
-> ([g a] -> Doc ann) -> [f (g a)] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
liftPFormatList (PPrintArgs Arity1 a ann -> PPrintType -> Int -> g a -> Doc ann
forall a ann.
PPrintArgs Arity1 a ann -> PPrintType -> Int -> g a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs Arity1 a ann
arg PPrintType
Pref) (PPrintArgs Arity1 a ann -> [g a] -> Doc ann
forall a ann.
HasCallStack =>
PPrintArgs Arity1 a ann -> [g a] -> Doc ann
forall arity (f :: * -> *) a ann.
(GPPrint arity f, HasCallStack) =>
PPrintArgs arity a ann -> [f a] -> Doc ann
gpformatList PPrintArgs Arity1 a ann
arg) ([f (g a)] -> Doc ann) -> [f (g a)] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (:.:) f g a -> f (g a)
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f g a -> f (g a)) -> [(:.:) f g a] -> [f (g a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(:.:) f g a]
l

-- | Generic 'pformatPrec' function.
genericPFormatPrec ::
  (Generic a, GPPrint Arity0 (Rep a)) =>
  Int ->
  a ->
  Doc ann
genericPFormatPrec :: forall a ann.
(Generic a, GPPrint Arity0 (Rep a)) =>
Int -> a -> Doc ann
genericPFormatPrec Int
n = PPrintArgs Arity0 Any ann
-> PPrintType -> Int -> Rep a Any -> Doc ann
forall a ann.
PPrintArgs Arity0 a ann -> PPrintType -> Int -> Rep a a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec PPrintArgs Arity0 Any ann
forall _ _. PPrintArgs Arity0 _ _
PPrintArgs0 PPrintType
Pref Int
n (Rep a Any -> Doc ann) -> (a -> Rep a Any) -> a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
{-# INLINE genericPFormatPrec #-}

-- | Generic 'pformatList' function.
genericPFormatList ::
  (Generic a, GPPrint Arity0 (Rep a)) =>
  [a] ->
  Doc ann
genericPFormatList :: forall a ann. (Generic a, GPPrint Arity0 (Rep a)) => [a] -> Doc ann
genericPFormatList = PPrintArgs Arity0 Any ann -> [Rep a Any] -> Doc ann
forall a ann.
HasCallStack =>
PPrintArgs Arity0 a ann -> [Rep a a] -> Doc ann
forall arity (f :: * -> *) a ann.
(GPPrint arity f, HasCallStack) =>
PPrintArgs arity a ann -> [f a] -> Doc ann
gpformatList PPrintArgs Arity0 Any ann
forall _ _. PPrintArgs Arity0 _ _
PPrintArgs0 ([Rep a Any] -> Doc ann) -> ([a] -> [Rep a Any]) -> [a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Rep a Any) -> [a] -> [Rep a Any]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
{-# INLINE genericPFormatList #-}

-- | Generic 'liftPFormatPrec' function.
genericLiftPFormatPrec ::
  (Generic1 f, GPPrint Arity1 (Rep1 f)) =>
  (Int -> a -> Doc ann) ->
  ([a] -> Doc ann) ->
  Int ->
  f a ->
  Doc ann
genericLiftPFormatPrec :: forall (f :: * -> *) a ann.
(Generic1 f, GPPrint Arity1 (Rep1 f)) =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
genericLiftPFormatPrec Int -> a -> Doc ann
p [a] -> Doc ann
l Int
n = PPrintArgs Arity1 a ann -> PPrintType -> Int -> Rep1 f a -> Doc ann
forall a ann.
PPrintArgs Arity1 a ann -> PPrintType -> Int -> Rep1 f a -> Doc ann
forall arity (f :: * -> *) a ann.
GPPrint arity f =>
PPrintArgs arity a ann -> PPrintType -> Int -> f a -> Doc ann
gpformatPrec ((Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> PPrintArgs Arity1 a ann
forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> PPrintArgs Arity1 a ann
PPrintArgs1 Int -> a -> Doc ann
p [a] -> Doc ann
l) PPrintType
Pref Int
n (Rep1 f a -> Doc ann) -> (f a -> Rep1 f a) -> f a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1
{-# INLINE genericLiftPFormatPrec #-}

-- | Generic 'liftPFormatList' function.
genericLiftPFormatList ::
  (Generic1 f, GPPrint Arity1 (Rep1 f)) =>
  (Int -> a -> Doc ann) ->
  ([a] -> Doc ann) ->
  [f a] ->
  Doc ann
genericLiftPFormatList :: forall (f :: * -> *) a ann.
(Generic1 f, GPPrint Arity1 (Rep1 f)) =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
genericLiftPFormatList Int -> a -> Doc ann
p [a] -> Doc ann
l = PPrintArgs Arity1 a ann -> [Rep1 f a] -> Doc ann
forall a ann.
HasCallStack =>
PPrintArgs Arity1 a ann -> [Rep1 f a] -> Doc ann
forall arity (f :: * -> *) a ann.
(GPPrint arity f, HasCallStack) =>
PPrintArgs arity a ann -> [f a] -> Doc ann
gpformatList ((Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> PPrintArgs Arity1 a ann
forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> PPrintArgs Arity1 a ann
PPrintArgs1 Int -> a -> Doc ann
p [a] -> Doc ann
l) ([Rep1 f a] -> Doc ann)
-> ([f a] -> [Rep1 f a]) -> [f a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> Rep1 f a) -> [f a] -> [Rep1 f a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1
{-# INLINE genericLiftPFormatList #-}

instance
  (Generic a, GPPrint Arity0 (Rep a)) =>
  PPrint (Default a)
  where
  pformatPrec :: forall ann. Int -> Default a -> Doc ann
pformatPrec Int
n = Int -> a -> Doc ann
forall a ann.
(Generic a, GPPrint Arity0 (Rep a)) =>
Int -> a -> Doc ann
genericPFormatPrec Int
n (a -> Doc ann) -> (Default a -> a) -> Default a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Default a -> a
forall a. Default a -> a
unDefault
  pformatList :: forall ann. [Default a] -> Doc ann
pformatList = [a] -> Doc ann
forall a ann. (Generic a, GPPrint Arity0 (Rep a)) => [a] -> Doc ann
genericPFormatList ([a] -> Doc ann) -> ([Default a] -> [a]) -> [Default a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Default a -> a) -> [Default a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Default a -> a
forall a. Default a -> a
unDefault

instance
  (Generic1 f, GPPrint Arity1 (Rep1 f), PPrint a) =>
  PPrint (Default1 f a)
  where
  pformatPrec :: forall ann. Int -> Default1 f a -> Doc ann
pformatPrec = Int -> Default1 f a -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1
  pformatList :: forall ann. [Default1 f a] -> Doc ann
pformatList = [Default1 f a] -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
[f a] -> Doc ann
pformatList1

instance
  (Generic1 f, GPPrint Arity1 (Rep1 f)) =>
  PPrint1 (Default1 f)
  where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> Default1 f a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
p [a] -> Doc ann
l Int
n = (Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
forall (f :: * -> *) a ann.
(Generic1 f, GPPrint Arity1 (Rep1 f)) =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
genericLiftPFormatPrec Int -> a -> Doc ann
p [a] -> Doc ann
l Int
n (f a -> Doc ann)
-> (Default1 f a -> f a) -> Default1 f a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Default1 f a -> f a
forall (f :: * -> *) a. Default1 f a -> f a
unDefault1
  liftPFormatList :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> [Default1 f a] -> Doc ann
liftPFormatList Int -> a -> Doc ann
p [a] -> Doc ann
l = (Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
forall (f :: * -> *) a ann.
(Generic1 f, GPPrint Arity1 (Rep1 f)) =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
genericLiftPFormatList Int -> a -> Doc ann
p [a] -> Doc ann
l ([f a] -> Doc ann)
-> ([Default1 f a] -> [f a]) -> [Default1 f a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Default1 f a -> f a) -> [Default1 f a] -> [f a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Default1 f a -> f a
forall (f :: * -> *) a. Default1 f a -> f a
unDefault1

#define FORMAT_SIMPLE(type) \
instance PPrint type where pformatPrec = viaShowsPrec showsPrec

#if 1
FORMAT_SIMPLE(Bool)
FORMAT_SIMPLE(Integer)
FORMAT_SIMPLE(Int)
FORMAT_SIMPLE(Int8)
FORMAT_SIMPLE(Int16)
FORMAT_SIMPLE(Int32)
FORMAT_SIMPLE(Int64)
FORMAT_SIMPLE(Word)
FORMAT_SIMPLE(Word8)
FORMAT_SIMPLE(Word16)
FORMAT_SIMPLE(Word32)
FORMAT_SIMPLE(Word64)
FORMAT_SIMPLE(Float)
FORMAT_SIMPLE(Double)
FORMAT_SIMPLE(FPRoundingMode)
FORMAT_SIMPLE(Monoid.All)
FORMAT_SIMPLE(Monoid.Any)
FORMAT_SIMPLE(Ordering)
FORMAT_SIMPLE(AlgReal)
#endif

instance (PPrint a) => PPrint (Ratio a) where
  pformatPrec :: forall ann. Int -> Ratio a -> Doc ann
pformatPrec Int
p Ratio a
r =
    Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
condEnclose (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ratioPrec) Doc ann
"(" Doc ann
")" (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
      Int -> a -> Doc ann
forall ann. Int -> a -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec Int
ratioPrec1 (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r)
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"%"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> a -> Doc ann
forall ann. Int -> a -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec Int
ratioPrec1 (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r)

instance PPrint B.ByteString where
  pformat :: forall ann. ByteString -> Doc ann
pformat = [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann)
-> (ByteString -> [Char]) -> ByteString -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C.unpack

instance PPrint T.Text where
  pformat :: forall ann. Text -> Doc ann
pformat = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty

instance (KnownNat n, 1 <= n) => PPrint (IntN n) where
  pformat :: forall ann. IntN n -> Doc ann
pformat = IntN n -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance (KnownNat n, 1 <= n) => PPrint (WordN n) where
  pformat :: forall ann. WordN n -> Doc ann
pformat = WordN n -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance (ValidFP eb sb) => PPrint (FP eb sb) where
  pformat :: forall ann. FP eb sb -> Doc ann
pformat = FP eb sb -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance (Show a, Show b) => PPrint (a =-> b) where
  pformat :: forall ann. (a =-> b) -> Doc ann
pformat = (a =-> b) -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance PPrint (a --> b) where
  pformat :: forall ann. (a --> b) -> Doc ann
pformat = (a --> b) -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

-- Prettyprint
#define FORMAT_SYM_SIMPLE(symtype) \
instance PPrint symtype where \
  pformat (symtype t) = prettyPrintTerm t

#define FORMAT_SYM_BV(symtype) \
instance (KnownNat n, 1 <= n) => PPrint (symtype n) where \
  pformat (symtype t) = prettyPrintTerm t

#define FORMAT_SYM_FUN(op, cons) \
instance PPrint (sa op sb) where \
  pformat (cons t) = prettyPrintTerm t

#if 1
FORMAT_SYM_SIMPLE(SymBool)
FORMAT_SYM_SIMPLE(SymInteger)
FORMAT_SYM_SIMPLE(SymFPRoundingMode)
FORMAT_SYM_SIMPLE(SymAlgReal)
FORMAT_SYM_BV(SymIntN)
FORMAT_SYM_BV(SymWordN)
FORMAT_SYM_FUN(=~>, SymTabularFun)
FORMAT_SYM_FUN(-~>, SymGeneralFun)
#endif

instance (ValidFP eb sb) => PPrint (SymFP eb sb) where
  pformat :: forall ann. SymFP eb sb -> Doc ann
pformat (SymFP Term (FP eb sb)
t) = Term (FP eb sb) -> Doc ann
forall t ann. Term t -> Doc ann
prettyPrintTerm Term (FP eb sb)
t

-- Instance
deriveBuiltins
  (ViaDefault ''PPrint)
  [''PPrint]
  [ ''Maybe,
    ''Either,
    ''(),
    ''(,),
    ''(,,),
    ''(,,,),
    ''(,,,,),
    ''(,,,,,),
    ''(,,,,,,),
    ''(,,,,,,,),
    ''(,,,,,,,,),
    ''(,,,,,,,,,),
    ''(,,,,,,,,,,),
    ''(,,,,,,,,,,,),
    ''(,,,,,,,,,,,,),
    ''(,,,,,,,,,,,,,),
    ''(,,,,,,,,,,,,,,),
    ''AssertionError,
    ''VerificationConditions,
    ''NotRepresentableFPError,
    ''Monoid.Dual,
    ''Monoid.Sum,
    ''Monoid.Product,
    ''Monoid.First,
    ''Monoid.Last,
    ''Down
  ]

deriveBuiltins
  (ViaDefault1 ''PPrint1)
  [''PPrint, ''PPrint1]
  [ ''Maybe,
    ''Either,
    ''(,),
    ''(,,),
    ''(,,,),
    ''(,,,,),
    ''(,,,,,),
    ''(,,,,,,),
    ''(,,,,,,,),
    ''(,,,,,,,,),
    ''(,,,,,,,,,),
    ''(,,,,,,,,,,),
    ''(,,,,,,,,,,,),
    ''(,,,,,,,,,,,,),
    ''(,,,,,,,,,,,,,),
    ''(,,,,,,,,,,,,,,),
    ''Monoid.Dual,
    ''Monoid.Sum,
    ''Monoid.Product,
    ''Monoid.First,
    ''Monoid.Last,
    ''Down
  ]

-- Identity
instance (PPrint a) => PPrint (Identity a) where
  pformatPrec :: forall ann. Int -> Identity a -> Doc ann
pformatPrec = Int -> Identity a -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1

instance PPrint1 Identity where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> Identity a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
_ Int
n (Identity a
a) = Int -> a -> Doc ann
f Int
n a
a

-- MaybeT
instance
  (PPrint1 m, PPrint a) =>
  PPrint (MaybeT m a)
  where
  pformatPrec :: forall ann. Int -> MaybeT m a -> Doc ann
pformatPrec = Int -> MaybeT m a -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1

instance
  (PPrint1 m) =>
  PPrint1 (MaybeT m)
  where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> MaybeT m a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l Int
n (MaybeT m (Maybe a)
a) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor
      Int
n
      Doc ann
"MaybeT"
      [(Int -> Maybe a -> Doc ann)
-> ([Maybe a] -> Doc ann) -> Int -> m (Maybe a) -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> m a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec ((Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> Maybe a -> Doc ann
forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> Maybe a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l) ((Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [Maybe a] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [Maybe a] -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
liftPFormatList Int -> a -> Doc ann
f [a] -> Doc ann
l) Int
11 m (Maybe a)
a]

-- ExceptT
instance
  (PPrint1 m, PPrint e, PPrint a) =>
  PPrint (ExceptT e m a)
  where
  pformatPrec :: forall ann. Int -> ExceptT e m a -> Doc ann
pformatPrec = Int -> ExceptT e m a -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1

instance
  (PPrint1 m, PPrint e) =>
  PPrint1 (ExceptT e m)
  where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> ExceptT e m a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l Int
n (ExceptT m (Either e a)
a) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor
      Int
n
      Doc ann
"ExceptT"
      [(Int -> Either e a -> Doc ann)
-> ([Either e a] -> Doc ann) -> Int -> m (Either e a) -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> m a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec ((Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> Either e a -> Doc ann
forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> Either e a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l) ((Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> [Either e a] -> Doc ann
forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> [Either e a] -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
liftPFormatList Int -> a -> Doc ann
f [a] -> Doc ann
l) Int
11 m (Either e a)
a]

-- WriterT
instance
  (PPrint1 m, PPrint a, PPrint w) =>
  PPrint (WriterLazy.WriterT w m a)
  where
  pformatPrec :: forall ann. Int -> WriterT w m a -> Doc ann
pformatPrec = Int -> WriterT w m a -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1

instance
  (PPrint1 m, PPrint w) =>
  PPrint1 (WriterLazy.WriterT w m)
  where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> WriterT w m a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l Int
n (WriterLazy.WriterT m (a, w)
a) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor
      Int
n
      Doc ann
"WriterT"
      [ (Int -> (a, w) -> Doc ann)
-> ([(a, w)] -> Doc ann) -> Int -> m (a, w) -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> m a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec
          ((Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> w -> Doc ann)
-> ([w] -> Doc ann)
-> Int
-> (a, w)
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> (a, b)
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
f [a] -> Doc ann
l Int -> w -> Doc ann
forall ann. Int -> w -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [w] -> Doc ann
forall ann. [w] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList)
          ((Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> w -> Doc ann)
-> ([w] -> Doc ann)
-> [(a, w)]
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [(a, b)]
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [f a b]
-> Doc ann
liftPFormatList2 Int -> a -> Doc ann
f [a] -> Doc ann
l Int -> w -> Doc ann
forall ann. Int -> w -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [w] -> Doc ann
forall ann. [w] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList)
          Int
11
          m (a, w)
a
      ]

instance
  (PPrint1 m, PPrint a, PPrint w) =>
  PPrint (WriterStrict.WriterT w m a)
  where
  pformatPrec :: forall ann. Int -> WriterT w m a -> Doc ann
pformatPrec = Int -> WriterT w m a -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1

instance
  (PPrint1 m, PPrint w) =>
  PPrint1 (WriterStrict.WriterT w m)
  where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> WriterT w m a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l Int
n (WriterStrict.WriterT m (a, w)
a) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor
      Int
n
      Doc ann
"WriterT"
      [ (Int -> (a, w) -> Doc ann)
-> ([(a, w)] -> Doc ann) -> Int -> m (a, w) -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> m a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec
          ((Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> w -> Doc ann)
-> ([w] -> Doc ann)
-> Int
-> (a, w)
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> (a, b)
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
f [a] -> Doc ann
l Int -> w -> Doc ann
forall ann. Int -> w -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [w] -> Doc ann
forall ann. [w] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList)
          ((Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> w -> Doc ann)
-> ([w] -> Doc ann)
-> [(a, w)]
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [(a, b)]
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [f a b]
-> Doc ann
liftPFormatList2 Int -> a -> Doc ann
f [a] -> Doc ann
l Int -> w -> Doc ann
forall ann. Int -> w -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [w] -> Doc ann
forall ann. [w] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList)
          Int
11
          m (a, w)
a
      ]

-- IdentityT
instance (PPrint1 m, PPrint a) => PPrint (IdentityT m a) where
  pformatPrec :: forall ann. Int -> IdentityT m a -> Doc ann
pformatPrec = Int -> IdentityT m a -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1

instance (PPrint1 m) => PPrint1 (IdentityT m) where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> IdentityT m a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l Int
n (IdentityT m a
a) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor Int
n Doc ann
"IdentityT" [(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> m a -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> m a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l Int
11 m a
a]

-- Product
deriving via
  (Default (Product l r a))
  instance
    (PPrint (l a), PPrint (r a)) => PPrint (Product l r a)

deriving via
  (Default1 (Product l r))
  instance
    (PPrint1 l, PPrint1 r) => PPrint1 (Product l r)

-- Sum
deriving via
  (Default (Sum l r a))
  instance
    (PPrint (l a), PPrint (r a)) => PPrint (Sum l r a)

deriving via
  (Default1 (Sum l r))
  instance
    (PPrint1 l, PPrint1 r) => PPrint1 (Sum l r)

-- Compose
instance (PPrint (f (g a))) => PPrint (Compose f g a) where
  pformatPrec :: forall ann. Int -> Compose f g a -> Doc ann
pformatPrec Int
n (Compose f (g a)
a) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor Int
n Doc ann
"Compose" [Int -> f (g a) -> Doc ann
forall ann. Int -> f (g a) -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec Int
11 f (g a)
a]

instance (PPrint1 f, PPrint1 g) => PPrint1 (Compose f g) where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> Compose f g a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l Int
n (Compose f (g a)
a) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor
      Int
n
      Doc ann
"Compose"
      [(Int -> g a -> Doc ann)
-> ([g a] -> Doc ann) -> Int -> f (g a) -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec ((Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> g a -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> g a -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
f [a] -> Doc ann
l) ((Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [g a] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [g a] -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> [f a] -> Doc ann
liftPFormatList Int -> a -> Doc ann
f [a] -> Doc ann
l) Int
11 f (g a)
a]

-- Const
deriving via (Default (Const a b)) instance (PPrint a) => PPrint (Const a b)

deriving via (Default1 (Const a)) instance (PPrint a) => PPrint1 (Const a)

-- Alt
deriving via (Default (Alt f a)) instance (PPrint (f a)) => PPrint (Alt f a)

deriving via (Default1 (Alt f)) instance (PPrint1 f) => PPrint1 (Alt f)

-- Ap
deriving via (Default (Ap f a)) instance (PPrint (f a)) => PPrint (Ap f a)

deriving via (Default1 (Ap f)) instance (PPrint1 f) => PPrint1 (Ap f)

-- Generic
deriving via (Default (U1 p)) instance PPrint (U1 p)

deriving via (Default (V1 p)) instance PPrint (V1 p)

deriving via
  (Default (K1 i c p))
  instance
    (PPrint c) => PPrint (K1 i c p)

deriving via
  (Default (M1 i c f p))
  instance
    (PPrint (f p)) => PPrint (M1 i c f p)

deriving via
  (Default ((f :+: g) p))
  instance
    (PPrint (f p), PPrint (g p)) => PPrint ((f :+: g) p)

deriving via
  (Default ((f :*: g) p))
  instance
    (PPrint (f p), PPrint (g p)) => PPrint ((f :*: g) p)

deriving via
  (Default (Par1 p))
  instance
    (PPrint p) => PPrint (Par1 p)

deriving via
  (Default (Rec1 f p))
  instance
    (PPrint (f p)) => PPrint (Rec1 f p)

deriving via
  (Default ((f :.: g) p))
  instance
    (PPrint (f (g p))) => PPrint ((f :.: g) p)

-- PPrint2
instance PPrint2 Either where
  liftPFormatPrec2 :: forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> Either a b
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
fe [a] -> Doc ann
_ Int -> b -> Doc ann
_ [b] -> Doc ann
_ Int
n (Left a
e) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor Int
n Doc ann
"Left" [Int -> a -> Doc ann
fe Int
11 a
e]
  liftPFormatPrec2 Int -> a -> Doc ann
_ [a] -> Doc ann
_ Int -> b -> Doc ann
fa [b] -> Doc ann
_ Int
n (Right b
a) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor Int
n Doc ann
"Right" [Int -> b -> Doc ann
fa Int
11 b
a]

instance PPrint2 (,) where
  liftPFormatPrec2 :: forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> (a, b)
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
fa [a] -> Doc ann
_ Int -> b -> Doc ann
fb [b] -> Doc ann
_ Int
_ (a
a, b
b) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyPrintTuple [Int -> a -> Doc ann
fa Int
0 a
a, Int -> b -> Doc ann
fb Int
0 b
b]

instance (PPrint a) => PPrint2 ((,,) a) where
  liftPFormatPrec2 :: forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> (a, a, b)
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
fb [a] -> Doc ann
_ Int -> b -> Doc ann
fc [b] -> Doc ann
_ Int
_ (a
a, a
b, b
c) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyPrintTuple [a -> Doc ann
forall ann. a -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat a
a, Int -> a -> Doc ann
fb Int
0 a
b, Int -> b -> Doc ann
fc Int
0 b
c]

instance (PPrint a, PPrint b) => PPrint2 ((,,,) a b) where
  liftPFormatPrec2 :: forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> (a, b, a, b)
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
fc [a] -> Doc ann
_ Int -> b -> Doc ann
fd [b] -> Doc ann
_ Int
_ (a
a, b
b, a
c, b
d) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyPrintTuple [a -> Doc ann
forall ann. a -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat a
a, b -> Doc ann
forall ann. b -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat b
b, Int -> a -> Doc ann
fc Int
0 a
c, Int -> b -> Doc ann
fd Int
0 b
d]

instance (PPrint a) => PPrint (HS.HashSet a) where
  pformatPrec :: forall ann. Int -> HashSet a -> Doc ann
pformatPrec = Int -> HashSet a -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1

instance PPrint1 HS.HashSet where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> HashSet a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
p [a] -> Doc ann
l Int
n HashSet a
s =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor Int
n Doc ann
"HashSet" [(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> [a] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> [a] -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
p [a] -> Doc ann
l Int
11 ([a] -> Doc ann) -> [a] -> Doc ann
forall a b. (a -> b) -> a -> b
$ HashSet a -> [a]
forall a. HashSet a -> [a]
HS.toList HashSet a
s]

instance (PPrint k, PPrint v) => PPrint (HM.HashMap k v) where
  pformatPrec :: forall ann. Int -> HashMap k v -> Doc ann
pformatPrec = Int -> HashMap k v -> Doc ann
forall (f :: * -> *) a ann.
(PPrint1 f, PPrint a) =>
Int -> f a -> Doc ann
pformatPrec1

instance (PPrint k) => PPrint1 (HM.HashMap k) where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> HashMap k a -> Doc ann
liftPFormatPrec = (Int -> k -> Doc ann)
-> ([k] -> Doc ann)
-> (Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> Int
-> HashMap k a
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> HashMap a b
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
liftPFormatPrec2 Int -> k -> Doc ann
forall ann. Int -> k -> Doc ann
forall a ann. PPrint a => Int -> a -> Doc ann
pformatPrec [k] -> Doc ann
forall ann. [k] -> Doc ann
forall a ann. PPrint a => [a] -> Doc ann
pformatList

instance PPrint2 HM.HashMap where
  liftPFormatPrec2 :: forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> HashMap a b
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
pk [a] -> Doc ann
lk Int -> b -> Doc ann
pv [b] -> Doc ann
lv Int
n HashMap a b
s =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor
      Int
n
      Doc ann
"HashMap"
      [ (Int -> (a, b) -> Doc ann)
-> ([(a, b)] -> Doc ann) -> Int -> [(a, b)] -> Doc ann
forall a ann.
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> [a] -> Doc ann
forall (f :: * -> *) a ann.
PPrint1 f =>
(Int -> a -> Doc ann) -> ([a] -> Doc ann) -> Int -> f a -> Doc ann
liftPFormatPrec
          ((Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> (a, b)
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> (a, b)
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> Int
-> f a b
-> Doc ann
liftPFormatPrec2 Int -> a -> Doc ann
pk [a] -> Doc ann
lk Int -> b -> Doc ann
pv [b] -> Doc ann
lv)
          ((Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [(a, b)]
-> Doc ann
forall a ann b.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [(a, b)]
-> Doc ann
forall (f :: * -> * -> *) a ann b.
PPrint2 f =>
(Int -> a -> Doc ann)
-> ([a] -> Doc ann)
-> (Int -> b -> Doc ann)
-> ([b] -> Doc ann)
-> [f a b]
-> Doc ann
liftPFormatList2 Int -> a -> Doc ann
pk [a] -> Doc ann
lk Int -> b -> Doc ann
pv [b] -> Doc ann
lv)
          Int
11
          ([(a, b)] -> Doc ann) -> [(a, b)] -> Doc ann
forall a b. (a -> b) -> a -> b
$ HashMap a b -> [(a, b)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap a b
s
      ]

instance PPrint Identifier where
  pformat :: forall ann. Identifier -> Doc ann
pformat = Identifier -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance PPrint Symbol where
  pformat :: forall ann. Symbol -> Doc ann
pformat = Symbol -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance PPrint (TypedSymbol knd t) where
  pformat :: forall ann. TypedSymbol knd t -> Doc ann
pformat = TypedSymbol knd t -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance PPrint (SomeTypedSymbol knd) where
  pformat :: forall ann. SomeTypedSymbol knd -> Doc ann
pformat = SomeTypedSymbol knd -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance PPrint ModelValue where
  pformat :: forall ann. ModelValue -> Doc ann
pformat = ModelValue -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance PPrint Model where
  pformatPrec :: forall ann. Int -> Model -> Doc ann
pformatPrec Int
n (Model HashMap SomeTypedAnySymbol ModelValue
m) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor Int
n Doc ann
"Model" [Doc ann
bodyFormatted]
    where
      pformatSymbolWithoutType :: SomeTypedSymbol knd -> Doc ann
      pformatSymbolWithoutType :: forall (knd :: SymbolKind) ann. SomeTypedSymbol knd -> Doc ann
pformatSymbolWithoutType (SomeTypedSymbol TypedSymbol knd t
s) = Symbol -> Doc ann
forall ann. Symbol -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat (Symbol -> Doc ann) -> Symbol -> Doc ann
forall a b. (a -> b) -> a -> b
$ TypedSymbol knd t -> Symbol
forall t (knd :: SymbolKind). TypedSymbol knd t -> Symbol
unTypedSymbol TypedSymbol knd t
s
      pformatPair :: (SomeTypedSymbol knd, ModelValue) -> Doc ann
      pformatPair :: forall (knd :: SymbolKind) ann.
(SomeTypedSymbol knd, ModelValue) -> Doc ann
pformatPair (SomeTypedSymbol knd
s, ModelValue
v) = SomeTypedSymbol knd -> Doc ann
forall (knd :: SymbolKind) ann. SomeTypedSymbol knd -> Doc ann
pformatSymbolWithoutType SomeTypedSymbol knd
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" -> " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ModelValue -> Doc ann
forall ann. ModelValue -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat ModelValue
v
      bodyFormatted :: Doc ann
bodyFormatted = Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> [Doc ann] -> Doc ann
pformatListLike Doc ann
"{" Doc ann
"}" ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (SomeTypedAnySymbol, ModelValue) -> Doc ann
forall (knd :: SymbolKind) ann.
(SomeTypedSymbol knd, ModelValue) -> Doc ann
pformatPair ((SomeTypedAnySymbol, ModelValue) -> Doc ann)
-> [(SomeTypedAnySymbol, ModelValue)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap SomeTypedAnySymbol ModelValue
-> [(SomeTypedAnySymbol, ModelValue)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap SomeTypedAnySymbol ModelValue
m

instance PPrint (SymbolSet knd) where
  pformatPrec :: forall ann. Int -> SymbolSet knd -> Doc ann
pformatPrec Int
n (SymbolSet HashSet (SomeTypedSymbol knd)
s) =
    Int -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Int -> Doc ann -> [Doc ann] -> Doc ann
pformatWithConstructor
      Int
n
      Doc ann
"SymbolSet"
      [Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> [Doc ann] -> Doc ann
pformatListLike Doc ann
"{" Doc ann
"}" ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ SomeTypedSymbol knd -> Doc ann
forall ann. SomeTypedSymbol knd -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat (SomeTypedSymbol knd -> Doc ann)
-> [SomeTypedSymbol knd] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet (SomeTypedSymbol knd) -> [SomeTypedSymbol knd]
forall a. HashSet a -> [a]
HS.toList HashSet (SomeTypedSymbol knd)
s]