PP.hs

-- |
-- Module      :  $Header$
-- Copyright   :  (c) 2013-2015 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE Safe #-}
{-# LANGUAGE PatternGuards #-}
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


-- | Information about associativity.
data Assoc = LeftAssoc | RightAssoc | NonAssoc
              deriving (Show,Eq)

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

commaSep :: [Doc] -> Doc
commaSep = fsep . punctuate 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 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



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

-- | The suffix to use when displaying a number as an oridinal
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