text-generic-pretty (empty) → 1.2.1
raw patch · 15 files changed
+1774/−0 lines, 15 filesdep +QuickCheckdep +basedep +containerssetup-changed
Dependencies added: QuickCheck, base, containers, ghc-prim, groom, ixset-typed, protolude, string-conversions, tasty, tasty-hunit, tasty-quickcheck, text, text-generic-pretty, time, unordered-containers, wl-pprint-text
Files
- LICENSE +30/−0
- README +269/−0
- Setup.hs +2/−0
- src/Text/PrettyPrint/GenericPretty.hs +305/−0
- src/Text/PrettyPrint/GenericPrettyStructure.hs +236/−0
- src/Text/PrettyPrint/GenericStructure.hs +224/−0
- src/Text/PrettyPrint/TestGenericPretty.hs +263/−0
- test/GenericPretty/Tests.hs +86/−0
- test/K1.hs +23/−0
- test/Product.hs +27/−0
- test/Spec.hs +14/−0
- test/Sum.hs +26/−0
- test/TestData.hs +108/−0
- test/U1.hs +23/−0
- text-generic-pretty.cabal +138/−0
+ LICENSE view
@@ -0,0 +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.
+ README view
@@ -0,0 +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:+ Razvan Ranca - ranca.razvan@gmail.com
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Text/PrettyPrint/GenericPretty.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++{-|+ 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+ ( Pretty(..)+ , Generic+ , displayPrettyL+ , displayPretty+ , displayPrettyLenL+ , displayPrettyLen+ , displayPrettyPrefixL+ , displayPrettyPrefix+ ) where++import qualified Data.HashMap.Strict+import qualified Data.IntMap.Strict+import Data.IxSet.Typed (Indexable)+import qualified Data.IxSet.Typed+import qualified Data.Map.Strict+import Data.String.Conversions (cs)+import qualified Data.Text as T+import Data.Text.Lazy (Text, fromStrict)+import Data.Time+import GHC.Generics+import Protolude hiding (Text, bool,+ (<$>), (<>))+import Text.PrettyPrint.Leijen.Text hiding (Pretty (..),+ (<>))+import qualified Text.PrettyPrint.Leijen.Text as PP++-- | The class 'Pretty' is the equivalent of 'Prelude.Show'+--+-- It provides conversion of values to pretty printable Pretty.Doc's.+--+class Pretty a where+ pretty :: a -> Doc+ default pretty :: (Generic a, GPretty (Rep a)) =>+ a -> Doc+ pretty x =+ case (gpretty . from) x of+ (o:[]) -> o+ os -> PP.list os++--'GPretty' is a helper class used to output the Sum-of-Products type, since it has kind *->*,+-- so can't be an instance of 'Pretty'+class GPretty f+ -- |'gpretty' is the (*->*) kind equivalent of 'docPrec'+ where+ gpretty :: f x -> [Doc]++-- if empty, output nothing, this is a null constructor+instance GPretty U1 where+ gpretty _ = []++-- ignore datatype meta-information+instance (GPretty f) =>+ GPretty (M1 D c f) where+ gpretty (M1 a) = gpretty a++instance (GPretty f, Selector c) =>+ GPretty (M1 S c f) where+ gpretty s@(M1 a)+ | selector == "" = gpretty a+ | otherwise =+ if null components+ then []+ else [ nest+ prefixLength+ (string (cs selector) <+> char '=' <+> cat components)+ ]+ where+ selector = selName s+ components = gpretty a+ prefixLength = length selector + 3++-- | otherwise = Just PP.empty+-- constructor+-- here the real type and parens flag is set and propagated forward via t and n, the precedence factor is updated+-- let prefixLength = (succ . succ . length . conName) c+-- let prefixLength = (succ . succ . length . conName) c+-- let prefixLength = 1+-- in [nest prefixLength ( parens ((string . cs . conName) c <+> (align . sep) components))]+instance (GPretty f, Constructor c) =>+ GPretty (M1 C c f) where+ gpretty c@(M1 a)+ | null components = [(string . cs . conName) c]+ | conIsRecord c =+ let prefixLength = 1+ in [ nest+ prefixLength+ ((string . cs . conName) c <$>+ (braces . nest 1 . fillSep . punctuate comma) components)+ ]+ | otherwise =+ [parens ((string . cs . conName) c <+> (align . sep) components)]+ where+ components = gpretty a++-- ignore tagging, call docPrec since these are concrete types+instance (Pretty f) =>+ GPretty (K1 t f) where+ gpretty (K1 a) = [(pretty a)]++-- output both sides of the product, possible separated by a comma or an infix operator+instance (GPretty a, GPretty b) =>+ GPretty (a :*: b) where+ gpretty (x :*: y) = xs ++ ys+ where+ xs = gpretty x+ ys = gpretty y++-- just continue to the corresponding side of the OR+instance (GPretty a, GPretty b) =>+ GPretty (a :+: b) where+ gpretty (L1 x) = gpretty x+ gpretty (R1 x) = gpretty x++instance Pretty Char where+ pretty = squotes . char++instance Pretty Text where+ pretty = dquotes . string++instance Pretty T.Text where+ pretty = pretty . fromStrict++instance Pretty Int where+ pretty i =+ if i < 0+ then (parens . int) i+ else int i++instance Pretty Integer where+ pretty i =+ if i < 0+ then (parens . integer) i+ else integer i++instance Pretty Float where+ pretty i =+ if i < 0+ then (parens . float) i+ else float i++instance Pretty Double where+ pretty i =+ if i < 0+ then (parens . double) i+ else double i++instance Pretty Rational where+ pretty = rational++instance Pretty Bool where+ pretty = bool++instance Pretty ByteString where+ pretty = (pretty :: Text -> Doc) . cs++instance Pretty a =>+ Pretty [a] where+ pretty = brackets . align . fillCat . punctuate comma . fmap pretty++-- pretty (Just x) = nest 3 (text "Just" <$> pretty x)+instance Pretty a =>+ Pretty (Maybe a) where+ pretty Nothing = text "Nothing"+ pretty (Just x) = nest 5 (text "Just" <+> pretty x)++-- pretty (Left x) = nest 3 ( text "Left" <$> pretty x)+-- pretty (Right y) = nest 3 ( text "Right" <$> pretty y)+instance (Pretty a, Pretty b) =>+ Pretty (Either a b) where+ pretty (Left x) = nest 5 (text "Left" <$> pretty x)+ pretty (Right y) = nest 5 (text "Right" <$> pretty y)++instance (Pretty a, Pretty b) =>+ Pretty (a, b) where+ pretty (a, b) = tupled [pretty a, pretty b]++instance (Pretty a, Pretty b, Pretty c) =>+ Pretty (a, b, c) where+ pretty (a, b, c) = tupled [pretty a, pretty b, pretty c]++instance (Pretty a, Pretty b, Pretty c, Pretty d) =>+ Pretty (a, b, c, d) where+ pretty (a, b, c, d) = tupled [pretty a, pretty b, pretty c, pretty d]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) =>+ Pretty (a, b, c, d, e) where+ pretty (a, b, c, d, e) =+ tupled [pretty a, pretty b, pretty c, pretty d, pretty e]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) =>+ Pretty (a, b, c, d, e, f) where+ pretty (a, b, c, d, e, f) =+ tupled [pretty a, pretty b, pretty c, pretty d, pretty e, pretty f]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g) =>+ Pretty (a, b, c, d, e, f, g) where+ pretty (a, b, c, d, e, f, g) =+ tupled+ [pretty a, pretty b, pretty c, pretty d, pretty e, pretty f, pretty g]++instance (Pretty a, Pretty b) =>+ Pretty (Data.Map.Strict.Map a b) where+ pretty v = text "fromList" <+> (pretty . Data.Map.Strict.toList) v++instance (Pretty a) =>+ Pretty (Data.IntMap.Strict.IntMap a) where+ pretty v = text "fromList" <+> (pretty . Data.IntMap.Strict.toList) v++instance (Pretty a, Pretty b) =>+ Pretty (Data.HashMap.Strict.HashMap a b) where+ pretty v = text "fromList" <+> (pretty . Data.HashMap.Strict.toList) v++instance Pretty UTCTime where+-- pretty = text . cs . formatTime defaultTimeLocale rfc822DateFormat+-- though the above looks better, the below can be read back+ pretty = text . cs . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z"++instance (Show a, Indexable ixs a) =>+ Pretty (Data.IxSet.Typed.IxSet ixs a) where+ pretty = text . show++instance Pretty Word where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Word8 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Word16 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Word32 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Word64 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Int8 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Int16 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Int32 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Int64 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++displayPrettyLenL+ :: Pretty a+ => Int -> a -> Text+displayPrettyLenL l = PP.displayT . PP.renderPretty 1.0 l . pretty++displayPrettyLen+ :: Pretty a+ => Int -> a -> T.Text+displayPrettyLen l = toStrict . displayPrettyLenL l++displayPrettyL+ :: Pretty a+ => a -> Text+displayPrettyL = displayPrettyLenL 70++-- displayPretty+-- :: (Show a, Pretty a)+-- => a -> T.Text+-- displayPretty = toStrict . displayPrettyL . (\x -> trace ("calling displayPretty: " ++ show x) x)+displayPretty+ :: Pretty a+ => a -> T.Text+displayPretty = toStrict . displayPrettyL++displayPrettyPrefixL+ :: (Pretty a, Pretty b)+ => a -> b -> Text+displayPrettyPrefixL prefix =+ PP.displayT . PP.renderPretty 1.0 70 . (PP.<>) (pretty prefix) . pretty++displayPrettyPrefix+ :: (Pretty a, Pretty b)+ => a -> b -> T.Text+displayPrettyPrefix prefix = toStrict . displayPrettyPrefixL prefix
+ src/Text/PrettyPrint/GenericPrettyStructure.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++module Text.PrettyPrint.GenericPrettyStructure+ ( PrettyStructure(..)+ , Generic+ , displayPrettyStructure+ , prettyStructure+ ) where++import qualified Data.HashMap.Strict+import qualified Data.IntMap+import Data.IxSet.Typed (Indexable)+import qualified Data.IxSet.Typed+import qualified Data.Map+import Data.String.Conversions (cs)+import qualified Data.Text as T+import Data.Text.Lazy (Text, append,+ fromStrict,+ intercalate, singleton,+ unlines, unwords)+import Data.Time+import GHC.Generics+import Protolude hiding (Text, bool,+ intercalate,+ intersperse)+import Text.PrettyPrint.Leijen.Text hiding (Pretty (..),+ (<$>), (<>))+import qualified Text.PrettyPrint.Leijen.Text as PP++-- | The class 'PrettyStructure' is the equivalent of 'Prelude.Show'+--+-- It provides conversion of values to prettyStructure printable PrettyStructure.Text's.+--+class PrettyStructure a where+ prettyStructure :: a -> Doc+ default prettyStructure :: (Generic a, GPrettyStructure (Rep a)) =>+ a -> Doc+ prettyStructure x =+ string "prettyStructure begin" PP.<$>+ nest 3 (fillSep ((gprettyStructure . from) x)) PP.<$>+ string "prettyStructure end"++-- prettyStructure x = case (gprettyStructure . from) x of+-- (o:[]) -> o+-- os -> PP.list os+--'GPrettyStructure' is a helper class used to output the Sum-of-Products type, since it has kind *->*,+-- so can't be an instance of 'PrettyStructure'+class GPrettyStructure f+ -- |'gprettyStructure' is the (*->*) kind equivalent of 'docPrec'+ where+ gprettyStructure :: f x -> [Doc]++-- if empty, output nothing, this is a null constructor+instance GPrettyStructure U1 where+ gprettyStructure _ = [string "M1 U Begin" PP.<> string "M1 U End"]++-- , append "datatypeName: " ((show . datatypeName) a)+-- , append "moduleName: " ((cs . moduleName) d)+-- , append "packageName: " ((cs . packageName) d)+-- , append "isNewtype: " ((show . isNewtype) d)+-- ignore datatype meta-information+instance (GPrettyStructure f) =>+ GPrettyStructure (M1 D c f) where+ gprettyStructure (M1 a) =+ [ (string "M1 D Begin") PP.<$>+ ((nest 3 . fillSep) (gprettyStructure a)) PP.<$> (string "M1 D End")+ ]++instance (GPrettyStructure f, Selector c) =>+ GPrettyStructure (M1 S c f) where+ gprettyStructure s@(M1 a) =+ [string "M1 S Begin" PP.<$>+ (nest 3 . fillSep) [ string ("selName: " <> (cs . selName) s)+ , fillSep (gprettyStructure a)]+ PP.<$> string "M1 S End"+ ]++-- constructor+-- here the real type and parens flag is set and propagated forward via t and n, the precedence factor is updated+instance (GPrettyStructure f, Constructor c) =>+ GPrettyStructure (M1 C c f) where+ gprettyStructure c@(M1 a) =+ [ string "M1 C Begin" PP.<$>+ (nest 3 . fillSep)[+ string ("conName: " <> (cs . conName) c)+ , string ("conFixity: " <> (show . conFixity) c)+ , string ("conIsRecord: " <> (show . conIsRecord) c)+ , fillSep (gprettyStructure a)+ ]+ PP.<$> string "M1 C End"+ ]++-- ignore tagging, call docPrec since these are concrete types+instance (PrettyStructure f) =>+ GPrettyStructure (K1 t f) where+ gprettyStructure (K1 a) =+-- [string "M1 K Begin" <+> (nest 3 . prettyStructure) a PP.<+> string "M1 K End"]+ [string "M1 K Begin" PP.<$> (nest 3 . prettyStructure) a PP.<$> string "M1 K End"]++-- just continue to the corresponding side of the OR+instance (GPrettyStructure a, GPrettyStructure b) =>+ GPrettyStructure (a :+: b) where+ gprettyStructure (L1 x) =+ [ string "M1 :+: L1 Begin" PP.<$>+ (nest 3 . fillSep) (gprettyStructure x)+ PP.<$> string "M1 :+: L1 End"+ ]+-- [ vcat [ string "M1 :+: L1 Begin"+-- , (nest 1 . nest 3 . fillSep) (gprettyStructure x)+-- , string "\nM1 :+: L1 End"]+-- ]+-- [ string "M1 :+: L1 Begin" <+>+-- (nest 3 . fillSep) (gprettyStructure x)+-- PP.<> string "\nM1 :+: L1 End"+-- ]+ gprettyStructure (R1 x) =+ [ string "M1 :*: R1 Begin" PP.<$>+ (nest 3 . fillSep) (gprettyStructure x)+ PP.<$> string "M1 :*: R1 End"+ ]++-- output both sides of the product, possible separated by a comma or an infix operator+instance (GPrettyStructure a, GPrettyStructure b) =>+ GPrettyStructure (a :*: b) where+ gprettyStructure (x :*: y) =+ [ sep+ [ string "M1 :*: Begin"+ , (nest 1 . sep) (gprettyStructure x)+ , string ":*:"+ , (nest 1 . sep) (gprettyStructure y)+ , string "M1 :*: End"+ ]+ ]++instance PrettyStructure Char where+ prettyStructure = char++instance PrettyStructure Text where+ prettyStructure = string++instance PrettyStructure T.Text where+ prettyStructure = string . fromStrict++instance PrettyStructure Int where+ prettyStructure = int++instance PrettyStructure Integer where+ prettyStructure = integer++instance PrettyStructure Float where+ prettyStructure = float++instance PrettyStructure Double where+ prettyStructure = double++instance PrettyStructure Rational where+ prettyStructure = rational++instance PrettyStructure Bool where+ prettyStructure = bool++instance PrettyStructure ByteString where+ prettyStructure = string . cs++instance PrettyStructure a =>+ PrettyStructure [a] where+ prettyStructure = PP.list . fmap prettyStructure++instance PrettyStructure a =>+ PrettyStructure (Maybe a) where+ prettyStructure Nothing = "Nothing"+ prettyStructure (Just x) = sep [string "Just", prettyStructure x]++instance (PrettyStructure a, PrettyStructure b) =>+ PrettyStructure (Either a b) where+ prettyStructure (Left x) = sep [string "Left", prettyStructure x]+ prettyStructure (Right y) = sep [string "Right", prettyStructure y]++instance (PrettyStructure a, PrettyStructure b) =>+ PrettyStructure (a, b) where+ prettyStructure (a, b) = tupled [prettyStructure a, prettyStructure b]++instance (PrettyStructure a, PrettyStructure b) =>+ PrettyStructure (Data.Map.Map a b) where+ prettyStructure v =+ sep [string "fromList ", (prettyStructure . Data.Map.toList) v]++instance PrettyStructure UTCTime where+ prettyStructure = text . cs . formatTime defaultTimeLocale rfc822DateFormat++instance (Show a, Indexable ixs a) =>+ PrettyStructure (Data.IxSet.Typed.IxSet ixs a) where+ prettyStructure = text . show++instance PrettyStructure Word where+ prettyStructure = (prettyStructure :: Integer -> Doc) . fromIntegral++instance PrettyStructure Word8 where+ prettyStructure = (prettyStructure :: Integer -> Doc) . fromIntegral++instance PrettyStructure Word16 where+ prettyStructure = (prettyStructure :: Integer -> Doc) . fromIntegral++instance PrettyStructure Word32 where+ prettyStructure = (prettyStructure :: Integer -> Doc) . fromIntegral++instance PrettyStructure Word64 where+ prettyStructure = (prettyStructure :: Integer -> Doc) . fromIntegral++instance PrettyStructure Int8 where+ prettyStructure = (prettyStructure :: Integer -> Doc) . fromIntegral++instance PrettyStructure Int16 where+ prettyStructure = (prettyStructure :: Integer -> Doc) . fromIntegral++instance PrettyStructure Int32 where+ prettyStructure = (prettyStructure :: Integer -> Doc) . fromIntegral++instance PrettyStructure Int64 where+ prettyStructure = (prettyStructure :: Integer -> Doc) . fromIntegral++displayPrettyStructureL+ :: PrettyStructure a+ => a -> Text+displayPrettyStructureL = PP.displayT . PP.renderPretty 1.0 70 . prettyStructure++displayPrettyStructure+ :: PrettyStructure a+ => a -> T.Text+displayPrettyStructure = toStrict . displayPrettyStructureL
+ src/Text/PrettyPrint/GenericStructure.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++module Text.PrettyPrint.GenericStructure+ ( Structure(..)+ , Generic+ , displayStructure+ , structure+ ) where++import qualified Data.HashMap.Strict+import qualified Data.IntMap+import Data.IxSet.Typed (Indexable)+import qualified Data.IxSet.Typed+import qualified Data.Map+import Data.String.Conversions (cs)+import qualified Data.Text as T+import Data.Text.Lazy (Text, append, fromStrict,+ intercalate, singleton,+ unlines, unwords)+import Data.Time+import GHC.Generics+import Protolude hiding (Text, bool,+ intercalate, intersperse)++-- | The class 'Structure' is the equivalent of 'Prelude.Show'+--+-- It provides conversion of values to structure printable Structure.Text's.+--+class Structure a where+ structure :: a -> Text+ default structure :: (Generic a, GStructure (Rep a)) =>+ a -> Text+ structure x =+ intercalate+ "\n"+ [ "structure begin"+ , intercalate "\n" ((gstructure . from) x)+ , "structure end"+ ]++-- structure x = case (gstructure . from) x of+-- (o:[]) -> o+-- os -> PP.list os+--'GStructure' is a helper class used to output the Sum-of-Products type, since it has kind *->*,+-- so can't be an instance of 'Structure'+class GStructure f+ -- |'gstructure' is the (*->*) kind equivalent of 'docPrec'+ where+ gstructure :: f x -> [Text]++-- if empty, output nothing, this is a null constructor+instance GStructure U1 where+ gstructure _ = ["M1 U Begin" <> "M1 U End"]++-- , append "datatypeName: " ((show . datatypeName) a)+-- , append "moduleName: " ((cs . moduleName) d)+-- , append "packageName: " ((cs . packageName) d)+-- , append "isNewtype: " ((show . isNewtype) d)+instance (GStructure f) =>+ GStructure (M1 D c f) where+ gstructure (M1 a) =+ [ intercalate+ "\n"+ ["M1 D Begin", intercalate "\n" (gstructure a), "M1 D End"]+ ]++instance (GStructure f, Selector c) =>+ GStructure (M1 S c f) where+ gstructure s@(M1 a) =+ [ intercalate+ "\n"+ [ "M1 S Begin"+ , "selName: " <> (cs . selName) s+ , intercalate "\n" (gstructure a)+ , "M1 S End"+ ]+ ]++-- constructor+-- here the real type and parens flag is set and propagated forward via t and n, the precedence factor is updated+instance (GStructure f, Constructor c) =>+ GStructure (M1 C c f) where+ gstructure c@(M1 a) =+ [ intercalate+ "\n"+ [ "M1 C Begin"+ , "conName: " <> (cs . conName) c+ , "conFixity: " <> (show . conFixity) c+ , "conIsRecord: " <> (show . conIsRecord) c+ , intercalate "\n" (gstructure a)+ , "M1 C End"+ ]+ ]++-- ignore tagging, call docPrec since these are concrete types+instance (Structure f) =>+ GStructure (K1 t f) where+ gstructure (K1 a) = [intercalate "\n" ["M1 K Begin", structure a, "M1 K End"]]++-- just continue to the corresponding side of the OR+instance (GStructure a, GStructure b) =>+ GStructure (a :+: b) where+ gstructure (L1 x) =+ [ intercalate+ "\n"+ ["M1 :+: L1 Begin", intercalate "\n" (gstructure x), "M1 :+: L1 End"]+ ]+ gstructure (R1 x) =+ [ intercalate+ "\n"+ ["M1 :*: R1 Begin", intercalate "\n" (gstructure x), "M1 :*: R1 End"]+ ]++-- output both sides of the product, possible separated by a comma or an infix operator+instance (GStructure a, GStructure b) =>+ GStructure (a :*: b) where+ gstructure (x :*: y) =+ [ intercalate+ "\n"+ [ "M1 :*: Begin"+ , intercalate "\n" (gstructure x)+ , ":*:"+ , intercalate "\n" (gstructure y)+ , "M1 :*: End"+ ]+ ]++instance Structure Char where+ structure = singleton++instance Structure Text where+ structure = identity++instance Structure T.Text where+ structure = fromStrict++instance Structure Int where+ structure = show++instance Structure Integer where+ structure = show++instance Structure Float where+ structure = show++instance Structure Double where+ structure = show++instance Structure Rational where+ structure = show++instance Structure Bool where+ structure = show++instance Structure ByteString where+ structure = cs++instance Structure a =>+ Structure [a] where+ structure = show . fmap structure++instance Structure a =>+ Structure (Maybe a) where+ structure Nothing = "Nothing"+ structure (Just x) = "Just " <> structure x++instance (Structure a, Structure b) =>+ Structure (Either a b) where+ structure (Left x) = "Left " <> structure x+ structure (Right y) = "Right " <> structure y++instance (Structure a, Structure b) =>+ Structure (a, b) where+ structure (a, b) =+ "(" <> show (structure a) <> " , " <> show (structure b) <> ")"++instance (Structure a, Structure b) =>+ Structure (Data.Map.Map a b) where+ structure v = "fromList " <> structure v++instance Structure UTCTime where+ structure = cs . formatTime defaultTimeLocale rfc822DateFormat++instance (Show a, Indexable ixs a) =>+ Structure (Data.IxSet.Typed.IxSet ixs a) where+ structure = show++instance Structure Word where+ structure = (structure :: Integer -> Text) . fromIntegral++instance Structure Word8 where+ structure = (structure :: Integer -> Text) . fromIntegral++instance Structure Word16 where+ structure = (structure :: Integer -> Text) . fromIntegral++instance Structure Word32 where+ structure = (structure :: Integer -> Text) . fromIntegral++instance Structure Word64 where+ structure = (structure :: Integer -> Text) . fromIntegral++instance Structure Int8 where+ structure = (structure :: Integer -> Text) . fromIntegral++instance Structure Int16 where+ structure = (structure :: Integer -> Text) . fromIntegral++instance Structure Int32 where+ structure = (structure :: Integer -> Text) . fromIntegral++instance Structure Int64 where+ structure = (structure :: Integer -> Text) . fromIntegral++displayStructure+ :: Structure a+ => a -> T.Text+displayStructure = toStrict . structure
+ src/Text/PrettyPrint/TestGenericPretty.hs view
@@ -0,0 +1,263 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++{-|+ 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.TestGenericPretty+ ( Pretty(..)+ , Generic+ , displayPrettyL+ , displayPretty+ , displayPrettyLenL+ , displayPrettyLen+ ) where++import qualified Data.HashMap.Strict+import qualified Data.IntMap+import Data.IxSet.Typed (Indexable)+import qualified Data.IxSet.Typed+import qualified Data.Map+import Data.String.Conversions (cs)+import qualified Data.Text as T+import Data.Text.Lazy (Text, fromStrict)+import Data.Time+import GHC.Generics+import Protolude hiding (Text, bool,+ (<>))+import Text.PrettyPrint.Leijen.Text hiding (Pretty (..),+ (<$>), (<>))+import qualified Text.PrettyPrint.Leijen.Text as PP++-- | The class 'Pretty' is the equivalent of 'Prelude.Show'+--+-- It provides conversion of values to pretty printable Pretty.Doc's.+--+class Pretty a where+ pretty :: a -> Doc+ default pretty :: (Generic a, GPretty (Rep a)) =>+ a -> Doc+ pretty x = case (gpretty . from) x of+ (o:[]) -> o+ os -> PP.list os++--'GPretty' is a helper class used to output the Sum-of-Products type, since it has kind *->*,+-- so can't be an instance of 'Pretty'+class GPretty f+ -- |'gpretty' is the (*->*) kind equivalent of 'docPrec'+ where+ gpretty :: f x -> [Doc]++-- if empty, output nothing, this is a null constructor+instance GPretty U1 where+ gpretty _ = []++-- ignore datatype meta-information+instance (GPretty f) =>+ GPretty (M1 D c f) where+ gpretty (M1 a) = gpretty a++instance (GPretty f, Selector c) =>+ GPretty (M1 S c f) where+ gpretty s@(M1 a)+ | selector == "" = gpretty a+ | otherwise =+ if null components+ then []+ else [string (cs selector) <+> string "=" <+> cat components]+ where+ selector = selName s+ components = fmap (nest (length selector + 3)) (gpretty a)++-- | otherwise = Just PP.empty+-- constructor+-- here the real type and parens flag is set and propagated forward via t and n, the precedence factor is updated+instance (GPretty f, Constructor c) =>+ GPretty (M1 C c f) where+ gpretty c@(M1 a)+ | null components = [(string . cs . conName) c]+ | conIsRecord c =+ [(string . cs . conName) c <+> (braces . align . fillSep . punctuate comma) components]+ | otherwise =+ [parens ((string . cs . conName) c <+> (align . sep) components)]+ where components = gpretty a++-- ignore tagging, call docPrec since these are concrete types+instance (Pretty f) =>+ GPretty (K1 t f) where+ gpretty (K1 a) = [(pretty a)]++-- output both sides of the product, possible separated by a comma or an infix operator+instance (GPretty a, GPretty b) =>+ GPretty (a :*: b) where+ gpretty (x :*: y) = xs ++ ys+ where xs = gpretty x+ ys = gpretty y++-- just continue to the corresponding side of the OR+instance (GPretty a, GPretty b) =>+ GPretty (a :+: b) where+ gpretty (L1 x) = gpretty x+ gpretty (R1 x) = gpretty x++instance Pretty Char where+ pretty = char++instance Pretty Text where+ pretty = string++instance Pretty T.Text where+ pretty = string . fromStrict++instance Pretty Int where+ pretty i = if i < 0+ then (parens . int) i+ else int i++instance Pretty Integer where+ pretty i = if i < 0+ then (parens . integer) i+ else integer i++instance Pretty Float where+ pretty i = if i < 0+ then (parens . float) i+ else float i++instance Pretty Double where+ pretty i = if i < 0+ then (parens . double) i+ else double i++instance Pretty Rational where+ pretty = rational++instance Pretty Bool where+ pretty = bool++instance Pretty ByteString where+ pretty = string . cs++instance Pretty a =>+ Pretty [a] where+ pretty = PP.list . fmap pretty++instance Pretty a =>+ Pretty (Maybe a) where+ pretty Nothing = text "Nothing"+ pretty (Just x) = text "Just" <+> pretty x++instance (Pretty a, Pretty b) =>+ Pretty (Either a b) where+ pretty (Left x) = text "Left" <+> pretty x+ pretty (Right y) = text "Right" <+> pretty y++instance (Pretty a, Pretty b) =>+ Pretty (a, b) where+ pretty (a, b) = tupled [pretty a, pretty b]++instance (Pretty a, Pretty b, Pretty c) =>+ Pretty (a, b, c) where+ pretty (a, b, c) = tupled [pretty a, pretty b, pretty c]++instance (Pretty a, Pretty b, Pretty c, Pretty d) =>+ Pretty (a, b, c, d) where+ pretty (a, b, c, d) = tupled [pretty a, pretty b, pretty c, pretty d]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) =>+ Pretty (a, b, c, d, e) where+ pretty (a, b, c, d, e) =+ tupled [pretty a, pretty b, pretty c, pretty d, pretty e]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) =>+ Pretty (a, b, c, d, e, f) where+ pretty (a, b, c, d, e, f) =+ tupled [pretty a, pretty b, pretty c, pretty d, pretty e, pretty f]++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g) =>+ Pretty (a, b, c, d, e, f, g) where+ pretty (a, b, c, d, e, f, g) =+ tupled+ [pretty a, pretty b, pretty c, pretty d, pretty e, pretty f, pretty g]++instance (Pretty a, Pretty b) =>+ Pretty (Data.Map.Map a b) where+ pretty v = text "fromList " <+> pretty v++instance (Pretty a) =>+ Pretty (Data.IntMap.IntMap a) where+ pretty v = text "fromList " <+> pretty v++instance (Pretty a, Pretty b) =>+ Pretty (Data.HashMap.Strict.HashMap a b) where+ pretty v = text "fromList " <+> pretty v++instance Pretty UTCTime where+ pretty = text . cs . formatTime defaultTimeLocale rfc822DateFormat++instance (Show a, Indexable ixs a) =>+ Pretty (Data.IxSet.Typed.IxSet ixs a) where+ pretty = text . show++instance Pretty Word where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Word8 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Word16 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Word32 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Word64 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Int8 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Int16 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Int32 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++instance Pretty Int64 where+ pretty = (pretty :: Integer -> Doc) . fromIntegral++displayPrettyL+ :: Pretty a+ => a -> Text+displayPrettyL = PP.displayT . PP.renderPretty 1.0 70 . pretty++displayPretty+ :: Pretty a+ => a -> T.Text+displayPretty = toStrict . displayPrettyL++displayPrettyLenL+ :: Pretty a+ => Int -> a -> Text+displayPrettyLenL l = PP.displayT . PP.renderPretty 1.0 l . pretty++displayPrettyLen+ :: Pretty a+ => Int -> a -> T.Text+displayPrettyLen l = toStrict . displayPrettyLenL l
+ test/GenericPretty/Tests.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}++module GenericPretty.Tests+ ( tests+ ) where++import Protolude hiding (Product, Sum, empty)+import Test.Tasty+import Test.Tasty.HUnit++import qualified K1+import qualified Product+import qualified Sum+import qualified TestData+import qualified U1++-- got this idea from+-- https://jaspervdj.be/posts/2015-03-13-practical-testing-in-haskell.html+-- it would be cool to generate the data types using Arbitrary as GAST+-- supposedly did+-- testProperty "test U1" prop_U1+tests :: TestTree+tests =+ testGroup+ "GenericPretty"+ [ testCase "testU1" testU1+ , testCase "testSum" testSum+ , testCase "testProduct" testProduct+ , testCase "testK1" testK1+ , testCase "testDataTree1" testDataTree1+ , testCase "testDataTree2" testDataTree2+ , testCase "testDataTree3" testDataTree3+ , testCase "testDataTree4" testDataTree4+ , testCase "testDataAnimal1" testDataAnimal1+ , testCase "testHashMap" testHashMap+ , testCase "testIntMap" testIntMap+ , testCase "testMap" testMap+ , testCase "testUTCTime" testUTCTime+ ]++testU1 :: Assertion+testU1 = U1.showAndRead U1.sample @?= Right U1.sample++testSum :: Assertion+testSum = Sum.showAndRead Sum.sample @?= Right Sum.sample++testProduct :: Assertion+testProduct = Product.showAndRead Product.sample @?= Right Product.sample++testK1 :: Assertion+testK1 = K1.showAndRead K1.sample @?= Right K1.sample++testDataTree1 :: Assertion+testDataTree1 = TestData.showAndReadTree TestData.tree1 @?= Right TestData.tree1++testDataTree2 :: Assertion+testDataTree2 = TestData.showAndReadTree TestData.tree2 @?= Right TestData.tree2++testDataTree3 :: Assertion+testDataTree3 = TestData.showAndReadTree TestData.tree3 @?= Right TestData.tree3++testDataTree4 :: Assertion+testDataTree4 =+ TestData.showAndReadTree1 TestData.tree4 @?= Right TestData.tree4++testDataAnimal1 :: Assertion+testDataAnimal1 =+ TestData.showAndReadAnimal1 TestData.animal1 @?= Right TestData.animal1++testHashMap :: Assertion+testHashMap =+ TestData.showAndReadHashMap TestData.hashMapTest @?= Right TestData.hashMapTest++testIntMap :: Assertion+testIntMap =+ TestData.showAndReadIntMap TestData.intMapTest @?= Right TestData.intMapTest++testMap :: Assertion+testMap =+ TestData.showAndReadMap TestData.mapTest @?= Right TestData.mapTest++testUTCTime :: Assertion+testUTCTime =+ TestData.showAndReadUTCTime TestData.utcTimeTest @?= Right TestData.utcTimeTest
+ test/K1.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module K1 where++import Data.String.Conversions (cs)+import GHC.Base+import GHC.Generics+import Protolude hiding (K1)++import Text.PrettyPrint.GenericPretty++data Sample =+ Sample ByteString+ deriving (Eq, Read, Show, Generic, Pretty)++sample :: Sample+sample = Sample "sample bytestring"++showAndRead :: Sample -> Either GHC.Base.String Sample+showAndRead = readEither . cs . displayPretty
+ test/Product.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Product where++import Data.String.Conversions (cs)+import GHC.Base+import GHC.Generics+import Protolude hiding (Product)++import Text.PrettyPrint.GenericPretty++data Product =+ Product Int+ Integer+ Char+ Text+ ByteString+ deriving (Eq, Read, Show, Generic, Pretty)++sample :: Product+sample = Product 1 10 'C' "sample text" "sample bytestring"++showAndRead :: Product -> Either GHC.Base.String Product+showAndRead = readEither . cs . displayPretty
+ test/Spec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Protolude+import Test.Tasty (defaultMain, testGroup)++import qualified GenericPretty.Tests++-- got this idea from+-- https://jaspervdj.be/posts/2015-03-13-practical-testing-in-haskell.html+main :: IO ()+main = defaultMain $ testGroup "Tests" [GenericPretty.Tests.tests]
+ test/Sum.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Sum where++import Data.String.Conversions (cs)+import GHC.Base+import GHC.Generics+import Protolude hiding (Sum, empty)++import Text.PrettyPrint.GenericPretty++data Sum+ = Cat+ | Dog+ | Rat+ | Elephant+ deriving (Eq, Read, Show, Generic, Pretty)++sample :: Sum+sample = Elephant++showAndRead :: Sum -> Either GHC.Base.String Sum+showAndRead = readEither . cs . displayPretty
+ test/TestData.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module TestData where++import Data.String.Conversions (cs)+import Data.Time+import GHC.Base+import GHC.Generics+import Protolude hiding (K1)+import qualified Data.HashMap.Strict as HashMap+import qualified Data.IntMap.Strict as IntMap+import qualified Data.Map.Strict as Map++import Text.PrettyPrint.GenericPretty++showAndReadTree :: Tree Int -> Either GHC.Base.String (Tree Int)+showAndReadTree = readEither . cs . displayPretty++showAndReadTree1 :: Tree1 Int Text -> Either GHC.Base.String (Tree1 Int Text)+showAndReadTree1 = readEither . cs . displayPretty++showAndReadAnimal1 :: Animal1 -> Either GHC.Base.String Animal1+showAndReadAnimal1 = readEither . cs . displayPretty++data Tree a+ = Leaf a+ | Node (Tree a)+ (Tree a)+ deriving (Eq, Read, Show, Generic, Pretty)++data Tree1 a b+ = Leaf1 a+ b+ | Node1 (Tree1 a b)+ (Tree1 a b)+ deriving (Eq, Read, Show, Generic, Pretty)++tree1 :: Tree Int+tree1 =+ Node+ (Node (Leaf 333333) (Leaf (-555555)))+ (Node+ (Node (Node (Leaf 888888) (Leaf 57575757)) (Leaf (-14141414)))+ (Leaf 7777777))++tree2 :: Tree Int+tree2 = Leaf 7777777++tree3 :: Tree Int+tree3 = Node (Leaf 7777777) (Leaf 5555555)++tree4 :: Tree1 Int Text+tree4 =+ Node1+ (Node1 (Leaf1 333333 "testing agan") (Leaf1 (-555555) "ntest"))+ (Node1+ (Node1+ (Node1 (Leaf1 888888 "again") (Leaf1 57575757 "tisti"))+ (Leaf1 (-14141414) "test"))+ (Leaf1 7777777 "aointhk"))++animal1 :: Animal1+animal1 =+ Animal1 10 "junk animal" "junk animal again" Dog tree1 'C' "test bytestring"++data Animal+ = Dog+ | Cat+ | Horse+ | Elephant+ deriving (Eq, Read, Show, Generic, Pretty, Enum)++data Animal1 = Animal1+ { aType :: Int+ , aName :: Text+ , aNameAgain :: Text+ , animal :: Animal+ , aTree :: Tree Int+ , aChar :: Char+ , aBS :: ByteString+ } deriving (Eq, Read, Show, Generic, Pretty)++hashMapTest :: HashMap.HashMap Int Text+hashMapTest = HashMap.fromList [(1, "10")]++showAndReadHashMap :: HashMap.HashMap Int Text -> Either GHC.Base.String ( HashMap.HashMap Int Text)+showAndReadHashMap = readEither . cs . displayPretty++intMapTest :: IntMap.IntMap Text+intMapTest = IntMap.fromList [(1, "10")]++showAndReadIntMap :: IntMap.IntMap Text -> Either GHC.Base.String ( IntMap.IntMap Text)+showAndReadIntMap = readEither . cs . displayPretty++mapTest :: Map.Map Int Text+mapTest = Map.fromList [(1, "10")]++showAndReadMap :: Map.Map Int Text -> Either GHC.Base.String ( Map.Map Int Text)+showAndReadMap = readEither . cs . displayPretty++utcTimeTest :: UTCTime+utcTimeTest = UTCTime (ModifiedJulianDay 40587) 0++showAndReadUTCTime :: UTCTime -> Either GHC.Base.String UTCTime+showAndReadUTCTime = readEither . cs . displayPretty
+ test/U1.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module U1 where++import Data.String.Conversions (cs)+import GHC.Base+import GHC.Generics+import Protolude hiding (empty, get, put)++import Text.PrettyPrint.GenericPretty++data Empty =+ Empty+ deriving (Eq, Read, Show, Generic, Pretty)++sample :: Empty+sample = Empty++showAndRead :: Empty -> Either GHC.Base.String Empty+showAndRead = readEither . cs . displayPretty
+ text-generic-pretty.cabal view
@@ -0,0 +1,138 @@+-- The name of the package.+Name: text-generic-pretty++-- 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 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/joe9/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: joe9mail@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++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.10+++Library+ -- Modules exported by the library.+ Exposed-modules: Text.PrettyPrint.GenericPretty Text.PrettyPrint.TestGenericPretty Text.PrettyPrint.GenericStructure Text.PrettyPrint.GenericPrettyStructure++ -- Packages needed in order to build this package.+ Build-depends: base >= 3 && < 5+ , ghc-prim+ , wl-pprint-text+ , protolude+ , text+ , string-conversions+ , QuickCheck+ , containers+ , unordered-containers+ , time+ , ixset-typed+ , groom++ -- use Protolude instead of Prelude+ ghc-options: -Wall+ hs-source-dirs: src+ default-language: Haskell2010++ -- Modules not exported by this package.+ -- Other-modules:++ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools:++test-suite GenericPretty-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: GenericPretty.Tests+ U1+ Sum+ Product+ K1+ TestData+ build-tools: hsc2hs+ build-depends: base+ , protolude+ , string-conversions+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , QuickCheck+ , text-generic-pretty+ , containers+ , unordered-containers+ , time+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ other-extensions: NoImplicitPrelude, OverloadedStrings+ default-language: Haskell2010++source-repository head+ type: git+ location: git@github.com:joe9/GenericPretty.git