tree-render-text 0.3.0.0 → 0.4.0.0

raw patch · 3 files changed

+80/−19 lines, 3 files

Files

• src/Data/Tree/Render/Text.hs +37/−4
• src/Data/Tree/Render/TextTest.hs +42/−14
• tree-render-text.cabal +1/−1

@@ -84,11 +84,13 @@    tracedRenderOptions,   tracedRenderOptionsAscii,+  middleCutRenderOptions,   zigZagRenderOptions,   tabbedRenderOptions,    tracedRenderOptionsM,   tracedRenderOptionsAsciiM,+  middleCutRenderOptionsM,   zigZagRenderOptionsM,   tabbedRenderOptionsM, @@ -115,7 +117,7 @@ -- | Describes where a parent node is rendered, relative to its children. data ParentLocation   = ParentBeforeChildren-  -- ^ Renders the before any of its children.+  -- ^ Renders the parent before any of its children.   | ParentAfterChildren   -- ^ Renders the parent after all of its children.   | ParentBetweenChildren@@ -330,8 +332,9 @@       BranchEmpty    -> "  "  -- | A variety on 'tracedRenderOptionsM' where the path tracing is--- performed in a zig-zag fashion.-zigZagRenderOptionsM+-- performed in a zig-zag-like fashion such that there is a cut down+-- the middle of a node's children.+middleCutRenderOptionsM   :: Monad m   => (String -> string)   -- ^ Promotes a 'String' to a 'string'.@@ -340,7 +343,7 @@   -> (label -> m string)   -- ^ Shows a 'Tree.rootLabel'.   -> RenderOptionsM m string label-zigZagRenderOptionsM fromStr write showLabel = options+middleCutRenderOptionsM fromStr write showLabel = options   { oParentLocation = pure . \case       Nothing -> ParentBeforeChildren       Just LocalContext@@ -353,6 +356,29 @@   where     options = tracedRenderOptionsM fromStr write showLabel +-- | A variety on 'tracedRenderOptionsM' where the path tracing is+-- performed in a zig-zag fashion.+zigZagRenderOptionsM+  :: Monad m+  => (String -> string)+  -- ^ Promotes a 'String' to a 'string'.+  -> (string -> m ())+  -- ^ Writes a 'string'.+  -> (label -> m string)+  -- ^ Shows a 'Tree.rootLabel'.+  -> RenderOptionsM m string label+zigZagRenderOptionsM fromStr write showLabel = options+  { oParentLocation = pure . \case+      Nothing -> ParentBeforeChildren+      Just LocalContext+        { lcCurrentDepth = depth+        } -> case depth `mod` 2 of+          0 -> ParentBeforeChildren+          _ -> ParentAfterChildren+  }+  where+    options = tracedRenderOptionsM fromStr write showLabel+ -- | Options for rendering a tree in rows indented only by tabs. tabbedRenderOptionsM   :: Monad m@@ -388,6 +414,13 @@   -- ^ Shows a 'Tree.rootLabel'.   -> RenderOptions String label tabbedRenderOptions tab = tabbedRenderOptionsM tab id tellDList . fmap pure++-- | A simplified 'middleCutRenderOptionsM' specialized to @RenderOptions@.+middleCutRenderOptions+  :: (label -> String)+  -- ^ Shows a 'Tree.rootLabel'.+  -> RenderOptions String label+middleCutRenderOptions = middleCutRenderOptionsM id tellDList . fmap pure  -- | A simplified 'zigZagRenderOptionsM' specialized to @RenderOptions@. zigZagRenderOptions

@@ -25,7 +25,7 @@ renderFlavors :: R.RenderOptions String String -> Box renderFlavors options =   let go ord loc =-        let str = flip R.renderTree testTree1 options+        let str = flip R.renderTree tree1 options               { R.oChildOrder = const $ pure ord               , R.oParentLocation = const $ pure loc               }@@ -44,37 +44,41 @@ test1 :: IO () test1 = do   let options = R.tracedRenderOptions id-  putStrLn ""   let b0 = renderFlavors options   let b1 = renderFlavors options { R.oVerticalPad = 1 }+  putStrLn ""   Box.printBox $ vsep [b0, b1]   putStrLn ""  test2 :: IO () test2 = do-  let tree = testTree1+  let tree = tree1   let options = (R.tracedRenderOptions id)         { R.oChildOrder = const $ pure R.LastToFirst         , R.oParentLocation = const $ pure R.ParentBetweenChildren         }-  putStrLn ""   let f0 = R.renderForest options []   let f1 = R.renderForest options [tree]   let f2 = R.renderForest options [tree, tree]+  putStrLn ""   Box.printBox $ hsep $ map naturalBox [f0, f1, f2]   putStrLn ""  test3 :: IO () test3 = do-  let tree = testTree2-  let options = (R.zigZagRenderOptions id)+  let options1 = (R.middleCutRenderOptions id)+  let options2 = (R.zigZagRenderOptions id)+  let mkBox options =+        let f2 = R.renderForest options [tree2]+            f3 = R.renderForest options [tree3]+            f4 = R.renderForest options [tree4]+        in hsep $ map naturalBox [f2, f3, f4]   putStrLn ""-  let f1 = R.renderForest options [tree]-  Box.printBox $ hsep $ map naturalBox [f1]+  Box.printBox $ hsep $ map mkBox [options1, options2]   putStrLn "" -testTree1 :: Tree String-testTree1+tree1 :: Tree String+tree1   = node "Add"     [ node "Add"       [ node "0" []@@ -100,13 +104,13 @@     node :: String -> [Tree String] -> Tree String     node = Tree.Node -testTree2 :: Tree String-testTree2+tree2 :: Tree String+tree2   = node "Add"     [ node "Add"       [ node "a" []       , node "Mul"-        [ node "b" [testTree1]+        [ node "b" [tree1]         , node "c" []         ]       ]@@ -116,7 +120,7 @@         , node "e" []         , node "f" []         , node "Var"-          [ node "x" [testTree1]+          [ node "x" [tree1]           ]         , node "g" []         ]@@ -126,4 +130,28 @@   where     node :: String -> [Tree String] -> Tree String     node = Tree.Node++treeNat :: Int -> Tree Int+treeNat n = iterate s z !! n+  where+    z :: Tree Int+    z = Tree.Node 0 []++    s :: Tree Int -> Tree Int+    s t = Tree.Node (1 + Tree.rootLabel t) [t]++treePow2 :: Int -> Tree Int+treePow2 n = iterate f z !! n+  where+    z :: Tree Int+    z = Tree.Node 1 []++    f :: Tree Int -> Tree Int+    f t = Tree.Node (2 * Tree.rootLabel t) [t, t]++tree3 :: Tree String+tree3 = fmap show $ treeNat 10++tree4 :: Tree String+tree4 = fmap show $ treePow2 4 

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