-- | Pretty-printing of terms and assorted other values.

{-# LANGUAGE Rank2Types #-}
module Twee.Pretty(module Twee.Pretty, module Text.PrettyPrint.HughesPJClass, Pretty(..)) where

import Text.PrettyPrint.HughesPJClass hiding (empty, (<>))
import qualified Text.PrettyPrint.HughesPJClass as PP
import qualified Data.Map as Map
import Data.Map(Map)
import qualified Data.Set as Set
import Data.Set(Set)
import Data.Ratio
import Twee.Term

-- * Miscellaneous 'Pretty' instances and utilities.

-- | Print a value to the console.
prettyPrint :: Pretty a => a -> IO ()
prettyPrint :: a -> IO ()
prettyPrint a
x = String -> IO ()
putStrLn (a -> String
forall a. Pretty a => a -> String
prettyShow a
x)

-- | Put one document beside another, i.e., 'PP.<>'.
-- Renamed here because (a different) '<>' is exported by "Prelude".
infixl 6 <#>
(<#>) :: Doc -> Doc -> Doc
<#> :: Doc -> Doc -> Doc
(<#>) = Doc -> Doc -> Doc
(PP.<>)

-- | The empty document. Used to avoid name clashes with 'Twee.Term.empty'.
pPrintEmpty :: Doc
pPrintEmpty :: Doc
pPrintEmpty = Doc
PP.empty

instance Pretty Doc where pPrint :: Doc -> Doc
pPrint = Doc -> Doc
forall a. a -> a
id

-- | Print a tuple of values.
pPrintTuple :: [Doc] -> Doc
pPrintTuple :: [Doc] -> Doc
pPrintTuple = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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

instance Pretty a => Pretty (Set a) where
  pPrint :: Set a -> Doc
pPrint = [Doc] -> Doc
pPrintSet ([Doc] -> Doc) -> (Set a -> [Doc]) -> Set a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pPrint ([a] -> [Doc]) -> (Set a -> [a]) -> Set a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList

-- | Print a set of vlaues.
pPrintSet :: [Doc] -> Doc
pPrintSet :: [Doc] -> Doc
pPrintSet = Doc -> Doc
braces (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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

instance Pretty Var where
  pPrint :: Var -> Doc
pPrint (V Int
n) =
    String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
      String
vars String -> Int -> Char
forall a. [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
vars)Char -> String -> String
forall a. a -> [a] -> [a]
:
      case Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
vars of
        Int
0 -> String
""
        Int
m -> Int -> String
forall a. Show a => a -> String
show (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    where
      vars :: String
vars = String
"XYZWVUTS"

instance (Pretty k, Pretty v) => Pretty (Map k v) where
  pPrint :: Map k v -> Doc
pPrint = [Doc] -> Doc
pPrintSet ([Doc] -> Doc) -> (Map k v -> [Doc]) -> Map k v -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> Doc) -> [(k, v)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> Doc
forall a a. (Pretty a, Pretty a) => (a, a) -> Doc
binding ([(k, v)] -> [Doc]) -> (Map k v -> [(k, v)]) -> Map k v -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList
    where
      binding :: (a, a) -> Doc
binding (a
x, a
v) = Doc -> Int -> Doc -> Doc
hang (a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
x Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>") Int
2 (a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
v)

instance (Eq a, Integral a, Pretty a) => Pretty (Ratio a) where
  pPrint :: Ratio a -> Doc
pPrint Ratio a
a
    | Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = a -> Doc
forall a. Pretty a => a -> Doc
pPrint (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
a)
    | Bool
otherwise = String -> Doc
text String
"(" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pPrint (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
a) Doc -> Doc -> Doc
<#> String -> Doc
text String
"/" Doc -> Doc -> Doc
<#> a -> Doc
forall a. Pretty a => a -> Doc
pPrint (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
a) Doc -> Doc -> Doc
<+> String -> Doc
text String
")"

-- | Generate a list of candidate names for pretty-printing.
supply :: [String] -> [String]
supply :: [String] -> [String]
supply [String]
names =
  [String]
names [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  [ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i | Integer
i <- [Integer
2..], String
name <- [String]
names ]

-- * Pretty-printing of terms.

instance (Pretty f, Labelled f) => Pretty (Fun f) where
  pPrintPrec :: PrettyLevel -> Rational -> Fun f -> Doc
pPrintPrec PrettyLevel
l Rational
p = PrettyLevel -> Rational -> f -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
p (f -> Doc) -> (Fun f -> f) -> Fun f -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fun f -> f
forall f. Labelled f => Fun f -> f
fun_value

instance (Labelled f, PrettyTerm f) => Pretty (Term f) where
  pPrintPrec :: PrettyLevel -> Rational -> Term f -> Doc
pPrintPrec PrettyLevel
l Rational
p (Var Var
x) = PrettyLevel -> Rational -> Var -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
p Var
x
  pPrintPrec PrettyLevel
l Rational
p (App Fun f
f TermList f
xs) =
    TermStyle -> PrettyLevel -> Rational -> Doc -> [Term f] -> Doc
TermStyle
-> forall a.
   Pretty a =>
   PrettyLevel -> Rational -> Doc -> [a] -> Doc
pPrintTerm (f -> TermStyle
forall f. PrettyTerm f => f -> TermStyle
termStyle (Fun f -> f
forall f. Labelled f => Fun f -> f
fun_value Fun f
f)) PrettyLevel
l Rational
p (Fun f -> Doc
forall a. Pretty a => a -> Doc
pPrint Fun f
f) (TermList f -> [Term f]
forall f. TermList f -> [Term f]
unpack TermList f
xs)

data HighlightedTerm f = HighlightedTerm [ANSICode] (Maybe [Int]) (Term f)

type ANSICode = String
green, bold :: ANSICode
green :: String
green = String
"32"
bold :: String
bold = String
"1"

highlight :: [ANSICode] -> Doc -> Doc
highlight :: [String] -> Doc -> Doc
highlight [String]
cs Doc
d =
  [Doc] -> Doc
hsep ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
escape [String]
cs) Doc -> Doc -> Doc
<#> Doc
d Doc -> Doc -> Doc
<#> [Doc] -> Doc
hsep [String -> Doc
escape String
"" | Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cs)]
  where
    escape :: String -> Doc
escape String
s = String -> Doc
zeroWidthText (String
"\027[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"m")

maybeHighlight :: [ANSICode] -> Maybe [Int] -> Doc -> Doc
maybeHighlight :: [String] -> Maybe [Int] -> Doc -> Doc
maybeHighlight [String]
cs (Just []) Doc
d = [String] -> Doc -> Doc
highlight [String]
cs Doc
d
maybeHighlight [String]
_ Maybe [Int]
_ Doc
d = Doc
d

instance (Labelled f, PrettyTerm f) => Pretty (HighlightedTerm f) where
  pPrintPrec :: PrettyLevel -> Rational -> HighlightedTerm f -> Doc
pPrintPrec PrettyLevel
l Rational
p (HighlightedTerm [String]
cs Maybe [Int]
h (Var Var
x)) =
    [String] -> Maybe [Int] -> Doc -> Doc
maybeHighlight [String]
cs Maybe [Int]
h (PrettyLevel -> Rational -> Var -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
p Var
x)
  pPrintPrec PrettyLevel
l Rational
p (HighlightedTerm [String]
cs Maybe [Int]
h (App Fun f
f TermList f
xs)) =
    [String] -> Maybe [Int] -> Doc -> Doc
maybeHighlight [String]
cs Maybe [Int]
h (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    TermStyle
-> PrettyLevel -> Rational -> Doc -> [HighlightedTerm f] -> Doc
TermStyle
-> forall a.
   Pretty a =>
   PrettyLevel -> Rational -> Doc -> [a] -> Doc
pPrintTerm (f -> TermStyle
forall f. PrettyTerm f => f -> TermStyle
termStyle (Fun f -> f
forall f. Labelled f => Fun f -> f
fun_value Fun f
f)) PrettyLevel
l Rational
p (Fun f -> Doc
forall a. Pretty a => a -> Doc
pPrint Fun f
f)
      ((Int -> Term f -> HighlightedTerm f)
-> [Int] -> [Term f] -> [HighlightedTerm f]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Term f -> HighlightedTerm f
forall f. Int -> Term f -> HighlightedTerm f
annotate [Int
0..] (TermList f -> [Term f]
forall f. TermList f -> [Term f]
unpack TermList f
xs))
    where
      annotate :: Int -> Term f -> HighlightedTerm f
annotate Int
i Term f
t =
        case Maybe [Int]
h of
          Just (Int
n:[Int]
ns) | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n -> [String] -> Maybe [Int] -> Term f -> HighlightedTerm f
forall f. [String] -> Maybe [Int] -> Term f -> HighlightedTerm f
HighlightedTerm [String]
cs ([Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int]
ns) Term f
t
          Maybe [Int]
_ -> [String] -> Maybe [Int] -> Term f -> HighlightedTerm f
forall f. [String] -> Maybe [Int] -> Term f -> HighlightedTerm f
HighlightedTerm [String]
cs Maybe [Int]
forall a. Maybe a
Nothing Term f
t

instance (Labelled f, PrettyTerm f) => Pretty (TermList f) where
  pPrintPrec :: PrettyLevel -> Rational -> TermList f -> Doc
pPrintPrec PrettyLevel
_ Rational
_ = [Term f] -> Doc
forall a. Pretty a => a -> Doc
pPrint ([Term f] -> Doc) -> (TermList f -> [Term f]) -> TermList f -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermList f -> [Term f]
forall f. TermList f -> [Term f]
unpack

instance (Labelled f, PrettyTerm f) => Pretty (Subst f) where
  pPrint :: Subst f -> Doc
pPrint Subst f
sub = String -> Doc
text String
"{" Doc -> Doc -> Doc
<#> [Doc] -> Doc
fsep (Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
",") [Doc]
docs) Doc -> Doc -> Doc
<#> String -> Doc
text String
"}"
    where
      docs :: [Doc]
docs =
        [ Doc -> Int -> Doc -> Doc
hang (Var -> Doc
forall a. Pretty a => a -> Doc
pPrint Var
x Doc -> Doc -> Doc
<+> String -> Doc
text String
"->") Int
2 (Term f -> Doc
forall a. Pretty a => a -> Doc
pPrint Term f
t)
        | (Var
x, Term f
t) <- Subst f -> [(Var, Term f)]
forall f. Subst f -> [(Var, Term f)]
substToList Subst f
sub ]

-- | A class for customising the printing of function symbols.
class Pretty f => PrettyTerm f where
  -- | The style of the function symbol. Defaults to 'curried'.
  termStyle :: f -> TermStyle
  termStyle f
_ = TermStyle
curried

-- | Defines how to print out a function symbol.
newtype TermStyle =
  TermStyle {
    -- | Renders a function application.
    -- Takes the following arguments in this order:
    -- Pretty-printing level, current precedence,
    -- pretty-printed function symbol and list of arguments to the function.
    TermStyle
-> forall a.
   Pretty a =>
   PrettyLevel -> Rational -> Doc -> [a] -> Doc
pPrintTerm :: forall a. Pretty a => PrettyLevel -> Rational -> Doc -> [a] -> Doc }

invisible, curried, uncurried, prefix, postfix :: TermStyle

-- | For operators like @$@ that should be printed as a blank space.
invisible :: TermStyle
invisible =
  (forall a.
 Pretty a =>
 PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
TermStyle ((forall a.
  Pretty a =>
  PrettyLevel -> Rational -> Doc -> [a] -> Doc)
 -> TermStyle)
-> (forall a.
    Pretty a =>
    PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
forall a b. (a -> b) -> a -> b
$ \PrettyLevel
l Rational
p Doc
d ->
    let
      f :: [a] -> Doc
f [] = Doc
d
      f [a
t] = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
p a
t
      f (a
t:[a]
ts) =
        Bool -> Doc -> Doc
maybeParens (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
10) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
          a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
t Doc -> Doc -> Doc
<+>
            ([Doc] -> Doc
hsep ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
11) [a]
ts))
    in [a] -> Doc
forall a. Pretty a => [a] -> Doc
f

-- | For functions that should be printed curried.
curried :: TermStyle
curried =
  (forall a.
 Pretty a =>
 PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
TermStyle ((forall a.
  Pretty a =>
  PrettyLevel -> Rational -> Doc -> [a] -> Doc)
 -> TermStyle)
-> (forall a.
    Pretty a =>
    PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
forall a b. (a -> b) -> a -> b
$ \PrettyLevel
l Rational
p Doc
d ->
    let
      f :: [a] -> Doc
f [] = Doc
d
      f [a]
xs =
        Bool -> Doc -> Doc
maybeParens (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
10) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
          Doc
d Doc -> Doc -> Doc
<+>
            ([Doc] -> Doc
hsep ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
11) [a]
xs))
    in [a] -> Doc
forall a. Pretty a => [a] -> Doc
f

-- | For functions that should be printed uncurried.
uncurried :: TermStyle
uncurried =
  (forall a.
 Pretty a =>
 PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
TermStyle ((forall a.
  Pretty a =>
  PrettyLevel -> Rational -> Doc -> [a] -> Doc)
 -> TermStyle)
-> (forall a.
    Pretty a =>
    PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
forall a b. (a -> b) -> a -> b
$ \PrettyLevel
l Rational
_ Doc
d ->
    let
      f :: [a] -> Doc
f [] = Doc
d
      f [a]
xs =
        Doc
d Doc -> Doc -> Doc
<#> Doc -> Doc
parens ([Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
0) [a]
xs)))
    in [a] -> Doc
forall a. Pretty a => [a] -> Doc
f

-- | A helper function that deals with under- and oversaturated applications.
fixedArity :: Int -> TermStyle -> TermStyle
fixedArity :: Int -> TermStyle -> TermStyle
fixedArity Int
arity TermStyle
style =
  (forall a.
 Pretty a =>
 PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
TermStyle ((forall a.
  Pretty a =>
  PrettyLevel -> Rational -> Doc -> [a] -> Doc)
 -> TermStyle)
-> (forall a.
    Pretty a =>
    PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
forall a b. (a -> b) -> a -> b
$ \PrettyLevel
l Rational
p Doc
d ->
    let
      f :: [a] -> Doc
f [a]
xs
        | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arity = TermStyle -> PrettyLevel -> Rational -> Doc -> [a] -> Doc
TermStyle
-> forall a.
   Pretty a =>
   PrettyLevel -> Rational -> Doc -> [a] -> Doc
pPrintTerm TermStyle
curried PrettyLevel
l Rational
p (Doc -> Doc
parens Doc
d) [a]
xs
        | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
arity =
            Bool -> Doc -> Doc
maybeParens (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
10) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
              [Doc] -> Doc
hsep (TermStyle -> PrettyLevel -> Rational -> Doc -> [a] -> Doc
TermStyle
-> forall a.
   Pretty a =>
   PrettyLevel -> Rational -> Doc -> [a] -> Doc
pPrintTerm TermStyle
style PrettyLevel
l Rational
11 Doc
d [a]
ysDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                    (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
11) [a]
zs)
        | Bool
otherwise = TermStyle -> PrettyLevel -> Rational -> Doc -> [a] -> Doc
TermStyle
-> forall a.
   Pretty a =>
   PrettyLevel -> Rational -> Doc -> [a] -> Doc
pPrintTerm TermStyle
style PrettyLevel
l Rational
p Doc
d [a]
xs
        where
          ([a]
ys, [a]
zs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
arity [a]
xs
    in [a] -> Doc
forall a. Pretty a => [a] -> Doc
f

-- | A helper function that drops a certain number of arguments.
implicitArguments :: Int -> TermStyle -> TermStyle
implicitArguments :: Int -> TermStyle -> TermStyle
implicitArguments Int
n (TermStyle forall a. Pretty a => PrettyLevel -> Rational -> Doc -> [a] -> Doc
pp) =
  (forall a.
 Pretty a =>
 PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
TermStyle ((forall a.
  Pretty a =>
  PrettyLevel -> Rational -> Doc -> [a] -> Doc)
 -> TermStyle)
-> (forall a.
    Pretty a =>
    PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
forall a b. (a -> b) -> a -> b
$ \PrettyLevel
l Rational
p Doc
d [a]
xs -> PrettyLevel -> Rational -> Doc -> [a] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> Doc -> [a] -> Doc
pp PrettyLevel
l Rational
p Doc
d (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs)

-- | For prefix operators.
prefix :: TermStyle
prefix =
  Int -> TermStyle -> TermStyle
fixedArity Int
1 (TermStyle -> TermStyle) -> TermStyle -> TermStyle
forall a b. (a -> b) -> a -> b
$
  (forall a.
 Pretty a =>
 PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
TermStyle ((forall a.
  Pretty a =>
  PrettyLevel -> Rational -> Doc -> [a] -> Doc)
 -> TermStyle)
-> (forall a.
    Pretty a =>
    PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
forall a b. (a -> b) -> a -> b
$ \PrettyLevel
l Rational
_ Doc
d [a
x] ->
    Doc
d Doc -> Doc -> Doc
<#> PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
11 a
x

-- | For postfix operators.
postfix :: TermStyle
postfix =
  Int -> TermStyle -> TermStyle
fixedArity Int
1 (TermStyle -> TermStyle) -> TermStyle -> TermStyle
forall a b. (a -> b) -> a -> b
$
  (forall a.
 Pretty a =>
 PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
TermStyle ((forall a.
  Pretty a =>
  PrettyLevel -> Rational -> Doc -> [a] -> Doc)
 -> TermStyle)
-> (forall a.
    Pretty a =>
    PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
forall a b. (a -> b) -> a -> b
$ \PrettyLevel
l Rational
_ Doc
d [a
x] ->
    PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
11 a
x Doc -> Doc -> Doc
<#> Doc
d

-- | For infix operators.
infixStyle :: Int -> TermStyle
infixStyle :: Int -> TermStyle
infixStyle Int
pOp =
  Int -> TermStyle -> TermStyle
fixedArity Int
2 (TermStyle -> TermStyle) -> TermStyle -> TermStyle
forall a b. (a -> b) -> a -> b
$
  (forall a.
 Pretty a =>
 PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
TermStyle ((forall a.
  Pretty a =>
  PrettyLevel -> Rational -> Doc -> [a] -> Doc)
 -> TermStyle)
-> (forall a.
    Pretty a =>
    PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
forall a b. (a -> b) -> a -> b
$ \PrettyLevel
l Rational
p Doc
d [a
x, a
y] ->
    Bool -> Doc -> Doc
maybeParens (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pOp) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pOpRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1) a
x Doc -> Doc -> Doc
<+> Doc
d Doc -> Doc -> Doc
<+>
      PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pOpRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1) a
y

-- | For tuples.
tupleStyle :: TermStyle
tupleStyle :: TermStyle
tupleStyle =
  (forall a.
 Pretty a =>
 PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
TermStyle ((forall a.
  Pretty a =>
  PrettyLevel -> Rational -> Doc -> [a] -> Doc)
 -> TermStyle)
-> (forall a.
    Pretty a =>
    PrettyLevel -> Rational -> Doc -> [a] -> Doc)
-> TermStyle
forall a b. (a -> b) -> a -> b
$ \PrettyLevel
l Rational
_ Doc
_ [a]
xs ->
    Doc -> Doc
parens ([Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
0) [a]
xs)))