-- |
-- Module      :  Cryptol.Utils.PP
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE Safe #-}

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Cryptol.Utils.PP where

import           Cryptol.Utils.Ident
import           Control.DeepSeq
import           Control.Monad (mplus)
import           Data.Maybe (fromMaybe)
import qualified Data.Semigroup as S
import           Data.String (IsString(..))
import qualified Data.Text as T
import           GHC.Generics (Generic)
import qualified Text.PrettyPrint as PJ

import Prelude ()
import Prelude.Compat

-- Name Displaying -------------------------------------------------------------

{- | How to display names, inspired by the GHC `Outputable` module.
Getting a value of 'Nothing' from the NameDisp function indicates
that the display has no opinion on how this name should be displayed,
and some other display should be tried out. -}
data NameDisp = EmptyNameDisp
              | NameDisp (ModName -> Ident -> Maybe NameFormat)
                deriving ((forall x. NameDisp -> Rep NameDisp x)
-> (forall x. Rep NameDisp x -> NameDisp) -> Generic NameDisp
forall x. Rep NameDisp x -> NameDisp
forall x. NameDisp -> Rep NameDisp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameDisp x -> NameDisp
$cfrom :: forall x. NameDisp -> Rep NameDisp x
Generic, NameDisp -> ()
(NameDisp -> ()) -> NFData NameDisp
forall a. (a -> ()) -> NFData a
rnf :: NameDisp -> ()
$crnf :: NameDisp -> ()
NFData)

instance Show NameDisp where
  show :: NameDisp -> String
show _ = "<NameDisp>"

instance S.Semigroup NameDisp where
  NameDisp f :: ModName -> Ident -> Maybe NameFormat
f    <> :: NameDisp -> NameDisp -> NameDisp
<> NameDisp g :: ModName -> Ident -> Maybe NameFormat
g    = (ModName -> Ident -> Maybe NameFormat) -> NameDisp
NameDisp (\m :: ModName
m n :: Ident
n -> ModName -> Ident -> Maybe NameFormat
f ModName
m Ident
n Maybe NameFormat -> Maybe NameFormat -> Maybe NameFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ModName -> Ident -> Maybe NameFormat
g ModName
m Ident
n)
  EmptyNameDisp <> EmptyNameDisp = NameDisp
EmptyNameDisp
  EmptyNameDisp <> x :: NameDisp
x             = NameDisp
x
  x :: NameDisp
x             <> _             = NameDisp
x

instance Monoid NameDisp where
  mempty :: NameDisp
mempty = NameDisp
EmptyNameDisp
  mappend :: NameDisp -> NameDisp -> NameDisp
mappend = NameDisp -> NameDisp -> NameDisp
forall a. Semigroup a => a -> a -> a
(S.<>)

data NameFormat = UnQualified
                | Qualified !ModName
                | NotInScope
                  deriving (Int -> NameFormat -> ShowS
[NameFormat] -> ShowS
NameFormat -> String
(Int -> NameFormat -> ShowS)
-> (NameFormat -> String)
-> ([NameFormat] -> ShowS)
-> Show NameFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameFormat] -> ShowS
$cshowList :: [NameFormat] -> ShowS
show :: NameFormat -> String
$cshow :: NameFormat -> String
showsPrec :: Int -> NameFormat -> ShowS
$cshowsPrec :: Int -> NameFormat -> ShowS
Show)

-- | Never qualify names from this module.
neverQualifyMod :: ModName -> NameDisp
neverQualifyMod :: ModName -> NameDisp
neverQualifyMod mn :: ModName
mn = (ModName -> Ident -> Maybe NameFormat) -> NameDisp
NameDisp ((ModName -> Ident -> Maybe NameFormat) -> NameDisp)
-> (ModName -> Ident -> Maybe NameFormat) -> NameDisp
forall a b. (a -> b) -> a -> b
$ \ mn' :: ModName
mn' _ ->
  if ModName
mn ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
mn' then NameFormat -> Maybe NameFormat
forall a. a -> Maybe a
Just NameFormat
UnQualified
               else Maybe NameFormat
forall a. Maybe a
Nothing

alwaysQualify :: NameDisp
alwaysQualify :: NameDisp
alwaysQualify  = (ModName -> Ident -> Maybe NameFormat) -> NameDisp
NameDisp ((ModName -> Ident -> Maybe NameFormat) -> NameDisp)
-> (ModName -> Ident -> Maybe NameFormat) -> NameDisp
forall a b. (a -> b) -> a -> b
$ \ mn :: ModName
mn _ -> NameFormat -> Maybe NameFormat
forall a. a -> Maybe a
Just (ModName -> NameFormat
Qualified ModName
mn)

neverQualify :: NameDisp
neverQualify :: NameDisp
neverQualify  = (ModName -> Ident -> Maybe NameFormat) -> NameDisp
NameDisp ((ModName -> Ident -> Maybe NameFormat) -> NameDisp)
-> (ModName -> Ident -> Maybe NameFormat) -> NameDisp
forall a b. (a -> b) -> a -> b
$ \ _ _ -> NameFormat -> Maybe NameFormat
forall a. a -> Maybe a
Just NameFormat
UnQualified

fmtModName :: ModName -> NameFormat -> T.Text
fmtModName :: ModName -> NameFormat -> Text
fmtModName _  UnQualified    = Text
T.empty
fmtModName _  (Qualified mn :: ModName
mn) = ModName -> Text
modNameToText ModName
mn
fmtModName mn :: ModName
mn NotInScope     = ModName -> Text
modNameToText ModName
mn

-- | Compose two naming environments, preferring names from the left
-- environment.
extend :: NameDisp -> NameDisp -> NameDisp
extend :: NameDisp -> NameDisp -> NameDisp
extend  = NameDisp -> NameDisp -> NameDisp
forall a. Monoid a => a -> a -> a
mappend

-- | Get the format for a name. When 'Nothing' is returned, the name is not
-- currently in scope.
getNameFormat :: ModName -> Ident -> NameDisp -> NameFormat
getNameFormat :: ModName -> Ident -> NameDisp -> NameFormat
getNameFormat m :: ModName
m i :: Ident
i (NameDisp f :: ModName -> Ident -> Maybe NameFormat
f)  = NameFormat -> Maybe NameFormat -> NameFormat
forall a. a -> Maybe a -> a
fromMaybe NameFormat
NotInScope (ModName -> Ident -> Maybe NameFormat
f ModName
m Ident
i)
getNameFormat _ _ EmptyNameDisp = NameFormat
NotInScope

-- | Produce a document in the context of the current 'NameDisp'.
withNameDisp :: (NameDisp -> Doc) -> Doc
withNameDisp :: (NameDisp -> Doc) -> Doc
withNameDisp k :: NameDisp -> Doc
k = (NameDisp -> Doc) -> Doc
Doc (\disp :: NameDisp
disp -> NameDisp -> Doc -> Doc
runDoc NameDisp
disp (NameDisp -> Doc
k NameDisp
disp))

-- | Fix the way that names are displayed inside of a doc.
fixNameDisp :: NameDisp -> Doc -> Doc
fixNameDisp :: NameDisp -> Doc -> Doc
fixNameDisp disp :: NameDisp
disp (Doc f :: NameDisp -> Doc
f) = (NameDisp -> Doc) -> Doc
Doc (\ _ -> NameDisp -> Doc
f NameDisp
disp)


-- Documents -------------------------------------------------------------------

newtype Doc = Doc (NameDisp -> PJ.Doc) deriving ((forall x. Doc -> Rep Doc x)
-> (forall x. Rep Doc x -> Doc) -> Generic Doc
forall x. Rep Doc x -> Doc
forall x. Doc -> Rep Doc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Doc x -> Doc
$cfrom :: forall x. Doc -> Rep Doc x
Generic, Doc -> ()
(Doc -> ()) -> NFData Doc
forall a. (a -> ()) -> NFData a
rnf :: Doc -> ()
$crnf :: Doc -> ()
NFData)

instance S.Semigroup Doc where
  <> :: Doc -> Doc -> Doc
(<>) = (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
liftPJ2 Doc -> Doc -> Doc
(PJ.<>)

instance Monoid Doc where
  mempty :: Doc
mempty = Doc -> Doc
liftPJ Doc
PJ.empty
  mappend :: Doc -> Doc -> Doc
mappend = Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(S.<>)

runDoc :: NameDisp -> Doc -> PJ.Doc
runDoc :: NameDisp -> Doc -> Doc
runDoc names :: NameDisp
names (Doc f :: NameDisp -> Doc
f) = NameDisp -> Doc
f NameDisp
names

instance Show Doc where
  show :: Doc -> String
show d :: Doc
d = Doc -> String
forall a. Show a => a -> String
show (NameDisp -> Doc -> Doc
runDoc NameDisp
forall a. Monoid a => a
mempty Doc
d)

instance IsString Doc where
  fromString :: String -> Doc
fromString = String -> Doc
text

render :: Doc -> String
render :: Doc -> String
render d :: Doc
d = Doc -> String
PJ.render (NameDisp -> Doc -> Doc
runDoc NameDisp
forall a. Monoid a => a
mempty Doc
d)

renderOneLine :: Doc -> String
renderOneLine :: Doc -> String
renderOneLine d :: Doc
d = Style -> Doc -> String
PJ.renderStyle (Style
PJ.style { mode :: Mode
PJ.mode = Mode
PJ.OneLineMode }) (NameDisp -> Doc -> Doc
runDoc NameDisp
forall a. Monoid a => a
mempty Doc
d)

class PP a where
  ppPrec :: Int -> a -> Doc

class PP a => PPName a where
  -- | Fixity information for infix operators
  ppNameFixity :: a -> Maybe (Assoc, Int)

  -- | Print a name in prefix: @f a b@ or @(+) a b)@
  ppPrefixName :: a -> Doc

  -- | Print a name as an infix operator: @a + b@
  ppInfixName  :: a -> Doc

pp :: PP a => a -> Doc
pp :: a -> Doc
pp = Int -> a -> Doc
forall a. PP a => Int -> a -> Doc
ppPrec 0

pretty :: PP a => a -> String
pretty :: a -> String
pretty  = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. PP a => a -> Doc
pp

optParens :: Bool -> Doc -> Doc
optParens :: Bool -> Doc -> Doc
optParens b :: Bool
b body :: Doc
body | Bool
b         = Doc -> Doc
parens Doc
body
                 | Bool
otherwise = Doc
body


-- | Information about associativity.
data Assoc = LeftAssoc | RightAssoc | NonAssoc
              deriving (Int -> Assoc -> ShowS
[Assoc] -> ShowS
Assoc -> String
(Int -> Assoc -> ShowS)
-> (Assoc -> String) -> ([Assoc] -> ShowS) -> Show Assoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assoc] -> ShowS
$cshowList :: [Assoc] -> ShowS
show :: Assoc -> String
$cshow :: Assoc -> String
showsPrec :: Int -> Assoc -> ShowS
$cshowsPrec :: Int -> Assoc -> ShowS
Show, Assoc -> Assoc -> Bool
(Assoc -> Assoc -> Bool) -> (Assoc -> Assoc -> Bool) -> Eq Assoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assoc -> Assoc -> Bool
$c/= :: Assoc -> Assoc -> Bool
== :: Assoc -> Assoc -> Bool
$c== :: Assoc -> Assoc -> Bool
Eq, (forall x. Assoc -> Rep Assoc x)
-> (forall x. Rep Assoc x -> Assoc) -> Generic Assoc
forall x. Rep Assoc x -> Assoc
forall x. Assoc -> Rep Assoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Assoc x -> Assoc
$cfrom :: forall x. Assoc -> Rep Assoc x
Generic, Assoc -> ()
(Assoc -> ()) -> NFData Assoc
forall a. (a -> ()) -> NFData a
rnf :: Assoc -> ()
$crnf :: Assoc -> ()
NFData)

-- | Information about an infix expression of some sort.
data Infix op thing = Infix
  { Infix op thing -> op
ieOp    :: op       -- ^ operator
  , Infix op thing -> thing
ieLeft  :: thing    -- ^ left argument
  , Infix op thing -> thing
ieRight :: thing    -- ^ right argument
  , Infix op thing -> Int
iePrec  :: Int      -- ^ operator precedence
  , Infix op thing -> Assoc
ieAssoc :: Assoc    -- ^ operator associativity
  }

commaSep :: [Doc] -> Doc
commaSep :: [Doc] -> Doc
commaSep = [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma


-- | Pretty print an infix expression of some sort.
ppInfix :: (PP thing, PP op)
        => Int            -- ^ Non-infix leaves are printed with this precedence
        -> (thing -> Maybe (Infix op thing))
                          -- ^ pattern to check if sub-thing is also infix
        -> Infix op thing -- ^ Pretty print this infix expression
        -> Doc
ppInfix :: Int -> (thing -> Maybe (Infix op thing)) -> Infix op thing -> Doc
ppInfix lp :: Int
lp isInfix :: thing -> Maybe (Infix op thing)
isInfix expr :: Infix op thing
expr =
  [Doc] -> Doc
sep [ (Int -> Bool) -> thing -> Doc
ppSub (Assoc -> Int -> Bool
wrapSub Assoc
LeftAssoc ) (Infix op thing -> thing
forall op thing. Infix op thing -> thing
ieLeft Infix op thing
expr) Doc -> Doc -> Doc
<+> op -> Doc
forall a. PP a => a -> Doc
pp (Infix op thing -> op
forall op thing. Infix op thing -> op
ieOp Infix op thing
expr)
      , (Int -> Bool) -> thing -> Doc
ppSub (Assoc -> Int -> Bool
wrapSub Assoc
RightAssoc) (Infix op thing -> thing
forall op thing. Infix op thing -> thing
ieRight Infix op thing
expr) ]
  where
  wrapSub :: Assoc -> Int -> Bool
wrapSub dir :: Assoc
dir p :: Int
p = Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Infix op thing -> Int
forall op thing. Infix op thing -> Int
iePrec Infix op thing
expr Bool -> Bool -> Bool
|| Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Infix op thing -> Int
forall op thing. Infix op thing -> Int
iePrec Infix op thing
expr Bool -> Bool -> Bool
&& Infix op thing -> Assoc
forall op thing. Infix op thing -> Assoc
ieAssoc Infix op thing
expr Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
/= Assoc
dir

  ppSub :: (Int -> Bool) -> thing -> Doc
ppSub w :: Int -> Bool
w e :: thing
e
    | Just e1 :: Infix op thing
e1 <- thing -> Maybe (Infix op thing)
isInfix thing
e = Bool -> Doc -> Doc
optParens (Int -> Bool
w (Infix op thing -> Int
forall op thing. Infix op thing -> Int
iePrec Infix op thing
e1)) (Int -> (thing -> Maybe (Infix op thing)) -> Infix op thing -> Doc
forall thing op.
(PP thing, PP op) =>
Int -> (thing -> Maybe (Infix op thing)) -> Infix op thing -> Doc
ppInfix Int
lp thing -> Maybe (Infix op thing)
isInfix Infix op thing
e1)
  ppSub _ e :: thing
e                = Int -> thing -> Doc
forall a. PP a => Int -> a -> Doc
ppPrec Int
lp thing
e



-- | Display a numeric value as an ordinal (e.g., 2nd)
ordinal :: (Integral a, Show a, Eq a) => a -> Doc
ordinal :: a -> Doc
ordinal x :: a
x = String -> Doc
text (a -> String
forall a. Show a => a -> String
show a
x) Doc -> Doc -> Doc
<.> String -> Doc
text (a -> String
forall a. (Integral a, Eq a) => a -> String
ordSuffix a
x)

-- | The suffix to use when displaying a number as an oridinal
ordSuffix :: (Integral a, Eq a) => a -> String
ordSuffix :: a -> String
ordSuffix n0 :: a
n0 =
  case a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` 10 of
    1 | Bool
notTeen -> "st"
    2 | Bool
notTeen -> "nd"
    3 | Bool
notTeen -> "rd"
    _ -> "th"

  where
  n :: a
n       = a -> a
forall a. Num a => a -> a
abs a
n0
  m :: a
m       = a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` 100
  notTeen :: Bool
notTeen = a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 11 Bool -> Bool -> Bool
|| a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 19


-- Wrapped Combinators ---------------------------------------------------------

liftPJ :: PJ.Doc -> Doc
liftPJ :: Doc -> Doc
liftPJ d :: Doc
d = (NameDisp -> Doc) -> Doc
Doc (Doc -> NameDisp -> Doc
forall a b. a -> b -> a
const Doc
d)

liftPJ1 :: (PJ.Doc -> PJ.Doc) -> Doc -> Doc
liftPJ1 :: (Doc -> Doc) -> Doc -> Doc
liftPJ1 f :: Doc -> Doc
f (Doc d :: NameDisp -> Doc
d) = (NameDisp -> Doc) -> Doc
Doc (\env :: NameDisp
env -> Doc -> Doc
f (NameDisp -> Doc
d NameDisp
env))

liftPJ2 :: (PJ.Doc -> PJ.Doc -> PJ.Doc) -> (Doc -> Doc -> Doc)
liftPJ2 :: (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
liftPJ2 f :: Doc -> Doc -> Doc
f (Doc a :: NameDisp -> Doc
a) (Doc b :: NameDisp -> Doc
b) = (NameDisp -> Doc) -> Doc
Doc (\e :: NameDisp
e -> Doc -> Doc -> Doc
f (NameDisp -> Doc
a NameDisp
e) (NameDisp -> Doc
b NameDisp
e))

liftSep :: ([PJ.Doc] -> PJ.Doc) -> ([Doc] -> Doc)
liftSep :: ([Doc] -> Doc) -> [Doc] -> Doc
liftSep f :: [Doc] -> Doc
f ds :: [Doc]
ds = (NameDisp -> Doc) -> Doc
Doc (\e :: NameDisp
e -> [Doc] -> Doc
f [ NameDisp -> Doc
d NameDisp
e | Doc d :: NameDisp -> Doc
d <- [Doc]
ds ])

infixl 6 <.>, <+>

(<.>) :: Doc -> Doc -> Doc
<.> :: Doc -> Doc -> Doc
(<.>)  = (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
liftPJ2 Doc -> Doc -> Doc
(PJ.<>)

(<+>) :: Doc -> Doc -> Doc
<+> :: Doc -> Doc -> Doc
(<+>)  = (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
liftPJ2 Doc -> Doc -> Doc
(PJ.<+>)

infixl 5 $$

($$) :: Doc -> Doc -> Doc
$$ :: Doc -> Doc -> Doc
($$)  = (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
liftPJ2 Doc -> Doc -> Doc
(PJ.$$)

sep :: [Doc] -> Doc
sep :: [Doc] -> Doc
sep  = ([Doc] -> Doc) -> [Doc] -> Doc
liftSep [Doc] -> Doc
PJ.sep

fsep :: [Doc] -> Doc
fsep :: [Doc] -> Doc
fsep  = ([Doc] -> Doc) -> [Doc] -> Doc
liftSep [Doc] -> Doc
PJ.fsep

hsep :: [Doc] -> Doc
hsep :: [Doc] -> Doc
hsep  = ([Doc] -> Doc) -> [Doc] -> Doc
liftSep [Doc] -> Doc
PJ.hsep

hcat :: [Doc] -> Doc
hcat :: [Doc] -> Doc
hcat  = ([Doc] -> Doc) -> [Doc] -> Doc
liftSep [Doc] -> Doc
PJ.hcat

vcat :: [Doc] -> Doc
vcat :: [Doc] -> Doc
vcat  = ([Doc] -> Doc) -> [Doc] -> Doc
liftSep [Doc] -> Doc
PJ.vcat

hang :: Doc -> Int -> Doc -> Doc
hang :: Doc -> Int -> Doc -> Doc
hang (Doc p :: NameDisp -> Doc
p) i :: Int
i (Doc q :: NameDisp -> Doc
q) = (NameDisp -> Doc) -> Doc
Doc (\e :: NameDisp
e -> Doc -> Int -> Doc -> Doc
PJ.hang (NameDisp -> Doc
p NameDisp
e) Int
i (NameDisp -> Doc
q NameDisp
e))

nest :: Int -> Doc -> Doc
nest :: Int -> Doc -> Doc
nest n :: Int
n = (Doc -> Doc) -> Doc -> Doc
liftPJ1 (Int -> Doc -> Doc
PJ.nest Int
n)

parens :: Doc -> Doc
parens :: Doc -> Doc
parens  = (Doc -> Doc) -> Doc -> Doc
liftPJ1 Doc -> Doc
PJ.parens

braces :: Doc -> Doc
braces :: Doc -> Doc
braces  = (Doc -> Doc) -> Doc -> Doc
liftPJ1 Doc -> Doc
PJ.braces

brackets :: Doc -> Doc
brackets :: Doc -> Doc
brackets  = (Doc -> Doc) -> Doc -> Doc
liftPJ1 Doc -> Doc
PJ.brackets

quotes :: Doc -> Doc
quotes :: Doc -> Doc
quotes  = (Doc -> Doc) -> Doc -> Doc
liftPJ1 Doc -> Doc
PJ.quotes

backticks :: Doc -> Doc
backticks :: Doc -> Doc
backticks d :: Doc
d = [Doc] -> Doc
hcat [ "`", Doc
d, "`" ]

punctuate :: Doc -> [Doc] -> [Doc]
punctuate :: Doc -> [Doc] -> [Doc]
punctuate p :: Doc
p = [Doc] -> [Doc]
go
  where
  go :: [Doc] -> [Doc]
go (d :: Doc
d:ds :: [Doc]
ds) | [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
ds   = [Doc
d]
            | Bool
otherwise = Doc
d Doc -> Doc -> Doc
<.> Doc
p Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
go [Doc]
ds
  go []                 = []

text :: String -> Doc
text :: String -> Doc
text s :: String
s = Doc -> Doc
liftPJ (String -> Doc
PJ.text String
s)

char :: Char -> Doc
char :: Char -> Doc
char c :: Char
c = Doc -> Doc
liftPJ (Char -> Doc
PJ.char Char
c)

integer :: Integer -> Doc
integer :: Integer -> Doc
integer i :: Integer
i = Doc -> Doc
liftPJ (Integer -> Doc
PJ.integer Integer
i)

int :: Int -> Doc
int :: Int -> Doc
int i :: Int
i = Doc -> Doc
liftPJ (Int -> Doc
PJ.int Int
i)

comma :: Doc
comma :: Doc
comma  = Doc -> Doc
liftPJ Doc
PJ.comma

empty :: Doc
empty :: Doc
empty  = Doc -> Doc
liftPJ Doc
PJ.empty

colon :: Doc
colon :: Doc
colon  = Doc -> Doc
liftPJ Doc
PJ.colon

instance PP T.Text where
  ppPrec :: Int -> Text -> Doc
ppPrec _ str :: Text
str = String -> Doc
text (Text -> String
T.unpack Text
str)

instance PP Ident where
  ppPrec :: Int -> Ident -> Doc
ppPrec _ i :: Ident
i = String -> Doc
text (Text -> String
T.unpack (Ident -> Text
identText Ident
i))

instance PP ModName where
  ppPrec :: Int -> ModName -> Doc
ppPrec _   = String -> Doc
text (String -> Doc) -> (ModName -> String) -> ModName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ModName -> Text) -> ModName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModName -> Text
modNameToText

instance PP Assoc where
  ppPrec :: Int -> Assoc -> Doc
ppPrec _ LeftAssoc  = String -> Doc
text "left-associative"
  ppPrec _ RightAssoc = String -> Doc
text "right-associative"
  ppPrec _ NonAssoc   = String -> Doc
text "non-associative"