pretty-types 0.1.0.3 → 0.1.1.0
raw patch · 3 files changed
+125/−110 lines, 3 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Data.Type.Pretty: showPretty :: forall proxy t. PrettyTypeShow (ToPretty t) => proxy t -> String
+ Data.Type.Pretty: showPretty :: forall proxy (t :: k). PrettyTypeShow (ToPretty t) => proxy t -> String
Files
- pretty-types.cabal +2/−2
- spec/PrettyTypesSpec.hs +21/−21
- src/Data/Type/Pretty.hs +102/−87
pretty-types.cabal view
@@ -1,5 +1,5 @@ name: pretty-types-version: 0.1.0.3+version: 0.1.1.0 synopsis: A small pretty printing DSL for complex types. description: Please see README.md homepage: https://github.com/sheyll/pretty-types#readme@@ -8,7 +8,7 @@ author: Sven Heyll maintainer: sven.heyll@gmail.com copyright: 2016 Sven Heyll-category: Codec+category: Text build-type: Simple extra-source-files: README.md , stack.yaml
spec/PrettyTypesSpec.hs view
@@ -18,54 +18,54 @@ describe "PrettyNat" $ do it "renders (PutNat 123) as 123" $- ptShow (PX :: PX (PutNat 123)) `shouldBe` "123"+ showPretty (PX :: PX (PutNat 123)) `shouldBe` "123" it "renders ('PrettyNat ('PrettyPadded 10) ('PrettyPrecision 5) 'PrettyDec 123) as \" 00123\"" $- ptShow (PX :: PX ('PrettyNat ('PrettyPadded 10) ('PrettyPrecision 5) 'PrettyDec 123))+ showPretty (PX :: PX ('PrettyNat ('PrettyPadded 10) ('PrettyPrecision 5) 'PrettyDec 123)) `shouldBe` " 00123" it "renders (PutHex8 123) as 7b" $- ptShow (PX :: PX (PutHex8 123)) `shouldBe` "7b"+ showPretty (PX :: PX (PutHex8 123)) `shouldBe` "7b" it "renders (PutHeX8 123) as 7B" $- ptShow (PX :: PX (PutHeX8 123)) `shouldBe` "7B"+ showPretty (PX :: PX (PutHeX8 123)) `shouldBe` "7B" it "renders (PutHeX64 123) as 000000000000007B" $- ptShow (PX :: PX (PutHeX64 123)) `shouldBe` "000000000000007B"+ showPretty (PX :: PX (PutHeX64 123)) `shouldBe` "000000000000007B" it "renders (PutBits16 123) as 0000000001111011" $- ptShow (PX :: PX (PutBits16 123)) `shouldBe` "0000000001111011"+ showPretty (PX :: PX (PutBits16 123)) `shouldBe` "0000000001111011" it "renders (PutBits32 123) as 00000000000000000000000001111011" $- ptShow (PX :: PX (PutBits32 123)) `shouldBe` "00000000000000000000000001111011"+ showPretty (PX :: PX (PutBits32 123)) `shouldBe` "00000000000000000000000001111011" describe "PrettySymbol" $ do it "renders (PutStr \"hello\") as \"hello\"" $- ptShow (PX :: PX (PutStr "hello")) `shouldBe` "hello"+ showPretty (PX :: PX (PutStr "hello")) `shouldBe` "hello" it "renders ('PrettySymbol ('PrettyPadded 10) ('PrettyPrecision 2) \"hello\") as \" he\"" $- ptShow (PX :: PX ('PrettySymbol ('PrettyPadded 10) ('PrettyPrecision 2) "hello"))+ showPretty (PX :: PX ('PrettySymbol ('PrettyPadded 10) ('PrettyPrecision 2) "hello")) `shouldBe` " he" describe "PrettySeperated" $ do it "renders (PutNat 0 <++> PutNat 1) as \"01\"" $- ptShow (PX :: PX (PutNat 0 <++> PutNat 1)) `shouldBe` "01"+ showPretty (PX :: PX (PutNat 0 <++> PutNat 1)) `shouldBe` "01" it "renders (PutNat 0 <+> PutNat 1) as \"0 1\"" $- ptShow (PX :: PX (PutNat 0 <+> PutNat 1)) `shouldBe` "0 1"+ showPretty (PX :: PX (PutNat 0 <+> PutNat 1)) `shouldBe` "0 1" it "renders (PutNat 0 <$$> PutNat 1) as \"0\\n1\"" $- ptShow (PX :: PX (PutNat 0 <$$> PutNat 1)) `shouldBe` "0\n1"+ showPretty (PX :: PX (PutNat 0 <$$> PutNat 1)) `shouldBe` "0\n1" it "renders (PutNat 0 <++> PutNat 1 <+> PutNat 2 <$$> PutNat 3 <+> PutNat 4) as \"01 2\\n3 4\"" $- ptShow (PX :: PX (PutNat 0 <++> PutNat 1 <+> PutNat 2 <$$> PutNat 3 <+> PutNat 4))+ showPretty (PX :: PX (PutNat 0 <++> PutNat 1 <+> PutNat 2 <$$> PutNat 3 <+> PutNat 4)) `shouldBe` "01 2\n3 4" it "renders (PutNat 0 <++> 'PrettySpace) as \"0 \"" $- ptShow (PX :: PX (PutNat 0 <++> 'PrettySpace)) `shouldBe` "0 "+ showPretty (PX :: PX (PutNat 0 <++> 'PrettySpace)) `shouldBe` "0 " it "renders (PutNat 0 <++> 'PrettyEmpty) as \"0\"" $- ptShow (PX :: PX (PutNat 0 <++> 'PrettyEmpty)) `shouldBe` "0"+ showPretty (PX :: PX (PutNat 0 <++> 'PrettyEmpty)) `shouldBe` "0" it "renders ('PrettyEmpty <++> PutNat 0) as \"0\"" $- ptShow (PX :: PX ('PrettyEmpty <++> PutNat 0)) `shouldBe` "0"+ showPretty (PX :: PX ('PrettyEmpty <++> PutNat 0)) `shouldBe` "0" it "renders (PutNat 0 <++> 'PrettyEmpty <++> PutNat 1) as \"01\"" $- ptShow (PX :: PX (PutNat 0 <++> 'PrettyEmpty <++> PutNat 1)) `shouldBe` "01"+ showPretty (PX :: PX (PutNat 0 <++> 'PrettyEmpty <++> PutNat 1)) `shouldBe` "01" it "renders (PrettyOften 7 (PutStr \".\") as \".......\"" $- ptShow (PX :: PX (PrettyOften 7 (PutStr "."))) `shouldBe` "......."+ showPretty (PX :: PX (PrettyOften 7 (PutStr "."))) `shouldBe` "......." it "renders (PrettyMany (PutNat 777) '[]) as \"\"" $- ptShow (PX :: PX (PrettyMany (PutNat 777) '[])) `shouldBe` ""+ showPretty (PX :: PX (PrettyMany (PutNat 777) '[])) `shouldBe` "" it "renders (PrettyMany (PutNat 777) '[PutStr \".\"]) as \".\"" $- ptShow (PX :: PX (PrettyMany (PutNat 777) '[PutStr "."])) `shouldBe` "."+ showPretty (PX :: PX (PrettyMany (PutNat 777) '[PutStr "."])) `shouldBe` "." it "renders (PrettyMany (PutNat 777) '[PutStr \".\", PutNat 3, PutNat 4]) as \".77737774\"" $- ptShow (PX :: PX (PrettyMany (PutNat 777) '[PutStr ".", PutNat 3, PutNat 4])) `shouldBe` ".77737774"+ showPretty (PX :: PX (PrettyMany (PutNat 777) '[PutStr ".", PutNat 3, PutNat 4])) `shouldBe` ".77737774" describe "ToPretty" $ do it "renders a custom type" $ do
src/Data/Type/Pretty.hs view
@@ -10,17 +10,22 @@ -- One way to create 'PrettyType' /documents/ is to define 'ToPretty' instances -- for your types by combining the promoted constructors of 'PrettyType'. --+-- If `UndecidableInstances` isn't holding you back, use the type aliases like+-- 'PutStr', 'PutNat', 'PrettySeperated', etc in these instance definitions.+-- -- 'ToPretty' is an open type family, that converts a custom type to a -- `PrettyType`. ----- Use the type aliases to get rid of unticked or even ticked promoteds.------ 'showPretty' eventually crafts a 'String' value from a proxy to they custom+-- 'showPretty' eventually crafts a 'String' value from a proxy to the custom -- type. --+-- It might be helpful to overcome egoistic needs for guaranteed compiler+-- termination (i.e. allowing UndecidableInstances) in order to be able to use+-- type aliases like 'PutStr', 'PutNat', etc.+-- -- == Example ----- This example shows howto render this table:+-- Let's start with the output: -- -- > +-------+-----+------------+ -- > | col 1|col 2| col 3|@@ -32,9 +37,7 @@ -- > | 0| 4351| 623562| -- > +-------+-----+------------+ ----- Assume a custom type for tables calles @MyTable@.------ Rendering this table:+-- ... of rendering this table: -- -- >type TestTable = -- > 'MyTable '[MyCol "col 1" 7, MyCol "col 2" 5, MyCol "col 3" 12]@@ -46,25 +49,25 @@ -- > ] -- > ----- Using this function:+-- ...using this function: -- -- @ -- prettyTestTable :: String -- prettyTestTable = 'showPretty' (Proxy :: Proxy TestTable) -- @ ----- These are the data types. Note that only numbers can be stored in MyTable.+-- ...from these data types: -- -- > -- | A type with a list of columns and rows. -- > data MyTable = MyTable [Type] [Type] -- >--- > -- | A row of a table, with a list of values, one each for every column.+-- > -- | A row of a table, with a list of numbers, one each for every column. -- > data MyRow :: [Nat] -> Type -- > -- > -- | The column of a table. It has a width and a column title. -- > data MyCol :: Symbol -> Nat -> Type ----- Here's the top-level 'ToPretty' instance:+-- ...converted to 'PrettyType' using this 'ToPretty' instance: -- -- @ -- type instance 'ToPretty' ('MyTable cols rows) =@@ -73,11 +76,7 @@ -- '<$$>' 'PrettyManyIn' ('PutStr' "+") (RowSepLine cols) -- '<$$>' 'PrettyHigh' (TableRows cols rows) -- '<$$>' 'PrettyManyIn' ('PutStr' "+") (RowSepLine cols)--- @ ----- It delegates to these:------ @ -- type family -- TableHeading (cols :: [Type]) :: ['PrettyType'] where -- TableHeading '[] = '[]@@ -109,24 +108,31 @@ import Data.Proxy import Text.Printf --- * Printing Custom Types+-- * Pretty Printing Types --- | Pretty print a type for which a 'ToPretty' instance was defined, that--- converts the type to a 'PrettyType'. If you want to roll your own converter--- for your type to 'PrettyType', just do that and call 'ptShow' directly.+-- | Pretty print either types of kind 'PrettyType' or any other type with a+-- 'ToPretty' instance. showPretty- :: forall proxy t . PrettyTypeShow (ToPretty t)+ :: forall proxy (t :: k) . PrettyTypeShow (ToPretty t) => proxy t -- ^ A proxy to the type to print. A 'ToPretty' instance for t must exists. -> String showPretty _ = ptShow (Proxy :: Proxy (ToPretty t)) --- | Write an instance of this for converting your type (preferrable of your--- kind also) to a promoted 'PrettyType'. NOTE: It might be helpful to turn on--- UndecidableInstances and use the type like 'PutStr' aliases below.+-- | Create a 'PrettyType' from a type.+--+-- This is a type-level equivalent of the 'Show' class.+--+-- Write an instance of this for converting your type (preferrable of your+-- kind also) to a promoted 'PrettyType'. type family ToPretty (a :: k) :: PrettyType --- * Building Pretty Type Documents+-- | A type of kind 'PrettyType' has a trivial @id@-like'ToPretty' instance.+type instance ToPretty (t :: PrettyType) = t +-- * Pretty Printing++-- ** Pretty Printing Strings ('Symbol')+ -- | A 'PrettyType' for a string. type PutStr str = 'PrettySymbol 'PrettyUnpadded 'PrettyPrecise str @@ -137,59 +143,14 @@ -- | A 'PrettyType' for a string with a newline character at the end. type PutStrLn str = PutStr str <++> PutStr "\n" +-- ** Pretty Printing Numbers ('Nat')+ -- | A 'PrettyType' for a number. type PutNat x = 'PrettyNat 'PrettyUnpadded 'PrettyPrecise 'PrettyDec x -- | A 'PrettyType' for a number with a width. type PutNatW width x = 'PrettyNat ('PrettyPadded width) 'PrettyPrecise 'PrettyDec x --- | Concatenate two 'PrettyType'.-type (<++>) l r = 'PrettySeperated 'PrettyEmpty l r-infixl 6 <++>---- | Concatenate two 'PrettyType' using a 'PrettySpace'.-type (<+>) l r = 'PrettySeperated 'PrettySpace l r-infixl 5 <+>---- | Concatenate two 'PrettyType' using a 'PrettyNewline'.-type (<$$>) l r = 'PrettySeperated 'PrettyNewline l r-infixl 4 <$$>---- | Surround a pretty with parens-type PrettyParens doc = PrettySurrounded (PutStr "(") (PutStr ")") doc---- | Surround a pretty with some pretties-type PrettySurrounded open close doc =- open <++> doc <++> close---- | Combine a (type level) list of 'PrettyType's next to each other using--- 'PrettySpace'-type PrettyWide docs = PrettyMany 'PrettySpace docs---- | Combine a (type level) list of 'PrettyType's below each other using--- 'PrettyNewline'-type PrettyHigh docs = PrettyMany 'PrettyNewline docs---- | A combination of 'PrettySpace' and 'PrettyMany', e.g.:------ >>> ptShow (Proxy :: Proxy (PrettyManyIn (PutStr "|") '[PutStr "a", PutStr "b"]))--- "|a|b|"-type PrettyManyIn sep docs =- PrettySurrounded sep sep (PrettyMany sep docs)---- | Combine a (type level) list of 'PrettyType's seperated by a seperation--- element.-type family- PrettyMany (sep :: PrettyType)(docs :: [PrettyType]) :: PrettyType where- PrettyMany sep '[] = 'PrettyEmpty- PrettyMany sep '[singleOne] = singleOne- PrettyMany sep (next ': rest) = next <++> sep <++> PrettyMany sep rest---- | Repeat a 'PrettyType' @n@-times and append the copies.-type family PrettyOften (n :: Nat) (doc :: PrettyType) :: PrettyType where- PrettyOften 0 doc = 'PrettyEmpty- PrettyOften n doc = doc <++> PrettyOften (n-1) doc- -- | Create 'PrettyType' from a 'Nat' formatted as hex number using -- lower-case letters for the hex digits. type PutHex x = 'PrettyNat 'PrettyUnpadded 'PrettyPrecise 'PrettyHex x@@ -223,30 +184,83 @@ -- | Create 'PrettyType' from a 'Nat' formatted as bit representation, ----- >>> ptShow (Proxy :: Proxy (PutBits 5))+-- >>> showPretty (Proxy :: Proxy (PutBits 5)) -- "101" type PutBits x = 'PrettyNat 'PrettyUnpadded 'PrettyPrecise 'PrettyBit x -- | Create 'PrettyType' from a 'Nat' formatted as 8-bit bit representation, ----- >>> ptShow (Proxy :: Proxy (PutBits8 5))+-- >>> showPretty (Proxy :: Proxy (PutBits8 5)) -- "00000101" type PutBits8 x = 'PrettyNat 'PrettyUnpadded ('PrettyPrecision 8) 'PrettyBit x -- | Create 'PrettyType' from a 'Nat' formatted as 16-bit bit representation, ----- >>> ptShow (Proxy :: Proxy (PutBits16 5))+-- >>> showPretty (Proxy :: Proxy (PutBits16 5)) -- "00000000000000101" type PutBits16 x = 'PrettyNat 'PrettyUnpadded ('PrettyPrecision 16) 'PrettyBit x -- | Create 'PrettyType' from a 'Nat' formatted as 32-bit bit representation, ----- >>> ptShow (Proxy :: Proxy (PutBits32 5))+-- >>> showPretty (Proxy :: Proxy (PutBits32 5)) -- "00000000000000000000000000000000101" type PutBits32 x = 'PrettyNat 'PrettyUnpadded ('PrettyPrecision 32) 'PrettyBit x -- | Create 'PrettyType' from a 'Nat' formatted as 64-bit bit representation, ----- >>> ptShow (Proxy :: Proxy (PutBits64 5))+-- >>> showPretty (Proxy :: Proxy (PutBits64 5)) -- "00000000000000000000000000000000000000000000000000000000000000000000101" type PutBits64 x = 'PrettyNat 'PrettyUnpadded ('PrettyPrecision 64) 'PrettyBit x +-- ** Composing Pretty Printers++-- | Concatenate two 'PrettyType'.+type (<++>) l r = 'PrettySeperated 'PrettyEmpty l r+infixl 6 <++>++-- | Concatenate two 'PrettyType' using a 'PrettySpace'.+type (<+>) l r = 'PrettySeperated 'PrettySpace l r+infixl 5 <+>++-- | Concatenate two 'PrettyType' using a 'PrettyNewline'.+type (<$$>) l r = 'PrettySeperated 'PrettyNewline l r+infixl 4 <$$>++-- | Surround a pretty with parens+type PrettyParens doc = PrettySurrounded (PutStr "(") (PutStr ")") doc++-- | Surround a pretty with some pretties+type PrettySurrounded open close doc =+ open <++> doc <++> close++-- *** Pretty Printing Lists++-- | Combine a (type level) list of 'PrettyType's next to each other using+-- 'PrettySpace'+type PrettyWide docs = PrettyMany 'PrettySpace docs++-- | Combine a (type level) list of 'PrettyType's below each other using+-- 'PrettyNewline'+type PrettyHigh docs = PrettyMany 'PrettyNewline docs++-- | A combination of 'PrettySpace' and 'PrettyMany', e.g.:+--+-- >>> showPretty (Proxy :: Proxy (PrettyManyIn (PutStr "|") '[PutStr "a", PutStr "b"]))+-- "|a|b|"+type PrettyManyIn sep docs =+ PrettySurrounded sep sep (PrettyMany sep docs)++-- | Combine a (type level) list of 'PrettyType's seperated by a seperation+-- element.+type family+ PrettyMany (sep :: PrettyType)(docs :: [PrettyType]) :: PrettyType where+ PrettyMany sep '[] = 'PrettyEmpty+ PrettyMany sep '[singleOne] = singleOne+ PrettyMany sep (next ': rest) = next <++> sep <++> PrettyMany sep rest++-- | Repeat a 'PrettyType' @n@-times and append the copies.+type family PrettyOften (n :: Nat) (doc :: PrettyType) :: PrettyType where+ PrettyOften 0 doc = 'PrettyEmpty+ PrettyOften n doc = doc <++> PrettyOften (n-1) doc++-- * Basic Building Blocks+ -- | Combinators for /type documents/. -- -- The basis for pretty printing is this eDSL. It is rendered via the@@ -286,30 +300,31 @@ data PrettyNatFormat = -- | Hexa decimal rendering: --- -- >>> ptShow (Proxy::Proxy (PrettyNat PrettyUnpadded PrettyPrecise PrettyHex 51966))+ -- >>> showPretty (Proxy::Proxy (PrettyNat PrettyUnpadded PrettyPrecise PrettyHex 51966)) -- "cafe" PrettyHex -- | Hexa decimal rendering (upper case): --- -- >>> ptShow (Proxy::Proxy (PrettyNat PrettyUnpadded PrettyPrecise PrettyHexU 51966))+ -- >>> showPretty (Proxy::Proxy (PrettyNat PrettyUnpadded PrettyPrecise PrettyHexU 51966)) -- "CAFE" | PrettyHexU -- | Decimal rendering: --- -- >>> ptShow (Proxy::Proxy (PrettyNat PrettyUnpadded PrettyPrecise PrettyHexU 51966))+ -- >>> showPretty (Proxy::Proxy (PrettyNat PrettyUnpadded PrettyPrecise PrettyHexU 51966)) -- "51966" | PrettyDec -- | Binary rendering: --- -- >>> ptShow (Proxy::Proxy (PrettyNat PrettyUnpadded PrettyPrecise PrettyHexU 51966))+ -- >>> showPretty (Proxy::Proxy (PrettyNat PrettyUnpadded PrettyPrecise PrettyHexU 51966)) -- "1100101011111110" | PrettyBit --- * Low-Level Rendering+-- * Pretty Rendering --- | In order to actually print anything from the promoted constructors of--- 'PrettyTypeShow', a type class as common interface is required.+-- | An __internal__ type class for rendering the types of /kind/ 'PrettyType'. class PrettyTypeShow (p :: PrettyType) where+ -- | Given any proxy to a promoted constructor of 'PrettyType', generate a+ -- String. ptShow :: proxy p -> String -- | Print nothing.@@ -357,13 +372,13 @@ -- | Generate a piece of a 'printf' format string from a proxy for a type. toPrintfArgModifier :: p a -> String --- | Translation of 'PrettyHex' to 'printf' format character: @"x"@+-- | Translation of 'PrettyHex' to 'printf' format character: @x@ instance PrintfArgModifier 'PrettyHex where toPrintfArgModifier _ = "x"--- | Translation of 'PrettyHexU' to 'printf' format character: @"X"@+-- | Translation of 'PrettyHexU' to 'printf' format character: @X@ instance PrintfArgModifier 'PrettyHexU where toPrintfArgModifier _ = "X"--- | Translation of 'PrettyDec' to 'printf' format character: @"d"@+-- | Translation of 'PrettyDec' to 'printf' format character: @d@ instance PrintfArgModifier 'PrettyDec where toPrintfArgModifier _ = "d"--- | Translation of 'PrettyBit' to 'printf' format character: @"b"@+-- | Translation of 'PrettyBit' to 'printf' format character: @b@ instance PrintfArgModifier 'PrettyBit where toPrintfArgModifier _ = "b" -- | Translation of 'PrettyUnpadded' to an empty modifier string instance PrintfArgModifier 'PrettyUnpadded where toPrintfArgModifier _ = ""