hakaru-0.1: Util/Pretty.hs

module Util.Pretty (Pretty(..)) where

import Text.PrettyPrint
import Text.Show.Functions
import Data.Ratio (Ratio, numerator, denominator)
import qualified Data.Map as M
import qualified Data.Set as S
import Util.Finite

class (Show a) => Pretty a where
    pretty :: a -> Doc
    pretty = text . show
    prettyList :: [a] -> Doc
    prettyList = brackets . nest 1 . fsep . punctuate comma . map pretty

instance Pretty Bool
instance Pretty Int
instance Pretty Integer
instance Pretty Float
instance Pretty Double
instance Pretty ()
instance Pretty Ordering
instance Pretty Char where prettyList = text . show

instance (Pretty a, Integral a) => Pretty (Ratio a) where
    pretty r | denom == 1 = prnum
	     | otherwise  = cat [prnum, char '/' <> pretty denom]
	where denom = denominator r
	      prnum = pretty (numerator r)

instance (Pretty a) => Pretty [a] where
    pretty = prettyList

instance (Pretty a) => Pretty (Maybe a) where
    pretty Nothing  = text "Nothing"
    pretty (Just x) = text "Just" <+> pretty x

instance (Pretty a, Pretty b) => Pretty (Either a b) where
    pretty (Left  x) = text "Left"  <+> pretty x
    pretty (Right x) = text "Right" <+> pretty x

instance (Finite a, Pretty a, Pretty b) => Pretty (a -> b)
  where
    pretty f = braces $ nest 1 $ sep $ punctuate comma $
               [ hang (pretty x <> colon) 1 (pretty (f x)) | x <- everything ]

instance (Pretty a, Pretty b) => Pretty (M.Map a b)
  where
    pretty m = braces . nest 1 . sep . punctuate comma
        $ [ hang (pretty k <> colon) 1 (pretty v) | (k,v) <- M.assocs m ]

instance (Pretty a) => Pretty (S.Set a)
  where
    pretty = braces . nest 1 . fsep . punctuate comma . map pretty . S.elems

tuple :: [Doc] -> Doc
tuple = parens . nest 1 . fsep . punctuate comma

{- The Haskell code below is generated by the following Perl program.
@a = 'a'..'z';
$" = ", ";
print <<END foreach 2..5;
instance (@{[map "Pretty $_", @a[0..$_-1]]}) => Pretty (@a[0..$_-1]) where
    pretty (@a[0..$_-1]) = tuple [@{[map "pretty $_", @a[0..$_-1]]}]
END
-}
instance (Pretty a, Pretty b) => Pretty (a, b) where
    pretty (a, b) = tuple [pretty a, pretty b]
instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where
    pretty (a, b, c) = tuple [pretty a, pretty b, pretty c]
instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where
    pretty (a, b, c, d) = tuple [pretty a, pretty b, pretty c, pretty d]
instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) where
    pretty (a, b, c, d, e) = tuple [pretty a, pretty b, pretty c, pretty d, pretty e]