{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}

{- |

This module defines the 'Pretty' type class. The assert functions
from 'Test.Framework.HUnitWrapper' use the pretty-printing functionality
provided by this type class so as to provide nicely formatted
error messages.

Additionally, this module re-exports the standard Haskell pretty-printing module
'Text.PrettyPrint'
-}
module Test.Framework.Pretty (

  Pretty(..), (<=>),

  module Text.PrettyPrint
)

where

#if MIN_VERSION_base(4,11,0)
-- Text.PrettyPrint exports (<>) conflicting with newer Prelude.
import Text.PrettyPrint hiding ((<>))
#else
import Text.PrettyPrint
#endif

-- | A type class for pretty-printable things.
-- Minimal complete definition: @pretty@.
class Pretty a where
    -- | Pretty-print a single value.
    pretty :: a -> Doc
    -- | Pretty-print a list of things.
    prettyList :: [a] -> Doc
    prettyList [a]
l =
        Char -> Doc
char Char
'[' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
vcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty [a]
l)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
']'
    -- | Pretty-print a single value as a 'String'.
    showPretty :: a -> String
    showPretty = Doc -> String
render (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
pretty

{-
instance Pretty String where
    pretty = text
-}

instance Pretty Char where
    pretty :: Char -> Doc
pretty = Char -> Doc
char
    prettyList :: String -> Doc
prettyList String
s = String -> Doc
text String
s

instance Pretty a => Pretty [a] where
    pretty :: [a] -> Doc
pretty = [a] -> Doc
forall a. Pretty a => [a] -> Doc
prettyList

instance Pretty Int where
    pretty :: Int -> Doc
pretty = Int -> Doc
int

instance Pretty Bool where
    pretty :: Bool -> Doc
pretty = String -> Doc
text (String -> Doc) -> (Bool -> String) -> Bool -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show

-- | Utility function for inserting a @=@ between two 'Doc' values.
(<=>) :: Doc -> Doc -> Doc
Doc
d1 <=> :: Doc -> Doc -> Doc
<=> Doc
d2 = Doc
d1 Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
d2