module BuildBox.Pretty
( module Text.PrettyPrint
, Pretty(..)
, pprPSecTime
, pprFloatTime
, pprFloatSR
, pprFloatRef
, padRc, padR
, padLc, padL
, blank)
where
import Text.PrettyPrint
import Data.Time
class Pretty a where
ppr :: a -> Doc
instance Pretty Doc where
ppr = id
instance Pretty String where
ppr = text
instance Pretty Float where
ppr = text . show
instance Pretty Int where
ppr = int
instance Pretty Integer where
ppr = text . show
instance Pretty UTCTime where
ppr = text . show
ten12i :: Integer
ten12i = 10^(12 :: Integer)
pprPSecTime :: Integer -> Doc
pprPSecTime psecs
= text (show (psecs `quot` ten12i))
<> text "."
<> (text $ (take 3 $ render $ padRc 12 '0' $ text $ show $ psecs `rem` ten12i))
pprFloatTime :: Float -> Doc
pprFloatTime stime
= let (secs :: Integer, frac :: Float)
= properFraction stime
msecs = frac * 1000
in text (show secs)
<> text "."
<> (padRc 3 '0' $ text $ show $ ((round $ msecs) :: Integer) )
pprFloatRef :: Float -> Float -> Doc
pprFloatRef stime stimeRef
= let diff = ((stime stimeRef) / stimeRef )*100
in pprFloatTime stime
<> parens (padR 4 $ pprFloatSR diff)
pprFloatSR :: Float -> Doc
pprFloatSR p
| p == 0
= text "----"
| p > 0
= text "+" <> (ppr $ (round p :: Integer))
| otherwise
= text "-" <> (ppr $ (round (negate p) :: Integer))
padRc :: Int -> Char -> Doc -> Doc
padRc n c str
= (text $ replicate (n length (render str)) c) <> str
padR :: Int -> Doc -> Doc
padR n str = padRc n ' ' str
padLc :: Int -> Char -> Doc -> Doc
padLc n c str
= str <> (text $ replicate (n length (render str)) c)
padL :: Int -> Doc -> Doc
padL n str = padLc n ' ' str
blank :: Doc
blank = ppr ""