GenericPretty 1.2.0 → 1.2.1
raw patch · 9 files changed
+1075/−1073 lines, 9 filesdep −ghcsetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies removed: ghc
API changes (from Hackage documentation)
Files
- GenericPretty.cabal +98/−98
- LICENSE +30/−30
- README +268/−268
- Setup.hs +2/−2
- TestSuite/CustomTest.hs +17/−17
- TestSuite/SimpleTest.hs +13/−13
- TestSuite/Tests.hs +176/−176
- TestSuite/ZigZagTest.hs +16/−16
- Text/PrettyPrint/GenericPretty.hs +455/−453
GenericPretty.cabal view
@@ -1,99 +1,99 @@--- GenericPretty.cabal auto-generated by cabal init. For additional --- options, see --- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. --- The name of the package. -Name: GenericPretty - --- The package version. See the Haskell package versioning policy --- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for --- standards guiding when and how versions should be incremented. -Version: 1.2.0 - --- A short (one-line) description of the package. -Synopsis: A generic, derivable, haskell pretty printer. - --- A longer description of the package. -Description: - GenericPretty is a Haskell library that supports automatic - derivation of pretty printing functions on user defined data - types. - . - The form of geenrics used is based on that introduced in the paper: - Magalhaes, Dijkstra, Jeuring, and Loh, - A Generic Deriving Mechanism for Haskell, - 3'rd ACM Symposium on Haskell, pp. 37-48, September 2010, - <http://dx.doi.org/10.1145/1863523.1863529>. - Changes from the original paper in the GHC implementation - are described here: - <http://www.haskell.org/haskellwiki/GHC.Generics#Changes_from_the_paper>. - . - This package requires the use of the new GHC.Generics features - <http://www.haskell.org/haskellwiki/GHC.Generics>, present from GHC 7.2. - Use of these features is indicated by the DeriveGeneric pragma. - or the flag -XDeriveGeneric. - . - Pretty printing produces values of type Text.PrettyPrint.Doc, using - the Text.PrettyPrint library - <http://www.haskell.org/ghc/docs/latest/html/libraries/pretty-1.1.1.0/Text-PrettyPrint.html>. - . - The output provided is a pretty printed version of that provided by - Prelude.show. That is, rendering the document provided by this pretty - printer yields an output identical to that of Prelude.show, except - for extra whitespace. - . - For information about the functions exported by the package please see - the API linked further down this page. - - For examples of usage, both basic and more complex see the README file and - the haskell source code files in the TestSuite folder, both included in the package. - - Finally for installation instructions also see the README file or this page: - <http://www.haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package> - --- URL for the project homepage or repository. -Homepage: https://github.com/RazvanRanca/GenericPretty - --- The license under which the package is released. -License: BSD3 - --- The file containing the license text. -License-file: LICENSE - --- The package author(s). -Author: Razvan Ranca - --- An email address to which users can send suggestions, bug reports, --- and patches. -Maintainer: ranca.razvan@gmail.com - --- A copyright notice. --- Copyright: - -Category: Text, Generics, Pretty Printer - -Build-type: Simple - --- Extra files to be distributed with the package, such as examples or --- a README. -Extra-source-files: README TestSuite\SimpleTest.hs TestSuite\Tests.hs TestSuite\CustomTest.hs TestSuite\ZigZagTest.hs - --- Constraint on the version of Cabal needed to build this package. -Cabal-version: >=1.6 - - -Library - -- Modules exported by the library. - Exposed-modules: Text.PrettyPrint.GenericPretty - - -- Packages needed in order to build this package. - Build-depends: base >= 3 && < 5, ghc-prim, pretty, ghc >= 7.4 - - -- Modules not exported by this package. - -- Other-modules: - - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: - -source-repository head - type: git +-- GenericPretty.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name: GenericPretty++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version: 1.2.1++-- A short (one-line) description of the package.+Synopsis: A generic, derivable, haskell pretty printer.++-- A longer description of the package.+Description: + GenericPretty is a Haskell library that supports automatic+ derivation of pretty printing functions on user defined data+ types.+ .+ The form of generics used is based on that introduced in the paper:+ Magalhaes, Dijkstra, Jeuring, and Loh,+ A Generic Deriving Mechanism for Haskell,+ 3'rd ACM Symposium on Haskell, pp. 37-48, September 2010,+ <http://dx.doi.org/10.1145/1863523.1863529>.+ Changes from the original paper in the GHC implementation+ are described here:+ <http://www.haskell.org/haskellwiki/GHC.Generics#Changes_from_the_paper>.+ .+ This package requires the use of the new GHC.Generics features+ <http://www.haskell.org/haskellwiki/GHC.Generics>, present from GHC 7.2.+ Use of these features is indicated by the DeriveGeneric pragma+ or the flag -XDeriveGeneric.+ .+ Pretty printing produces values of type Text.PrettyPrint.Doc, using+ the Text.PrettyPrint library+ <http://www.haskell.org/ghc/docs/latest/html/libraries/pretty-1.1.1.0/Text-PrettyPrint.html>.+ .+ The output provided is a pretty printed version of that provided by+ Prelude.show. That is, rendering the document provided by this pretty+ printer yields an output identical to that of Prelude.show, except+ for extra whitespace.+ .+ For information about the functions exported by the package please see+ the API linked further down this page.+ + For examples of usage, both basic and more complex see the README file and+ the haskell source code files in the TestSuite folder, both included in the package.+ + Finally for installation instructions also see the README file or this page:+ <http://www.haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package>+ +-- URL for the project homepage or repository.+Homepage: https://github.com/RazvanRanca/GenericPretty++-- The license under which the package is released.+License: BSD3++-- The file containing the license text.+License-file: LICENSE ++-- The package author(s).+Author: Razvan Ranca++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: ranca.razvan@gmail.com++-- A copyright notice.+-- Copyright: ++Category: Text, Generics, Pretty Printer++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files: README TestSuite/SimpleTest.hs TestSuite/Tests.hs TestSuite/CustomTest.hs TestSuite/ZigZagTest.hs++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.6+++Library+ -- Modules exported by the library.+ Exposed-modules: Text.PrettyPrint.GenericPretty+ + -- Packages needed in order to build this package.+ Build-depends: base >= 3 && < 5, ghc-prim, pretty+ + -- Modules not exported by this package.+ -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: + +source-repository head+ type: git location: git@github.com:RazvanRanca/GenericPretty.git
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c)2011, Razvan Ranca - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Razvan Ranca nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c)2011, Razvan Ranca++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Razvan Ranca nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README view
@@ -1,269 +1,269 @@-******************************************************************************* -* GenericPretty -* A Generic, Derivable, Haskell Pretty Printer -******************************************************************************* - -=============================================================================== -========================== Description ======================================== -=============================================================================== - -GenericPretty is a Haskell library that supports automatic -derivation of pretty printing functions on user defined data -types. - -The form of geenrics used is based on that introduced in the paper: -Magalhaes, Dijkstra, Jeuring, and Loh, -A Generic Deriving Mechanism for Haskell, -3'rd ACM Symposium on Haskell, pp. 37-48, September 2010, - http://dx.doi.org/10.1145/1863523.1863529. -Changes from the original paper in the GHC implementation -are described here: - http://www.haskell.org/haskellwiki/GHC.Generics#Changes_from_the_paper. - -This package requires the use of the new GHC.Generics features: - http://www.haskell.org/haskellwiki/GHC.Generics -present from GHC 7.2. -Use of these features is indicated by the DeriveGeneric pragma -or the flag -XDeriveGeneric. - -Pretty printing produces values of type Text.PrettyPrint.Doc, using -the Text.PrettyPrint library - http://www.haskell.org/ghc/docs/latest/html/libraries/pretty-1.1.1.0/Text-PrettyPrint.html. - -The output provided is a pretty printed version of that provided by -Prelude.show. That is, rendering the document provided by this pretty -printer yields an output identical to that of Prelude.show, except -for extra whitespace. - -The generics mechanism works on all haskell datatypes except for -constrained datatypes. -That is to say, datatypes which have a context will fail. -For instance, - data (Eq a) => Constr a = Constr a deriving (Generic) -will fail because of the (Eq a) context. - -=============================================================================== -===================== Installation Instructions =============================== -=============================================================================== - -The package is installed in the same way as any other package. -If you have cabal, you can simply do: - $ cabal update - $ cabal install GenericPretty - -Otherwise, the steps are: - 0. Make sure you have a version of ghc >= 7.4 installed and that you can - use the 'runhaskell' command from the command line. - 1. Download and unpack "GenericPretty-1.2.0.tar.gz" - 2. Move to the correct directory: - $ cd GenericPretty-1.2.0 - 3. Run the following haskell commands to install the library globally: - $ runhaskell Setup configure - $ runhaskell Setup build - $ runhaskell Setup install - - The last command requires root access, so you might need to run is as: - $ sudo runhaskell Setup install - -If something went wrong, you can check this page for more info, -look at manual installation: - http://www.haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package - -=============================================================================== -============================== Basic Example ================================== -=============================================================================== - -Here is a haskell source file, called 'SimpleTest.hs' ----------------------------------------------------- -{-# LANGUAGE DeriveGeneric #-} - -import Text.PrettyPrint.GenericPretty - -data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic) - -instance (Out a) => Out (Tree a) - -tree1 :: Tree Int -tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) - (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777)) - -main = pp tree1 ------------------------------------------------- -The flag DeriveGeneric must be given to GHC. This can be done as above, -in a 'LANGUAGE' pragma, or manually by compiling with 'ghc -XDeriveGeneric'. - -As can be seen, to use the library you must simply import it, derive Generic -on the custom data type by typing - "deriving (Generic)" -and writing an empty instance of Out. - -Then you can use the pretty printing functions, such as 'pp' and 'pretty'. - -Compiling and running the file is simple and gives the following result. ------------------------------ -$ ghc SimpleTest.hs -$ SimpleTest - -Node (Node (Leaf 333333) (Leaf (-555555))) - (Node (Node (Node (Leaf 888888) (Leaf 57575757)) - (Leaf (-14141414))) - (Leaf 7777777)) ---------------------------- -If we replaced the main function with 'main = ppLen 30 tree1', -the result would instead be: ------------------------------ -Node (Node (Leaf 333333) - (Leaf (-555555))) - (Node (Node (Node (Leaf 888888) - (Leaf 57575757)) - (Leaf (-14141414))) - (Leaf 7777777)) -------------------------------- -In this case the output tries to remain under 30 characters/line, -if possible, while always maintaining correct indentation. - -=============================================================================== -================= The 'ppStyle' and 'prettyStyle' functions =================== -=============================================================================== - -The 'ppStyle' function lets you further customize the output -by giving a 'Style' which consists of the line length, the number of ribbons -per line and the mode to use. - -The 'prettyStyle' function does the same thing except it outputs a String -instead of an IO() operation. - -A ribbon length is the maximum length of non-indentation text per line. -So if I used a line length of 80 and 2 ribbons per line than I would have a -maximum of 40 non-indentation characters on any line. - -The mode tells 'Pretty' how to render the result. There are 4 options: - 1. PageMode - the default rendering - 2. ZigZagMode - zig-zag cuts - 3. LeftMode - there is no indentation and no maximum line length - 4. OneLineMode - everything is put on one line - -The most interesting one is the ZigZagMode. -Modifying the running example we get: --------------------------------------- -{-# LANGUAGE DeriveGeneric #-} - -import Text.PrettyPrint.GenericPretty -import Text.PrettyPrint - -data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic) - -instance (Out a) => Out (Tree a) - -tree1 :: Tree Int -tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) - (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777)) - -zigStyle :: Style -zigStyle = Style {mode = ZigZagMode, lineLength = 30, ribbonsPerLine = 1.5} - -main = ppStyle zigStyle tree1 --------------------------------------- -We import "Text.PrettyPrint" to gain access to the "Style" functionality. -Then we proceed to define the 'zigStyle' using a maximum line length of 30, -1.5 ribbonsPerLine and the ZigZagMode. - -Running the program, we get: -------------------------------------- -Node (Node (Leaf 333333) - -///// - (Leaf (-555555))) -(Node (Node (Node (Leaf 888888) - -///// - (Leaf 57575757)) - (Leaf (-14141414))) - (Leaf 7777777)) -------------------------------------- -Notice that the "/" show us the direction in which the rows below have been -moved (left in this case) and the number of "/"s indicate the number of -characters that the rows were moved(in this case 5 characters to the left). - -So the last 3 lines are 10 characters to the left compared to where they -would be if we had no maximum line length. - -=============================================================================== -======================= Full Customization Example ============================ -=============================================================================== - -While the previous approach provides us some with some options as to the -format of the pretty printed result, sometimes you need even more control. - -Fully customizing the pretty printed results is straightforward, as in the -following example called 'CustomTest.hs' ----------------------------- -{-# LANGUAGE DeriveGeneric #-} - -import Text.PrettyPrint.GenericPretty -import Text.PrettyPrint - -data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic) - -instance (Out a) => Out (Tree a) where - doc (Leaf a) = parens $ text "customLeaf" <+> doc a - doc (Node a b) = parens $ text "customNode" $$ nest 1 (doc a) - $$ nest 1 (doc b) - docPrec _ = doc - -tree1 :: Tree Int -tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) - (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777)) - -main = pp tree1 ------------------------------- -Here we import the library 'Text.PrettyPrint' and use it directly to define doc. -We then define 'docPrec' in terms of 'doc', ignoring the precedence parameter. -We could have manually defined 'docList' as well if we wanted. As it is now, -'docList' is inferred from 'doc'. - -*****Note***** -As opposed to the 'Show' class, 'doc' and 'docPrec' are NOT defined in term -of one another. This means that even after giving a custom definition for -one of them, the other will retain the default behaviour. -If both are to be used, then custom definitions must be provided for both. - -For instance, in the above example, if we had ommited 'docPrec's definition, -the result would have been identical to that of 'SimpleTest.hs'. - -By running the above custom definition we get a tree with little indentation: ------------------------------------ -(customNode - (customNode - (customLeaf 333333) - (customLeaf -555555)) - (customNode - (customNode - (customNode - (customLeaf 888888) - (customLeaf 57575757)) - (customLeaf -14141414)) - (customLeaf 7777777))) ------------------------------------ -The details of the syntax used above can be found in the -Text.PrettyPrint library: - http://www.haskell.org/ghc/docs/latest/html/libraries/pretty-1.1.1.0/Text-PrettyPrint.html - -=============================================================================== -========================= Further Info ======================================== -=============================================================================== - -The above 'Tree' examples can be found in 'TestSuite/SimpleTest.hs', -'TestSuite.ZigZagTest.hs' and 'TestSuite/CustomTest.hs'. More involved -examples integrated with QuickCheck can be found in 'TestSuite/Tests.hs'. - -Further information can be found in the API: - http://hackage.haskell.org/packages/archive/GenericPretty/latest/doc/html/Text-PrettyPrint-GenericPretty.html -and in the source code itself. - -=============================================================================== -============================ Contact ========================================== -=============================================================================== - -Please send any questions/suggestions/issues to: +*******************************************************************************+* GenericPretty+* A Generic, Derivable, Haskell Pretty Printer+*******************************************************************************++===============================================================================+========================== Description ========================================+===============================================================================++GenericPretty is a Haskell library that supports automatic+derivation of pretty printing functions on user defined data+types.++The form of geenrics used is based on that introduced in the paper:+Magalhaes, Dijkstra, Jeuring, and Loh,+A Generic Deriving Mechanism for Haskell,+3'rd ACM Symposium on Haskell, pp. 37-48, September 2010,+ http://dx.doi.org/10.1145/1863523.1863529.+Changes from the original paper in the GHC implementation+are described here:+ http://www.haskell.org/haskellwiki/GHC.Generics#Changes_from_the_paper.++This package requires the use of the new GHC.Generics features:+ http://www.haskell.org/haskellwiki/GHC.Generics+present from GHC 7.2.+Use of these features is indicated by the DeriveGeneric pragma+or the flag -XDeriveGeneric.++Pretty printing produces values of type Text.PrettyPrint.Doc, using+the Text.PrettyPrint library+ http://www.haskell.org/ghc/docs/latest/html/libraries/pretty-1.1.1.0/Text-PrettyPrint.html.+ +The output provided is a pretty printed version of that provided by+Prelude.show. That is, rendering the document provided by this pretty+printer yields an output identical to that of Prelude.show, except+for extra whitespace.++The generics mechanism works on all haskell datatypes except for +constrained datatypes.+That is to say, datatypes which have a context will fail. +For instance,+ data (Eq a) => Constr a = Constr a deriving (Generic)+will fail because of the (Eq a) context.+ +===============================================================================+===================== Installation Instructions ===============================+===============================================================================++The package is installed in the same way as any other package. +If you have cabal, you can simply do:+ $ cabal update+ $ cabal install GenericPretty++Otherwise, the steps are:+ 0. Make sure you have a version of ghc >= 7.4 installed and that you can + use the 'runhaskell' command from the command line.+ 1. Download and unpack "GenericPretty-1.2.0.tar.gz"+ 2. Move to the correct directory:+ $ cd GenericPretty-1.2.0+ 3. Run the following haskell commands to install the library globally:+ $ runhaskell Setup configure + $ runhaskell Setup build+ $ runhaskell Setup install+ + The last command requires root access, so you might need to run is as:+ $ sudo runhaskell Setup install+ +If something went wrong, you can check this page for more info, +look at manual installation: + http://www.haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package++===============================================================================+============================== Basic Example ==================================+===============================================================================++Here is a haskell source file, called 'SimpleTest.hs'+----------------------------------------------------+{-# LANGUAGE DeriveGeneric #-}++import Text.PrettyPrint.GenericPretty++data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic)++instance (Out a) => Out (Tree a)++tree1 :: Tree Int+tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) + (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777))+ +main = pp tree1+------------------------------------------------+The flag DeriveGeneric must be given to GHC. This can be done as above, +in a 'LANGUAGE' pragma, or manually by compiling with 'ghc -XDeriveGeneric'.++As can be seen, to use the library you must simply import it, derive Generic+on the custom data type by typing+ "deriving (Generic)"+and writing an empty instance of Out.++Then you can use the pretty printing functions, such as 'pp' and 'pretty'.++Compiling and running the file is simple and gives the following result.+-----------------------------+$ ghc SimpleTest.hs+$ SimpleTest++Node (Node (Leaf 333333) (Leaf (-555555)))+ (Node (Node (Node (Leaf 888888) (Leaf 57575757))+ (Leaf (-14141414)))+ (Leaf 7777777))+---------------------------+If we replaced the main function with 'main = ppLen 30 tree1', +the result would instead be:+-----------------------------+Node (Node (Leaf 333333)+ (Leaf (-555555)))+ (Node (Node (Node (Leaf 888888)+ (Leaf 57575757))+ (Leaf (-14141414)))+ (Leaf 7777777))+-------------------------------+In this case the output tries to remain under 30 characters/line, +if possible, while always maintaining correct indentation.++===============================================================================+================= The 'ppStyle' and 'prettyStyle' functions ===================+===============================================================================++The 'ppStyle' function lets you further customize the output+by giving a 'Style' which consists of the line length, the number of ribbons +per line and the mode to use.++The 'prettyStyle' function does the same thing except it outputs a String+instead of an IO() operation.++A ribbon length is the maximum length of non-indentation text per line.+So if I used a line length of 80 and 2 ribbons per line than I would have a+maximum of 40 non-indentation characters on any line.++The mode tells 'Pretty' how to render the result. There are 4 options:+ 1. PageMode - the default rendering+ 2. ZigZagMode - zig-zag cuts+ 3. LeftMode - there is no indentation and no maximum line length+ 4. OneLineMode - everything is put on one line ++The most interesting one is the ZigZagMode. +Modifying the running example we get:+--------------------------------------+{-# LANGUAGE DeriveGeneric #-}++import Text.PrettyPrint.GenericPretty+import Text.PrettyPrint++data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic)++instance (Out a) => Out (Tree a)++tree1 :: Tree Int+tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) + (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777))+ +zigStyle :: Style+zigStyle = Style {mode = ZigZagMode, lineLength = 30, ribbonsPerLine = 1.5}++main = ppStyle zigStyle tree1+--------------------------------------+We import "Text.PrettyPrint" to gain access to the "Style" functionality.+Then we proceed to define the 'zigStyle' using a maximum line length of 30,+1.5 ribbonsPerLine and the ZigZagMode.++Running the program, we get:+-------------------------------------+Node (Node (Leaf 333333)++/////+ (Leaf (-555555)))+(Node (Node (Node (Leaf 888888)++/////+ (Leaf 57575757))+ (Leaf (-14141414)))+ (Leaf 7777777))+-------------------------------------+Notice that the "/" show us the direction in which the rows below have been +moved (left in this case) and the number of "/"s indicate the number of +characters that the rows were moved(in this case 5 characters to the left).+ +So the last 3 lines are 10 characters to the left compared to where they +would be if we had no maximum line length.++===============================================================================+======================= Full Customization Example ============================+===============================================================================++While the previous approach provides us some with some options as to the +format of the pretty printed result, sometimes you need even more control.++Fully customizing the pretty printed results is straightforward, as in the+following example called 'CustomTest.hs'+----------------------------+{-# LANGUAGE DeriveGeneric #-}++import Text.PrettyPrint.GenericPretty+import Text.PrettyPrint++data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic)++instance (Out a) => Out (Tree a) where+ doc (Leaf a) = parens $ text "customLeaf" <+> doc a+ doc (Node a b) = parens $ text "customNode" $$ nest 1 (doc a) + $$ nest 1 (doc b)+ docPrec _ = doc+ +tree1 :: Tree Int+tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) + (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777))+ +main = pp tree1+------------------------------+Here we import the library 'Text.PrettyPrint' and use it directly to define doc.+We then define 'docPrec' in terms of 'doc', ignoring the precedence parameter.+We could have manually defined 'docList' as well if we wanted. As it is now,+'docList' is inferred from 'doc'.++*****Note*****+As opposed to the 'Show' class, 'doc' and 'docPrec' are NOT defined in term +of one another. This means that even after giving a custom definition for+one of them, the other will retain the default behaviour. +If both are to be used, then custom definitions must be provided for both.++For instance, in the above example, if we had ommited 'docPrec's definition,+the result would have been identical to that of 'SimpleTest.hs'.++By running the above custom definition we get a tree with little indentation:+-----------------------------------+(customNode+ (customNode+ (customLeaf 333333)+ (customLeaf -555555))+ (customNode+ (customNode+ (customNode+ (customLeaf 888888)+ (customLeaf 57575757))+ (customLeaf -14141414))+ (customLeaf 7777777)))+-----------------------------------+The details of the syntax used above can be found in the +Text.PrettyPrint library:+ http://www.haskell.org/ghc/docs/latest/html/libraries/pretty-1.1.1.0/Text-PrettyPrint.html++===============================================================================+========================= Further Info ========================================+===============================================================================++The above 'Tree' examples can be found in 'TestSuite/SimpleTest.hs',+'TestSuite.ZigZagTest.hs' and 'TestSuite/CustomTest.hs'. More involved +examples integrated with QuickCheck can be found in 'TestSuite/Tests.hs'.++Further information can be found in the API:+ http://hackage.haskell.org/packages/archive/GenericPretty/latest/doc/html/Text-PrettyPrint-GenericPretty.html+and in the source code itself.++===============================================================================+============================ Contact ==========================================+===============================================================================++Please send any questions/suggestions/issues to: Razvan Ranca - ranca.razvan@gmail.com
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
TestSuite/CustomTest.hs view
@@ -1,18 +1,18 @@-{-# LANGUAGE DeriveGeneric #-} - -import Text.PrettyPrint.GenericPretty -import Text.PrettyPrint - -data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic) - -instance (Out a) => Out (Tree a) where - doc (Leaf a) = parens $ text "customLeaf" <+> doc a - doc (Node a b) = parens $ text "customNode" $$ nest 1 (doc a) - $$ nest 1 (doc b) - docPrec _ = doc - -tree1 :: Tree Int -tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) - (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777)) - +{-# LANGUAGE DeriveGeneric #-}++import Text.PrettyPrint.GenericPretty+import Text.PrettyPrint++data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic)++instance (Out a) => Out (Tree a) where+ doc (Leaf a) = parens $ text "customLeaf" <+> doc a+ doc (Node a b) = parens $ text "customNode" $$ nest 1 (doc a) + $$ nest 1 (doc b)+ docPrec _ = doc++tree1 :: Tree Int+tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) + (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777))+ main = pp tree1
TestSuite/SimpleTest.hs view
@@ -1,14 +1,14 @@-{-# LANGUAGE DeriveGeneric #-} - -import Text.PrettyPrint.GenericPretty - -data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic) - -instance (Out a) => Out (Tree a) - -tree1 :: Tree Int -tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) - (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777)) - ---main = pp tree1 +{-# LANGUAGE DeriveGeneric #-}++import Text.PrettyPrint.GenericPretty++data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic)++instance (Out a) => Out (Tree a)++tree1 :: Tree Int+tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) + (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777))+ +--main = pp tree1 main = ppLen 30 tree1
TestSuite/Tests.hs view
@@ -1,177 +1,177 @@-{-# LANGUAGE DeriveGeneric #-} - -{- Tests.hs has a number of different custom data types. All of them implement 'Out' and 'Arbitrary'. -Properties are provided for each that specify that the output given by 'pretty' and that given -by 'show' should be identical except for the whitespace - -The different data types follow the same pattern of implementation and functions, so most of the -functions are only commented for the first data type -} - -import Text.PrettyPrint.GenericPretty -import Test.QuickCheck -import Control.Monad -import Data.Maybe -import Text.Printf - --- used to make pretty printed and show output identical for comparing purposes -removeSpaces :: String -> String -removeSpaces [] = [] -removeSpaces (x:xs) - | x `elem` " \n" = removeSpaces xs - | otherwise = x : removeSpaces xs - --- checks the output of a specific value -checkOutput :: (Out a, Show a) => a -> Bool -checkOutput a = removeSpaces (pretty a) == removeSpaces (show a) - --- Finite State Machine Type -data FSM q = FSMCons ([q], Alphabet, q, [q], [Transition q]) deriving (Show, Generic) -type Alphabet = String -type Transition q = (q, Char, q) - --- implement 'Out' so we can pretty print -instance (Out a) => Out (FSM a) - ---implementation needed for quickCheck generation of random values -instance Arbitrary a => Arbitrary (FSM a) where - arbitrary = liftM FSMCons arbitrary - --- check wether 'Maybe Int' FSM's are outputed the same via pretty and show (modulo the whitespace) -checkFSM :: FSM (Maybe Int) -> FSM (Maybe Int) -> Bool -checkFSM _ a = removeSpaces (pretty a) == removeSpaces (show a) - --- example of an FSM, you can check the output of this manually with 'checkOutput' -f :: FSM Int -f = FSMCons([0,1,2,3,4], - "ab", - 0, - [4], - [(0,'a',1), (0,'b',1), (0,'a',2), (0,'b',2), - (1,'b',4), (2,'a',3), (2,'b',3), (3,'b',4), - (4,'a',4), (4,'b',4)]) - --- Binary Tree data type -data BinaryTree a = EmptyBTree | BNode a (BinaryTree a) (BinaryTree a) deriving (Show, Generic) - -instance (Out a) => Out (BinaryTree a) - -instance (Arbitrary a) => Arbitrary (BinaryTree a) where - arbitrary = sized arbitTree - where - arbitTree 0 = return EmptyBTree - arbitTree n - | n>0 = oneof [return EmptyBTree, liftM3 BNode arbitrary subTree subTree] - | otherwise = error "tree size should never be < 0" - where - subTree = arbitTree (n `div` 2) - -checkBinaryTree :: BinaryTree Char -> BinaryTree Char -> Bool -checkBinaryTree _ a = removeSpaces (pretty a) == removeSpaces (show a) - --- functions for the construction of BinaryTrees -singleton :: a -> BinaryTree a -singleton x = BNode x EmptyBTree EmptyBTree - -treeInsert :: (Ord a) => a -> BinaryTree a -> BinaryTree a -treeInsert x EmptyBTree = singleton x -treeInsert x (BNode a left right) - | x == a = BNode x left right - | x < a = BNode a (treeInsert x left) right - | x > a = BNode a left (treeInsert x right) - -nums :: [Int] -nums = [55555,99999,22222,77777,88888,11111,33333,44444,66666] - --- mkBTree takes a list and creates a BinaryTree docPrec of it -mkBTree :: (Ord a) => [a] -> BinaryTree a -mkBTree = foldr treeInsert EmptyBTree - --- example BinaryTree -bt :: BinaryTree Int -bt = mkBTree nums - --- Tree using record syntax -data RecordTree a = RNode {val :: a, children :: [RecordTree a]} deriving (Show, Generic) - -instance (Out a) => Out (RecordTree a) - -instance (Arbitrary a) => Arbitrary (RecordTree a) where - arbitrary = sized arbitTree - where - arbitTree 0 = liftM2 RNode arbitrary (return []) - arbitTree n - | n>0 = liftM2 RNode arbitrary childList - | otherwise = error "tree size should never be < 0" - where - childList = resize (floor.sqrt.fromIntegral $ n) (listOf (arbitTree (n`div` 2)) ) - -checkRecordTree :: RecordTree String -> RecordTree String -> Bool -checkRecordTree _ a = removeSpaces (pretty a) == removeSpaces (show a) - -rt :: RecordTree Int -rt = RNode (-656565) [RNode 33344 [], RNode 98789 [RNode (-766444) [], RNode 454545 [], RNode 59996 []]] - -infixr 5 :*: -infixr 3 :+: --- tree using infix notation -data InfixTree a = ILeaf a a | (InfixTree a) :*: (InfixTree a) | (InfixTree a) :+: (InfixTree a) - deriving (Show, Generic) - -instance (Out a) => Out (InfixTree a) - -instance (Arbitrary a) => Arbitrary (InfixTree a) where - arbitrary = sized arbitTree - where - arbitTree 0 = liftM2 ILeaf arbitrary arbitrary - arbitTree n - | n>0 = oneof [ liftM2 (:*:) subTree subTree, liftM2 (:+:) subTree subTree] - | otherwise = error "tree size should never be < 0" - where - subTree = arbitTree (n `div` 2) - -nt :: InfixTree Int -nt = ILeaf 5454544 55 :*: (ILeaf 5375738 44 :+: ((ILeaf 699879 55 :*: ILeaf 2332323 66 :+: ILeaf 676765 77) - :*: ILeaf 99999 88) ) :+: ILeaf 555 666 - -checkInfixTree :: InfixTree (Either Int Char) -> InfixTree (Either Int Char) -> Bool -checkInfixTree _ a = removeSpaces (pretty a) == removeSpaces (show a) - -infixr 5 :^: --- infix and record tree, also uses a second user defined type in it's definition, 'Wrap' -data InfixRecordTree a = IRLeaf (Wrap a) | (:^:) {left :: InfixRecordTree a, right :: InfixRecordTree a} - deriving (Show, Generic) - -instance (Out a) => Out (InfixRecordTree a) - -instance (Arbitrary a) => Arbitrary (InfixRecordTree a) where - arbitrary = sized arbitTree - where - arbitTree 0 = liftM IRLeaf arbitrary - arbitTree n - | n>0 = liftM2 (:^:) subTree subTree - | otherwise = error "tree size should never be < 0" - where - subTree = arbitTree (n `div` 2) - -irt :: InfixRecordTree Int -irt = IRLeaf (Wrap 5454544) :^: (IRLeaf (Wrap (-5375738)) :^: ((IRLeaf (Wrap 699879) :^: - (IRLeaf (Wrap (-2332323)) :^: IRLeaf (Wrap 676765))) :^: IRLeaf (Wrap 99999))) - -checkInfixRecordTree :: InfixRecordTree Float -> InfixRecordTree Float -> Bool -checkInfixRecordTree _ a = removeSpaces (pretty a) == removeSpaces (show a) - --- just a very simple user defined type that is used in IRTree -data Wrap a = Wrap a deriving (Show, Generic) - -instance Out a => Out (Wrap a) - -instance Arbitrary a => Arbitrary (Wrap a) where - arbitrary = liftM Wrap arbitrary - -allTests = [ ("FSM (Maybe Int)", quickCheck checkFSM), - ("BinaryTree (Char)", quickCheck checkBinaryTree), - ("RecordTree (String)", quickCheck checkRecordTree), - ("InfixTree (Either Int Char)", quickCheck checkInfixTree), - ("InfixRecordTree (Float)", quickCheck checkInfixRecordTree)] - +{-# LANGUAGE DeriveGeneric #-}++{- Tests.hs has a number of different custom data types. All of them implement 'Out' and 'Arbitrary'.+Properties are provided for each that specify that the output given by 'pretty' and that given+by 'show' should be identical except for the whitespace ++The different data types follow the same pattern of implementation and functions, so most of the+functions are only commented for the first data type -}++import Text.PrettyPrint.GenericPretty+import Test.QuickCheck+import Control.Monad+import Data.Maybe+import Text.Printf++-- used to make pretty printed and show output identical for comparing purposes+removeSpaces :: String -> String+removeSpaces [] = []+removeSpaces (x:xs)+ | x `elem` " \n" = removeSpaces xs+ | otherwise = x : removeSpaces xs+ +-- checks the output of a specific value+checkOutput :: (Out a, Show a) => a -> Bool+checkOutput a = removeSpaces (pretty a) == removeSpaces (show a)++-- Finite State Machine Type+data FSM q = FSMCons ([q], Alphabet, q, [q], [Transition q]) deriving (Show, Generic)+type Alphabet = String+type Transition q = (q, Char, q)++-- implement 'Out' so we can pretty print+instance (Out a) => Out (FSM a)++--implementation needed for quickCheck generation of random values+instance Arbitrary a => Arbitrary (FSM a) where+ arbitrary = liftM FSMCons arbitrary++-- check wether 'Maybe Int' FSM's are outputed the same via pretty and show (modulo the whitespace) +checkFSM :: FSM (Maybe Int) -> FSM (Maybe Int) -> Bool+checkFSM _ a = removeSpaces (pretty a) == removeSpaces (show a)++-- example of an FSM, you can check the output of this manually with 'checkOutput'+f :: FSM Int+f = FSMCons([0,1,2,3,4],+ "ab",+ 0,+ [4],+ [(0,'a',1), (0,'b',1), (0,'a',2), (0,'b',2),+ (1,'b',4), (2,'a',3), (2,'b',3), (3,'b',4),+ (4,'a',4), (4,'b',4)])+ +-- Binary Tree data type+data BinaryTree a = EmptyBTree | BNode a (BinaryTree a) (BinaryTree a) deriving (Show, Generic) ++instance (Out a) => Out (BinaryTree a)++instance (Arbitrary a) => Arbitrary (BinaryTree a) where+ arbitrary = sized arbitTree+ where + arbitTree 0 = return EmptyBTree+ arbitTree n + | n>0 = oneof [return EmptyBTree, liftM3 BNode arbitrary subTree subTree]+ | otherwise = error "tree size should never be < 0"+ where+ subTree = arbitTree (n `div` 2)++checkBinaryTree :: BinaryTree Char -> BinaryTree Char -> Bool+checkBinaryTree _ a = removeSpaces (pretty a) == removeSpaces (show a)++-- functions for the construction of BinaryTrees +singleton :: a -> BinaryTree a +singleton x = BNode x EmptyBTree EmptyBTree + +treeInsert :: (Ord a) => a -> BinaryTree a -> BinaryTree a +treeInsert x EmptyBTree = singleton x +treeInsert x (BNode a left right) + | x == a = BNode x left right + | x < a = BNode a (treeInsert x left) right + | x > a = BNode a left (treeInsert x right) ++nums :: [Int]+nums = [55555,99999,22222,77777,88888,11111,33333,44444,66666] ++-- mkBTree takes a list and creates a BinaryTree docPrec of it+mkBTree :: (Ord a) => [a] -> BinaryTree a+mkBTree = foldr treeInsert EmptyBTree++-- example BinaryTree+bt :: BinaryTree Int+bt = mkBTree nums++-- Tree using record syntax+data RecordTree a = RNode {val :: a, children :: [RecordTree a]} deriving (Show, Generic) ++instance (Out a) => Out (RecordTree a)++instance (Arbitrary a) => Arbitrary (RecordTree a) where+ arbitrary = sized arbitTree+ where+ arbitTree 0 = liftM2 RNode arbitrary (return [])+ arbitTree n + | n>0 = liftM2 RNode arbitrary childList+ | otherwise = error "tree size should never be < 0"+ where+ childList = resize (floor.sqrt.fromIntegral $ n) (listOf (arbitTree (n`div` 2)) )++checkRecordTree :: RecordTree String -> RecordTree String -> Bool+checkRecordTree _ a = removeSpaces (pretty a) == removeSpaces (show a)+ +rt :: RecordTree Int+rt = RNode (-656565) [RNode 33344 [], RNode 98789 [RNode (-766444) [], RNode 454545 [], RNode 59996 []]]++infixr 5 :*:+infixr 3 :+:+-- tree using infix notation+data InfixTree a = ILeaf a a | (InfixTree a) :*: (InfixTree a) | (InfixTree a) :+: (InfixTree a) + deriving (Show, Generic) + +instance (Out a) => Out (InfixTree a)++instance (Arbitrary a) => Arbitrary (InfixTree a) where+ arbitrary = sized arbitTree+ where+ arbitTree 0 = liftM2 ILeaf arbitrary arbitrary+ arbitTree n + | n>0 = oneof [ liftM2 (:*:) subTree subTree, liftM2 (:+:) subTree subTree]+ | otherwise = error "tree size should never be < 0"+ where+ subTree = arbitTree (n `div` 2)++nt :: InfixTree Int+nt = ILeaf 5454544 55 :*: (ILeaf 5375738 44 :+: ((ILeaf 699879 55 :*: ILeaf 2332323 66 :+: ILeaf 676765 77) + :*: ILeaf 99999 88) ) :+: ILeaf 555 666++checkInfixTree :: InfixTree (Either Int Char) -> InfixTree (Either Int Char) -> Bool+checkInfixTree _ a = removeSpaces (pretty a) == removeSpaces (show a)+ +infixr 5 :^:+-- infix and record tree, also uses a second user defined type in it's definition, 'Wrap'+data InfixRecordTree a = IRLeaf (Wrap a) | (:^:) {left :: InfixRecordTree a, right :: InfixRecordTree a} + deriving (Show, Generic) + +instance (Out a) => Out (InfixRecordTree a)+ +instance (Arbitrary a) => Arbitrary (InfixRecordTree a) where+ arbitrary = sized arbitTree+ where+ arbitTree 0 = liftM IRLeaf arbitrary+ arbitTree n+ | n>0 = liftM2 (:^:) subTree subTree+ | otherwise = error "tree size should never be < 0"+ where+ subTree = arbitTree (n `div` 2)+ +irt :: InfixRecordTree Int+irt = IRLeaf (Wrap 5454544) :^: (IRLeaf (Wrap (-5375738)) :^: ((IRLeaf (Wrap 699879) :^: + (IRLeaf (Wrap (-2332323)) :^: IRLeaf (Wrap 676765))) :^: IRLeaf (Wrap 99999)))++checkInfixRecordTree :: InfixRecordTree Float -> InfixRecordTree Float -> Bool+checkInfixRecordTree _ a = removeSpaces (pretty a) == removeSpaces (show a)+ +-- just a very simple user defined type that is used in IRTree+data Wrap a = Wrap a deriving (Show, Generic)++instance Out a => Out (Wrap a)+ +instance Arbitrary a => Arbitrary (Wrap a) where+ arbitrary = liftM Wrap arbitrary+ +allTests = [ ("FSM (Maybe Int)", quickCheck checkFSM),+ ("BinaryTree (Char)", quickCheck checkBinaryTree),+ ("RecordTree (String)", quickCheck checkRecordTree),+ ("InfixTree (Either Int Char)", quickCheck checkInfixTree),+ ("InfixRecordTree (Float)", quickCheck checkInfixRecordTree)]+ main = mapM_ (\(s,r) -> printf "%-30s: " s >> r) allTests
TestSuite/ZigZagTest.hs view
@@ -1,17 +1,17 @@-{-# LANGUAGE DeriveGeneric #-} - -import Text.PrettyPrint.GenericPretty -import Text.PrettyPrint - -data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic) - -instance (Out a) => Out (Tree a) - -tree1 :: Tree Int -tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) - (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777)) - -zigStyle :: Style -zigStyle = Style {mode = ZigZagMode, lineLength = 30, ribbonsPerLine = 1.5} - +{-# LANGUAGE DeriveGeneric #-}++import Text.PrettyPrint.GenericPretty+import Text.PrettyPrint++data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic)++instance (Out a) => Out (Tree a)++tree1 :: Tree Int+tree1 = Node (Node (Leaf 333333) (Leaf (-555555)))(Node (Node(Node(Leaf 888888) + (Leaf 57575757))(Leaf (-14141414)))(Leaf 7777777))+ +zigStyle :: Style+zigStyle = Style {mode = ZigZagMode, lineLength = 30, ribbonsPerLine = 1.5}+ main = ppStyle zigStyle tree1
Text/PrettyPrint/GenericPretty.hs view
@@ -1,454 +1,456 @@-{-# LANGUAGE TypeOperators, FlexibleInstances, FlexibleContexts, DefaultSignatures #-} - -{-| - GenericPretty is a Haskell library that supports automatic - derivation of pretty printing functions on user defined data - types. - - The output provided is a pretty printed version of that provided by - 'Prelude.show'. That is, rendering the document provided by this pretty - printer yields an output identical to that of 'Prelude.show', except - for extra whitespace. - - For examples of usage please see the README file included in the package. - - For more information see the HackageDB project page: <http://hackage.haskell.org/package/GenericPretty> --} - -module Text.PrettyPrint.GenericPretty - ( - Out(..), - pp, ppLen, ppStyle, pretty, prettyLen, prettyStyle, fullPP, - Generic, - outputIO, outputStr, - ) where - -import Data.List -import GHC.Generics -import Data.Char -import Text.PrettyPrint - --- | The class 'Out' is the equivalent of 'Prelude.Show' --- --- It provides conversion of values to pretty printable Pretty.Doc's. --- --- Minimal complete definition: 'docPrec' or 'doc'. --- --- Derived instances of 'Out' have the following properties --- --- * The result of 'docPrec' is a syntactically correct Haskell --- expression containing only constants, given the fixity --- declarations in force at the point where the type is declared. --- It contains only the constructor names defined in the data type, --- parentheses, and spaces. When labelled constructor fields are --- used, braces, commas, field names, and equal signs are also used. --- --- * If the constructor is defined to be an infix operator, then --- 'docPrec' will produce infix applications of the constructor. --- --- * the representation will be enclosed in parentheses if the --- precedence of the top-level constructor in @x@ is less than @d@ --- (associativity is ignored). Thus, if @d@ is @0@ then the result --- is never surrounded in parentheses; if @d@ is @11@ it is always --- surrounded in parentheses, unless it is an atomic expression. --- --- * If the constructor is defined using record syntax, then 'docPrec' --- will produce the record-syntax form, with the fields given in the --- same order as the original declaration. --- --- For example, given the declarations --- --- --- > data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic) --- --- The derived instance of 'Out' is equivalent to: --- --- > instance (Out a) => Out (Tree a) where --- > --- > docPrec d (Leaf m) = Pretty.sep $ wrapParens (d > appPrec) $ --- > text "Leaf" : [nest (constrLen + parenLen) (docPrec (appPrec+1) m)] --- > where appPrec = 10 --- > constrLen = 5; --- > parenLen = if(d > appPrec) then 1 else 0 --- > --- > docPrec d (Node u v) = Pretty.sep $ wrapParens (d > appPrec) $ --- > text "Node" : --- > nest (constrLen + parenLen) (docPrec (appPrec+1) u) : --- > [nest (constrLen + parenLen) (docPrec (appPrec+1) v)] --- > where appPrec = 10 --- > constrLen = 5 --- > parenLen = if(d > appPrec) then 1 else 0 - -class Out a where - -- | 'docPrec' is the equivalent of 'Prelude.showsPrec'. - -- - -- Convert a value to a pretty printable 'Pretty.Doc'. - docPrec :: Int -- ^ the operator precedence of the enclosing - -- context (a number from @0@ to @11@). - -- Function application has precedence @10@. - -> a -- ^ the value to be converted to a 'String' - -> Doc -- ^ the resulting Doc - default docPrec :: (Generic a ,GOut (Rep a)) => Int -> a -> Doc - docPrec n x = sep $ out1 (from x) Pref n False - - -- | 'doc' is the equivalent of 'Prelude.show' - -- - -- This is a specialised variant of 'docPrec', using precedence context zero. - doc :: a -> Doc - default doc :: (Generic a ,GOut (Rep a)) => a -> Doc - doc x = sep $ out1 (from x) Pref 0 False - - -- | 'docList' is the equivalent of 'Prelude.showList'. - -- - -- The method 'docList' is provided to allow the programmer to - -- give a specialised way of showing lists of values. - -- For example, this is used by the predefined 'Out' instance of - -- the 'Char' type, where values of type 'String' should be shown - -- in double quotes, rather than between square brackets. - docList :: [a] -> Doc - docList = docListWith doc - --- used to define docList, creates output identical to that of show for general list types -docListWith :: (a -> Doc) -> [a] -> Doc -docListWith f = brackets . fcat . punctuate comma . map f - --- returns a list without it's first and last elements --- except if the list has a single element, in which case it returns the list unchanged -middle :: [a] -> [a] -middle [] = [] -middle [x] = [x] -middle (x:xs) = init xs - --- |Utility function used to wrap the passed value in parens if the bool is true. -wrapParens :: Bool -> [Doc] -> [Doc] -wrapParens _ [] = [] -wrapParens False s = s -wrapParens True s - | length s == 1 = [lparen <> head s <> rparen] - |otherwise = [lparen <> head s] ++ middle s ++ [last s <> rparen] - --- show the whole document in one line -showDocOneLine :: Doc -> String -showDocOneLine = fullRender OneLineMode 1 1 outputStr "" - --- The types of data we need to consider for product operator. Record, Prefix and Infix. --- Tuples aren't considered since they're already instances of 'Out' and thus won't pass through that code. -data Type = Rec | Pref | Inf String - ---'GOut' is a helper class used to output the Sum-of-Products type, since it has kind *->*, --- so can't be an instance of 'Out' -class GOut f where - -- |'out1' is the (*->*) kind equivalent of 'docPrec' - out1 :: f x -- The sum of products representation of the user's custom type - -> Type -- The type of multiplication. Record, Prefix or Infix. - -> Int -- The operator precedence, determines wether to wrap stuff in parens. - -> Bool -- A flag, marks wether the constructor directly above was wrapped in parens. - -- Used to determine correct indentation - -> [Doc] -- The result. Each Doc could be on a newline, depending on available space. - -- |'isNullary' marks nullary constructors, so that we don't put parens around them - isNullary :: f x -> Bool - --- if empty, output nothing, this is a null constructor -instance GOut U1 where - out1 _ _ _ _ = [empty] - isNullary _ = True - --- ignore datatype meta-information -instance (GOut f, Datatype c) => GOut (M1 D c f) where - out1 (M1 a) = out1 a - isNullary (M1 a) = isNullary a - --- if there is a selector, display it and it's value + appropriate white space -instance (GOut f, Selector c) => GOut (M1 S c f) where - out1 s@(M1 a) t d p - | selector == "" = out1 a t d p - | otherwise = (text selector <+> char '='):map (nest $ length selector + 3) (out1 a t 0 p) - where - selector = selName s - - isNullary (M1 a) = isNullary a - --- constructor --- here the real type and parens flag is set and propagated forward via t and n, the precedence factor is updated -instance (GOut f, Constructor c) => GOut (M1 C c f) where - out1 c@(M1 a) _ d p = - case fixity of - -- if prefix add the constructor name, nest the result and possibly put it in parens - Prefix -> wrapParens boolParens $ text name: makeMargins t boolParens (out1 a t 11 boolParens) - -- if infix possibly put in parens - Infix _ m -> wrapParens (d>m) $ out1 a t (m+1) (d>m) - where - boolParens = d>10 && (not $ isNullary a) - name = checkInfix $ conName c - fixity = conFixity c - -- get the type of the data, Record, Infix or Prefix. - t = if conIsRecord c then Rec else - case fixity of - Prefix -> Pref - Infix _ _ -> Inf (conName c) - - --add whitespace and possible braces for records - makeMargins :: Type -> Bool -> [Doc] -> [Doc] - makeMargins _ _ [] = [] - makeMargins Rec b s - | length s == 1 = [nest (length name + 1) (lbrace <> head s <> rbrace)] - | otherwise = nest (length name + 1) (lbrace <> head s) : - map (nest $ length name + 2) (middle s ++ [last s <> rbrace]) - makeMargins _ b s = map (nest $ length name + if b then 2 else 1) s - - -- check for infix operators that are acting like prefix ones due to records, put them in parens - checkInfix :: String -> String - checkInfix [] = [] - checkInfix (x:xs) - | fixity == Prefix && (isAlphaNum x || x == '_') = (x:xs) - | otherwise = "(" ++ (x:xs) ++ ")" - - isNullary (M1 a) = isNullary a - --- ignore tagging, call docPrec since these are concrete types -instance (Out f) => GOut (K1 t f) where - out1 (K1 a) _ d _ = [docPrec d a] - isNullary _ = False - --- just continue to the corresponding side of the OR -instance (GOut f, GOut g) => GOut (f :+: g) where - out1 (L1 a) t d p = out1 a t d p - out1 (R1 a) t d p = out1 a t d p - isNullary (L1 a) = isNullary a - isNullary (R1 a) = isNullary a - --- output both sides of the product, possible separated by a comma or an infix operator -instance (GOut f, GOut g) => GOut (f :*: g) where - out1 (f :*: g) t@Rec d p = init pfn ++ [last pfn <> comma] ++ pgn - where - pfn = out1 f t d p - pgn = out1 g t d p - - -- if infix, nest the second value since it isn't nested in the constructor - out1 (f :*: g) t@(Inf s) d p = init pfn ++ [last pfn <+> text s] ++ checkIndent pgn - where - pfn = out1 f t d p - pgn = out1 g t d p - - -- if the second value of the :*: is in parens, nest it, otherwise just check for an extra paren space - -- needs to get the string representation of the first elements in the left and right Doc lists - -- to be able to determine the correct indentation - checkIndent :: [Doc] -> [Doc] - checkIndent [] = [] - checkIndent m@(x:xs) - | parens == 0 = if p then map (nest 1) m else m - | otherwise = map (nest $ cons + 1 + parenSpace) m - where - parenSpace = if p then 1 else 0 - strG = showDocOneLine x - strF = showDocOneLine (head pfn) - parens = length $ takeWhile (== '(') strG - cons = length $ takeWhile( /= ' ') (dropWhile(== '(') strF) - - out1 (f :*: g) t@Pref n p = out1 f t n p ++ out1 g t n p - - isNullary _ = False - --- | 'fullPP' is a fully customizable Pretty Printer --- --- Every other pretty printer just gives some default values to 'fullPP' -fullPP :: (Out a) => (TextDetails -> b -> b) -- ^Function that handles the text conversion /(eg: 'outputIO')/ - -> b -- ^The end element of the result /( eg: "" or putChar('\n') )/ - -> Style -- ^The pretty printing 'Text.PrettyPrint.MyPretty.Style' to use - -> a -- ^The value to pretty print - -> b -- ^The pretty printed result -fullPP td end s a = fullRender (mode s) (lineLength s) (ribbonsPerLine s) td end doc - where - doc = docPrec 0 a - -defaultStyle :: Style -defaultStyle = Style {mode = PageMode, lineLength = 80, ribbonsPerLine = 1.5} - --- | Utility function that handles the text conversion for 'fullPP'. --- --- 'outputIO' transforms the text into 'String's and outputs it directly. -outputIO :: TextDetails -> IO() -> IO() -outputIO td act = do - putStr $ decode td - act - where - decode :: TextDetails -> String - decode (Str s) = s - decode (PStr s1) = s1 - decode (Chr c) = [c] - --- | Utility function that handles the text conversion for 'fullPP'. --- ---'outputStr' just leaves the text as a 'String' which is usefull if you want --- to further process the pretty printed result. -outputStr :: TextDetails -> String -> String -outputStr td str = decode td ++ str - where - decode :: TextDetails -> String - decode (Str s) = s - decode (PStr s1) = s1 - decode (Chr c) = [c] - --- | Customizable pretty printer --- --- Takes a user defined 'Text.PrettyPrint.MyPretty.Style' as a parameter and uses 'outputStr' to obtain the result --- Equivalent to: --- --- > fullPP outputStr "" -prettyStyle :: (Out a) => Style -> a -> String -prettyStyle = fullPP outputStr "" - --- | Semi-customizable pretty printer. --- --- Equivalent to: --- --- > prettyStyle customStyle --- --- Where customStyle uses the specified line length, mode = PageMode and ribbonsPerLine = 1. -prettyLen :: (Out a) => Int -> a -> String -prettyLen l = prettyStyle customStyle - where - customStyle = Style {mode = PageMode, lineLength = l, ribbonsPerLine = 1} - --- | The default pretty printer returning 'String's --- --- Equivalent to --- --- > prettyStyle defaultStyle --- --- Where defaultStyle = (mode=PageMode, lineLength=80, ribbonsPerLine=1.5) -pretty :: (Out a) => a -> String -pretty = prettyStyle defaultStyle - --- | Customizable pretty printer. --- --- Takes a user defined 'Text.PrettyPrint.MyPretty.Style' as a parameter and uses 'outputIO' to obtain the result --- Equivalent to: --- --- > fullPP outputIO (putChar '\n') -ppStyle :: (Out a) => Style -> a -> IO() -ppStyle = fullPP outputIO (putChar '\n') - --- | Semi-customizable pretty printer. --- --- Equivalent to: --- --- > ppStyle customStyle --- --- Where customStyle uses the specified line length, mode = PageMode and ribbonsPerLine = 1. -ppLen :: (Out a) => Int -> a -> IO() -ppLen l = ppStyle customStyle - where - customStyle = Style {mode = PageMode, lineLength = l, ribbonsPerLine = 1} - --- | The default Pretty Printer, --- --- Equivalent to: --- --- > ppStyle defaultStyle --- --- Where defaultStyle = (mode=PageMode, lineLength=80, ribbonsPerLine=1.5) -pp :: (Out a) => a -> IO() -pp = ppStyle defaultStyle - - --- define some instances of Out making sure to generate output identical to 'show' modulo the extra whitespace -instance Out () where - doc _ = text "()" - docPrec _ = doc - -instance Out Char where - doc a = char '\'' <> (text.middle.show $ a) <> char '\'' - docPrec _ = doc - docList xs = text $ show xs - -instance Out Int where - docPrec n x - | n/=0 && x<0 = parens $ int x - | otherwise = int x - doc = docPrec 0 - -instance Out Integer where - docPrec n x - | n/=0 && x<0 = parens $ integer x - | otherwise = integer x - doc = docPrec 0 - -instance Out Float where - docPrec n x - | n/=0 && x<0 = parens $ float x - | otherwise = float x - doc = docPrec 0 - -instance Out Double where - docPrec n x - | n/=0 && x<0 = parens $ double x - | otherwise = double x - doc = docPrec 0 - -instance Out Rational where - docPrec n x - | n/=0 && x<0 = parens $ rational x - | otherwise = rational x - doc = docPrec 0 - -instance Out a => Out [a] where - doc = docList - docPrec _ = doc - -instance Out Bool where - doc True = text "True" - doc False = text "False" - docPrec _ = doc - -instance Out a => Out (Maybe a) where - docPrec n Nothing = text "Nothing" - docPrec n (Just x) - | n/=0 = parens result - |otherwise = result - where - result = text "Just" <+> docPrec 10 x - doc = docPrec 0 - -instance (Out a, Out b) => Out (Either a b) where - docPrec n (Left x) - | n/=0 = parens result - | otherwise = result - where - result = text "Left" <+> docPrec 10 x - docPrec n (Right y) - | n/=0 = parens result - | otherwise = result - where - result = text "Right" <+> docPrec 10 y - doc = docPrec 0 - -instance (Out a, Out b) => Out (a, b) where - doc (a,b) = parens (sep [doc a <> comma, doc b]) - docPrec _ = doc - -instance (Out a, Out b, Out c) => Out (a, b, c) where - doc (a,b,c) = parens (sep [doc a <> comma, doc b <> comma, doc c]) - docPrec _ = doc - -instance (Out a, Out b, Out c, Out d) => Out (a, b, c, d) where - doc (a,b,c,d) = parens (sep [doc a <> comma, doc b <> comma, doc c <> comma, doc d]) - docPrec _ = doc - -instance (Out a, Out b, Out c, Out d, Out e) => Out (a, b, c, d, e) where - doc (a,b,c,d,e) = parens (sep [doc a <> comma, doc b <> comma, doc c <> comma, doc d <> comma, doc e]) - docPrec _ = doc - -instance (Out a, Out b, Out c, Out d, Out e, Out f) - => Out (a, b, c, d, e, f) where - doc (a, b, c, d, e, f) = - parens (sep [ doc a <> comma, doc b <> comma, doc c <> comma, - doc d <> comma, doc e <> comma, doc f]) - docPrec _ = doc - -instance (Out a, Out b, Out c, Out d, Out e, Out f, Out g) - => Out (a, b, c, d, e, f, g) where - doc (a, b, c, d, e, f, g) = - parens (sep [ doc a <> comma, doc b <> comma, doc c <> comma, - doc d <> comma, doc e <> comma, doc f <> comma, doc g]) +{-# LANGUAGE TypeOperators, FlexibleInstances, FlexibleContexts, DefaultSignatures #-}++{-|+ GenericPretty is a Haskell library that supports automatic+ derivation of pretty printing functions on user defined data+ types.+ + The output provided is a pretty printed version of that provided by+ 'Prelude.show'. That is, rendering the document provided by this pretty+ printer yields an output identical to that of 'Prelude.show', except+ for extra whitespace.+ + For examples of usage please see the README file included in the package.+ + For more information see the HackageDB project page: <http://hackage.haskell.org/package/GenericPretty> +-}++module Text.PrettyPrint.GenericPretty + (+ Out(..), + pp, ppLen, ppStyle, pretty, prettyLen, prettyStyle, fullPP, + Generic,+ outputIO, outputStr,+ ) where++import Data.List+import GHC.Generics+import Data.Char+import Text.PrettyPrint++-- | The class 'Out' is the equivalent of 'Prelude.Show'+--+-- It provides conversion of values to pretty printable Pretty.Doc's.+--+-- Minimal complete definition: 'docPrec' or 'doc'.+--+-- Derived instances of 'Out' have the following properties+--+-- * The result of 'docPrec' is a syntactically correct Haskell+-- expression containing only constants, given the fixity+-- declarations in force at the point where the type is declared.+-- It contains only the constructor names defined in the data type,+-- parentheses, and spaces. When labelled constructor fields are+-- used, braces, commas, field names, and equal signs are also used.+--+-- * If the constructor is defined to be an infix operator, then+-- 'docPrec' will produce infix applications of the constructor.+--+-- * the representation will be enclosed in parentheses if the+-- precedence of the top-level constructor in @x@ is less than @d@+-- (associativity is ignored). Thus, if @d@ is @0@ then the result+-- is never surrounded in parentheses; if @d@ is @11@ it is always+-- surrounded in parentheses, unless it is an atomic expression.+--+-- * If the constructor is defined using record syntax, then 'docPrec'+-- will produce the record-syntax form, with the fields given in the+-- same order as the original declaration.+--+-- For example, given the declarations+--+-- +-- > data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Generic)+--+-- The derived instance of 'Out' is equivalent to:+--+-- > instance (Out a) => Out (Tree a) where+-- > +-- > docPrec d (Leaf m) = Pretty.sep $ wrapParens (d > appPrec) $+-- > text "Leaf" : [nest (constrLen + parenLen) (docPrec (appPrec+1) m)]+-- > where appPrec = 10+-- > constrLen = 5;+-- > parenLen = if(d > appPrec) then 1 else 0+-- > +-- > docPrec d (Node u v) = Pretty.sep $ wrapParens (d > appPrec) $+-- > text "Node" : +-- > nest (constrLen + parenLen) (docPrec (appPrec+1) u) : +-- > [nest (constrLen + parenLen) (docPrec (appPrec+1) v)]+-- > where appPrec = 10+-- > constrLen = 5+-- > parenLen = if(d > appPrec) then 1 else 0++class Out a where+ -- | 'docPrec' is the equivalent of 'Prelude.showsPrec'.+ --+ -- Convert a value to a pretty printable 'Pretty.Doc'.+ docPrec :: Int -- ^ the operator precedence of the enclosing+ -- context (a number from @0@ to @11@).+ -- Function application has precedence @10@. + -> a -- ^ the value to be converted to a 'String'+ -> Doc -- ^ the resulting Doc+ default docPrec :: (Generic a ,GOut (Rep a)) => Int -> a -> Doc+ docPrec n x = sep $ out1 (from x) Pref n False+ + -- | 'doc' is the equivalent of 'Prelude.show'+ --+ -- This is a specialised variant of 'docPrec', using precedence context zero.+ doc :: a -> Doc+ default doc :: (Generic a ,GOut (Rep a)) => a -> Doc+ doc x = sep $ out1 (from x) Pref 0 False+ + -- | 'docList' is the equivalent of 'Prelude.showList'.+ --+ -- The method 'docList' is provided to allow the programmer to+ -- give a specialised way of showing lists of values.+ -- For example, this is used by the predefined 'Out' instance of+ -- the 'Char' type, where values of type 'String' should be shown+ -- in double quotes, rather than between square brackets.+ docList :: [a] -> Doc+ docList = docListWith doc++-- used to define docList, creates output identical to that of show for general list types+docListWith :: (a -> Doc) -> [a] -> Doc+docListWith f = brackets . fcat . punctuate comma . map f+ +-- returns a list without it's first and last elements+-- except if the list has a single element, in which case it returns the list unchanged+middle :: [a] -> [a]+middle [] = []+middle [x] = [x]+middle (x:xs) = init xs++-- |Utility function used to wrap the passed value in parens if the bool is true.+wrapParens :: Bool -> [Doc] -> [Doc]+wrapParens _ [] = []+wrapParens False s = s+wrapParens True s+ | length s == 1 = [lparen <> head s <> rparen]+ |otherwise = [lparen <> head s] ++ middle s ++ [last s <> rparen]+ +-- show the whole document in one line+showDocOneLine :: Doc -> String+showDocOneLine = fullRender OneLineMode 1 1 outputStr ""+ +-- The types of data we need to consider for product operator. Record, Prefix and Infix.+-- Tuples aren't considered since they're already instances of 'Out' and thus won't pass through that code.+data Type = Rec | Pref | Inf String++--'GOut' is a helper class used to output the Sum-of-Products type, since it has kind *->*, +-- so can't be an instance of 'Out'+class GOut f where+ -- |'out1' is the (*->*) kind equivalent of 'docPrec'+ out1 :: f x -- The sum of products representation of the user's custom type+ -> Type -- The type of multiplication. Record, Prefix or Infix.+ -> Int -- The operator precedence, determines wether to wrap stuff in parens.+ -> Bool -- A flag, marks wether the constructor directly above was wrapped in parens.+ -- Used to determine correct indentation+ -> [Doc] -- The result. Each Doc could be on a newline, depending on available space.+ -- |'isNullary' marks nullary constructors, so that we don't put parens around them+ isNullary :: f x -> Bool+ +-- if empty, output nothing, this is a null constructor+instance GOut U1 where+ out1 _ _ _ _ = [empty]+ isNullary _ = True+ +-- ignore datatype meta-information+instance (GOut f, Datatype c) => GOut (M1 D c f) where+ out1 (M1 a) = out1 a+ isNullary (M1 a) = isNullary a+ +-- if there is a selector, display it and it's value + appropriate white space+instance (GOut f, Selector c) => GOut (M1 S c f) where+ out1 s@(M1 a) t d p+ | selector == "" = out1 a t d p+ | otherwise = (text selector <+> char '='):map (nest $ length selector + 3) (out1 a t 0 p)+ where+ selector = selName s+ + isNullary (M1 a) = isNullary a++-- constructor+-- here the real type and parens flag is set and propagated forward via t and n, the precedence factor is updated+instance (GOut f, Constructor c) => GOut (M1 C c f) where+ out1 c@(M1 a) _ d p = + case fixity of+ -- if prefix add the constructor name, nest the result and possibly put it in parens+ Prefix -> wrapParens boolParens $ text name: makeMargins t boolParens (out1 a t 11 boolParens)+ -- if infix possibly put in parens+ Infix _ m -> wrapParens (d>m) $ out1 a t (m+1) (d>m)+ where + boolParens = d>10 && (not $ isNullary a)+ name = checkInfix $ conName c+ fixity = conFixity c+ -- get the type of the data, Record, Infix or Prefix. + t = if conIsRecord c then Rec else+ case fixity of+ Prefix -> Pref+ Infix _ _ -> Inf (conName c)+ + --add whitespace and possible braces for records+ makeMargins :: Type -> Bool -> [Doc] -> [Doc]+ makeMargins _ _ [] = []+ makeMargins Rec b s + | length s == 1 = [nest (length name + 1) (lbrace <> head s <> rbrace)]+ | otherwise = nest (length name + 1) (lbrace <> head s) : + map (nest $ length name + 2) (middle s ++ [last s <> rbrace])+ makeMargins _ b s = map (nest $ length name + if b then 2 else 1) s+ + -- check for infix operators that are acting like prefix ones due to records, put them in parens+ checkInfix :: String -> String+ checkInfix [] = []+ checkInfix (x:xs)+ | fixity == Prefix && (isAlphaNum x || x == '_') = (x:xs)+ | otherwise = "(" ++ (x:xs) ++ ")"+ + isNullary (M1 a) = isNullary a+ +-- ignore tagging, call docPrec since these are concrete types+instance (Out f) => GOut (K1 t f) where+ out1 (K1 a) _ d _ = [docPrec d a]+ isNullary _ = False++-- just continue to the corresponding side of the OR+instance (GOut f, GOut g) => GOut (f :+: g) where+ out1 (L1 a) t d p = out1 a t d p+ out1 (R1 a) t d p = out1 a t d p+ isNullary (L1 a) = isNullary a+ isNullary (R1 a) = isNullary a+ +-- output both sides of the product, possible separated by a comma or an infix operator+instance (GOut f, GOut g) => GOut (f :*: g) where+ out1 (f :*: g) t@Rec d p = init pfn ++ [last pfn <> comma] ++ pgn+ where + pfn = out1 f t d p+ pgn = out1 g t d p+ + -- if infix, nest the second value since it isn't nested in the constructor + out1 (f :*: g) t@(Inf s) d p = init pfn ++ [last pfn <+> text s] ++ checkIndent pgn+ where+ pfn = out1 f t d p+ pgn = out1 g t d p+ + -- if the second value of the :*: is in parens, nest it, otherwise just check for an extra paren space+ -- needs to get the string representation of the first elements in the left and right Doc lists + -- to be able to determine the correct indentation+ checkIndent :: [Doc] -> [Doc]+ checkIndent [] = []+ checkIndent m@(x:xs)+ | parens == 0 = if p then map (nest 1) m else m+ | otherwise = map (nest $ cons + 1 + parenSpace) m+ where+ parenSpace = if p then 1 else 0+ strG = showDocOneLine x+ strF = showDocOneLine (head pfn)+ parens = length $ takeWhile (== '(') strG+ cons = length $ takeWhile( /= ' ') (dropWhile(== '(') strF) + + out1 (f :*: g) t@Pref n p = out1 f t n p ++ out1 g t n p+ + isNullary _ = False+ +-- | 'fullPP' is a fully customizable Pretty Printer+--+-- Every other pretty printer just gives some default values to 'fullPP' +fullPP :: (Out a) => (TextDetails -> b -> b) -- ^Function that handles the text conversion /(eg: 'outputIO')/+ -> b -- ^The end element of the result /( eg: "" or putChar('\n') )/+ -> Style -- ^The pretty printing 'Text.PrettyPrint.MyPretty.Style' to use+ -> a -- ^The value to pretty print+ -> b -- ^The pretty printed result+fullPP td end s a = fullRender (mode s) (lineLength s) (ribbonsPerLine s) td end doc+ where+ doc = docPrec 0 a+ +defaultStyle :: Style+defaultStyle = Style {mode = PageMode, lineLength = 80, ribbonsPerLine = 1.5}++-- | Utility function that handles the text conversion for 'fullPP'.+--+-- 'outputIO' transforms the text into 'String's and outputs it directly.+outputIO :: TextDetails -> IO() -> IO()+outputIO td act = do+ putStr $ decode td+ act+ where+ decode :: TextDetails -> String+ decode (Str s) = s+ decode (PStr s1) = s1+ decode (Chr c) = [c]+ +-- | Utility function that handles the text conversion for 'fullPP'. +--+--'outputStr' just leaves the text as a 'String' which is usefull if you want +-- to further process the pretty printed result.+outputStr :: TextDetails -> String -> String+outputStr td str = decode td ++ str+ where+ decode :: TextDetails -> String+ decode (Str s) = s+ decode (PStr s1) = s1+ decode (Chr c) = [c]++-- | Customizable pretty printer +--+-- Takes a user defined 'Text.PrettyPrint.MyPretty.Style' as a parameter and uses 'outputStr' to obtain the result+--+-- Equivalent to:+--+-- > fullPP outputStr ""+prettyStyle :: (Out a) => Style -> a -> String+prettyStyle = fullPP outputStr ""++-- | Semi-customizable pretty printer. +--+-- Equivalent to:+--+-- > prettyStyle customStyle+-- +-- Where customStyle uses the specified line length, mode = PageMode and ribbonsPerLine = 1. +prettyLen :: (Out a) => Int -> a -> String+prettyLen l = prettyStyle customStyle+ where+ customStyle = Style {mode = PageMode, lineLength = l, ribbonsPerLine = 1}++-- | The default pretty printer returning 'String's+--+-- Equivalent to+--+-- > prettyStyle defaultStyle+--+-- Where defaultStyle = (mode=PageMode, lineLength=80, ribbonsPerLine=1.5)+pretty :: (Out a) => a -> String+pretty = prettyStyle defaultStyle++-- | Customizable pretty printer.+-- +-- Takes a user defined 'Text.PrettyPrint.MyPretty.Style' as a parameter and uses 'outputIO' to obtain the result+--+-- Equivalent to:+--+-- > fullPP outputIO (putChar '\n')+ppStyle :: (Out a) => Style -> a -> IO()+ppStyle = fullPP outputIO (putChar '\n')++-- | Semi-customizable pretty printer. +--+-- Equivalent to:+--+-- > ppStyle customStyle+-- +-- Where customStyle uses the specified line length, mode = PageMode and ribbonsPerLine = 1. +ppLen :: (Out a) => Int -> a -> IO()+ppLen l = ppStyle customStyle+ where+ customStyle = Style {mode = PageMode, lineLength = l, ribbonsPerLine = 1}++-- | The default Pretty Printer,+--+-- Equivalent to:+--+-- > ppStyle defaultStyle+--+-- Where defaultStyle = (mode=PageMode, lineLength=80, ribbonsPerLine=1.5)+pp :: (Out a) => a -> IO()+pp = ppStyle defaultStyle++ +-- define some instances of Out making sure to generate output identical to 'show' modulo the extra whitespace+instance Out () where+ doc _ = text "()"+ docPrec _ = doc+ +instance Out Char where+ doc a = char '\'' <> (text.middle.show $ a) <> char '\''+ docPrec _ = doc+ docList xs = text $ show xs+ +instance Out Int where+ docPrec n x+ | n/=0 && x<0 = parens $ int x+ | otherwise = int x+ doc = docPrec 0+ +instance Out Integer where+ docPrec n x+ | n/=0 && x<0 = parens $ integer x+ | otherwise = integer x+ doc = docPrec 0++instance Out Float where+ docPrec n x+ | n/=0 && x<0 = parens $ float x+ | otherwise = float x+ doc = docPrec 0++instance Out Double where+ docPrec n x+ | n/=0 && x<0 = parens $ double x+ | otherwise = double x+ doc = docPrec 0+ +instance Out Rational where+ docPrec n x+ | n/=0 && x<0 = parens $ rational x+ | otherwise = rational x+ doc = docPrec 0+ +instance Out a => Out [a] where+ doc = docList+ docPrec _ = doc+ +instance Out Bool where+ doc True = text "True"+ doc False = text "False"+ docPrec _ = doc++instance Out a => Out (Maybe a) where+ docPrec n Nothing = text "Nothing"+ docPrec n (Just x)+ | n/=0 = parens result+ |otherwise = result+ where+ result = text "Just" <+> docPrec 10 x+ doc = docPrec 0++instance (Out a, Out b) => Out (Either a b) where+ docPrec n (Left x)+ | n/=0 = parens result+ | otherwise = result+ where+ result = text "Left" <+> docPrec 10 x+ docPrec n (Right y)+ | n/=0 = parens result+ | otherwise = result+ where+ result = text "Right" <+> docPrec 10 y+ doc = docPrec 0++instance (Out a, Out b) => Out (a, b) where+ doc (a,b) = parens (sep [doc a <> comma, doc b])+ docPrec _ = doc+ +instance (Out a, Out b, Out c) => Out (a, b, c) where+ doc (a,b,c) = parens (sep [doc a <> comma, doc b <> comma, doc c])+ docPrec _ = doc++instance (Out a, Out b, Out c, Out d) => Out (a, b, c, d) where+ doc (a,b,c,d) = parens (sep [doc a <> comma, doc b <> comma, doc c <> comma, doc d])+ docPrec _ = doc++instance (Out a, Out b, Out c, Out d, Out e) => Out (a, b, c, d, e) where+ doc (a,b,c,d,e) = parens (sep [doc a <> comma, doc b <> comma, doc c <> comma, doc d <> comma, doc e])+ docPrec _ = doc++instance (Out a, Out b, Out c, Out d, Out e, Out f) + => Out (a, b, c, d, e, f) where+ doc (a, b, c, d, e, f) = + parens (sep [ doc a <> comma, doc b <> comma, doc c <> comma, + doc d <> comma, doc e <> comma, doc f])+ docPrec _ = doc+ +instance (Out a, Out b, Out c, Out d, Out e, Out f, Out g) + => Out (a, b, c, d, e, f, g) where+ doc (a, b, c, d, e, f, g) = + parens (sep [ doc a <> comma, doc b <> comma, doc c <> comma, + doc d <> comma, doc e <> comma, doc f <> comma, doc g]) docPrec _ = doc