prettyprinter-graphviz 0.1.1.1 → 1.0.0.0

raw patch · 3 files changed

+65/−90 lines, 3 filesdep ~prettyprinterPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: prettyprinter

API changes (from Hackage documentation)

Files

• README.md +0/−2
• prettyprinter-graphviz.cabal +23/−18
• src/Data/Text/Prettyprint/Doc/Render/GraphViz.hs +42/−70

@@ -1,8 +1,6 @@ GraphViz pretty-printing =================================== -http://hackage.haskell.org/package/prettyprinter-graphviz- Just some simple utility functions for hooking up the Haskell libraries [graphviz](https://hackage.haskell.org/package/graphviz) and [prettyprinter](https://hackage.haskell.org/package/prettyprinter).  Given a [Doc](https://hackage.haskell.org/package/prettyprinter/docs/Data-Text-Prettyprint-Doc.html#t:Doc), you can use [render](https://hackage.haskell.org/package/prettyprinter-graphviz/docs/Data-Text-Prettyprint-Doc-Render-GraphViz.html#v:render) to transform it to a GraphViz [Label](https://hackage.haskell.org/package/graphviz/docs/Data-GraphViz-Attributes-Complete.html#t:Label). If you are using a different annotation type (eg. something more abstract), then you can define a mapping to GraphViz HTML attributes, and `fmap` it over your `Doc`.

@@ -1,29 +1,34 @@-cabal-version:       2.4+cabal-version:       3.0 name:                prettyprinter-graphviz-version:             0.1.1.1-synopsis:            a prettyprinter backend for graphviz-description:         Contains utility functions for rendering pretty GraphViz labels.+version:             1.0.0.0+synopsis:            A prettyprinter backend for graphviz+description:         Provides utility functions for rendering pretty GraphViz labels. homepage:            https://github.com/georgefst/prettyprinter-graphviz license:             BSD-3-Clause license-file:        LICENSE author:              George Thomas maintainer:          georgefsthomas@gmail.com category:            Graphics-extra-source-files:  CHANGELOG.md-                     README.md+extra-doc-files:+    CHANGELOG.md+    README.md  source-repository head-  type:     git-  location: git://github.com/georgefst/prettyprinter-graphviz.git+    type: git+    location: git://github.com/georgefst/prettyprinter-graphviz.git  library-  exposed-modules:     Data.Text.Prettyprint.Doc.Render.GraphViz-  build-depends:       base >= 4.11 && < 5-                      ,graphviz ^>= 2999.20.0.3-                      ,prettyprinter ^>= 1.5.1-                      ,text ^>= 1.2.3.1-  hs-source-dirs:      src-  default-language:    Haskell2010-  ghc-options:         -Wall-  default-extensions:  LambdaCase-                       OverloadedStrings+    exposed-modules:+        Data.Text.Prettyprint.Doc.Render.GraphViz+    build-depends:+        base >= 4.11 && < 5,+        graphviz ^>= 2999.20.0.3,+        prettyprinter ^>= { 1.5.1, 1.6 },+        text ^>= 1.2.3.1,+    hs-source-dirs: src+    ghc-options:+        -Wall+    default-language: Haskell2010+    default-extensions:+        LambdaCase+        OverloadedStrings

@@ -1,94 +1,66 @@ -- | Pretty-print GraphViz labels module Data.Text.Prettyprint.Doc.Render.GraphViz (-    -- * Rendering functions     render,     render',--    -- * Error handling-    -- The functions in this module can throw errors, given a malformed document stream.-    -- The average user is very unlikely to run into this,-    -- but error handling functionality is provided for completeness.-    GraphVizRenderError(..),-    renderSafe,-    renderSafe', ) where  import qualified Data.Text.Lazy as TL import qualified Data.Text as T -import Control.Exception (-    Exception,-    displayException,-    throw,-    )-import Data.GraphViz.Attributes.Complete (-    Label (HtmlLabel),-    )+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 (..),-        defaultLayoutOptions,-        layoutPretty,+    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 'defaultLayoutOptions'.+-- | Render a document as a GraphViz label, using sensible defaults. render :: Doc H.Attribute -> Label-render = throwLeft . renderSafe+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' = throwLeft . renderSafe'---- | Errors which indicate a malformed 'SimpleDocStream'.-data GraphVizRenderError-    -- | The stream ended with 'SFail'.-    = GVDocStreamFail-    -- | The stream contained more 'SAnnPop's than 'SAnnPush's.-    | GVEmptyStack-    deriving (Eq, Ord, Read, Show)-instance Exception GraphVizRenderError where-    displayException = \case-        GVDocStreamFail -> t ++ "encountered failure in document stream"-        GVEmptyStack    -> t ++ "attempted to pop empty attribute stack"-        where t = "Failed to render HTML for GraphViz: "---- | A total version of 'render'.-renderSafe :: Doc H.Attribute -> Either GraphVizRenderError Label-renderSafe = fmap (HtmlLabel . H.Text) . renderSafe' . layoutPretty defaultLayoutOptions---- | A total version of 'render''.--- This can be seen as a generalisation of any of the other functions exported by this module.-renderSafe' :: SimpleDocStream H.Attribute -> Either GraphVizRenderError H.Text-renderSafe' =-    let go cs = \case-            SFail           -> Left GVDocStreamFail-            SEmpty          -> Right []-            SChar c ds      -> renderText cs (T.singleton c) ?: go cs ds-            SText _ txt ds  -> renderText cs txt ?: go cs ds-            SLine n ds      -> H.Newline [] ?: renderText cs (T.replicate n " ") ?: go cs ds-            SAnnPush col ds -> go (col : cs) ds-            SAnnPop ds      -> flip go ds =<< maybeToEither GVEmptyStack (tailMay cs)-        infixr 0 ?:-        (?:) = fmap . (:)-    in  go []+render' = renderSimplyDecorated' (pure .: renderText) mempty mempty  -{- Internal utilities -}---- | On encountering a 'Left', throw it as an exception.-throwLeft :: Exception e => Either e a -> a-throwLeft = either throw id+{- Util -} --- | Equal to the function of the same name from [extra](https://hackage.haskell.org/package/extra).-maybeToEither :: a -> Maybe b -> Either a b-maybeToEither x = maybe (Left x) Right+(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d+(.:) = (.) . (.) --- | Equal to the function of the same name from [safe](https://hackage.haskell.org/package/safe).-tailMay :: [a] -> Maybe [a]-tailMay = \case-    []     -> Nothing-    _ : xs -> Just xs+-- | 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