diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Revision history for prettyprinter-graphviz +## 1.1.0.0 -- 2020-10-09 + +* Use shallower module hierarchy, reflecting changes in `prettyprinter-1.7`. +* Take a list of attributes as annotation, so that zero or many can be specified. +* Handle newlines correctly. Previously, labels would always take up just one line. + ## 1.0.0.0 -- 2020-06-12 * Simplify considerably by using helper functions from `prettyprinter`. diff --git a/prettyprinter-graphviz.cabal b/prettyprinter-graphviz.cabal --- a/prettyprinter-graphviz.cabal +++ b/prettyprinter-graphviz.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: prettyprinter-graphviz -version: 1.0.0.2 +version: 1.1.0.0 synopsis: A prettyprinter backend for graphviz description: Provides utility functions for rendering pretty GraphViz labels. homepage: https://github.com/georgefst/prettyprinter-graphviz @@ -19,11 +19,11 @@ library exposed-modules: - Data.Text.Prettyprint.Doc.Render.GraphViz + Prettyprinter.Render.GraphViz build-depends: base >= 4.11 && < 5, graphviz ^>= 2999.20.0.3, - prettyprinter ^>= { 1.5.1, 1.6 }, + prettyprinter ^>= { 1.5.1, 1.6, 1.7 }, text ^>= 1.2.3.1, hs-source-dirs: src ghc-options: diff --git a/src/Data/Text/Prettyprint/Doc/Render/GraphViz.hs b/src/Data/Text/Prettyprint/Doc/Render/GraphViz.hs deleted file mode 100644 --- a/src/Data/Text/Prettyprint/Doc/Render/GraphViz.hs +++ /dev/null @@ -1,70 +0,0 @@ --- | Pretty-print GraphViz labels -module Data.Text.Prettyprint.Doc.Render.GraphViz ( - render, - render', -) where - -import qualified Data.Text.Lazy as TL -import qualified Data.Text as T - -import Data.GraphViz.Attributes.Complete (Label(HtmlLabel)) -import qualified Data.GraphViz.Attributes.HTML as H -import Data.Text (Text) -import Data.Text.Prettyprint.Doc ( - Doc, - SimpleDocStream( - SFail, - SEmpty, - SChar, - SText, - SLine, - SAnnPush, - SAnnPop), - layoutPretty, defaultLayoutOptions, - ) -import Data.Text.Prettyprint.Doc.Internal (textSpaces) -import Data.Text.Prettyprint.Doc.Render.Util.Panic ( - panicUnpairedPop, panicInputNotFullyConsumed, panicUncaughtFail - ) - --- | Render a document as a GraphViz label, using sensible defaults. -render :: Doc H.Attribute -> Label -render = HtmlLabel . H.Text . render' . layoutPretty defaultLayoutOptions - --- | Render a document stream as HTML text for GraphViz. This provides more fine-grained control than 'render'. -render' :: SimpleDocStream H.Attribute -> H.Text -render' = renderSimplyDecorated' (pure .: renderText) mempty mempty - - -{- Util -} - -(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d -(.:) = (.) . (.) - --- | This is a very minor modification of 'renderSimplyDecorated', where the /text/ function is --- additionally passed the current stack. Worth suggesting change upstream. -renderSimplyDecorated' - :: Monoid out - => ([ann] -> Text -> out) -- ^ Render plain 'Text' - -> (ann -> out) -- ^ How to render an annotation - -> (ann -> out) -- ^ How to render the removed annotation - -> SimpleDocStream ann - -> out -renderSimplyDecorated' text push pop = go [] - where - go _ SFail = panicUncaughtFail - go [] SEmpty = mempty - go (_:_) SEmpty = panicInputNotFullyConsumed - go stack (SChar c rest) = text stack (T.singleton c) <> go stack rest - go stack (SText _l t rest) = text stack t <> go stack rest - go stack (SLine i rest) = text stack (T.singleton '\n') <> text stack (textSpaces i) <> go stack rest - go stack (SAnnPush ann rest) = push ann <> go (ann : stack) rest - go (ann:stack) (SAnnPop rest) = pop ann <> go stack rest - go [] SAnnPop{} = panicUnpairedPop - --- | Helper for rendering an individual 'H.TextItem'. -renderText :: H.Attributes -> T.Text -> H.TextItem -renderText cs t - | T.null t = ti -- graphviz doesn't like an empty string between tags - | otherwise = H.Font cs [ti] - where ti = H.Str $ TL.fromStrict t diff --git a/src/Prettyprinter/Render/GraphViz.hs b/src/Prettyprinter/Render/GraphViz.hs new file mode 100644 --- /dev/null +++ b/src/Prettyprinter/Render/GraphViz.hs @@ -0,0 +1,65 @@ +-- | Pretty-print GraphViz labels +module Prettyprinter.Render.GraphViz ( + render, + render', +) where + +import qualified Data.Text.Lazy as TL +import qualified Data.Text as T + +import Data.GraphViz.Attributes.Complete (Label(HtmlLabel)) +import qualified Data.GraphViz.Attributes.HTML as H +import Data.Text.Prettyprint.Doc ( + Doc, + SimpleDocStream( + SFail, + SEmpty, + SChar, + SText, + SLine, + SAnnPush, + SAnnPop), + layoutPretty, defaultLayoutOptions, + ) +import Data.Text.Prettyprint.Doc.Internal (textSpaces) +import Data.Text.Prettyprint.Doc.Render.Util.Panic ( + panicUnpairedPop, panicInputNotFullyConsumed, panicUncaughtFail + ) + +-- | Render a document as a GraphViz label, using sensible defaults. +render :: Doc H.Attributes -> Label +render = HtmlLabel . H.Text . render' . layoutPretty defaultLayoutOptions + +-- | Render a document stream as HTML text for GraphViz. This provides more fine-grained control than 'render'. +render' :: SimpleDocStream H.Attributes -> H.Text +render' = renderSimplyDecorated' mempty mempty + + +{- Util -} + +(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d +(.:) = (.) . (.) + + +-- | This is a minor modification of 'renderSimplyDecorated', where the /text/ function is +-- additionally passed the current stack. +renderSimplyDecorated' :: ([H.Attribute] -> [H.TextItem]) -> ([H.Attribute] -> [H.TextItem]) -> SimpleDocStream [H.Attribute] -> [H.TextItem] +renderSimplyDecorated' push pop = go [] + where + text = pure .: (renderText . concat) + go _ SFail = panicUncaughtFail + go [] SEmpty = mempty + go (_:_) SEmpty = panicInputNotFullyConsumed + go stack (SChar c rest) = text stack (T.singleton c) <> go stack rest + go stack (SText _l t rest) = text stack t <> go stack rest + go stack (SLine i rest) = [H.Newline [H.Align H.HLeft]] <> text stack (textSpaces i) <> go stack rest + go stack (SAnnPush ann rest) = push ann <> go (ann : stack) rest + go (ann:stack) (SAnnPop rest) = pop ann <> go stack rest + go [] SAnnPop{} = panicUnpairedPop + +-- | Helper for rendering an individual 'H.TextItem'. +renderText :: H.Attributes -> T.Text -> H.TextItem +renderText cs t + | T.null t = ti -- graphviz doesn't like an empty string between tags + | otherwise = H.Font cs [ti] + where ti = H.Str $ TL.fromStrict t