7186053...master · rowtype-yoga/purescript-yoga-tree

git.iko.soy/rowtype-yoga/purescript-yoga-tree

on master help sign in

.gitignore+1

since splitsnapshots

unifiedsplit

@@ -7,3 +7,4 @@

7/.purs*

8/.psa*

9.DS_Store

10+/.spago

.travis.yml+3−3

@@ -2,7 +2,7 @@ node_js:

2 - "node"

3language: node_js

4install:

5− - npm install -g purescript pulp bower

5+ - npm install -g purescript spago

6− - bower install

6+ - spago install

7script:

8− - pulp test

8+ - spago -x test.dhall test

LICENSEnew file+8

@@ -0,0 +1,8 @@

4+Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

6+The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

8+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

README.md+19−5

@@ -1,15 +1,29 @@

1−# purescript-tree

1+# purescript-yoga-tree

3−[![Build status](https://img.shields.io/travis/dmbfm/purescript-tree.svg)](https://travis-ci.org/dmbfm/purescript-tree)

3+Multi-way trees (Rose Trees) with Zippers.

5−Multi-way trees with Zippers.

5+This is a fork of `purescript-tree-rose` that uses `Array`s instead of `List`s.

7## Installation

9```

10−bower install purescript-tree

10+{ yoga-tree =

11+ { dependencies =

12+ [ "arrays"

13+ , "control"

14+ , "foldable-traversable"

15+ , "free"

16+ , "maybe"

17+ , "prelude"

18+ , "tailrec"

19+ ]

20+ , version = "master"

21+ , repo = "https://github.com/rowtype-yoga/purescript-yoga-tree.git"

22+ }

23+}

24+

11```

25```

13## Documentation

27## Documentation

15−Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-tree).

29+Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-yoga-tree).

bower.json+23−22

@@ -1,24 +1,25 @@

2− "name": "purescript-tree",

2+ "name": "purescript-yoga-tree",

3− "license": "MIT",

3+ "license": [

4+ "MIT"

5+ ],

6+ "repository": {

7+ "type": "git",

8+ "url": "https://github.com/jordanmartinez/purescript-tree-rose"

9+ },

4− "ignore": [

10+ "ignore": [

5− "**/.*",

11+ "**/.*",

6− "node_modules",

12+ "node_modules",

7− "bower_components",

13+ "bower_components",

8− "output"

14+ "output"

9− ],

15+ ],

10− "repository": {

11− "type": "git",

12− "url": "git://github.com/dmbfm/purescript-tree.git"

13− },

14− "dependencies": {

16+ "dependencies": {

17+ "purescript-arrays": "^v7.0.0",

18+ "purescript-control": "^v6.0.0",

19+ "purescript-foldable-traversable": "^v6.0.0",

20+ "purescript-free": "^v7.0.0",

21+ "purescript-maybe": "^v6.0.0",

15− "purescript-prelude": "^3.1.0",

22+ "purescript-prelude": "^v6.0.1",

16− "purescript-console": "^3.0.0",

17− "purescript-lists": "^4.9.1",

18− "purescript-free": "^4.1.0"

19− },

20− "devDependencies": {

21− "purescript-psci-support": "^3.0.0",

23+ "purescript-tailrec": "^v6.0.0"

22− "purescript-spec": "^1.0.0"

23− }

24+ }

24}

25}

package.json+3−3

@@ -1,7 +1,7 @@

2− "name": "purescript-tree",

2+ "name": "purescript-yoga-tree",

3− "version": "1.0.0",

3+ "version": "4.0.0",

4− "description": "A Tree data structure inspired by haskell's Data.Tree",

4+ "description": "A Tree data structure inspired by Haskell's Data.Tree",

5 "main": "index.js",

6 "author": "Daniel Fortes",

7 "license": "MIT"

packages.dhallnew file+5

@@ -0,0 +1,5 @@

1+let upstream =

2+ https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220822/packages.dhall

3+ sha256:908b4ffbfba37a0a4edf806513a555d0dbcdd0cde7abd621f8d018d2e8ecf828

5+in upstream

spago.dhallnew file+15

@@ -0,0 +1,15 @@

1+{ sources = [ "src/**/*.purs" ]

2+, license = "MIT"

3+, repository = "https://github.com/jordanmartinez/purescript-tree-rose"

4+, name = "yoga-tree"

5+, dependencies =

6+ [ "arrays"

7+ , "control"

8+ , "foldable-traversable"

9+ , "free"

10+ , "maybe"

11+ , "prelude"

12+ , "tailrec"

13+ ]

14+, packages = ./packages.dhall

15+}

src/Data/Tree.pursdeleted−71

@@ -1,71 +0,0 @@

1−module Data.Tree where

2−

3−import Prelude

4−

5−import Control.Comonad.Cofree (Cofree, head, mkCofree, tail, (:<))

6−import Control.Monad.Rec.Class (Step(..), tailRec)

7−import Data.List (List(..), snoc, (:))

8−import Data.Monoid (power)

9−import Data.Traversable (Accum)

10−

11−-- | A Rose, or multi-way tree, with values of type `a`.

12−type Tree a = Cofree List a

13−

14−type Forest a = List (Tree a)

15−

16−-- | Create a `Tree` from a `Node` value of type `a` and a `Forest` of children.

17−mkTree :: forall a. a -> Forest a -> Tree a

18−mkTree = mkCofree

19−

20−-- | Draw a 2D `String` representation of a `Tree String`.

21−drawTree :: Tree String -> String

22−drawTree t = tailRec go {level: 0, drawn: (head t) <> "\n", current: (tail t)}

23− where

24− go :: _ -> Step _ String

25− go {level: l, drawn: s, current: Nil} = Done s

26− go {level: l, drawn: s, current: c:cs } =

27− let drawn = (power " " l) <> "|----> " <> (head c) <> "\n" in

28− Loop {level: l, drawn: s <> drawn <> (tailRec go {level: l + 1, drawn: "", current: (tail c)}) , current: cs}

29−

30−-- | Draw a 2D `String` representation of a `Tree` composed of `Show`able

31−-- | elements.

32−showTree :: forall a. Show a => Tree a -> String

33−showTree = drawTree <<< (map show)

34−

35−-- | Scan a `Tree`, accumulating values of `b` there are constant across `Node`s

36−-- | that have the same parent.

37−scanTree :: forall a b. (a -> b -> b) -> b -> Tree a -> Tree b

38−scanTree f b n =

39− let fb = f (head n) b

40− in fb :< (tailRec go {b: fb, current: (tail n), final: Nil})

41− where

42− go :: _ -> Step _ (Forest b)

43− go {b: b', current: Nil, final: final} = Done final

44− go {b: b', current: c:cs, final: final} =

45− let fb' = f (head c) b'

46− in Loop {b: b', current: cs, final: snoc final (fb' :< tailRec go {b: fb', current: (tail c), final: Nil})}

47−

48−-- | Scan a `Tree`, accumulating values of `b` there are constant across `Node`s

49−-- | that have the same parent, and returning a `Tree` of type `c`.

50−scanTreeAccum :: forall a b c. (a -> b -> Accum b c) -> b -> Tree a -> Tree c

51−scanTreeAccum f b n =

52− let fb = f (head n) b

53− in fb.value :< (tailRec go {b: fb.accum , current: (tail n), final: Nil})

54− where

55− go :: _ -> Step _ (Forest c)

56− go {b: b', current: Nil, final: final} = Done final

57− go {b: b', current: c:cs, final: final} =

58− let fb' = f (head c) b'

59− in Loop {b: b', current: cs, final: snoc final (fb'.value :< tailRec go {b: fb'.accum, current: (tail c), final: Nil})}

60−

61−-- | Set the value of a node.

62−setNodeValue :: forall a. a -> Tree a -> Tree a

63−setNodeValue a n = a :< (tail n)

64−

65−-- | Modify the value of a node.

66−modifyNodeValue :: forall a. (a -> a) -> Tree a -> Tree a

67−modifyNodeValue f n = f (head n) :< tail n

68−

69−-- | Append a child to a node.

70−appendChild :: forall a. Tree a -> Tree a -> Tree a

71−appendChild c n = head n :< snoc (tail n) c

src/Data/Tree/Zipper.pursdeleted−283

@@ -1,283 +0,0 @@

1−module Data.Tree.Zipper where

2−

3−import Prelude

4−

5−import Control.Comonad.Cofree (head, tail, (:<))

6−import Data.List (List(..), drop, reverse, take, (!!), (:))

7−import Data.Maybe (Maybe(..))

8−import Data.Tree (Forest, Tree, mkTree, modifyNodeValue, setNodeValue)

9−

10−-- | The `Loc` type describes the location of a `Node` inside a `Tree`. For this

11−-- | we store the current `Node`, the sibling nodes that appear before the current

12−-- | node, the sibling nodes that appear after the current node, and a `List` of

13−-- | `Loc`ations that store the parent node locations up to the root of the three.

14−-- |

15−-- | So, effectively, the `parents` field records the path travelled in the

16−-- | tree to reach the level of the current `Node` starting from the tree's root,

17−-- | and the `before` and `after` fields describe its location in the current

18−-- | level.

19−newtype Loc a = Loc { node :: Tree a

20− , before :: Forest a

21− , after :: Forest a

22− , parents :: List (Loc a)

23− }

24−

25−instance eqLoc :: Eq a => Eq (Loc a) where

26− eq (Loc r1) (Loc r2) =

27− r1.node == r2.node

28− && r1.before == r2.before

29− && r1.after == r2.after

30− && r1.parents == r2.parents

31−

32−-- -- Cursor movement

33−

34−-- | Move the cursor to the next sibling.

35−next :: forall a. Loc a -> Maybe (Loc a)

36−next (Loc r) =

37− case r.after of

38− Nil -> Nothing

39− (c:cs) -> Just $ Loc { node: c

40− , before: r.node : r.before

41− , after: cs

42− , parents: r.parents

43− }

44−

45−-- -- | Move the cursor to the previous sibling.

46−prev :: forall a. Loc a -> Maybe (Loc a)

47−prev (Loc r) =

48− case r.before of

49− Nil -> Nothing

50− (c:cs) -> Just $ Loc { node: c

51− , before: cs

52− , after: r.node : r.after

53− , parents: r.parents

54− }

55−

56−-- -- | Move the cursor to the first sibling.

57−first :: forall a. Loc a -> Loc a

58−first l@(Loc r) =

59− case r.before of

60− Nil -> l

61− c:cs -> Loc $ { node: c

62− , before: Nil

63− , after: (reverse cs) <> r.after

64− , parents: r.parents

65− }

66−

67−-- -- | Move the cursor to the last sibling.

68−last :: forall a. Loc a -> Loc a

69−last l@(Loc r) =

70− case reverse r.after of

71− Nil -> l

72− c:cs -> Loc $ { node: c

73− , before: cs <> r.before

74− , after: Nil

75− , parents: r.parents

76− }

77−

78−-- -- | Move the cursor to the parent `Node`.

79−up :: forall a. Loc a -> Maybe (Loc a)

80−up l@(Loc r) =

81− case r.parents of

82− Nil -> Nothing

83− (p:ps) -> Just $ Loc { node: (value p) :< (siblings l)

84− , before: before p

85− , after: after p

86− , parents: ps

87− }

88−

89−-- | Move the cursor to the root of the tree.

90−root :: forall a. Loc a -> Loc a

91−root l =

92− case up l of

93− Nothing -> l

94− Just p -> root p

95−

96−-- | Move the cursor to the first child of the current `Node`.

97−firstChild :: forall a. Loc a -> Maybe (Loc a)

98−firstChild n =

99− case children n of

100− Nil -> Nothing

101− c:cs ->

102− Just $ Loc { node: c

103− , before: Nil

104− , after: cs

105− , parents: n : (parents n)

106− }

107−

108−-- | Move the cursor to the first child of the current `Node`.

109−down :: forall a. Loc a -> Maybe (Loc a)

110−down = firstChild

111−

112−-- | Move the cursor to the last child of the current `Node`.

113−lastChild :: forall a. Loc a -> Maybe (Loc a)

114−lastChild p@(Loc r) = last <$> down p

115−

116−-- | Move the cursor to a specific sibling by it's index.

117−siblingAt :: forall a. Int -> Loc a -> Maybe (Loc a)

118−siblingAt i l@(Loc r) =

119− case up l of

120− Nothing -> Nothing

121− Just p@(Loc r') ->

122− case (children p) !! i of

123− Nothing -> Nothing

124− Just c ->

125− let before = reverse $ take i (children p)

126− after = drop (i+1) (children p)

127− in Just $ Loc { node: c

128− , before: before

129− , after: after

130− , parents: r.parents

131− }

132−

133−-- | Move the cursor to a specific child of the current `Node` by it's index.

134−childAt :: forall a. Int -> Loc a -> Maybe (Loc a)

135−childAt i p = (firstChild p) >>= (siblingAt i)

136−

137−

138−-- | Retrieve the `Tree` representation, i.e., returns the root `Node` of the

139−-- | current tree.

140−toTree :: forall a. Loc a -> Tree a

141−toTree = node <<< root

142−

143−-- | Get a `Loc`ation representation from a given `Tree`.

144−fromTree :: forall a. Tree a -> Loc a

145−fromTree n = Loc { node: n

146− , before: Nil

147− , after: Nil

148− , parents: Nil

149− }

150−

151−-- | Set the `Node` at the current position.

152−setNode :: forall a. Tree a -> Loc a -> Loc a

153−setNode a (Loc r) = Loc { node: a

154− , before: r.before

155− , after: r.after

156− , parents: r.parents

157− }

158−

159−-- | Set the `Node` at the current position.

160−modifyNode :: forall a. (Tree a -> Tree a) -> Loc a -> Loc a

161−modifyNode f (Loc r) = Loc { node: f r.node

162− , before: r.before

163− , after: r.after

164− , parents: r.parents

165− }

166−

167−-- | Set the value of the current `Node`.

168−setValue :: forall a. a -> Loc a -> Loc a

169−setValue a l = setNode (setNodeValue a (node l)) l

170−

171−-- | Modify the value of the current `Node`.

172−modifyValue :: forall a. (a -> a) -> Loc a -> Loc a

173−modifyValue f l = setNode (modifyNodeValue f (node l)) l

174−

175−-- -- insert and delete nodes

176−

177−-- | Insert a node after the current position, and move cursor to the new node.

178−insertAfter :: forall a. Tree a -> Loc a -> Loc a

179−insertAfter n l = Loc { node: n

180− , after: after l

181− , before: (node l) : (before l)

182− , parents: parents l

183− }

184−

185−-- | Insert a node before the current position, and move cursor to the new node.

186−insertBefore :: forall a. Tree a -> Loc a -> Loc a

187−insertBefore n l = Loc { node: n

188− , after: (node l) : (after l)

189− , before: before l

190− , parents: parents l

191− }

192−

193−-- | Insert a node as a child to the current node, and move cursor to the new node.

194−insertChild :: forall a. Tree a -> Loc a -> Loc a

195−insertChild n l =

196− case down l of

197− Just c -> insertAfter n c

198− Nothing -> Loc { node: n

199− , after: Nil

200− , before: Nil

201− , parents: l : (parents l)

202− }

203−

204−-- | Delete the node in the current position.

205−delete :: forall a. Loc a -> Loc a

206−delete l@(Loc r) =

207− case r.after of

208− c:cs -> Loc { node: c

209− , before: r.before

210− , after: cs

211− , parents: r.parents

212− }

213− Nil ->

214− case r.before of

215− c:cs -> Loc { node: c

216− , before: cs

217− , after: r.after

218− , parents: r.parents

219− }

220−

221− Nil ->

222− case r.parents of

223− Nil -> l

224− c:cs -> Loc { node: mkTree (value c) Nil

225− , before: before c

226− , after: after c

227− , parents: parents c

228− }

229−

230−-- Searches

231−

232−-- | Search for the first occurence of the value `a` downwards and to the right.

233−findDown :: forall a. Eq a => a -> Loc a -> Maybe (Loc a)

234−findDown a l@(Loc r) =

235− if a == (value l)

236− then (Just l)

237− else

238− case next l of

239− Just n -> findDown a n

240− Nothing ->

241− case down l of

242− Just n' -> findDown a n'

243− Nothing -> Nothing

244−

245−-- | Search for the first occurence of the value `a` upwards and to the left.

246−findUp :: forall a. Eq a => a -> Loc a -> Maybe (Loc a)

247−findUp a l@(Loc r) =

248− if a == (value l)

249− then (Just l)

250− else

251− case prev l of

252− Just n -> findUp a n

253− Nothing ->

254− case up l of

255− Just n' -> findUp a n'

256− Nothing -> Nothing

257−

258−-- | Search for the first occurence of the value `a` starting from the root of

259−-- | the tree.

260−findFromRoot :: forall a. Eq a => a -> Loc a -> Maybe (Loc a)

261−findFromRoot a = (findDown a) <<< root

262−

263−-- Setters and Getters

264−node :: forall a. Loc a -> Tree a

265−node (Loc r) = r.node

266−

267−value :: forall a. Loc a -> a

268−value = head <<< node

269−

270−before :: forall a. Loc a -> Forest a

271−before (Loc r) = r.before

272−

273−after :: forall a. Loc a -> Forest a

274−after (Loc r) = r.after

275−

276−parents :: forall a. Loc a -> List (Loc a)

277−parents (Loc r) = r.parents

278−

279−children :: forall a. Loc a -> Forest a

280−children = tail <<< node

281−

282−siblings :: forall a. Loc a -> Forest a

283−siblings (Loc r) = (reverse r.before) <> (r.node : r.after)

src/Yoga/Tree.pursnew file+92

@@ -0,0 +1,92 @@

1+module Yoga.Tree where

3+import Prelude

4+import Control.Comonad.Cofree (Cofree, head, mkCofree, tail, (:<))

5+import Control.Monad.Rec.Class (Step(..), tailRec)

6+import Data.Array (snoc, uncons)

7+import Data.Maybe (Maybe(..))

8+import Data.Monoid (power)

9+import Data.Traversable (Accum)

10+

11+-- | A Rose, or multi-way tree, with values of type `a`.

12+type Tree a =

13+ Cofree Array a

14+

15+type Forest a =

16+ Array (Tree a)

17+

18+-- | Create a `Tree` from a `Node` value of type `a` and a `Forest` of children.

19+mkTree ∷ ∀ a. a -> Forest a -> Tree a

20+mkTree = mkCofree

21+

22+mkLeaf ∷ ∀ a. a -> Tree a

23+mkLeaf = flip mkTree []

24+

25+leaf :: forall a. a -> Tree a

26+leaf = mkLeaf

27+

28+-- | Draw a 2D `String` representation of a `Tree String`.

29+drawTree ∷ Tree String -> String

30+drawTree t = tailRec go { level: 0, drawn: (head t) <> "\n", current: (tail t) }

31+ where

32+ go ∷ { current ∷ Forest String, drawn ∷ String, level ∷ Int } -> Step { current ∷ Forest String, drawn ∷ String, level ∷ Int } String

33+ go x = case x { current = uncons x.current } of

34+ { drawn: s, current: Nothing } -> Done s

35+ { level: l, drawn: s, current: Just { head: c, tail: cs } } ->

36+ let

37+ drawn = (power " " l) <> "|----> " <> (head c) <> "\n"

38+ in

39+ Loop { level: l, drawn: s <> drawn <> (tailRec go { level: l + 1, drawn: "", current: (tail c) }), current: cs }

40+

41+-- | Draw a 2D `String` representation of a `Tree` composed of `Show`able

42+-- | elements.

43+showTree ∷ ∀ a. Show a => Tree a -> String

44+showTree = drawTree <<< (map show)

45+

46+-- | Scan a `Tree`, accumulating values of `b` there are constant across `Node`s

47+-- | that have the same parent.

48+scanTree ∷ ∀ a b. (a -> b -> b) -> b -> Tree a -> Tree b

49+scanTree f b n =

50+ let

51+ fb = f (head n) b

52+ in

53+ fb :< (tailRec go { b: fb, current: (tail n), final: [] })

54+ where

55+ go ∷ { final ∷ Forest b, current ∷ Forest a, b ∷ b } -> Step { final ∷ Forest b, current ∷ Forest a, b ∷ b } (Forest b)

56+ go x = case x { current = uncons x.current } of

57+ { current: Nothing, final } -> Done final

58+ { b: b', current: Just { head: c, tail: cs }, final } ->

59+ let

60+ fb' = f (head c) b'

61+ in

62+ Loop { b: b', current: cs, final: snoc final (fb' :< tailRec go { b: fb', current: (tail c), final: [] }) }

63+

64+-- | Scan a `Tree`, accumulating values of `b` there are constant across `Node`s

65+-- | that have the same parent, and returning a `Tree` of type `c`.

66+scanTreeAccum ∷ ∀ a b c. (a -> b -> Accum b c) -> b -> Tree a -> Tree c

67+scanTreeAccum f b n =

68+ let

69+ fb = f (head n) b

70+ in

71+ fb.value :< (tailRec go { b: fb.accum, current: (tail n), final: [] })

72+ where

73+ go ∷ { final ∷ Forest c, current ∷ Forest a, b ∷ b } -> Step { final ∷ Forest c, current ∷ Forest a, b ∷ b } (Forest c)

74+ go x = case (x { current = uncons x.current }) of

75+ { current: Nothing, final } -> Done final

76+ { b: b', current: Just { head: c, tail: cs }, final } ->

77+ let

78+ fb' = f (head c) b'

79+ in

80+ Loop { b: b', current: cs, final: snoc final (fb'.value :< tailRec go { b: fb'.accum, current: (tail c), final: [] }) }

81+

82+-- | Set the value of a node.

83+setNodeValue ∷ ∀ a. a -> Tree a -> Tree a

84+setNodeValue a n = a :< (tail n)

85+

86+-- | Modify the value of a node.

87+modifyNodeValue ∷ ∀ a. (a -> a) -> Tree a -> Tree a

88+modifyNodeValue f n = f (head n) :< tail n

89+

90+-- | Append a child to a node.

91+appendChild ∷ ∀ a. Tree a -> Tree a -> Tree a

92+appendChild c n = head n :< snoc (tail n) c

src/Yoga/Tree/Zipper.pursnew file+333

@@ -0,0 +1,333 @@

1+module Yoga.Tree.Zipper where

3+import Prelude

4+import Control.Alt ((<|>))

5+import Control.Comonad.Cofree (head, tail, (:<))

6+import Data.Array (drop, reverse, take, uncons, (!!), (:))

7+import Data.Maybe (Maybe(Just, Nothing))

8+import Yoga.Tree (Forest, Tree, mkTree, modifyNodeValue, setNodeValue)

10+-- | The `Loc` type describes the location of a `Node` inside a `Tree`. For this

11+-- | we store the current `Node`, the sibling nodes that appear before the current

12+-- | node, the sibling nodes that appear after the current node, and a `Array` of

13+-- | `Loc`ations that store the parent node locations up to the root of the three.

14+-- |

15+-- | So, effectively, the `parents` field records the path travelled in the

16+-- | tree to reach the level of the current `Node` starting from the tree's root,

17+-- | and the `before` and `after` fields describe its location in the current

18+-- | level.

19+newtype Loc a = Loc

20+ { node ∷ Tree a

21+ , before ∷ Forest a

22+ , after ∷ Forest a

23+ , parents ∷ Array (Loc a)

24+ }

25+

26+instance eqLoc ∷ Eq a => Eq (Loc a) where

27+ eq (Loc r1) (Loc r2) =

28+ (r1.node == r2.node)

29+ && (r1.before == r2.before)

30+ && (r1.after == r2.after)

31+ && (r1.parents == r2.parents)

32+

33+-- -- Cursor movement

34+-- | Move the cursor to the next sibling.

35+next ∷ ∀ a. Loc a -> Maybe (Loc a)

36+next (Loc r) = case uncons r.after of

37+ Nothing -> Nothing

38+ Just { head: c, tail: cs } ->

39+ Just

40+ $ Loc

41+ { node: c

42+ , before: r.node : r.before

43+ , after: cs

44+ , parents: r.parents

45+ }

46+

47+-- -- | Move the cursor to the previous sibling.

48+prev ∷ ∀ a. Loc a -> Maybe (Loc a)

49+prev (Loc r) = case uncons r.before of

50+ Nothing -> Nothing

51+ Just { head: c, tail: cs } ->

52+ Just

53+ $ Loc

54+ { node: c

55+ , before: cs

56+ , after: r.node : r.after

57+ , parents: r.parents

58+ }

59+

60+-- -- | Move the cursor to the first sibling.

61+first ∷ ∀ a. Loc a -> Loc a

62+first l@(Loc r) = case uncons r.before of

63+ Nothing -> l

64+ Just { head: c, tail: cs } ->

65+ Loc

66+ $

67+ { node: c

68+ , before: []

69+ , after: (reverse cs) <> r.after

70+ , parents: r.parents

71+ }

72+

73+-- -- | Move the cursor to the last sibling.

74+last ∷ ∀ a. Loc a -> Loc a

75+last l@(Loc r) = case uncons (reverse r.after) of

76+ Nothing -> l

77+ Just { head: c, tail: cs } ->

78+ Loc

79+ $

80+ { node: c

81+ , before: cs <> r.before

82+ , after: []

83+ , parents: r.parents

84+ }

85+

86+-- -- | Move the cursor to the parent `Node`.

87+up ∷ ∀ a. Loc a -> Maybe (Loc a)

88+up l@(Loc r) = case uncons r.parents of

89+ Nothing -> Nothing

90+ Just { head: p, tail: ps } ->

91+ Just

92+ $ Loc

93+ { node: (value p) :< (siblings l)

94+ , before: before p

95+ , after: after p

96+ , parents: ps

97+ }

98+

99+-- | Move the cursor to the root of the tree.

100+root ∷ ∀ a. Loc a -> Loc a

101+root l = case up l of

102+ Nothing -> l

103+ Just p -> root p

104+

105+-- | Move the cursor to the first child of the current `Node`.

106+firstChild ∷ ∀ a. Loc a -> Maybe (Loc a)

107+firstChild n = case uncons (children n) of

108+ Nothing -> Nothing

109+ Just { head: c, tail: cs } ->

110+ Just

111+ $ Loc

112+ { node: c

113+ , before: []

114+ , after: cs

115+ , parents: n : (parents n)

116+ }

117+

118+-- | Move the cursor to the first child of the current `Node`.

119+down ∷ ∀ a. Loc a -> Maybe (Loc a)

120+down = firstChild

121+

122+-- | Move the cursor to the last child of the current `Node`.

123+lastChild ∷ ∀ a. Loc a -> Maybe (Loc a)

124+lastChild p = last <$> down p

125+

126+-- | Move the cursor to a specific sibling by it's index.

127+siblingAt ∷ ∀ a. Int -> Loc a -> Maybe (Loc a)

128+siblingAt i l@(Loc r) = case up l of

129+ Nothing -> Nothing

130+ Just p -> case (children p) !! i of

131+ Nothing -> Nothing

132+ Just c ->

133+ let

134+ before' = reverse $ take i (children p)

135+ after' = drop (i + 1) (children p)

136+ in

137+ Just

138+ $ Loc

139+ { node: c

140+ , before: before'

141+ , after: after'

142+ , parents: r.parents

143+ }

144+

145+-- | Move the cursor to a specific child of the current `Node` by it's index.

146+childAt ∷ ∀ a. Int -> Loc a -> Maybe (Loc a)

147+childAt i p = (firstChild p) >>= (siblingAt i)

148+

149+-- | Retrieve the `Tree` representation, i.e., returns the root `Node` of the

150+-- | current tree.

151+toTree ∷ ∀ a. Loc a -> Tree a

152+toTree = node <<< root

153+

154+-- | Get a `Loc`ation representation from a given `Tree`.

155+fromTree ∷ ∀ a. Tree a -> Loc a

156+fromTree n =

157+ Loc

158+ { node: n

159+ , before: []

160+ , after: []

161+ , parents: []

162+ }

163+

164+-- | Set the `Node` at the current position.

165+setNode ∷ ∀ a. Tree a -> Loc a -> Loc a

166+setNode a (Loc r) =

167+ Loc

168+ { node: a

169+ , before: r.before

170+ , after: r.after

171+ , parents: r.parents

172+ }

173+

174+-- | Set the `Node` at the current position.

175+modifyNode ∷ ∀ a. (Tree a -> Tree a) -> Loc a -> Loc a

176+modifyNode f (Loc r) =

177+ Loc

178+ { node: f r.node

179+ , before: r.before

180+ , after: r.after

181+ , parents: r.parents

182+ }

183+

184+-- | Set the value of the current `Node`.

185+setValue ∷ ∀ a. a -> Loc a -> Loc a

186+setValue a l = setNode (setNodeValue a (node l)) l

187+

188+-- | Modify the value of the current `Node`.

189+modifyValue ∷ ∀ a. (a -> a) -> Loc a -> Loc a

190+modifyValue f l = setNode (modifyNodeValue f (node l)) l

191+

192+-- -- insert and delete nodes

193+-- | Insert a node after the current position, and move cursor to the new node.

194+insertAfter ∷ ∀ a. Tree a -> Loc a -> Loc a

195+insertAfter n l =

196+ Loc

197+ { node: n

198+ , after: after l

199+ , before: (node l) : (before l)

200+ , parents: parents l

201+ }

202+

203+-- | Insert a node before the current position, and move cursor to the new node.

204+insertBefore ∷ ∀ a. Tree a -> Loc a -> Loc a

205+insertBefore n l =

206+ Loc

207+ { node: n

208+ , after: (node l) : (after l)

209+ , before: before l

210+ , parents: parents l

211+ }

212+

213+-- | Insert a node as a child to the current node, and move cursor to the new node.

214+insertChild ∷ ∀ a. Tree a -> Loc a -> Loc a

215+insertChild n l = case down l of

216+ Just c -> insertAfter n c

217+ Nothing ->

218+ Loc

219+ { node: n

220+ , after: []

221+ , before: []

222+ , parents: l : (parents l)

223+ }

224+

225+-- | Delete the node in the current position.

226+delete ∷ ∀ a. Loc a -> Loc a

227+delete l@(Loc r) = case uncons r.after of

228+ Just { head: c, tail: cs } ->

229+ Loc

230+ { node: c

231+ , before: r.before

232+ , after: cs

233+ , parents: r.parents

234+ }

235+ Nothing -> case uncons r.before of

236+ Just { head: c, tail: cs } ->

237+ Loc

238+ { node: c

239+ , before: cs

240+ , after: r.after

241+ , parents: r.parents

242+ }

243+ Nothing -> case uncons r.parents of

244+ Nothing -> l

245+ Just { head: c } ->

246+ Loc

247+ { node: mkTree (value c) []

248+ , before: before c

249+ , after: after c

250+ , parents: parents c

251+ }

252+

253+-- Searches

254+-- | Search down and to the right for the first occurence where the given predicate is true and return the Loc

255+findDownWhere ∷ ∀ a. (a -> Boolean) -> Loc a -> Maybe (Loc a)

256+findDownWhere predicate loc

257+ | predicate $ value loc = Just loc

258+

259+findDownWhere predicate loc = lookNext <|> lookDown

260+ where

261+ lookNext = next loc >>= findDownWhere predicate

262+

263+ lookDown = down loc >>= findDownWhere predicate

264+

265+-- | Search for the first occurence of the value `a` downwards and to the right.

266+findDown ∷ ∀ a. Eq a => a -> Loc a -> Maybe (Loc a)

267+findDown a = findDownWhere (_ == a)

268+

269+-- | Search to the left and up for the first occurence where the given predicate is true and return the Loc

270+findUpWhere ∷ ∀ a. (a -> Boolean) -> Loc a -> Maybe (Loc a)

271+findUpWhere predicate loc

272+ | predicate $ value loc = Just loc

273+

274+findUpWhere predicate loc = lookPrev <|> lookUp

275+ where

276+ lookPrev = prev loc >>= findUpWhere predicate

277+

278+ lookUp = up loc >>= findUpWhere predicate

279+

280+-- | Search for the first occurence of the value `a` upwards and to the left,

281+findUp ∷ ∀ a. Eq a => a -> Loc a -> Maybe (Loc a)

282+findUp a = findUpWhere (_ == a)

283+

284+-- | Search from the root of the mkTree for the first occurrence where the given predicate is truen and return the Loc

285+findFromRootWhere ∷ ∀ a. (a -> Boolean) -> Loc a -> Maybe (Loc a)

286+findFromRootWhere predicate loc

287+ | predicate $ value loc = Just loc

288+

289+findFromRootWhere predicate loc = findDownWhere predicate $ root loc

290+

291+-- | Search for the first occurence of the value `a` starting from the root of

292+-- | the tree.

293+findFromRoot ∷ ∀ a. Eq a => a -> Loc a -> Maybe (Loc a)

294+findFromRoot a = findFromRootWhere (_ == a)

295+

296+-- | flattens the Tree into a Array depth first.

297+flattenLocDepthFirst ∷ ∀ a. Loc a -> Array (Loc a)

298+flattenLocDepthFirst loc = loc : (go loc)

299+ where

300+ go ∷ Loc a -> Array (Loc a)

301+ go loc' =

302+ let

303+ downs = goDir loc' down

304+ nexts = goDir loc' next

305+ in

306+ downs <> nexts

307+

308+ goDir ∷ Loc a -> (Loc a -> Maybe (Loc a)) -> Array (Loc a)

309+ goDir loc' dirFn = case (dirFn loc') of

310+ Just l -> l : go l

311+ Nothing -> []

312+

313+-- Setters and Getters

314+node ∷ ∀ a. Loc a -> Tree a

315+node (Loc r) = r.node

316+

317+value ∷ ∀ a. Loc a -> a

318+value = head <<< node

319+

320+before ∷ ∀ a. Loc a -> Forest a

321+before (Loc r) = r.before

322+

323+after ∷ ∀ a. Loc a -> Forest a

324+after (Loc r) = r.after

325+

326+parents ∷ ∀ a. Loc a -> Array (Loc a)

327+parents (Loc r) = r.parents

328+

329+children ∷ ∀ a. Loc a -> Forest a

330+children = tail <<< node

331+

332+siblings ∷ ∀ a. Loc a -> Forest a

333+siblings (Loc r) = (reverse r.before) <> (r.node : r.after)

test.dhallnew file+20

@@ -0,0 +1,20 @@

1+let config = ./spago.dhall

3+in config

4+ // { sources = config.sources # [ "test/**/*.purs" ]

5+ , dependencies =

6+ [ "console"

7+ , "spec"

8+ , "aff"

9+ , "arrays"

10+ , "control"

11+ , "effect"

12+ , "foldable-traversable"

13+ , "free"

14+ , "lists"

15+ , "maybe"

16+ , "partial"

17+ , "prelude"

18+ , "tailrec"

19+ ]

20+ }

test/Example.pursnew file+93

@@ -0,0 +1,93 @@

1+module Test.Example where

3+import Prelude

5+import Control.Comonad.Cofree (head, tail, (:<))

6+import Control.Monad.Rec.Class (Step(..), tailRec)

7+import Data.Array (uncons)

8+import Data.Maybe (Maybe(..), maybe)

9+import Data.Monoid (power)

10+import Effect (Effect)

11+import Effect.Console (log)

12+import Yoga.Tree (Tree, mkLeaf)

13+import Yoga.Tree.Zipper (fromTree, toTree, modifyValue, down, next, root)

14+

15+-- Serves only to make this file runnable

16+main :: Effect Unit

17+main = do

18+ log "rootOnly_alias"

19+ log $ drawTree' rootOnly_alias

20+ log "----"

21+ log "rootWithLeaves"

22+ log $ drawTree' rootWithLeaves

23+ log "----"

24+ log "rootWithBranchesAndLeaves"

25+ log $ drawTree' rootWithBranchesAndLeaves

26+ log "----"

27+ log "exampleZipper"

28+ log $ maybe "" identity exampleZipper

29+

30+

31+-- These examples show how to create a Tree

32+rootOnly_mkCoFree :: Tree String

33+rootOnly_mkCoFree = mkLeaf "root"

34+

35+rootOnly_alias :: Tree String

36+rootOnly_alias = "root" :< [] -- `:<` is the alias for `mkCofree`

37+

38+rootWithLeaves :: Tree String

39+rootWithLeaves =

40+ "root" :<

41+ []

42+

43+rootWithBranchesAndLeaves :: Tree String

44+rootWithBranchesAndLeaves =

45+ "1" :< []

46+

47+-- In our code, we will need to iterate through a Tree and do something

48+-- with each of its contents. Such a function has already been done

49+-- via `drawTree`, which iterates through a tree's contents

50+-- and converts it into a String, indenting them according to their respective

51+-- level:

52+-- https://github.com/dmbfm/purescript-tree/blob/v1.3.2/src/Yoga/Tree.purs#L21-L21

53+

54+-- The below example is a reproduction of the above code but differs from

55+-- it in that the names are more clearly defined to make it easier to see

56+-- the pattern one will follow.

57+

58+drawTree' :: Tree String -> String

59+drawTree' tree =

60+ let

61+ root = head tree

62+ children = tail tree

63+ in

64+ tailRec go {level: 1, result: root <> "\n", current: children }

65+ where

66+ go :: { level :: Int, result :: String, current :: Array (Tree String) }

67+ -> Step { level :: Int, result :: String, current :: Array (Tree String) } String

68+ go rec@{level: l, result: s, current } =

69+ case uncons current of

70+ Nothing -> Done s

71+ Just { head: thisTree, tail: remainingTrees } -> do

72+ let levelRoot = head thisTree

73+ let levelChildren = tail thisTree

74+ let content = (power " " l) <> levelRoot <> "\n"

75+ Loop

76+ rec { current = remainingTrees

77+ , result = rec.result <> content <>

78+ (tailRec go { level: l + 1, result: "", current: levelChildren })

79+ }

80+

81+

82+-- Since we'll also be using the Zipper for the Tree (the `Loc` type),

83+-- we need to know how that works. For a clearer idea of what a 'Zipper' is,

84+-- see 'Design Patterns/Zipper.md':

85+exampleZipper :: Maybe String

86+exampleZipper = do

87+ let node1 = fromTree rootWithBranchesAndLeaves

88+ node1_1 <- down node1

89+ node1_1_1 <- down node1_1

90+ node1_1_2 <- next node1_1_1

91+ let node1_1_2a = modifyValue (\s -> s <> " a") node1_1_2

92+ let rootWithModification = root node1_1_2a

93+ pure $ drawTree' $ toTree rootWithModification

test/Main.purs+198−119

@@ -2,141 +2,220 @@ module Test.Main where

3import Prelude

5−import Control.Comonad.Cofree (Cofree, head, (:<))

5+import Control.Comonad.Cofree (head, (:<))

6−import Control.Monad.Eff (Eff)

6+import Data.Maybe (Maybe(..), fromJust)

7−import Control.Monad.Eff.Class (liftEff)

7+import Effect (Effect)

8−import Control.Monad.Eff.Console (CONSOLE, log)

8+import Effect.Aff (launchAff_)

9−import Data.List (List(..), (:))

10−import Data.Maybe (fromJust)

11−import Data.Tree (Tree, mkTree, scanTree, showTree)

12−import Data.Tree.Zipper (down, fromTree, insertAfter, modifyValue, next, toTree)

13import Partial.Unsafe (unsafePartial)

9import Partial.Unsafe (unsafePartial)

14import Test.Spec (describe, it)

10import Test.Spec (describe, it)

15import Test.Spec.Assertions (shouldEqual)

11import Test.Spec.Assertions (shouldEqual)

16import Test.Spec.Reporter (consoleReporter)

12import Test.Spec.Reporter (consoleReporter)

17−import Test.Spec.Runner (RunnerEffects, run)

13+import Test.Spec.Runner (runSpec)

14+import Yoga.Tree (Tree, leaf, scanTree, showTree)

15+import Yoga.Tree.Zipper (down, findDownWhere, findFromRoot, findUp, flattenLocDepthFirst, fromTree, modifyValue, next, toTree, value)

16+

17+newtype SpecTree a = SpecTree (Tree a)

18+

19+instance Show a => Show (SpecTree a) where

20+ show (SpecTree t) = showTree t

21+

22+derive instance (Eq a) => Eq (SpecTree a)

19sampleTree :: Tree Int

24sampleTree :: Tree Int

20−sampleTree =

25+sampleTree =

21− 1 :<

26+ 1 :<

22− (2 :< Nil)

27+ [ leaf 2

23− : (3 :< Nil)

28+ , leaf 3

24− : (4 :<

29+ , 4 :<

25− (5 :< Nil)

30+ [ leaf 5

26− : (6 :<

31+ , 6 :< [ leaf 7 ]

27− (7 :< Nil) : Nil)

32+ , leaf 8

28− : (8 :< Nil)

33+ ]

29− : Nil

34+

30− )

35+ ]

31− : Nil

36+

32−

37+main :: Effect Unit

33−main :: forall e. Eff (RunnerEffects e) Unit

34−main = run [consoleReporter] do

38+main = launchAff_ $ runSpec [ consoleReporter ] do

35− describe "Tree" do

39+ describe "Tree" do

37 it "mkTree" do

41 it "mkTree" do

38− let t = mkTree 10 Nil

42+ let t = 10 :< []

39 shouldEqual (head t) 10

43 shouldEqual (head t) 10

41 it "Functor" do

45 it "Functor" do

46+ let

42− let result =

47+ result = 2 :<

43− 2 :<

48+ [ leaf 3

44− (3 :< Nil)

49+ , leaf 4

45− : (4 :< Nil)

46− : (5 :<

50+ , 5 :<

47− (6 :< Nil)

51+ [ leaf 6

48− : (7 :<

52+ , 7 :< [ leaf 8 ]

49− (8 :< Nil) : Nil)

53+ , leaf 9

50− : (9 :< Nil)

54+ ]

51− : Nil

55+ ]

52− )

56+ SpecTree (((+) 1) <$> sampleTree) `shouldEqual` SpecTree result

53− : Nil

54− shouldEqual (eq (((+)1) <$> sampleTree) result) true

56 it "scanTree" do

58 it "scanTree" do

59+ let

57− let result =

60+ result =

58− 1 :<

61+ 1 :<

59− (3 :< Nil)

62+ [ leaf 3

60− : (4 :< Nil)

63+ , leaf 4

61− : (5 :<

64+ , 5 :<

62− (10 :< Nil)

65+ [ leaf 10

63− : (11 :<

66+ , 11 :< [ leaf 18 ]

64− (18 :< Nil) : Nil)

67+ , leaf 13

65− : (13 :< Nil)

68+ ]

66− : Nil

69+ ]

67− )

68− : Nil

69− shouldEqual (eq (scanTree (\a b -> a + b) 0 sampleTree) result) true

70+ SpecTree (scanTree (\a b -> a + b) 0 sampleTree) `shouldEqual` SpecTree result

70−

71+

71 describe "Zipper" do

72 describe "Zipper" do

73 let root = fromTree sampleTree

74 let root = fromTree sampleTree

75 it "Modify" do

76 it "Modify" do

77− let root' = unsafePartial $ toTree $ modifyValue (\a -> 2 * a) (fromJust $ down root)

78+ let root' = unsafePartial $ toTree $ modifyValue (\a -> 2 * a) (fromJust $ down root)

78− let root'' = unsafePartial $ toTree $ modifyValue (\a -> 2 * a) (fromJust $ down >=> next >=> next >=> down $ root)

79+ let root'' = unsafePartial $ toTree $ modifyValue (\a -> 2 * a) (fromJust $ down >=> next >=> next >=> down $ root)

80+

81+ let

79− let result =

82+ result =

80− 1 :<

83+ 1 :<

81− (4 :< Nil)

84+ [ leaf 4

82− : (3 :< Nil)

85+ , leaf 3

83− : (4 :<

86+ , 4 :<

84− (5 :< Nil)

87+ [ leaf 5

85− : (6 :<

88+ , 6 :< [ leaf 7 ]

86− (7 :< Nil) : Nil)

89+ , leaf 8

87− : (8 :< Nil)

90+ ]

88− : Nil

91+

89− )

92+ ]

90− : Nil

93+

91−

94+ let

92− let result' =

95+ result' =

93− 1 :<

96+ 1 :<

94− (2 :< Nil)

97+ [ 2 :< []

95− : (3 :< Nil)

98+ , 3 :< []

96− : (4 :<

99+ , 4 :<

97− (10 :< Nil)

100+ [ 10 :< []

98− : (6 :<

101+ , 6 :< [ 7 :< [] ]

99− (7 :< Nil) : Nil)

100− : (8 :< Nil)

102+ , 8 :< []

101− : Nil

103+ ]

102− )

104+ ]

103− : Nil

105+

104−

106+ SpecTree root' `shouldEqual` SpecTree result

105− shouldEqual (eq root' result) true

107+ SpecTree root'' `shouldEqual` SpecTree result'

106− shouldEqual (eq root'' result') true

108+

107−

108− it "Insert" do

109+ -- it "Insert" do

109−

110+

110− let root' = unsafePartial $ toTree $ insertAfter (mkTree 100 Nil) (fromJust $ down root)

111+ -- let root1 = unsafePartial $ toTree $ insertAfter (mkLeaf 100) (fromJust $ down root)

111− let root'' = unsafePartial $ toTree $ insertAfter (mkTree 100 Nil) (fromJust $ (down root) >>= next >>= next >>= down >>= next >>= down)

112+ -- let root2 = unsafePartial $ toTree $ insertAfter (mkLeaf 100) (fromJust $ (down root) >>= next >>= next >>= down >>= next >>= down)

112−

113+ -- let root3 = unsafePartial $ toTree $ insertAfter (mkLeaf 100) (fromJust $ (firstChild root))

113− let result =

114+ -- let root4 = unsafePartial $ toTree $ insertAfter (mkLeaf 100) (fromJust $ (lastChild root))

114− 1 :<

115+

115− (2 :< Nil)

116+ -- let result1 = 1 :< []

116− : (100 :< Nil)

117+ -- let result2 = 1 :< []

117− : (3 :< Nil)

118+ -- let result3 = 1 :< []

118− : (4 :<

119+ -- let result4 = 1 :< []

119− (5 :< Nil)

120+ -- shouldEqual (eq root1 result1) true

120− : (6 :<

121+ -- shouldEqual (eq root2 result2) true

121− (7 :< Nil) : Nil)

122+ -- shouldEqual (eq root3 result3) true

122− : (8 :< Nil)

123+ -- shouldEqual (eq root4 result4) true

123− : Nil

124+

124− )

125+ it "Should findDownWhere with single node" do

125− : Nil

126+ let tree = 1 :< []

126−

127+ let loc = fromTree tree

127− let result' =

128+ shouldEqual (Just 1) ((findDownWhere (_ == 1) loc) <#> value)

128− 1 :<

129+

129− (2 :< Nil)

130+ it "Should findDownWhere with 2 nodes and 2 levels" do

130− : (3 :< Nil)

131+ let tree = 1 :< [ leaf 2 ]

131− : (4 :<

132+ let loc = fromTree tree

132− (5 :< Nil)

133+ shouldEqual (Just 2) ((findDownWhere (_ == 2) loc) <#> value)

133− : (6 :<

134+

134− (7 :< Nil)

135+ it "Should findDownWhere with 3 nodes and 2 levels" do

135− : (100 :< Nil)

136+ let tree = 1 :< [ leaf 2, leaf 3 ]

136− : Nil)

137+ let loc = fromTree tree

137− : (8 :< Nil)

138+ shouldEqual (Just 3) ((findDownWhere (_ == 3) loc) <#> value)

138− : Nil

139+

139− )

140+ it "Should findDownWhere with 4 nodes and 2 levels" do

140− : Nil

141+ let tree = 1 :< (leaf <$> [ 2, 3, 4 ])

141− shouldEqual (eq root' result) true

142+ let loc = fromTree tree

142− shouldEqual (eq root'' result') true

143+ shouldEqual (Just 4) ((findDownWhere (_ == 4) loc) <#> value)

144+

145+ it "Should findDownWhere with 5 nodes and 3 levels" do

146+ let

147+ tree = 1 :<

148+ [ leaf 2

149+ , leaf 3

150+ , 4 :< [ leaf 5 ]

151+ ]

152+ -- log $ showTree tree

153+ let loc = fromTree tree

154+ shouldEqual (Just 5) ((findDownWhere (_ == 5) loc) <#> value)

155+

156+ it "Should findDownWhere with 6 nodes and 3 levels" do

157+ let

158+ tree = 1 :<

159+ [ leaf 2

160+ , leaf 3

161+ , 4 :< [ leaf 5, leaf 6 ]

162+ ]

163+ -- log $ showTree tree

164+ let loc = fromTree tree

165+ shouldEqual (Just 6) ((findDownWhere (_ == 6) loc) <#> value)

166+

167+ it "Should findDownWhere with 7 nodes and 4 levels" do

168+ let

169+ tree = 1 :<

170+ [ leaf 2

171+ , leaf 3

172+ , 4 :< [ leaf 5, 6 :< [ leaf 7 ] ]

173+ ]

174+ -- log $ showTree tree

175+ let loc = fromTree tree

176+ shouldEqual (Just 7) ((findDownWhere (_ == 7) loc) <#> value)

177+

178+ it "Should findDownWhere with 8 nodes and 4 levels" do

179+ let

180+ tree = 1 :<

181+ [ leaf 2

182+ , leaf 3

183+ , 4 :< [ leaf 5, 6 :< [ leaf 7 ] ]

184+ , leaf 8

185+ ]

186+ -- log $ showTree tree

187+ let loc = fromTree tree

188+ shouldEqual (Just 8) ((findDownWhere (_ == 8) loc) <#> value)

189+

190+ it "Should findDownWhere with 8 nodes and 4 levels with a step back" do

191+ let

192+ tree = 1 :<

193+ [ leaf 2

194+ , leaf 3

195+ , 4 :< [ leaf 5, 6 :< [ leaf 7 ] ]

196+ , leaf 8

197+ ]

198+ -- log $ showTree tree

199+ let loc = fromTree tree

200+ shouldEqual (Just 7) ((findDownWhere (_ == 7) loc) <#> value)

201+

202+ it "Should find 7 from the sampleTree" do

203+ shouldEqual (Just 7) (findDownWhere (_ == 7) (fromTree sampleTree) <#> value)

204+

205+ it "Should find 8 from the sampleTree (the bottom) and then find 1 (the top) with findUp" do

206+ let eight = unsafePartial $ fromJust $ findDownWhere (_ == 8) $ fromTree sampleTree

207+ shouldEqual (Just 1) (findUp 1 eight <#> value)

208+

209+ it "Should find 8 from the sampleTree (the bottom) but then not find 7 because it would require a downward traversal" do

210+ let eight = unsafePartial $ fromJust $ findDownWhere (_ == 8) $ fromTree sampleTree

211+ shouldEqual Nothing (findUp 7 eight <#> value)

212+

213+ it "Should find 8 from the sampleTree (the bottom) and then find 7 using findFromRoot" do

214+ let eight = unsafePartial $ fromJust $ findDownWhere (_ == 8) $ fromTree sampleTree

215+ shouldEqual (Just 7) (findFromRoot 7 eight <#> value)

216+

217+ it "Should flatten the Tree into a list of locations following a depth first pattern" do

218+ let flat = map value $ flattenLocDepthFirst $ fromTree sampleTree

219+ --log $ showTree sampleTree

220+ --log $ show flat

221+ shouldEqual flat [1,2,3,4,5,6,7,8]