{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Grisette.Internal.Core.Data.Class.GPretty
  ( GPretty (..),
    groupedEnclose,
    condEnclose,
  )
where

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.Sum (Sum)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.String (IsString (fromString))
import qualified Data.Text as T
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Generics
  ( C,
    C1,
    Constructor (conFixity, conIsRecord, conName),
    D,
    Fixity (Infix, Prefix),
    Generic (Rep, from),
    K1 (K1),
    M1 (M1),
    S,
    Selector (selName),
    U1 (U1),
    V1,
    type (:*:) ((:*:)),
    type (:+:) (L1, R1),
  )
import GHC.TypeLits (KnownNat, type (<=))
import Generics.Deriving (Default (Default, unDefault))
import Grisette.Internal.SymPrim.BV (IntN, WordN)
import Grisette.Internal.SymPrim.Prim.Term
  ( LinkedRep,
    SupportedPrim,
    prettyPrintTerm,
  )
import Grisette.Internal.SymPrim.SymBV
  ( SymIntN (SymIntN),
    SymWordN (SymWordN),
  )
import Grisette.Internal.SymPrim.SymBool (SymBool (SymBool))
import Grisette.Internal.SymPrim.SymGeneralFun (type (-~>) (SymGeneralFun))
import Grisette.Internal.SymPrim.SymInteger (SymInteger (SymInteger))
import Grisette.Internal.SymPrim.SymTabularFun (type (=~>) (SymTabularFun))

#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter
  ( (<+>),
    align,
    encloseSep,
    flatAlt,
    group,
    nest,
    vcat,
    viaShow,
    vsep,
    Doc,
    Pretty(pretty),
  )
#else
import Data.Text.Prettyprint.Doc
  ( (<+>),
    align,
    encloseSep,
    flatAlt,
    group,
    nest,
    vcat,
    viaShow,
    vsep,
    Doc,
    Pretty(pretty),
  )
#endif

glist :: [Doc ann] -> Doc ann
glist :: forall ann. [Doc ann] -> Doc ann
glist [Doc ann]
l
  | [Doc ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc ann]
l = Doc ann
"[]"
  | [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 -> 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 -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"
  | Bool
otherwise = 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
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep Doc ann
"" Doc ann
"" (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
", " Doc ann
",") [Doc ann]
l

class GPretty a where
  gpretty :: a -> Doc ann
  gprettyPrec :: Int -> a -> Doc ann
  gprettyList :: [a] -> Doc ann
  gprettyList = 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
glist ([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. GPretty a => a -> Doc ann
gpretty

  gpretty = Int -> a -> Doc ann
forall ann. Int -> a -> Doc ann
forall a ann. GPretty a => Int -> a -> Doc ann
gprettyPrec Int
0
  gprettyPrec Int
_ = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. GPretty a => a -> Doc ann
gpretty

  {-# MINIMAL gpretty | gprettyPrec #-}

#define GPRETTY_SIMPLE(type) \
instance GPretty type where gprettyPrec = viaShowsPrec showsPrec

instance GPretty Char where
  gpretty :: forall ann. Char -> Doc ann
gpretty = Char -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow
  gprettyList :: forall ann. [Char] -> Doc ann
gprettyList [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)

#if 1
GPRETTY_SIMPLE(Bool)
GPRETTY_SIMPLE(Integer)
GPRETTY_SIMPLE(Int)
GPRETTY_SIMPLE(Int8)
GPRETTY_SIMPLE(Int16)
GPRETTY_SIMPLE(Int32)
GPRETTY_SIMPLE(Int64)
GPRETTY_SIMPLE(Word)
GPRETTY_SIMPLE(Word8)
GPRETTY_SIMPLE(Word16)
GPRETTY_SIMPLE(Word32)
GPRETTY_SIMPLE(Word64)
#endif

instance GPretty B.ByteString where
  gpretty :: forall ann. ByteString -> Doc ann
gpretty = [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 GPretty T.Text where
  gpretty :: forall ann. Text -> Doc ann
gpretty = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty

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

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

-- ()
instance GPretty () where
  gpretty :: forall ann. () -> Doc ann
gpretty = () -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

-- Either
deriving via
  (Default (Either a b))
  instance
    (GPretty a, GPretty b) => GPretty (Either a b)

-- Maybe
deriving via
  (Default (Maybe a))
  instance
    (GPretty a) => GPretty (Maybe a)

-- List
instance (GPretty a) => GPretty [a] where
  gpretty :: forall ann. [a] -> Doc ann
gpretty = [a] -> Doc ann
forall ann. [a] -> Doc ann
forall a ann. GPretty a => [a] -> Doc ann
gprettyList

-- (,)
deriving via
  (Default (a, b))
  instance
    (GPretty a, GPretty b) => GPretty (a, b)

-- (,,)
deriving via
  (Default (a, b, c))
  instance
    (GPretty a, GPretty b, GPretty c) => GPretty (a, b, c)

-- (,,,)
deriving via
  (Default (a, b, c, d))
  instance
    ( GPretty a,
      GPretty b,
      GPretty c,
      GPretty d
    ) =>
    GPretty (a, b, c, d)

-- (,,,,)
deriving via
  (Default (a, b, c, d, e))
  instance
    ( GPretty a,
      GPretty b,
      GPretty c,
      GPretty d,
      GPretty e
    ) =>
    GPretty (a, b, c, d, e)

-- (,,,,,)
deriving via
  (Default (a, b, c, d, e, f))
  instance
    ( GPretty a,
      GPretty b,
      GPretty c,
      GPretty d,
      GPretty e,
      GPretty f
    ) =>
    GPretty (a, b, c, d, e, f)

-- (,,,,,,)
deriving via
  (Default (a, b, c, d, e, f, g))
  instance
    ( GPretty a,
      GPretty b,
      GPretty c,
      GPretty d,
      GPretty e,
      GPretty f,
      GPretty g
    ) =>
    GPretty (a, b, c, d, e, f, g)

-- (,,,,,,,)
deriving via
  (Default (a, b, c, d, e, f, g, h))
  instance
    ( GPretty a,
      GPretty b,
      GPretty c,
      GPretty d,
      GPretty e,
      GPretty f,
      GPretty g,
      GPretty h
    ) =>
    GPretty (a, b, c, d, e, f, g, h)

-- Sum
deriving via
  (Default (Sum f g a))
  instance
    (GPretty (f a), GPretty (g a)) =>
    GPretty (Sum f g a)

-- MaybeT
instance
  (GPretty (m (Maybe a))) =>
  GPretty (MaybeT m a)
  where
  gprettyPrec :: forall ann. Int -> MaybeT m a -> Doc ann
gprettyPrec Int
_ (MaybeT m (Maybe a)
a) =
    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
$
      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
"MaybeT",
            Int -> m (Maybe a) -> Doc ann
forall ann. Int -> m (Maybe a) -> Doc ann
forall a ann. GPretty a => Int -> a -> Doc ann
gprettyPrec Int
11 m (Maybe a)
a
          ]

-- ExceptT
instance
  (GPretty (m (Either e a))) =>
  GPretty (ExceptT e m a)
  where
  gprettyPrec :: forall ann. Int -> ExceptT e m a -> Doc ann
gprettyPrec Int
_ (ExceptT m (Either e a)
a) =
    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
$
      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
"ExceptT",
            Int -> m (Either e a) -> Doc ann
forall ann. Int -> m (Either e a) -> Doc ann
forall a ann. GPretty a => Int -> a -> Doc ann
gprettyPrec Int
11 m (Either e a)
a
          ]

-- WriterT
instance
  (GPretty (m (a, w))) =>
  GPretty (WriterLazy.WriterT w m a)
  where
  gprettyPrec :: forall ann. Int -> WriterT w m a -> Doc ann
gprettyPrec Int
_ (WriterLazy.WriterT m (a, w)
a) =
    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
$
      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
"WriterT",
            Int -> m (a, w) -> Doc ann
forall ann. Int -> m (a, w) -> Doc ann
forall a ann. GPretty a => Int -> a -> Doc ann
gprettyPrec Int
11 m (a, w)
a
          ]

instance
  (GPretty (m (a, w))) =>
  GPretty (WriterStrict.WriterT w m a)
  where
  gprettyPrec :: forall ann. Int -> WriterT w m a -> Doc ann
gprettyPrec Int
_ (WriterStrict.WriterT m (a, w)
a) =
    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
$
      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
"WriterT",
            Int -> m (a, w) -> Doc ann
forall ann. Int -> m (a, w) -> Doc ann
forall a ann. GPretty a => Int -> a -> Doc ann
gprettyPrec Int
11 m (a, w)
a
          ]

-- Identity
instance (GPretty a) => GPretty (Identity a) where
  gprettyPrec :: forall ann. Int -> Identity a -> Doc ann
gprettyPrec Int
_ (Identity a
a) =
    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
$
      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
"Identity",
            Int -> a -> Doc ann
forall ann. Int -> a -> Doc ann
forall a ann. GPretty a => Int -> a -> Doc ann
gprettyPrec Int
11 a
a
          ]

-- IdentityT
instance (GPretty (m a)) => GPretty (IdentityT m a) where
  gprettyPrec :: forall ann. Int -> IdentityT m a -> Doc ann
gprettyPrec Int
_ (IdentityT m a
a) =
    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
$
      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
"IdentityT",
            Int -> m a -> Doc ann
forall ann. Int -> m a -> Doc ann
forall a ann. GPretty a => Int -> a -> Doc ann
gprettyPrec Int
11 m a
a
          ]

-- Prettyprint
#define GPRETTY_SYM_SIMPLE(symtype) \
instance GPretty symtype where \
  gpretty (symtype t) = prettyPrintTerm t

#define GPRETTY_SYM_BV(symtype) \
instance (KnownNat n, 1 <= n) => GPretty (symtype n) where \
  gpretty (symtype t) = prettyPrintTerm t

#define GPRETTY_SYM_FUN(op, cons) \
instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb)\
  => GPretty (sa op sb) where \
  gpretty (cons t) = prettyPrintTerm t

#if 1
GPRETTY_SYM_SIMPLE(SymBool)
GPRETTY_SYM_SIMPLE(SymInteger)
GPRETTY_SYM_BV(SymIntN)
GPRETTY_SYM_BV(SymWordN)
GPRETTY_SYM_FUN(=~>, SymTabularFun)
GPRETTY_SYM_FUN(-~>, SymGeneralFun)
#endif

instance (Generic a, GPretty' (Rep a)) => GPretty (Default a) where
  gprettyPrec :: forall ann. Int -> Default a -> Doc ann
gprettyPrec Int
i Default a
v = Type -> Int -> Rep a Any -> Doc ann
forall c ann. Type -> Int -> Rep a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
Pref Int
i (Rep a Any -> Doc ann) -> Rep a Any -> Doc ann
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from (a -> Rep a Any) -> a -> Rep a Any
forall a b. (a -> b) -> a -> b
$ Default a -> a
forall a. Default a -> a
unDefault Default a
v

data Type = Rec | Tup | Pref | Inf String Int

class GPretty' a where
  gprettyPrec' :: Type -> Int -> a c -> Doc ann
  isNullary :: a c -> Bool
  isNullary = [Char] -> a c -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"generic gpretty (isNullary): unnecessary case"

instance GPretty' V1 where
  gprettyPrec' :: forall c ann. Type -> Int -> V1 c -> Doc ann
gprettyPrec' Type
_ Int
_ V1 c
x = case V1 c
x of {}

instance GPretty' U1 where
  gprettyPrec' :: forall c ann. Type -> Int -> U1 c -> Doc ann
gprettyPrec' Type
_ Int
_ U1 c
U1 = Doc ann
""
  isNullary :: forall c. U1 c -> Bool
isNullary U1 c
_ = Bool
True

instance (GPretty c) => GPretty' (K1 i c) where
  gprettyPrec' :: forall c ann. Type -> Int -> K1 i c c -> Doc ann
gprettyPrec' Type
_ Int
n (K1 c
a) = Int -> c -> Doc ann
forall ann. Int -> c -> Doc ann
forall a ann. GPretty a => Int -> a -> Doc ann
gprettyPrec Int
n c
a
  isNullary :: forall c. K1 i c c -> Bool
isNullary K1 i c c
_ = Bool
False

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
d, Doc ann
r]

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

instance (GPretty' a, Constructor c) => GPretty' (M1 C c a) where
  gprettyPrec' :: forall c ann. Type -> Int -> M1 C c a c -> Doc ann
gprettyPrec' Type
_ Int
n c :: M1 C c a c
c@(M1 a c
x) =
    case Type
t of
      Type
Tup ->
        Type -> Doc ann -> Doc ann
forall ann. Type -> Doc ann -> Doc ann
prettyBraces Type
t (Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
0 a c
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
$ Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
m a c
x
      Type
_ ->
        if a c -> Bool
forall c. a c -> Bool
forall (a :: * -> *) c. GPretty' a => a c -> Bool
isNullary a c
x
          then [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (M1 C c a c -> [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 M1 C c a c
c)
          else
            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
                      [ [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (M1 C c a c -> [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 M1 C c a c
c),
                        Type -> Doc ann -> Doc ann
forall ann. Type -> Doc ann -> Doc ann
prettyBraces Type
t (Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
11 a c
x)
                      ]
    where
      prettyBraces :: Type -> Doc ann -> Doc ann
      prettyBraces :: forall ann. Type -> Doc ann -> Doc ann
prettyBraces Type
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 Type
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 Type
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 = M1 C c a c -> 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 M1 C c a c
c
      t :: Type
t
        | M1 C c a c -> 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 M1 C c a c
c = Type
Rec
        | M1 C c a c -> Bool
forall (f :: * -> *) p. C1 c f p -> Bool
conIsTuple M1 C c a c
c = Type
Tup
        | Bool
otherwise = case Fixity
fixity of
            Fixity
Prefix -> Type
Pref
            Infix Associativity
_ Int
i -> [Char] -> Int -> Type
Inf (M1 C c a c -> [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 M1 C c a c
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, GPretty' a) => GPretty' (M1 S s a) where
  gprettyPrec' :: forall c ann. Type -> Int -> M1 S s a c -> Doc ann
gprettyPrec' Type
t Int
n s :: M1 S s a c
s@(M1 a c
x)
    | M1 S s a c -> [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 M1 S s a c
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" =
        case Type
t of
          Type
Pref -> Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a c
x
          Type
_ -> Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a c
x
    | Bool
otherwise =
        [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (M1 S s a c -> [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 M1 S s a c
s) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
0 a c
x
  isNullary :: forall c. M1 S s a c -> Bool
isNullary (M1 a c
x) = a c -> Bool
forall c. a c -> Bool
forall (a :: * -> *) c. GPretty' a => a c -> Bool
isNullary a c
x

instance (GPretty' a) => GPretty' (M1 D d a) where
  gprettyPrec' :: forall c ann. Type -> Int -> M1 D d a c -> Doc ann
gprettyPrec' Type
t Int
n (M1 a c
x) = Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
n a c
x

instance (GPretty' a, GPretty' b) => GPretty' (a :+: b) where
  gprettyPrec' :: forall c ann. Type -> Int -> (:+:) a b c -> Doc ann
gprettyPrec' Type
t Int
n (L1 a c
x) = Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
n a c
x
  gprettyPrec' Type
t Int
n (R1 b c
x) = Type -> Int -> b c -> Doc ann
forall c ann. Type -> Int -> b c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
n b c
x

instance (GPretty' a, GPretty' b) => GPretty' (a :*: b) where
  gprettyPrec' :: forall c ann. Type -> Int -> (:*:) a b c -> Doc ann
gprettyPrec' t :: Type
t@Type
Rec Int
n (a c
a :*: b c
b) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
      [ Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
n a c
a,
        Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Int -> b c -> Doc ann
forall c ann. Type -> Int -> b c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
n b c
b
      ]
  gprettyPrec' t :: Type
t@(Inf [Char]
s Int
_) Int
n (a c
a :*: b c
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
          [ Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
n a c
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
<+> Type -> Int -> b c -> Doc ann
forall c ann. Type -> Int -> b c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
n b c
b
          ]
  gprettyPrec' t :: Type
t@Type
Tup Int
_ (a c
a :*: b c
b) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
      [ Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
0 a c
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
"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type -> Int -> b c -> Doc ann
forall c ann. Type -> Int -> b c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t Int
0 b c
b
      ]
  gprettyPrec' t :: Type
t@Type
Pref Int
n (a c
a :*: b c
b) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ Type -> Int -> a c -> Doc ann
forall c ann. Type -> Int -> a c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a c
a,
        Type -> Int -> b c -> Doc ann
forall c ann. Type -> Int -> b c -> Doc ann
forall (a :: * -> *) c ann.
GPretty' a =>
Type -> Int -> a c -> Doc ann
gprettyPrec' Type
t (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) b c
b
      ]
  isNullary :: forall c. (:*:) a b c -> Bool
isNullary (:*:) a b c
_ = Bool
False

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