diff --git a/PPrinter.cabal b/PPrinter.cabal --- a/PPrinter.cabal +++ b/PPrinter.cabal @@ -10,21 +10,29 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.0.1 +version: 0.0.2 -- A short (one-line) description of the package. -synopsis: A generic, derivable, haskell pretty printer. +synopsis: A derivable Haskell pretty printer. -- A longer description of the package. -description: +description: + A library that supports deriving of pretty printing functions on data types. . - The form of generics used is based on that introduced in the paper: + The interfaces of pretty printer used are based on that introduced in the paper: Philip Wadler, A Prettier Printer, The Fun of Programming, Cornerstones of Computing (2003): 223-243. . - The implementation of API is referred to that designed in the library: + The form of generic feature used is based on that introduced in the paper: + Magalhaes, et al., A Generic Deriving Mechanism for Haskell, + 3'rd ACM Symposium on Haskell, pp. 37-48, September 2010, + . + The necessary information of implementation of GHC.Generics is described here: + . + . + The implementation of deriving part of API is based on that designed in the library: GenericPretty, the details are introduced here: @@ -50,7 +58,7 @@ -- Extra files to be distributed with the package, such as examples or a -- README. --- extra-source-files: README +-- extra-source-files: -- Constraint on the version of Cabal needed to build this package. cabal-version: >=1.10 diff --git a/Text/PPrinter.hs b/Text/PPrinter.hs --- a/Text/PPrinter.hs +++ b/Text/PPrinter.hs @@ -42,6 +42,8 @@ infixr 5 :<|> infixr 6 :<> infixr 6 <> +infixr 6 <+> +infixr 6 <-> data DOC = NIL | DOC :<> DOC @@ -89,6 +91,11 @@ layout (s `Text` x) = s ++ layout x layout (i `Line` x) = '\n' : copy i ' ' ++ layout x +-- interfaces for oneLineMode +oneLayout Nil = "" +oneLayout (s `Text` x) = s ++ oneLayout x +oneLayout (i `Line` x) = ' ' : oneLayout x + copy i x = [ x | _ <- [1 .. i] ] best w k x = be w k [(0, x)] @@ -165,9 +172,9 @@ | flag = if flag then map (nest 1) ([line] ++ s) else ([line] ++ s) | otherwise = map (nest $ white + 1 + (if flag then 1 else 0)) ([line] ++ s) where - len x = length (pretty 1 x) - sa = pretty (len x) x - sb = pretty (len x) (head gppa) + len x = length (pretty oneLayout 1 x) + sa = pretty oneLayout (len x) x + sb = pretty oneLayout (len x) (head gppa) parens = length $ takeWhile (== '(') sa white = length $ takeWhile( /= ' ') (dropWhile(== '(') sb) @@ -280,19 +287,22 @@ default pp :: (Generic a, GPretty (Rep a)) => a -> DOC pp x = rep $ gpp Prefixt 0 False (from x) + -- helper function for generating a DOC list + genList :: [a] -> DOC + genList [] = nil + genList (x:xs) = text "," <> + line <> whiteSpace <> + nest indent (pp x) <> + genList xs + -- | 'ppList' is the equivalent of 'Prelude.showList' - -- + -- ppList :: [a] -> DOC ppList [] = text "[]" - ppList (x:xs) = group $ text "[" - <> nest indent (pp x) <> - if null xs - then - text "]" - else - text "," - <> foldr1 (\l r -> l <> text "," <> r) (map pp' xs) - <> text "]" + ppList (x:xs) = group $ + text "[" <> + nest indent (pp x) <> genList xs <> + text "]" {-# MINIMAL ppPrec | pp #-} @@ -344,7 +354,7 @@ ppPrec _ = pp instance (Pretty a, Pretty b) => Pretty (Map a b) where - pp m = pp $ toList m + pp m = group $ "fromList" <-> (pp $ toList m) ppPrec _ = pp instance Pretty a => Pretty (Maybe a) where @@ -353,7 +363,7 @@ | n /= 0 = parens s | otherwise = s where - s = text "Just" <+> ppPrec 10 x + s = "Just" <-> ppPrec 10 x pp = ppPrec 0 instance (Pretty a, Pretty b) => Pretty (Either a b) where @@ -361,12 +371,12 @@ | n /= 0 = parens s | otherwise = s where - s = text "Left" <+> ppPrec 10 x + s = "Left" <-> ppPrec 10 x ppPrec n (Right x) | n /= 0 = parens s | otherwise = s where - s = text "Right" <+> ppPrec 10 x + s = "Right" <-> ppPrec 10 x pp = ppPrec 0 -- instances for the first few tuples @@ -470,12 +480,57 @@ sep (x:xs) = nest indent (x) <> foldr1 (\l r -> l <> nil <> r) (map (\x -> nest indent (line <> x)) xs) -pretty :: Int -> DOC -> String -pretty w x = layout (best w 0 x) +x <-> y = text x <+> nest (length x + 1) y -pshow :: Pretty a => Int -> a -> String -pshow w x = pretty w (pp x <> line) +pretty :: (Doc -> [Char]) -> Int -> DOC -> String +pretty f w x = f (best w 0 x) --- | The default Pretty Printer +pshow :: Pretty a => (Doc -> [Char]) -> Int -> a -> String +pshow f w x = pretty f w (pp x <> line) + pprint :: Pretty a => Int -> a -> IO() -pprint w x = putStr (pshow w x) +pprint w x = putStr (pshow layout w x) + +------------------------------------------------------------- +-- Pretty Printer +------------------------------------------------------------- + +data Mode = PageMode | NonIndentMode | OneLineMode + +-- | A rendering style +data Style = Style { mode :: Mode, -- ^ The redering mode + lineLen :: Int -- ^ Length of line + } + +styleMode :: Style -> Mode +styleMode (Style mode length) = mode + +styleLen :: Style -> Int +styleLen (Style mode length) = length + +-- | The default 'Style' +style :: Style +style = Style {mode = PageMode, lineLen = 40} + +render :: Show a => Pretty a => a -> String +fullRender :: Show a => Pretty a => + Mode + -> Int + -> a + -> String +fullRender PageMode w x = pshow layout w x +fullRender NonIndentMode _ x = show x +fullRender OneLineMode w x = pshow oneLayout w x + +-- use default style +render = fullRender (styleMode style) (styleLen style) + +printer :: Show a => Pretty a => a -> IO() +printer x = putStr (render x) + +printLen :: Show a => Pretty a => Int -> a -> IO() +printLen x = pprint x + +-- | The default Pretty Printer +fullPrinter :: Show a => Pretty a => Style -> a -> IO() +fullPrinter s x = putStr $ fullRender (styleMode s) (styleLen s) x