{-# 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 TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-missing-import-lists #-}

-- |
-- Module      :   Grisette.Internal.Internal.Decl.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.Internal.Decl.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,
    pformatListLike,
    prettyPrintTuple,
    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 Data.Kind (Type)
import Data.String (IsString (fromString))
import qualified Data.Text as T
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.Stack (HasCallStack)
import Generics.Deriving (Default (unDefault), Default1 (unDefault1))
import Grisette.Internal.SymPrim.Prim.Internal.Term ()
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 #-}

-- | Pretty print a list of documents with left and right delimiters.
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
"]"

-- | Pretty print a tuple.
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 = String -> Doc ann
forall a. HasCallStack => String -> a
error String
"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. String -> Doc ann
pformatList String
v = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (String -> Text
forall a. IsString a => String -> a
fromString String
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 = String -> IO ()
putStrLn (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
renderString (SimpleDocStream Any -> String)
-> (a -> SimpleDocStream Any) -> a -> String
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 -> String
(Int -> PPrintType -> ShowS)
-> (PPrintType -> String)
-> ([PPrintType] -> ShowS)
-> Show PPrintType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PPrintType -> ShowS
showsPrec :: Int -> PPrintType -> ShowS
$cshow :: PPrintType -> String
show :: PPrintType -> String
$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 = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int -> a -> ShowS
f Int
n a
a String
"")

-- | 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 = String -> PPrintArgs arity a ann -> [f a] -> Doc ann
forall a. HasCallStack => String -> a
error String
"generic format (gpformatList): unnecessary case"
  gisNullary :: (HasCallStack) => PPrintArgs arity a ann -> f a -> Bool
  gisNullary = String -> PPrintArgs arity a ann -> f a -> Bool
forall a. HasCallStack => String -> a
error String
"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 String
_ 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 String -> Doc ann
forall ann. String -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat (C1 c a a -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
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
              (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. PPrint a => a -> Doc ann
pformat (C1 c a a -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
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 String
_ 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 -> String -> Int -> PPrintType
Inf (C1 c a a -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
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 = String -> Bool
tupleName (C1 c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName C1 c f p
y)
        where
          tupleName :: String -> Bool
tupleName (Char
'(' : Char
',' : String
_) = Bool
True
          tupleName String
_ = 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 -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName S1 s a a
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" =
        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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (S1 s a a -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
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 String
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,
          String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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