diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,16 @@ [1]: http://semver.org/spec/v2.0.0.html [2]: https://github.com/roman/Haskell-teardown/libraries/teardown/CHANGELOG.md +## V0.5.0.0 + +**BREAKING CHANGES** + +* Move from `ansi-wl-pprint` to `prettyprinter` +* Re-implement `Printer` using `prettyprinter` API, now `prettyTeardownResult` + returns a `Doc` type from the `prettyprinter` library +* Add a `Pretty` instance for the `DisposeResult` type +* Add a `Display` instance for the `DisposeResult` type + ## v0.4.1.0 * Ensure that all `IO ()` sub-routines on `runTeardown` get executed inside a diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -32,17 +32,16 @@ ## Documentation -* [Tutorial](https://romanandreg.gitbooks.io/teardown/v0.4/tutorial.html) -* [How-To Guides](https://romanandreg.gitbooks.io/teardown/v0.4/how-to/create-teardown.html) * [API Reference](https://hackage.haskell.org/package/teardown) +* [How-To Guides](https://romanandreg.gitbook.io/teardown/how-to/v0.5) ## Development -[![Build Status](https://travis-ci.org/roman/Haskell-teardown.svg?branch=master)](https://travis-ci.org/roman/Haskell-teardown) -[![Github](https://img.shields.io/github/commits-since/roman/haskell-teardown/v0.4.0.0.svg)](https://img.shields.io/github/commits-since/roman/haskell-teardown/v0.4.0.0.svg) +![Build Status](https://circleci.com/gh/roman/Haskell-teardown.svg?style=svg) +[![Github](https://img.shields.io/github/commits-since/roman/haskell-teardown/v0.5.0.0.svg)](https://img.shields.io/github/commits-since/roman/haskell-teardown/v0.5.0.0.svg) [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/teardown.svg)](http://packdeps.haskellers.com/feed?needle=teardown) -Follow the [developer guidelines](https://romanandreg.gitbooks.io/teardown/content/CONTRIBUTING.html) +Follow the [developer guidelines](https://romanandreg.gitbook.io/teardown/development-notes) ## License diff --git a/src/Control/Teardown/Internal/Printer.hs b/src/Control/Teardown/Internal/Printer.hs --- a/src/Control/Teardown/Internal/Printer.hs +++ b/src/Control/Teardown/Internal/Printer.hs @@ -2,24 +2,22 @@ {-# LANGUAGE OverloadedStrings #-} module Control.Teardown.Internal.Printer where -import Data.Monoid ((<>)) -import RIO hiding ((<>)) +import RIO hiding ((<>)) import Data.Typeable (typeOf) import qualified RIO.Text as Text -import Text.PrettyPrint.ANSI.Leijen hiding ((<>)) - +import Data.Text.Prettyprint.Doc import Control.Teardown.Internal.Types -treeTrunk :: Int -> Int -> Doc -treeTrunk start level = hcat (map (\_ -> text " ") [1 .. start]) - <> hcat (map (\_ -> text " |") [start .. level - 1]) +treeTrunk :: Int -> Int -> Doc ann +treeTrunk start level = hcat (map (\_ -> " ") [1 .. start]) + <> hcat (map (\_ -> " |") [start .. level - 1]) -- | Renders an ASCII Tree with the "TeardownResult" of a "Teardown" sub-routine -- execution -prettyTeardownResult :: TeardownResult -> Doc +prettyTeardownResult :: TeardownResult -> Doc ann prettyTeardownResult result = render 0 0 result <> hardline where renderError start level (SomeException err) = @@ -33,12 +31,12 @@ errorReport = treeTrunk (start - 1) (level + 1) <> ">" - <> indent 2 (text (show (typeOf err)) <> ":") - <+> text (Text.unpack fstErrLine) + <> indent 2 (pretty (show (typeOf err)) <> ":") + <+> pretty (Text.unpack fstErrLine) : map (\l -> treeTrunk (start - 1) (level + 1) <> ">" <> indent 2 - (text $ Text.unpack l) + (pretty $ Text.unpack l) ) errLines in @@ -50,26 +48,30 @@ treeTrunk start (level + 1) <> render (start + 1) (level + 1) lastResult (r : results) -> treeTrunk start (level + 1) - <> render start (level + 1) r - <$$> renderTree start level results + <> render start (level + 1) r + <> hardline + <> renderTree start level results + render start level disposeResult = case disposeResult of - EmptyResult desc -> "`-" <+> "✓" <+> text (Text.unpack desc) <+> "(empty)" + EmptyResult desc -> + "`-" <+> "✓" <+> pretty (Text.unpack desc) <+> "(empty)" LeafResult desc elapsed Nothing -> - "`-" <+> "✓" <+> text (Text.unpack desc) <+> text + "`-" <+> "✓" <+> pretty (Text.unpack desc) <+> pretty ("(" <> show elapsed <> ")") LeafResult desc elapsed (Just err) -> "`-" - <+> "✘" - <+> text (Text.unpack desc) - <+> text ("(" <> show elapsed <> ")") - <$$> renderError start level err + <+> "✘" + <+> pretty (Text.unpack desc) + <+> pretty ("(" <> show elapsed <> ")") + <> hardline + <> renderError start level err BranchResult desc elapsed didFail results -> vcat [ "`-" <+> (if didFail then "✘" else "✓") - <+> text (Text.unpack desc) - <+> text ("(" <> show elapsed <> ")") + <+> pretty (Text.unpack desc) + <+> parens (pretty $ show elapsed) , renderTree start level results ] diff --git a/src/Control/Teardown/Internal/Types.hs b/src/Control/Teardown/Internal/Types.hs --- a/src/Control/Teardown/Internal/Types.hs +++ b/src/Control/Teardown/Internal/Types.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} module Control.Teardown.Internal.Types where import RIO @@ -12,6 +13,10 @@ import GHC.Generics (Generic) #endif +import Data.Text.Prettyprint.Doc (Pretty, pretty, (<+>)) +import qualified Data.Text.Prettyprint.Doc as Pretty + + -------------------------------------------------------------------------------- type Description = Text @@ -47,6 +52,34 @@ resultDescription :: !Description } deriving (Generic, Show) + +instance Pretty TeardownResult where + pretty result = + case result of + EmptyResult {resultDescription} -> + "✓" <+> pretty resultDescription <+> Pretty.parens "empty" + LeafResult {resultDescription, resultElapsedTime, resultError} -> + case resultError of + Nothing -> + "✓" <+> pretty resultDescription <+> Pretty.parens (pretty $ show resultElapsedTime) + Just err -> + Pretty.hang 2 + (Pretty.vsep ["✘" + <+> pretty resultDescription + <+> Pretty.parens (pretty $ show resultElapsedTime) + , "|" <+> pretty (show err) ]) + BranchResult {resultDidFail, resultDescription, resultElapsedTime, resultListing} -> + let + symbolDoc = if resultDidFail then "✘" else "✓" + in + symbolDoc + <+> pretty resultDescription + <+> Pretty.parens (pretty $ show resultElapsedTime) + <> Pretty.hardline + <> Pretty.indent 2 (Pretty.align (Pretty.vsep (map pretty resultListing))) + +instance Display TeardownResult where + display = displayShow . pretty getElapsedTime :: TeardownResult -> NominalDiffTime getElapsedTime result = diff --git a/teardown.cabal b/teardown.cabal --- a/teardown.cabal +++ b/teardown.cabal @@ -1,5 +1,5 @@ name: teardown -version: 0.4.1.0 +version: 0.5.0.0 cabal-version: >=1.10 build-type: Simple license: MIT @@ -39,8 +39,8 @@ exposed-modules: Control.Teardown build-depends: - ansi-wl-pprint >=0.6.7.3, base >=4.8 && <5, + prettyprinter >=1.1, rio >=0.0.0.0, typed-process >=0.1.0.0, unliftio >=0.2.4.0