module Text.Show.Pretty
(
Value(..), Name
, valToStr
, valToDoc
, valToHtmlPage
, parseValue, reify, ppDoc, ppShow
, dumpDoc, dumpStr, PrettyVal(..)
, valToHtml, HtmlOpts(..), defaultHtmlOpts, htmlPage, Html(..)
, ppValue
) where
import Text.PrettyPrint
import qualified Text.Show.Parser as P
import Text.Show.Value
import Text.Show.PrettyVal
import Text.Show.Html
import Language.Haskell.Lexer(rmSpace,lexerPass0)
ppValue :: Value -> Doc
ppValue = valToDoc
reify :: Show a => a -> Maybe Value
reify = parseValue . show
parseValue :: String -> Maybe Value
parseValue = P.parseValue . rmSpace . lexerPass0
ppShow :: Show a => a -> String
ppShow = show . ppDoc
ppDoc :: Show a => a -> Doc
ppDoc a = case parseValue txt of
Just v -> valToDoc v
Nothing -> text txt
where txt = show a
dumpDoc :: PrettyVal a => a -> Doc
dumpDoc = valToDoc . prettyVal
dumpStr :: PrettyVal a => a -> String
dumpStr = show . dumpDoc
valToStr :: Value -> String
valToStr = show . valToDoc
valToDoc :: Value -> Doc
valToDoc val = case val of
Con c vs -> ppCon c vs
Rec c fs -> hang (text c) 2 $ block '{' '}' (map ppField fs)
where ppField (x,v) = text x <+> char '=' <+> valToDoc v
List vs -> block '[' ']' (map valToDoc vs)
Tuple vs -> block '(' ')' (map valToDoc vs)
Neg v -> char '-' <> ppAtom v
Ratio x y -> ppCon "(%)" [x,y]
Integer x -> text x
Float x -> text x
Char x -> text x
String x -> text x
ppAtom :: Value -> Doc
ppAtom v
| isAtom v = valToDoc v
| otherwise = parens (valToDoc v)
ppCon :: Name -> [Value] -> Doc
ppCon c [] = text c
ppCon c (v : vs) = hang line1 2 (foldl addParam doc1 vs)
where (line1,doc1)
| isAtom v = (text c, valToDoc v)
| otherwise = (text c <+> char '(', valToDoc v <+> char ')')
addParam d p
| isAtom p = d $$ valToDoc p
| otherwise = (d <+> char '(') $$ (valToDoc p <+> char ')')
isAtom :: Value -> Bool
isAtom (Con _ (_:_)) = False
isAtom (Ratio {}) = False
isAtom (Neg {}) = False
isAtom _ = True
block :: Char -> Char -> [Doc] -> Doc
block a b [] = char a <> char b
block a b (d:ds) = char a <+> d
$$ vcat [ char ',' <+> x | x <- ds ]
$$ char b