module Main where import Text.PrettyPrint.MarkedHughesPJ hiding (Doc) data Exp = App Exp [Exp] | Var String | Lit Int | List [Exp] pretty :: Exp -> Doc pretty (App e args) = pretty e <+> sep (map (parens . pretty) args) pretty (Var v) = text v pretty (Lit l) = scope BOLD $ scope GREEN $ text (show l) pretty (List es) = brackets (scope RED (sep (punctuate (text ",") (map pretty es)))) type Doc = MDoc Markup data Markup = Open MStyle | Close MStyle data MStyle = BOLD | RED | GREEN open :: MStyle -> Doc open = mark . Open close :: MStyle -> Doc close = mark . Close scope :: MStyle -> Doc -> Doc scope s d = open s <> d <> close s example1 = Var "abc" example2 = Var "cde" example3 = App example1 [example2] example4 = Lit 99 example5 = App example3 [example1,example4,example2,example1,example2,example4,example2] example6 = List [example1,example2,example3,example4,example5] example7 = App example3 [example6] example8 = App example4 [example4] examples = [ example1 , example2 , example3 , example4 , example5 , example6 , example7 , example8 ] main = do putStrLn "

"
  sequence_ [ putStrLn $ render (pretty ex)
             |  ex <- examples
            ]
  putStrLn "

"
  sequence_ [ putStrLn $ fullRender PageMode 100 1.5 html_txt "" (pretty ex) 
             | ex <- examples
            ]
  putStrLn "

" html_txt (Chr c) r = concatMap escape [c] ++ r html_txt (Str s) r = concatMap escape s ++ r html_txt (PStr s) r = concatMap escape s ++ r html_txt (Mark (Open BOLD)) r = "" ++ r html_txt (Mark (Close BOLD)) r = "" ++ r html_txt (Mark (Open RED)) r = "" ++ r html_txt (Mark (Close RED)) r = "" ++ r html_txt (Mark (Open GREEN)) r = "" ++ r html_txt (Mark (Close GREEN)) r = "" ++ r escape '<' = "<" escape '>' = ">" escape c = [c]