tree-render-text 0.1.0.0 → 0.1.1.0

raw patch · 3 files changed

+122/−22 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Data/Tree/Render/Text.hs +108/−21
• src/Data/Tree/Render/TextTest.hs +13/−0
• tree-render-text.cabal +1/−1

@@ -3,17 +3,81 @@ {-# LANGUAGE Safe #-}  -- | Configurable text rendering of trees.+--+-- Example renderings for:+--+-- > import Data.Tree+-- >+-- > tree :: Tree String+-- > tree =+-- >   Node "Add"+-- >     [ Node "Add"+-- >       [ Node "0" []+-- >       , Node "Mul"+-- >         [ Node "1" []+-- >         , Node "2" []+-- >         ]+-- >       ]+-- >     , Node "Neg"+-- >       [ Node "Max"+-- >         [ Node "3" []+-- >         , Node "4" []+-- >         , Node "5" []+-- >         , Node "Var"+-- >           [ Node "x" []+-- >           ]+-- >         , Node "6" []+-- >         ]+-- >       ]+-- >     ]+-- >+-- > renderTree (tracedRenderOptions id) tree+-- >+-- > ● Add+-- > ├─● Add+-- > │ ├─● 0+-- > │ ╰─● Mul+-- > │   ├─● 1+-- > │   ╰─● 2+-- > ╰─● Neg+-- >   ╰─● Max+-- >     ├─● 3+-- >     ├─● 4+-- >     ├─● 5+-- >     ├─● Var+-- >     │ ╰─● x+-- >     ╰─● 6+-- >+-- > Other renderings by setting 'ParentLocation' and 'ChildOrder' in the options:+-- >+-- >   ╭─● 0         ╭─● 0       ● Add             ╭─● 6         ╭─● 6+-- >   │ ╭─● 1     ╭─● Add       ├─● Neg           │ ╭─● x       │ ╭─● x+-- >   │ ├─● 2     │ │ ╭─● 1     │ ╰─● Max         ├─● Var       ├─● Var+-- >   ├─● Mul     │ ╰─● Mul     │   ├─● 6         ├─● 5         ├─● 5+-- > ╭─● Add       │   ╰─● 2     │   ├─● Var       ├─● 4       ╭─● Max+-- > │   ╭─● 3     ● Add         │   │ ╰─● x       ├─● 3       │ ├─● 4+-- > │   ├─● 4     ╰─● Neg       │   ├─● 5       ╭─● Max       │ ╰─● 3+-- > │   ├─● 5       │ ╭─● 3     │   ├─● 4     ╭─● Neg       ╭─● Neg+-- > │   │ ╭─● x     │ ├─● 4     │   ╰─● 3     │   ╭─● 2     ● Add+-- > │   ├─● Var     ╰─● Max     ╰─● Add       │   ├─● 1     │   ╭─● 2+-- > │   ├─● 6         ├─● 5       ├─● Mul     │ ╭─● Mul     │ ╭─● Mul+-- > │ ╭─● Max         ├─● Var     │ ├─● 2     │ ├─● 0       │ │ ╰─● 1+-- > ├─● Neg           │ ╰─● x     │ ╰─● 1     ├─● Add       ╰─● Add+-- > ● Add             ╰─● 6       ╰─● 0       ● Add           ╰─● 0+ module Data.Tree.Render.Text (   ParentLocation(..),   ChildOrder(..),   BranchPath(..),    renderTreeM,+  renderForestM,   RenderOptionsM(..),   tracedRenderOptionsM,   tracedRenderOptionsAsciiM,    renderTree,+  renderForest,   RenderOptions,   tracedRenderOptions,   tracedRenderOptionsAscii,@@ -24,11 +88,14 @@ import qualified Data.List as List import           Data.Monoid ( Endo(Endo, appEndo) ) import qualified Data.Tree as Tree-import           Data.Tree ( Tree )+import           Data.Tree ( Tree, Forest )  -- | A difference list on typ 'a'. type DList a = Endo [a] +runDListWriter :: M.Writer (DList a) () -> [a]+runDListWriter = ($ []) . appEndo . M.execWriter+ -- | Appends a list '[a]' to the output of a 'M.Writer (DList a)'. tellDList :: [a] -> M.Writer (DList a) () tellDList s = M.tell $ Endo (s <>)@@ -51,23 +118,23 @@   = BranchUp   -- ^ Describes a turn going up toward the left.   ---  -- e.g. @╭─@+  -- e.g. @"╭─"@   | BranchDown   -- ^ Describes a turn going down toward the left.   ---  -- e.g. @╰─@+  -- e.g. @"╰─"@   | BranchJoin   -- ^ Describes a T-join of a path going up and down toward the left.   ---  -- e.g. @├─@+  -- e.g. @"├─"@   | BranchContinue   -- ^ Describes a path going up and down.   ---  -- e.g. @│ @+  -- e.g. @"│ "@   | BranchEmpty   -- ^ Describes a part that does NOT contain a path piece.   ---  -- e.g. @  @+  -- e.g. @"  "@   deriving (Show, Eq, Ord)  -- | Options used for rendering a 'Tree label'.@@ -91,10 +158,14 @@   -- this should not render the label itself.   --   -- The label is passed as an argument to allow things such as:+  --   --  * Rendering a node marker differently for labels that fail to pass a test.+  --   --  * Highlighting a node currently being visited.   --   -- Simple use cases would use a constant function ignoring the label value.+  , oForestRootMarker :: string+  -- ^ The marker usef for rendering an artificial root when rendering 'Forest's.   , oShowBranchPath :: BranchPath -> string   -- ^ Shows a 'BranchPath'. The returned values should contain no newlines and   -- should all be of the same printed width when rendered as text.@@ -106,12 +177,13 @@ -- | Options for producing a line-traced tree using unicode drawing characters. -- --  This uses:---      BranchUp       -> "╭─"---      BranchDown     -> "╰─"---      BranchJoin     -> "├─"---      BranchContinue -> "│ "---      BranchEmpty    -> "  " --+-- > BranchUp       -> "╭─"+-- > BranchDown     -> "╰─"+-- > BranchJoin     -> "├─"+-- > BranchContinue -> "│ "+-- > BranchEmpty    -> "  "+-- tracedRenderOptionsM   :: (String -> string)   -- ^ Promotes a 'String' to a 'string'.@@ -129,6 +201,7 @@   , oWrite = write'   , oShowNodeLabel = show'   , oGetNodeMarker = const $ fromString' "● "+  , oForestRootMarker = fromString' "●"   , oShowBranchPath = fromString' . \case       BranchUp       -> "╭─"       BranchDown     -> "╰─"@@ -140,12 +213,13 @@ -- | Options for producing a line-traced tree using ASCII characters. -- --  This uses:---        BranchUp       -> ",-"---        BranchDown     -> "`-"---        BranchJoin     -> "|-"---        BranchContinue -> "| "---        BranchEmpty    -> "  " --+-- > BranchUp       -> ",-"+-- > BranchDown     -> "`-"+-- > BranchJoin     -> "|-"+-- > BranchContinue -> "| "+-- > BranchEmpty    -> "  "+-- tracedRenderOptionsAsciiM   :: (String -> string)   -- ^ Promotes a 'String' to a 'string'.@@ -157,6 +231,7 @@ tracedRenderOptionsAsciiM fromString' write' show' =   (tracedRenderOptionsM fromString' write' show')     { oGetNodeMarker = const $ fromString' "o "+    , oForestRootMarker = fromString' "o"     , oShowBranchPath = fromString' . \case         BranchUp       -> ",-"         BranchDown     -> "`-"@@ -179,17 +254,29 @@   -> RenderOptions String label tracedRenderOptionsAscii = tracedRenderOptionsAsciiM id tellDList --- | Renders a 'Tree' a pretty printed tree asa a 'String'.+-- | Renders a 'Tree' a pretty printed tree as a 'String'. renderTree :: RenderOptions String label -> Tree label -> String-renderTree options = run . renderTreeM options-  where-    run = ($ "") . appEndo . M.execWriter+renderTree options = runDListWriter . renderTreeM options --- | Renders a pretty printed tree within a monadic context.+-- | Renders a 'Forest' a pretty printed tree as a 'String'.+renderForest :: RenderOptions String label -> Forest label -> String+renderForest options = runDListWriter . renderForestM options++-- | Renders a pretty printed 'Tree' within a monadic context. renderTreeM :: Monad m => RenderOptionsM m string label -> Tree label -> m () renderTreeM options tree = M.evalStateT action options   where     action = render [] tree++-- | Renders a pretty printed 'Forest' within a monadic context.+renderForestM :: Monad m => RenderOptionsM m string label -> Forest label -> m ()+renderForestM options trees = do+  let forestTree = Tree.Node Nothing $ map (fmap Just) trees+  let options' = options+        { oShowNodeLabel = maybe (oFromString options "") $ oShowNodeLabel options+        , oGetNodeMarker = maybe (oForestRootMarker options) $ oGetNodeMarker options+        }+  renderTreeM options' forestTree  type Render string label m = M.StateT (RenderOptionsM m string label) m 

@@ -3,6 +3,7 @@  module Data.Tree.Render.TextTest (   test1,+  test2, ) where  import qualified Data.Tree as Tree@@ -44,6 +45,18 @@   let b0 = renderFlavors options   let b1 = renderFlavors options { R.oVerticalPad = 1 }   Box.printBox $ vsep [b0, b1]+  putStrLn ""++test2 :: IO ()+test2 = do+  let options = (R.tracedRenderOptions id)+        { R.oChildOrder = R.LastToFirst+        , R.oParentLocation = R.ParentBetweenChildren+        }+  let forest = [testTree1, testTree1]+  putStrLn ""+  let f1 = R.renderForest options forest+  putStrLn f1   putStrLn ""  testTree1 :: Tree String

@@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/  name:                tree-render-text-version:             0.1.0.0+version:             0.1.1.0 synopsis:            Configurable text rendering of trees. description:         Configurable text rendering of trees. homepage:            https://github.com/thomaseding/tree-render-text