{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      :   Grisette.Internal.Internal.Impl.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.Impl.Core.Data.Class.PPrint () where

import Control.Monad.Except (ExceptT)
import Control.Monad.Identity
  ( Identity (Identity),
    IdentityT (IdentityT),
  )
import Control.Monad.Trans.Maybe (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.Monoid (Alt, Ap)
import qualified Data.Monoid as Monoid
import Data.Ord (Down)
import Data.Proxy (Proxy)
import Data.Ratio (Ratio, denominator, numerator)
import qualified Data.Text as T
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Generics
  ( K1 (K1),
    M1 (M1),
    Par1 (Par1),
    Rec1 (Rec1),
    V1,
    (:.:) (Comp1),
    type (:*:),
  )
import GHC.Real (ratioPrec, ratioPrec1)
import GHC.TypeLits (KnownNat, type (<=))
import Generics.Deriving
  ( Default (Default),
    Default1 (Default1),
    U1,
    (:+:),
  )
import Grisette.Internal.Core.Control.Exception
  ( AssertionError,
    VerificationConditions,
  )
import Grisette.Internal.Core.Data.Symbol (Identifier, Symbol)
import Grisette.Internal.Internal.Decl.Core.Data.Class.PPrint
  ( Doc,
    PPrint (pformat, pformatList, pformatPrec),
    PPrint1 (liftPFormatList, liftPFormatPrec),
    PPrint2 (liftPFormatList2, liftPFormatPrec2),
    Pretty (pretty),
    condEnclose,
    pformatListLike,
    pformatPrec1,
    pformatWithConstructor,
    viaShow,
    viaShowsPrec,
  )
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 (Term)
import Grisette.Internal.SymPrim.Prim.Model
  ( Model (Model),
    SymbolSet (SymbolSet),
  )
import Grisette.Internal.SymPrim.Prim.SomeTerm (SomeTerm (SomeTerm))
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.Derivation.Derive (derive)

#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 (Proxy a) where
  pformatPrec :: forall ann. Int -> Proxy a -> Doc ann
pformatPrec Int
_ Proxy a
_ = Doc ann
"Proxy"
  {-# INLINE pformatPrec #-}

instance PPrint1 Proxy where
  liftPFormatPrec :: forall a ann.
(Int -> a -> Doc ann)
-> ([a] -> Doc ann) -> Int -> Proxy a -> Doc ann
liftPFormatPrec Int -> a -> Doc ann
_ [a] -> Doc ann
_ Int
_ Proxy a
_ = Doc ann
"Proxy"
  {-# INLINE liftPFormatPrec #-}

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 = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann)
-> (ByteString -> String) -> ByteString -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
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

instance PPrint (Term t) where
  pformat :: forall ann. Term t -> Doc ann
pformat = Term t -> Doc ann
forall t ann. Term t -> Doc ann
prettyPrintTerm

instance PPrint SomeTerm where
  pformat :: forall ann. SomeTerm -> Doc ann
pformat (SomeTerm Term a
t) = Term a -> Doc ann
forall t ann. Term t -> Doc ann
prettyPrintTerm Term a
t

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

derive
  [ ''(),
    ''AssertionError,
    ''VerificationConditions,
    ''NotRepresentableFPError
  ]
  [''PPrint]

derive
  [ ''Either,
    ''(,),
    ''(,,),
    ''(,,,),
    ''(,,,,),
    ''(,,,,,),
    ''(,,,,,,),
    ''(,,,,,,,),
    ''(,,,,,,,,),
    ''(,,,,,,,,,),
    ''(,,,,,,,,,,),
    ''(,,,,,,,,,,,),
    ''(,,,,,,,,,,,,),
    ''(,,,,,,,,,,,,,),
    ''(,,,,,,,,,,,,,,)
  ]
  [''PPrint, ''PPrint1, ''PPrint2]

derive
  [ ''Maybe,
    ''Monoid.Dual,
    ''Monoid.First,
    ''Monoid.Last,
    ''Monoid.Sum,
    ''Monoid.Product,
    ''Down,
    ''MaybeT,
    ''ExceptT,
    ''WriterLazy.WriterT,
    ''WriterStrict.WriterT
  ]
  [''PPrint, ''PPrint1]

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

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

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]