module Cryptol.Utils.PP
( PP(..)
, pp
, pretty
, optParens
, ppInfix
, Assoc(..)
, Infix(..)
, module Text.PrettyPrint
, ordinal
, ordSuffix
, commaSep
) where
import Text.PrettyPrint
class PP a where
ppPrec :: Int -> a -> Doc
pp :: PP a => a -> Doc
pp = ppPrec 0
pretty :: PP a => a -> String
pretty = show . pp
optParens :: Bool -> Doc -> Doc
optParens b body | b = parens body
| otherwise = body
data Assoc = LeftAssoc | RightAssoc | NonAssoc
deriving (Show,Eq)
data Infix op thing = Infix
{ ieOp :: op
, ieLeft :: thing
, ieRight :: thing
, iePrec :: Int
, ieAssoc :: Assoc
}
commaSep :: [Doc] -> Doc
commaSep = fsep . punctuate comma
ppInfix :: (PP thing, PP op)
=> Int
-> (thing -> Maybe (Infix op thing))
-> Infix op thing
-> Doc
ppInfix lp isInfix expr =
sep [ ppSub (wrapSub LeftAssoc ) (ieLeft expr) <+> pp (ieOp expr)
, ppSub (wrapSub RightAssoc) (ieRight expr) ]
where
wrapSub dir p = p < iePrec expr || p == iePrec expr && ieAssoc expr /= dir
ppSub w e
| Just e1 <- isInfix e = optParens (w (iePrec e1)) (ppInfix lp isInfix e1)
ppSub _ e = ppPrec lp e
ordinal :: (Integral a, Show a, Eq a) => a -> Doc
ordinal x = text (show x) <> text (ordSuffix x)
ordSuffix :: (Integral a, Eq a) => a -> String
ordSuffix n0 =
case n `mod` 10 of
1 | notTeen -> "st"
2 | notTeen -> "nd"
3 | notTeen -> "rd"
_ -> "th"
where
n = abs n0
m = n `mod` 100
notTeen = m < 11 || m > 19