module BuildBox.Pretty
( module Text.PrettyPrint
, Pretty(..)
, pprPSecTime
, pprFloatTime
, pprFloatSF
, 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
ten12 :: Float
ten12 = 10^(12 :: Integer)
ten12i :: Integer
ten12i = 10^(12 :: Integer)
pprPSecTime :: Integer -> Doc
pprPSecTime psecs
= text (show (psecs `div` ten12i))
<> text "."
<> (text $ (take 3 $ render $ padRc 12 '0' $ text $ show $ psecs `mod` ten12i))
pprFloatTime :: Float -> Doc
pprFloatTime stime
= let psecs = truncate (stime * ten12)
in pprPSecTime psecs
pprFloatRef :: Float -> Float -> Doc
pprFloatRef stime stimeRef
= let psecs = truncate (stime * ten12)
diff = (1 (stimeRef / stime))*100
in pprPSecTime psecs
<> parens (padR 3 $ pprFloatSF diff)
pprFloatSF :: Float -> Doc
pprFloatSF p
| p > 0
= text "+" <> (ppr $ (floor p :: Integer))
| otherwise
= text "-" <> (ppr $ (floor (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 ""