generic-pretty (empty) → 0.1.0
raw patch · 5 files changed
+458/−0 lines, 5 filesdep +ansi-wl-pprintdep +basedep +bytestringsetup-changed
Dependencies added: ansi-wl-pprint, base, bytestring, containers, generic-pretty, tasty, tasty-hunit, text, vector
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- generic-pretty.cabal +45/−0
- src/Text/PrettyPrint/Generic.hs +264/−0
- test/test.hs +127/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Hideyuki Tanaka++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ generic-pretty.cabal view
@@ -0,0 +1,45 @@+name: generic-pretty+version: 0.1.0+synopsis: Pretty printing for Generic value+description: Pretty printing for Generic value. For more detail, please refer to <https://github.com/tanakh/generic-pretty>.+homepage: https://github.com/tanakh/generic-pretty+license: MIT+license-file: LICENSE+author: Hideyuki Tanaka+maintainer: tanaka.hideyuki@gmail.com+copyright: (c) 2015 Hideyuki Tanaka+category: Text+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/tanakh/generic-pretty.git++library+ exposed-modules: Text.PrettyPrint.Generic+ -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && <4.9+ , ansi-wl-pprint+ , bytestring >=0.10+ , containers >=0.5.6+ , text >=1.2+ , vector >=0.10+ hs-source-dirs: src+ default-language: Haskell2010++test-suite generic-pretty-test+ type: exitcode-stdio-1.0+ main-is: test.hs+ build-depends: base >=4.8 && <4.9+ , tasty >=0.10+ , tasty-hunit+ , containers+ , vector+ , bytestring+ , text+ , generic-pretty+ hs-source-dirs: test+ default-language: Haskell2010
+ src/Text/PrettyPrint/Generic.hs view
@@ -0,0 +1,264 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Pretty printing for Generic data types++module Text.PrettyPrint.Generic (+ -- * Type classes+ Pretty(..),+ GPretty(..),++ -- * Utility functions+ pretty, prettyShow, prettyPrint, hPrettyPrint,+ pretty', prettyShow', prettyPrint', hPrettyPrint',+ ) where++import GHC.Exts (IsList (..))+import GHC.Generics+import System.IO+import Text.PrettyPrint.ANSI.Leijen hiding (Pretty (..))++import Control.Applicative (Const, WrappedArrow,+ WrappedMonad, ZipList)+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L+import Data.Complex+import Data.Functor.Identity (Identity)+import Data.Int+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import Data.Monoid (All, Alt, Any, First, Last,+ Product, Sum)+import Data.Ratio+import qualified Data.Sequence as Seq+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Vector as V+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import Data.Word++-- Color scheme++constructorS, numericS, stringS, operatorS, selectorS :: Doc -> Doc+constructorS = underline . bold . dullgreen+numericS = magenta+stringS = dullyellow+operatorS = dullred+selectorS = blue++-- Generic function++-- | Type class for generic representations+class GPretty f where+ -- | Pretty print a `Generic` value+ gprettyPrec :: Int -> f a -> [Doc]++instance GPretty V1 where+ gprettyPrec _ _ = error "this never happen"++instance GPretty U1 where+ gprettyPrec _ U1 = []++instance Pretty c => GPretty (Rec0 c) where+ gprettyPrec p (K1 c) = [prettyPrec p c]++instance GPretty f => GPretty (D1 d f) where+ gprettyPrec p (M1 a) = gprettyPrec p a++instance (GPretty f, Constructor c) => GPretty (C1 c f) where+ gprettyPrec p c@(M1 a)+ | conIsRecord c =+ [ con <+> encloseSep (lbrace <> space) (space <> rbrace) (comma <> space) es ]+ | null es = [ con ]+ | p == 0 = [ con <+> align (sep es) ]+ | otherwise = [ parens $ con <+> align (sep es) ]+ where+ con = constructorS $ text (conName c)+ es = gprettyPrec (p + 1) a++instance {-# OVERLAPPABLE #-} (GPretty f, Selector s) => GPretty (S1 s f) where+ gprettyPrec _ s@(M1 a) =+ [ selectorS (text (selName s)) <+> operatorS (text "=") <+> sep (gprettyPrec 0 a) ]+instance {-# OVERLAPPING #-} GPretty f => GPretty (S1 NoSelector f) where+ gprettyPrec p (M1 a) = gprettyPrec p a++instance (GPretty f, GPretty g) => GPretty (f :+: g) where+ gprettyPrec p (L1 a) = gprettyPrec p a+ gprettyPrec p (R1 a) = gprettyPrec p a++instance (GPretty f, GPretty g) => GPretty (f :*: g) where+ gprettyPrec p (a :*: b) = gprettyPrec p a ++ gprettyPrec p b++-- Wrapper function++-- | Type class for pretty printing+class Pretty a where+ -- | Pretty print a value to `Doc`+ prettyPrec :: Int -> a -> Doc+ default prettyPrec :: (Generic a, GPretty (Rep a)) => Int -> a -> Doc+ prettyPrec p = sep . gprettyPrec p . from++-- Utility functions++-- | Pretty print a value with decoration+pretty :: Pretty a => a -> Doc+pretty = prettyPrec 0++-- | Pretty print a value to `String`+prettyShow :: Pretty a => a -> String+prettyShow = show . pretty++-- | Pretty print a value to `stdout`+prettyPrint :: Pretty a => a -> IO ()+prettyPrint = hPrettyPrint stdout++-- | Pretty print a value+hPrettyPrint :: Pretty a => Handle -> a -> IO ()+hPrettyPrint h = hPutDoc h . (<> hardline) . pretty++-- | Pretty print a value without decoration+pretty' :: Pretty a => a -> Doc+pretty' = plain . pretty++-- | Plain version for `prettyShow`+prettyShow' :: Pretty a => a -> String+prettyShow' = show . pretty'++-- | Plain version for `prettyPrint`+prettyPrint' :: Pretty a => a -> IO ()+prettyPrint' = hPrettyPrint' stdout++-- | Plain version for `hPrettyPrint`+hPrettyPrint' :: Pretty a => Handle -> a -> IO ()+hPrettyPrint' h = hPutDoc h . (<> hardline) . pretty'++-- instances++instance Pretty () where prettyPrec _ = text . show+instance Pretty Char where prettyPrec _ = stringS . text . show+instance Pretty Int where prettyPrec _ = numericS . text . show+instance Pretty Integer where prettyPrec _ = numericS . text . show+instance Pretty Float where prettyPrec _ = numericS . text . show+instance Pretty Double where prettyPrec _ = numericS . text . show+instance Pretty Bool where prettyPrec _ = numericS . text . show++instance Pretty Word where prettyPrec _ = numericS . text . show+instance Pretty Word8 where prettyPrec _ = numericS . text . show+instance Pretty Word16 where prettyPrec _ = numericS . text . show+instance Pretty Word32 where prettyPrec _ = numericS . text . show+instance Pretty Word64 where prettyPrec _ = numericS . text . show++instance Pretty Int8 where prettyPrec _ = numericS . text . show+instance Pretty Int16 where prettyPrec _ = numericS . text . show+instance Pretty Int32 where prettyPrec _ = numericS . text . show+instance Pretty Int64 where prettyPrec _ = numericS . text . show++instance (Integral a, Pretty a) => Pretty (Ratio a) where+ prettyPrec _ r =+ pretty (numerator r) <+> operatorS (char '%') <+> pretty (denominator r)++instance (Pretty a) => Pretty (Complex a) where+ prettyPrec _ (r :+ i) =+ pretty r <+> operatorS (text ":+") <+> pretty i++instance {-# OVERLAPPABLE #-} Pretty a => Pretty [a] where+ prettyPrec _ = encloseSep (lbracket <> space) (space <> rbracket) (comma <> space) . map pretty++instance {-# OVERLAPPING #-} Pretty String where+ prettyPrec _ = stringS . dquotes . text . prettyString where+ prettyString cs = foldr ((.) . prettyChar) id cs ""+ prettyChar c+ | fromEnum c < 0x80 = showChar c+ | otherwise = (c:)++instance (Pretty a, Pretty b) => Pretty (a, b) where+ prettyPrec _ (a, b) = parens $ pretty a <> comma <+> pretty b++instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where+ prettyPrec _ (a, b, c) = parens $ pretty a <> comma <+> pretty b <> comma <+> pretty c++instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where+ prettyPrec _ (a, b, c, d) = parens $ pretty a <> comma <+> pretty b <> comma <+> pretty c <> comma <+> pretty d++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) where+ prettyPrec _ (a, b, c, d, e) = parens $ pretty a <> comma <+> pretty b <> comma <+> pretty c <> comma <+> pretty d <> comma <+> pretty e++instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) => Pretty (a, b, c, d, e, f) where+ prettyPrec _ (a, b, c, d, e, f) = parens $ pretty a <> comma <+> pretty b <> comma <+> pretty c <> comma <+> pretty d <> comma <+> pretty e <> comma <+> 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+ prettyPrec _ (a, b, c, d, e, f, g) = parens $ pretty a <> comma <+> pretty b <> comma <+> pretty c <> comma <+> pretty d <> comma <+> pretty e <> comma <+> pretty f <> comma <+> pretty g++instance Pretty a => Pretty (Maybe a)+instance (Pretty a, Pretty b) => Pretty (Either a b)+instance Pretty Ordering+instance Pretty Any+instance Pretty All+instance Pretty a => Pretty (First a)+instance Pretty a => Pretty (Last a)+instance Pretty a => Pretty (Sum a)+instance Pretty a => Pretty (Product a)+instance Pretty (f a) => Pretty (Alt f a)+instance Pretty a => Pretty (Identity a)+instance Pretty a => Pretty (Const a b)+instance Pretty a => Pretty (ZipList a)+instance Pretty (m a) => Pretty (WrappedMonad m a)+instance Pretty (a b c) => Pretty (WrappedArrow a b c)++-- bytestrings, texts++instance Pretty S.ByteString where+ prettyPrec _ bs = case T.decodeUtf8' bs of+ Left err -> pretty $ show err+ Right t -> pretty t++instance Pretty T.Text where+ prettyPrec _ = pretty . T.unpack++instance Pretty L.ByteString where+ prettyPrec _ = pretty . L.toStrict++instance Pretty TL.Text where+ prettyPrec _ = pretty . TL.toStrict++-- containers++instance (Pretty a, Ord a) => Pretty (Set.Set a) where+ prettyPrec _ = encloseSep (lbracket <> space) (space <> rbracket) (comma <> space) . map pretty . toList++instance Pretty IntSet.IntSet where+ prettyPrec _ = pretty . Set.fromList . toList++instance (Pretty a, Pretty b, Ord a) => Pretty (Map.Map a b) where+ prettyPrec _ = encloseSep (lbrace <> space) (space <> rbrace) (comma <> space) . map f . toList where+ f (key, val) = pretty key <> colon <+> pretty val++instance Pretty b => Pretty (IntMap.IntMap b) where+ prettyPrec _ = pretty . Map.fromList . toList++instance Pretty a => Pretty (Seq.Seq a) where+ prettyPrec _ = pretty . toList++-- vectors++instance Pretty a => Pretty (V.Vector a) where+ prettyPrec _ = pretty . toList++instance (Pretty a, VP.Prim a) => Pretty (VP.Vector a) where+ prettyPrec _ = pretty . toList++instance (Pretty a, VS.Storable a) => Pretty (VS.Vector a) where+ prettyPrec _ = pretty . toList++instance (Pretty a, VU.Unbox a) => Pretty (VU.Vector a) where+ prettyPrec _ = pretty . toList
+ test/test.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L+import Data.Complex+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import Data.Ratio+import qualified Data.Sequence as Seq+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Vector as V+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import GHC.Generics+import Test.Tasty+import Test.Tasty.HUnit++import Text.PrettyPrint.Generic++data Foo = Foo { fooA :: Int, fooB :: String } deriving Generic+instance Pretty Foo++data Bar a = Bar { barA :: Foo, barB :: a } deriving Generic+instance Pretty a => Pretty (Bar a)++data Baz = Baz1 | Baz2 Int | Baz3 Foo (Bar Baz) deriving Generic+instance Pretty Baz++main :: IO ()+main =+ defaultMain $ testGroup "test cases"+ [ testCase "()" $+ prettyShow' () @?= "()"+ , testCase "Char" $+ prettyShow' 'a' @?= "'a'"+ , testCase "Int" $+ prettyShow' (123 :: Int) @?= "123"+ , testCase "Integer" $+ prettyShow' (2^100 :: Integer) @?= "1267650600228229401496703205376"+ , testCase "Float" $+ prettyShow' (pi :: Float) @?= "3.1415927"+ , testCase "Double" $+ prettyShow' (pi :: Double) @?= "3.141592653589793"+ , testCase "String" $+ prettyShow' ("Hello" :: String) @?= "\"Hello\""+ , testCase "Bool" $+ prettyShow' True @?= "True"++ , testCase "Rational" $+ prettyShow' (123 % 456 :: Rational) @?= "41 % 152"+ , testCase "Complex" $+ prettyShow' (123 :+ 456 :: Complex Double) @?= "123.0 :+ 456.0"++ , testCase "List" $+ prettyShow' ([1..5] :: [Int]) @?= "[ 1, 2, 3, 4, 5 ]"++ , testCase "2-tuple" $+ prettyShow' ('a', 'b') @?= "('a', 'b')"+ , testCase "3-tuple" $+ prettyShow' ('a', 'b', 'c') @?= "('a', 'b', 'c')"+ , testCase "4-tuple" $+ prettyShow' ('a', 'b', 'c', 'd') @?= "('a', 'b', 'c', 'd')"+ , testCase "5-tuple" $+ prettyShow' ('a', 'b', 'c', 'd', 'e') @?= "('a', 'b', 'c', 'd', 'e')"+ , testCase "6-tuple" $+ prettyShow' ('a', 'b', 'c', 'd', 'e', 'f') @?= "('a', 'b', 'c', 'd', 'e', 'f')"+ , testCase "7-tuple" $+ prettyShow' ('a', 'b', 'c', 'd', 'e', 'f', 'g') @?= "('a', 'b', 'c', 'd', 'e', 'f', 'g')"++ , testCase "Maybe 1" $+ prettyShow' (Nothing :: Maybe Int) @?= "Nothing"+ , testCase "Maybe 2" $+ prettyShow' (Just 123 :: Maybe Int) @?= "Just 123"+ , testCase "Maybe 3" $+ prettyShow' (Just (Just 123) :: Maybe (Maybe Int)) @?= "Just (Just 123)"+ , testCase "Either 1" $+ prettyShow' (Left "Left" :: Either String Double) @?= "Left \"Left\""+ , testCase "Either 2" $+ prettyShow' (Right pi :: Either String Double) @?= "Right 3.141592653589793"++ , testCase "Strict ByteString" $+ prettyShow' (T.encodeUtf8 "日本語" :: S.ByteString) @?= "\"日本語\""+ , testCase "Lazy ByteString" $+ prettyShow' (L.fromStrict $ T.encodeUtf8 "日本語" :: L.ByteString) @?= "\"日本語\""+ , testCase "Strict Text" $+ prettyShow' ("日本語" :: T.Text) @?= "\"日本語\""+ , testCase "Lazy Text" $+ prettyShow' ("日本語" :: TL.Text) @?= "\"日本語\""++ , testCase "Set" $+ prettyShow' (["foo", "bar", "baz"] :: Set.Set String) @?= "[ \"bar\", \"baz\", \"foo\" ]"+ , testCase "IntSet" $+ prettyShow' ([1..5] :: IntSet.IntSet) @?= "[ 1, 2, 3, 4, 5 ]"+ , testCase "Map" $+ prettyShow' ([("foo", 123), ("bar", 456)] :: Map.Map String Int) @?= "{ \"bar\": 456, \"foo\": 123 }"+ , testCase "IntMap" $+ prettyShow' ([(123, "foo"), (456, "bar")] :: IntMap.IntMap String) @?= "{ 123: \"foo\", 456: \"bar\" }"+ , testCase "Seq" $+ prettyShow' ([1..5] :: Seq.Seq Int) @?= "[ 1, 2, 3, 4, 5 ]"++ , testCase "Vector" $+ prettyShow' ([1..5] :: V.Vector Int) @?= "[ 1, 2, 3, 4, 5 ]"+ , testCase "Primitive Vector" $+ prettyShow' ([1..5] :: VP.Vector Int) @?= "[ 1, 2, 3, 4, 5 ]"+ , testCase "Storable Vector" $+ prettyShow' ([1..5] :: VS.Vector Int) @?= "[ 1, 2, 3, 4, 5 ]"+ , testCase "Unboxed Vector" $+ prettyShow' ([1..5] :: VU.Vector Int) @?= "[ 1, 2, 3, 4, 5 ]"++ , testCase "User defined 1" $+ prettyShow' (Foo 123 "foo") @?= "Foo { fooA = 123, fooB = \"foo\" }"+ , testCase "User defined 2" $+ prettyShow' (Bar (Foo 123 "foo") (Just True)) @?= "Bar { barA = Foo { fooA = 123\n , fooB = \"foo\" }\n , barB = Just True }"+ , testCase "User defined 3" $+ prettyShow' Baz1 @?= "Baz1"+ , testCase "User defined 4" $+ prettyShow' (Baz2 123) @?= "Baz2 123"+ , testCase "User defined 5" $+ prettyShow' (Baz3 (Foo 123 "foo") (Bar (Foo 456 "bar") Baz1)) @?= "Baz3 Foo { fooA = 123\n , fooB = \"foo\" }\n Bar { barA = Foo { fooA = 456\n , fooB = \"bar\" }\n , barB = Baz1 }"+ ]