{- CAO Compiler
Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see . -}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-
Module : $Header$
Description : Typeclass for pretty printing
Copyright : (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
License : GPL
Maintainer : Paulo Silva
Stability : experimental
Portability : non-portable
CAO 'PP' class based on the GHC Outputable typeclass
-}
module Language.CAO.Common.Outputable
(
-- * PP Class
PP(..)
, mppr
, pprElems
-- * Configurable Doc Type
, CDoc
, docToCDoc
-- * Show CDoc
, showCDoc, showCDocDebug, showCDocIds
, showPpr, showPprDebug, showPprIds
-- * Conditional pretty printing
, ifPprDebug, ifPprIds
, noPprDebug
-- * Values to CDoc
, char, text, int, integer, float, double, rational
-- * Simple derived CDocs
, semi, comma, colon, space, equals
, lparen, rparen, lbrack, rbrack, lbrace, rbrace
-- * Wrapping CDocs in delimiters
, parens, brackets, braces, quotes, doubleQuotes
-- * Combining CDocs
, empty, (<>), (<+>), ($$), ($+$)
, sep, cat, hsep, hcat, vsep, vcat, fsep, fcat
, nest, hang, punctuate
-- * Predicates on CDocs
, isEmpty
) where
import Text.PrettyPrint ( Doc )
import qualified Text.PrettyPrint as Pretty
type CDoc = PprCfg -> Doc
showCDoc :: CDoc -> String
showCDoc d = show (d PprCode)
showCDocDebug :: CDoc -> String
showCDocDebug d = show (d PprDebug)
showCDocIds :: CDoc -> String
showCDocIds d = show (d PprIds)
data PprCfg
= PprCode -- Pretty printing code
| PprIds -- Pretty print variable ids
| PprDebug -- Full verbose pretty printing
ifPprDebug :: CDoc -> CDoc
ifPprDebug d sty@PprDebug = d sty
ifPprDebug _ _ = Pretty.empty
ifPprIds :: CDoc -> CDoc
ifPprIds d sty@PprIds = d sty
ifPprIds _ _ = Pretty.empty
noPprDebug :: CDoc -> CDoc
noPprDebug d0 PprDebug = d0 PprCode
noPprDebug d0 sty = d0 sty
class PP a where
ppr :: a -> CDoc
showPpr :: PP a => a -> String
showPpr = showCDoc . ppr
showPprDebug :: PP a => a -> String
showPprDebug = showCDocDebug . ppr
showPprIds :: PP a => a -> String
showPprIds = showCDocIds . ppr
instance PP Doc where
ppr a _sty = a
instance PP Integer where
ppr i = integer i
instance PP Int where
ppr i = int i
instance PP Char where
ppr i = char i
instance PP a => PP (Maybe a) where
ppr Nothing = text "Nothing"
ppr (Just a) = text "Just" <+> ppr a
mppr :: PP a => Maybe a -> CDoc
mppr Nothing = empty
mppr (Just a) = ppr a
instance PP String where
ppr xs = text xs
instance PP a => PP [a] where
ppr xs = brackets (pprElems xs)
pprElems :: PP a => [a] -> CDoc
pprElems xs = fsep (punctuate comma (map ppr xs))
instance (PP a, PP b) => PP (a, b) where
ppr (a, b) = parens (ppr a <> comma <+> ppr b)
instance (PP a, PP b, PP c) => PP (a, b, c) where
ppr (a, b, c) = parens $ ppr a <> comma <+> ppr b <> comma <+> ppr c
docToCDoc :: Doc -> CDoc
docToCDoc d = \_ -> d
char :: Char -> CDoc
char c _sty = Pretty.char c
text :: String -> CDoc
text s _sty = Pretty.text s
int :: Int -> CDoc
int n _sty = Pretty.int n
integer :: Integer -> CDoc
integer n _sty = Pretty.integer n
float :: Float -> CDoc
float n _sty = Pretty.float n
double :: Double -> CDoc
double n _sty = Pretty.double n
rational :: Rational -> CDoc
rational n _sty = Pretty.rational n
semi :: CDoc
semi _sty = Pretty.semi
comma :: CDoc
comma _sty = Pretty.comma
colon :: CDoc
colon _sty = Pretty.colon
space :: CDoc
space _sty = Pretty.space
equals :: CDoc
equals _sty = Pretty.equals
lparen :: CDoc
lparen _sty = Pretty.lparen
rparen :: CDoc
rparen _sty = Pretty.rparen
lbrack :: CDoc
lbrack _sty = Pretty.lbrack
rbrack :: CDoc
rbrack _sty = Pretty.rbrack
lbrace :: CDoc
lbrace _sty = Pretty.lbrace
rbrace :: CDoc
rbrace _sty = Pretty.rbrace
parens :: CDoc -> CDoc
parens p sty = Pretty.parens (p sty)
brackets :: CDoc -> CDoc
brackets p sty = Pretty.brackets (p sty)
braces :: CDoc -> CDoc
braces p sty = Pretty.braces (p sty)
quotes :: CDoc -> CDoc
quotes p sty = Pretty.quotes (p sty)
doubleQuotes :: CDoc -> CDoc
doubleQuotes p sty = Pretty.doubleQuotes (p sty)
empty :: CDoc
empty _sty = Pretty.empty
(<>) :: CDoc -> CDoc -> CDoc
d1 <> d2 = \sty -> d1 sty Pretty.<> d2 sty
(<+>) :: CDoc -> CDoc -> CDoc
d1 <+> d2 = \sty -> d1 sty Pretty.<+> d2 sty
hcat :: [CDoc] -> CDoc
hcat ds sty = Pretty.hcat [d sty | d <- ds]
hsep :: [CDoc] -> CDoc
hsep ds sty = Pretty.hsep [d sty | d <- ds]
($$) :: CDoc -> CDoc -> CDoc
d1 $$ d2 = \sty -> d1 sty Pretty.$$ d2 sty
($+$) :: CDoc -> CDoc -> CDoc
d1 $+$ d2 = \sty -> d1 sty Pretty.$+$ d2 sty
vcat :: [CDoc] -> CDoc
vcat ds sty = Pretty.vcat [d sty | d <- ds]
vsep :: [CDoc] -> CDoc
vsep ds = foldr ($+$) empty ds
sep :: [CDoc] -> CDoc
sep ds sty = Pretty.sep [d sty | d <- ds]
cat :: [CDoc] -> CDoc
cat ds sty = Pretty.cat [d sty | d <- ds]
fsep :: [CDoc] -> CDoc
fsep ds sty = Pretty.fsep [d sty | d <- ds]
fcat :: [CDoc] -> CDoc
fcat ds sty = Pretty.fcat [d sty | d <- ds]
nest :: Int -> CDoc -> CDoc
nest n d sty = Pretty.nest n (d sty)
hang :: CDoc -> Int -> CDoc -> CDoc
hang d1 n d2 sty = Pretty.hang (d1 sty) n (d2 sty)
punctuate :: CDoc -> [CDoc] -> [CDoc]
punctuate _ [] = []
punctuate p (doc:docs) = go doc docs
where
go d [] = [d]
go d (e:es) = (d <> p) : go e es
isEmpty :: CDoc -> Bool
isEmpty d = Pretty.isEmpty (d PprCode)