show-prettyprint 0.1.0.2 → 0.1.2

raw patch · 7 files changed

+277/−185 lines, 7 filesdep ~basedep ~trifectaPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, trifecta

API changes (from Hackage documentation)

Files

• LICENSE +0/−30
• LICENSE.md +29/−0
• README.md +18/−60
• show-prettyprint.cabal +6/−3
• src/Text/Show/Prettyprint.hs +37/−92
• src/Text/Show/Prettyprint/Diagnostic.hs +41/−0
• src/Text/Show/Prettyprint/Internal.hs +146/−0

@@ -1,30 +0,0 @@-Copyright Author name here (c) 2016--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 Author name here 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.

@@ -0,0 +1,29 @@+BSD3 License+============++Copyright David Luposchainsky (c) 2016++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 Author name here 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.

@@ -10,72 +10,30 @@ reacts on parentheses, commas and the like. This makes it fairly robust even in the face of invalid `Show` instances, that may not produce valid Haskell code. ---## Examples--### Artificial+For example, consider this nested data structure:  ```haskell-Hello Foo ("(Bar", Haha) (Baz (A { foo = C, bar = D, qux = (E,"He)llo World!",G,-    H,[A,B,c,d,e,Fghi]) } ) (B,C) [Baz A1 B2, (Baz A3 (B4)), (Baz A5 (B6)), (Baz-    (A7) B8)]) (Foo) (Bar) (Baz (A) (B))--==>--Hello Foo ("(Bar",Haha)-          (Baz (A {foo = C-                  ,bar = D-                  ,qux = (E-                         ,"He)llo World!"-                         ,G-                         ,H-                         ,[A,B,c,d,e,Fghi])})-               (B,C)-               [Baz A1 B2-               ,(Baz A3 (B4))-               ,(Baz A5 (B6))-               ,(Baz (A7) B8)])-          (Foo)-          (Bar)-          (Baz (A) (B))+nestedExample = fromList+    [ ("hello", Left  (Pair True ()))+    , ("world", Right (Record { r1 = ('c', -1.2e34), r2 = 123 }))+    , ("!"    , Left  (Pair False ())) ] ``` -### Inspired by a real AST+Applying show to it results in the fairly dense representation  ```haskell-Set  (fromList [(Name "A string with (parenthesis",Ann  (Entry (Quality 1 1)-    (Ann  False) (Ann  (Map [Ann  (Bound (Ann  (Id "lorem"))),Ann  (Variable-    (Ann  (Id "ipsum")))])))),(Name "string",Ann  (Entry (Quality 1 1) (Ann-    True) (Ann  (Internal (Ann  (Reduce (Ann  (Id "dolor")) (Ann  (Id "sit")))))-    ))),(Name "Another } here",Ann  (Entry (Quality 1 1) (Ann  (Or [Ann  (Not-    (Ann  (Is (Ann  Flagged) (Ann  Type) (Ann  (Multi [Ann  (Literal (Ann  One))-    ]))))),Ann  (Is (Ann  Flagged) (Ann  Type) (Ann  (Multi [Ann  (Literal (Ann-    Three))]))),Ann  (Is (Ann  Flagged) (Ann  Type) (Ann  (Multi [Ann  (Literal-    (Ann  Two))])))])) (Ann  (Internal (Ann  (Concat (Ann  (Id "amet"))))))))])+fromList [("!",Left (Pair False ())),("hello",Left (Pair True ())),("world",Right (Record {r1 = ('c',-1.2e34), r2 = 123}))]+``` -==>+With the functions defined in this module, we can make this output a bit more+readable, -Set (fromList [(Name "A string with (parenthesis"-               ,Ann (Entry (Quality 1 1)-                           (Ann False)-                           (Ann (Map [Ann (Bound (Ann (Id "lorem")))-                                     ,Ann (Variable (Ann (Id "ipsum")))]))))-              ,(Name "string"-               ,Ann (Entry (Quality 1 1)-                           (Ann True)-                           (Ann (Internal (Ann (Reduce (Ann (Id "dolor"))-                                                       (Ann (Id "sit"))))))))-              ,(Name "Another } here"-               ,Ann (Entry (Quality 1 1)-                           (Ann (Or [Ann (Not (Ann (Is (Ann Flagged)-                                                       (Ann Type)-                                                       (Ann (Multi [Ann (Literal (Ann One))])))))-                                    ,Ann (Is (Ann Flagged)-                                             (Ann Type)-                                             (Ann (Multi [Ann (Literal (Ann Three))])))-                                    ,Ann (Is (Ann Flagged)-                                             (Ann Type)-                                             (Ann (Multi [Ann (Literal (Ann Two))])))]))-                           (Ann (Internal (Ann (Concat (Ann (Id "amet"))))))))])+```haskell+fromList [("!"+          ,Left (Pair False ()))+         ,("hello",Left (Pair True ()))+         ,("world"+          ,Right (Record {r1 = ('c'+                               ,-1.2e34)+                         ,r2 = 123}))] ```

@@ -1,11 +1,11 @@ name:                show-prettyprint-version:             0.1.0.2+version:             0.1.2 synopsis:            Robust prettyprinter for output of auto-generated Show                      instances description:         See README.md homepage:            https://github.com/quchen/show-prettyprint#readme license:             BSD3-license-file:        LICENSE+license-file:        LICENSE.md author:              David Luposchainsky <dluposchainsky (λ) google> maintainer:          David Luposchainsky <dluposchainsky (λ) google> copyright:           David Luposchainsky, 2016@@ -18,12 +18,15 @@ library   hs-source-dirs:      src   exposed-modules:     Text.Show.Prettyprint+                     , Text.Show.Prettyprint.Diagnostic+                     , Text.Show.Prettyprint.Internal   build-depends:       base >= 4.7 && < 5                      , trifecta >= 1.6                       -- Transitive dependency of Trifecta, so let the-                     --version be sorted out by that+                     -- version be sorted out by that                      , ansi-wl-pprint+  ghc-options:         -Wall   default-language:    Haskell2010  test-suite doctest

@@ -1,39 +1,55 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}- -- | Format a 'show'-generated string to make it nicer to read. --+-- For example, consider this nested data structure:+-- -- >>> :{--- (putStrLn . prettyShow . Data.Map.fromList)---     [("hello", Just True), ("world", Nothing), ("!", Just False)]+-- let nestedExample = fromList+--         [ ("hello", Left  (Pair True ()))+--         , ("world", Right (Record { r1 = ('c', -1.2e34), r2 = 123 }))+--         , ("!"    , Left  (Pair False ())) ] -- :}--- fromList [("!",Just False)---          ,("hello",Just True)---          ,("world",Nothing)] ----- See the readme for some more examples.+-- Applying 'show' to it results in the fairly dense representation+--+-- >>> print nestedExample+-- fromList [("!",Left (Pair False ())),("hello",Left (Pair True ())),("world",Right (Record {r1 = ('c',-1.2e34), r2 = 123}))]+--+-- With the functions defined in this module, we can make this output a bit more+-- readable,+--+-- >>> prettyPrint nestedExample+-- fromList [("!"+--           ,Left (Pair False ()))+--          ,("hello",Left (Pair True ()))+--          ,("world"+--           ,Right (Record {r1 = ('c'+--                                ,-1.2e34)+--                          ,r2 = 123}))] module Text.Show.Prettyprint (     prettifyShow,     prettyShow,--    -- * Diagnostic functions-    prettifyShowErr,-    prettyShowErr,+    prettyPrint, ) where   -import Control.Applicative-import Data.Monoid-import Text.PrettyPrint.ANSI.Leijen as Ppr hiding ((<>))-import Text.Trifecta                as Tri+import Text.Trifecta +import Text.Show.Prettyprint.Internal  ++-- $setup+-- >>> data Record a b = Record { r1 :: a, r2 :: b } deriving Show+-- >>> data Pair a b = Pair a b deriving Show+-- >>> import Data.Map (fromList)+++ -- | Prettyprint a string produced by 'show'. On parse error, silently fall back -- to a non-prettyprinted version. prettifyShow :: String -> String-prettifyShow s = case parseString conP mempty s of+prettifyShow s = case parseString shownP mempty s of     Success x -> show x     Failure _ -> s @@ -41,77 +57,6 @@ prettyShow :: Show a => a -> String prettyShow = prettifyShow . show --- | Attempt to prettify a string produced by 'show'. Report error information--- on failure.-prettifyShowErr :: String -> String-prettifyShowErr s = case parseString conP mempty s of-    Success x -> show x-    Failure ErrInfo{ _errDoc = e } -> "ERROR " <> show e---- | 'prettifyShowErr' with the 'show' baked in.-prettyShowErr :: Show a => a -> String-prettyShowErr = prettifyShowErr . show----conP :: Parser Doc-conP = do-    thing <- (token . choice)-        [ word-        , number-        , fmap (dquotes . Ppr.string) stringLiteral ]-    args <- many argP-    pure (if null args-        then thing-        else thing <+> align (sep args) )--word :: Parser Doc-word = variable <|> constructor--number :: Parser Doc-number = p <?> "number"-  where-    p = integerOrDouble >>= \case-        Left i -> pure (Ppr.integer i)-        Right d -> pure (Ppr.double d)--identifierStartingWith :: CharParsing f => f Char -> f Doc-identifierStartingWith x = liftA2 (\c cs -> Ppr.string (c:cs)) (x <|> Tri.char '_') (many (alphaNum <|> oneOf "'_"))--variable :: Parser Doc-variable = identifierStartingWith lower <?> "variable"--constructor :: Parser Doc-constructor = identifierStartingWith upper <?> "constructor"--argP :: Parser Doc-argP = (token . choice) [unitP, tupleP, listP, recordP, conP]--unitP :: Parser Doc-unitP = p <?> "()"-  where-    p = fmap Ppr.string (Tri.string "()")--tupleP :: Parser Doc-tupleP = p <?> "tuple"-  where-    p = fmap (encloseSep lparen rparen Ppr.comma) (Tri.parens (do-        x <- argP-        xs <- many (Tri.comma *> argP)-        pure (x:xs) ))--listP :: Parser Doc-listP = p <?> "list"-  where-    p = fmap (encloseSep lbracket rbracket Ppr.comma)-             (Tri.brackets (sepBy argP Tri.comma))--recordP :: Parser Doc-recordP = p <?> "{...}"-  where-    p = fmap (encloseSep lbrace rbrace Ppr.comma) (Tri.braces (sepBy recordEntryP Tri.comma))-    recordEntryP = do-        lhs <- token word-        _ <- token (Tri.char '=')-        rhs <- argP-        pure (lhs <+> Ppr.string "=" <+> rhs)+-- | 'prettifyShow' with the 'show' and the 'putStrLn' baked in.+prettyPrint :: Show a => a -> IO ()+prettyPrint = putStrLn . prettyShow

@@ -0,0 +1,41 @@+-- | These functions are identical to the ones in the main module, but instead+-- of falling back to the un-prettyprinted input, they will report an error on+-- failure.+--+-- >>> putStrLn (prettifyShowErr "Imbalanced (Parenthesis)) here")+-- ERROR (interactive):1:25: error: expected: char literal,+--     end of input, identifier, list,+--     number, record, string literal,+--     tuple, unit+-- Imbalanced (Parenthesis)) here<EOF>+--                         ^+module Text.Show.Prettyprint.Diagnostic (+    prettifyShowErr,+    prettyShowErr,+    prettyPrintErr,+) where++++import Data.Monoid+import Text.PrettyPrint.ANSI.Leijen as Ppr hiding ((<>))+import Text.Trifecta                as Tri++import Text.Show.Prettyprint.Internal++++-- | Attempt to prettify a string produced by 'show'. Report error information+-- on failure.+prettifyShowErr :: String -> String+prettifyShowErr s = case parseString shownP mempty s of+    Success x -> show x+    Failure ErrInfo{ _errDoc = e } -> "ERROR " <> show (plain e)++-- | 'prettifyShowErr' with the 'show' baked in.+prettyShowErr :: Show a => a -> String+prettyShowErr = prettifyShowErr . show++-- | 'prettifyShowErr' with the 'show' and the 'putStrLn' baked in.+prettyPrintErr :: Show a => a -> IO ()+prettyPrintErr = putStrLn . prettyShowErr

@@ -0,0 +1,146 @@+{-# LANGUAGE LambdaCase #-}++-- | __This module may change arbitrarily between versions.__ It is exposed only+-- for documentary purposes.+module Text.Show.Prettyprint.Internal (+    shownP,+    valueP,+    identifierP,+    numberP,+    stringLitP,+    charLitP,+    argP,+    unitP,+    tupleP,+    listP,+    recordP,+) where++++import Control.Applicative+import Text.PrettyPrint.ANSI.Leijen as Ppr hiding ((<>))+import Text.Trifecta                as Tri++++-- $setup+-- >>> :{+-- let testParse p s = case parseString p mempty s of+--         Success x -> print x+--         Failure ErrInfo{ _errDoc = e } -> putStrLn ("ERROR " ++ show (plain e))+-- :}++++-- | Prettyparser for a 'show'-generated string+shownP :: Parser Doc+shownP = valueP <* eof++-- | Prettyparser for a constructor, which is roughly a word applied to+-- arguments.+--+-- >>> testParse valueP "Just ('c', Left ())"+-- Just ('c',Left ())+valueP :: Parser Doc+valueP = do+    thing <- choice [identifierP, numberP, stringLitP, charLitP]+    args <- many argP+    pure (if null args+        then thing+        else thing <+> align (sep args) )++-- | An identifier is a liberal version of a "variable or constructor", which+-- roughly means that it's a printable word without parentheses.+--+-- >>> testParse identifierP "_foo'bar"+-- _foo'bar+identifierP :: Parser Doc+identifierP = token (p <?> "identifier")+  where+    p = fmap Ppr.text (some (alphaNum <|> oneOf "'_"))++-- | Number in integer or scientific notation.+--+-- >>> testParse numberP "123456"+-- 123456+--+-- >>> testParse numberP "-123.4e56"+-- -1.234e58+numberP :: Parser Doc+numberP = p <?> "number"+  where+    p = integerOrDouble >>= \case+        Left i -> pure (Ppr.integer i)+        Right d -> pure (Ppr.double d)++-- |+-- >>> testParse stringLitP "\"Hello world!\""+-- "Hello world!"+stringLitP :: Parser Doc+stringLitP = token (p <?> "string literal")+  where+    p = fmap (dquotes . Ppr.string) stringLiteral++-- |+-- >>> testParse charLitP "'c'"+-- 'c'+charLitP :: Parser Doc+charLitP = token (p <?> "char literal")+  where+    p = fmap (squotes . Ppr.char) Tri.charLiteral++-- | Anything that could be considered an argument to something else.+--+-- >>> testParse argP "()"+-- ()+--+-- >>> testParse argP "['h', 'e', 'l', 'l', 'o']"+-- ['h','e','l','l','o']+argP :: Parser Doc+argP = (token . choice) [unitP, tupleP, listP, recordP, valueP]++-- |+-- >>> testParse unitP "()"+-- ()+unitP :: Parser Doc+unitP = p <?> "unit"+  where+    p = fmap Ppr.string (Tri.string "()")++-- | Prettyparser for tuples from size 1. Since 1-tuples are just parenthesized+-- expressions to first order approximation, this parser handles those as well.+--+-- >>> testParse tupleP "((), True, 'c')"+-- ((),True,'c')+tupleP :: Parser Doc+tupleP = p <?> "tuple"+  where+    p = fmap (encloseSep lparen rparen Ppr.comma) (Tri.parens (do+        x <- argP+        xs <- many (Tri.comma *> argP)+        pure (x:xs) ))++-- | List prettyparser. Lists can be heterogeneous, which is realistic if we+-- consider ill-defined Show instances.+--+-- >>> testParse listP "[\"Hello\", World]"+-- ["Hello",World]+listP :: Parser Doc+listP = p <?> "list"+  where+    p = fmap (encloseSep lbracket rbracket Ppr.comma)+             (Tri.brackets (sepBy argP Tri.comma))++-- |+-- >>> testParse recordP "{ r1 = (), r2 = Just True }"+-- {r1 = (),r2 = Just True}+recordP :: Parser Doc+recordP = p <?> "record"+  where+    p = fmap (encloseSep lbrace rbrace Ppr.comma) (Tri.braces (sepBy recordEntryP Tri.comma))+    recordEntryP = do+        lhs <- token identifierP+        _ <- token (Tri.char '=')+        rhs <- argP+        pure (lhs <+> Ppr.string "=" <+> rhs)