4c37646 · rowtype-yoga/purescript-yoga-tree

6import Data.List (List(Nil), (:))

7import Data.Maybe (Maybe(..), fromJust)

8import Data.Tree (Tree, mkTree, scanTree)

9−import Data.Tree.Zipper (down, findDownWhere, findFromRoot, findUp, flattenLocDepthFirst, fromTree, insertAfter, modifyValue, next, toTree, value)

9+import Data.Tree.Zipper (down, findDownWhere, findFromRoot, findUp, flattenLocDepthFirst, fromTree, insertAfter, modifyValue, next, toTree, value, firstChild, lastChild)

10import Effect (Effect)

11import Partial.Unsafe (unsafePartial)

12import Test.Spec (describe, it)

15import Test.Spec.Runner (run)

16

17sampleTree :: Tree Int

18−sampleTree =

18+sampleTree =

19− 1 :<

19+ 1 :<

20 (2 :< Nil)

21 : (3 :< Nil)

22 : (4 :<

23 (5 :< Nil)

24− : (6 :<

24+ : (6 :<

25 (7 :< Nil) : Nil)

26 : (8 :< Nil)

27 : Nil

29 : Nil

30

31main :: Effect Unit

32−main = run [consoleReporter] do

32+main = run [consoleReporter] do

33− describe "Tree" do

33+ describe "Tree" do

34

35 it "mkTree" do

36 let t = mkTree 10 Nil

37 shouldEqual (head t) 10

38

39 it "Functor" do

40− let result =

40+ let result =

41− 2 :<

41+ 2 :<

42 (3 :< Nil)

43 : (4 :< Nil)

44 : (5 :<

45 (6 :< Nil)

46− : (7 :<

46+ : (7 :<

47 (8 :< Nil) : Nil)

48 : (9 :< Nil)

49 : Nil

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

53

54 it "scanTree" do

55− let result =

55+ let result =

56− 1 :<

56+ 1 :<

57 (3 :< Nil)

58 : (4 :< Nil)

59 : (5 :<

60 (10 :< Nil)

61− : (11 :<

61+ : (11 :<

62 (18 :< Nil) : Nil)

63 : (13 :< Nil)

64 : Nil

65 )

66 : Nil

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

68−

68+

69 describe "Zipper" do

70

71 let root = fromTree sampleTree

72

73 it "Modify" do

74

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

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

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

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

77 let result =

78− 1 :<

78+ 1 :<

79 (4 :< Nil)

80 : (3 :< Nil)

81 : (4 :<

82 (5 :< Nil)

83− : (6 :<

83+ : (6 :<

84 (7 :< Nil) : Nil)

85 : (8 :< Nil)

86 : Nil

88 : Nil

89

90 let result' =

91− 1 :<

91+ 1 :<

92 (2 :< Nil)

93 : (3 :< Nil)

94 : (4 :<

95 (10 :< Nil)

96− : (6 :<

96+ : (6 :<

97 (7 :< Nil) : Nil)

98 : (8 :< Nil)

99 : Nil

102

103 shouldEqual (eq root' result) true

104 shouldEqual (eq root'' result') true

105−

105+

106 it "Insert" do

107

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

108+ let root1 = unsafePartial $ toTree $ insertAfter (mkTree 100 Nil) (fromJust $ down root)

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

109+ let root2 = unsafePartial $ toTree $ insertAfter (mkTree 100 Nil) (fromJust $ (down root) >>= next >>= next >>= down >>= next >>= down)

110+ let root3 = unsafePartial $ toTree $ insertAfter (mkTree 100 Nil) (fromJust $ (firstChild root))

111+ let root4 = unsafePartial $ toTree $ insertAfter (mkTree 100 Nil) (fromJust $ (lastChild root))

110

112

111− let result =

113+ let result1 =

112− 1 :<

114+ 1 :<

113 (2 :< Nil)

115 (2 :< Nil)

114 : (100 :< Nil)

116 : (100 :< Nil)

115 : (3 :< Nil)

117 : (3 :< Nil)

116 : (4 :<

118 : (4 :<

117 (5 :< Nil)

119 (5 :< Nil)

118− : (6 :<

120+ : (6 :<

119 (7 :< Nil) : Nil)

121 (7 :< Nil) : Nil)

120 : (8 :< Nil)

122 : (8 :< Nil)

121 : Nil

123 : Nil

122 )

124 )

123 : Nil

125 : Nil

124

126

125− let result' =

127+ let result2 =

126− 1 :<

128+ 1 :<

127 (2 :< Nil)

129 (2 :< Nil)

128 : (3 :< Nil)

130 : (3 :< Nil)

129 : (4 :<

131 : (4 :<

130 (5 :< Nil)

132 (5 :< Nil)

131− : (6 :<

133+ : (6 :<

132− (7 :< Nil)

134+ (7 :< Nil)

133 : (100 :< Nil)

135 : (100 :< Nil)

134 : Nil)

136 : Nil)

135 : (8 :< Nil)

137 : (8 :< Nil)

136 : Nil

138 : Nil

137 )

139 )

138 : Nil

140 : Nil

141+ let result3 =

142+ 1 :<

143+ (2 :< Nil)

144+ : (100 :< Nil)

145+ : (3 :< Nil)

146+ : (4 :<

147+ (5 :< Nil)

148+ : (6 :<

149+ (7 :< Nil)

150+ : Nil

151+ )

152+ : (8 :< Nil)

153+ : Nil

154+ )

155+ : Nil

156+ let result4 =

157+ 1 :<

158+ (2 :< Nil)

159+ : (3 :< Nil)

160+ : (4 :<

161+ (5 :< Nil)

162+ : (6 :<

163+ (7 :< Nil) : Nil)

164+ : (8 :< Nil)

165+ : Nil

166+ )

167+ : (100 :< Nil)

168+ : Nil

139− shouldEqual (eq root' result) true

169+ shouldEqual (eq root1 result1) true

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

170+ shouldEqual (eq root2 result2) true

171+ shouldEqual (eq root3 result3) true

172+ shouldEqual (eq root4 result4) true

141

173

142 it "Should findDownWhere with single node" do

174 it "Should findDownWhere with single node" do

143 let tree = 1 :< Nil

175 let tree = 1 :< Nil

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

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

146

178

147 it "Should findDownWhere with 2 nodes and 2 levels" do

179 it "Should findDownWhere with 2 nodes and 2 levels" do

148− let tree = 1 :<

180+ let tree = 1 :<

149− (2 :< Nil)

181+ (2 :< Nil)

150 : Nil

182 : Nil

151 -- log $ showTree tree

183 -- log $ showTree tree

152 let loc = fromTree tree

184 let loc = fromTree tree

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

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

154

186

155 it "Should findDownWhere with 3 nodes and 2 levels" do

187 it "Should findDownWhere with 3 nodes and 2 levels" do

156− let tree = 1 :<

188+ let tree = 1 :<

157− (2 :< Nil)

189+ (2 :< Nil)

158− : (3 :< Nil)

190+ : (3 :< Nil)

159 : Nil

191 : Nil

160 -- log $ showTree tree

192 -- log $ showTree tree

161 let loc = fromTree tree

193 let loc = fromTree tree

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

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

163

195

164 it "Should findDownWhere with 4 nodes and 2 levels" do

196 it "Should findDownWhere with 4 nodes and 2 levels" do

165− let tree = 1 :<

197+ let tree = 1 :<

166− (2 :< Nil)

198+ (2 :< Nil)

167− : (3 :< Nil)

199+ : (3 :< Nil)

168− : (4 :< Nil)

200+ : (4 :< Nil)

169 : Nil

201 : Nil

170 -- log $ showTree tree

202 -- log $ showTree tree

171 let loc = fromTree tree

203 let loc = fromTree tree

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

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

173

205

174 it "Should findDownWhere with 5 nodes and 3 levels" do

206 it "Should findDownWhere with 5 nodes and 3 levels" do

175− let tree = 1 :<

207+ let tree = 1 :<

176− (2 :< Nil)

208+ (2 :< Nil)

177− : (3 :< Nil)

209+ : (3 :< Nil)

178− : (4 :<

210+ : (4 :<

179 (5 :< Nil)

211 (5 :< Nil)

180− : Nil)

212+ : Nil)

181 : Nil

213 : Nil

182 -- log $ showTree tree

214 -- log $ showTree tree

183 let loc = fromTree tree

215 let loc = fromTree tree

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

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

185

217

186 it "Should findDownWhere with 6 nodes and 3 levels" do

218 it "Should findDownWhere with 6 nodes and 3 levels" do

187− let tree = 1 :<

219+ let tree = 1 :<

188− (2 :< Nil)

220+ (2 :< Nil)

189− : (3 :< Nil)

221+ : (3 :< Nil)

190− : (4 :<

222+ : (4 :<

191 (5 :< Nil)

223 (5 :< Nil)

192 : (6 :< Nil)

224 : (6 :< Nil)

193− : Nil)

225+ : Nil)

194 : Nil

226 : Nil

195 -- log $ showTree tree

227 -- log $ showTree tree

196 let loc = fromTree tree

228 let loc = fromTree tree

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

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

198

230

199 it "Should findDownWhere with 7 nodes and 4 levels" do

231 it "Should findDownWhere with 7 nodes and 4 levels" do

200− let tree = 1 :<

232+ let tree = 1 :<

201− (2 :< Nil)

233+ (2 :< Nil)

202− : (3 :< Nil)

234+ : (3 :< Nil)

203− : (4 :<

235+ : (4 :<

204 (5 :< Nil)

236 (5 :< Nil)

205− : (6 :<

237+ : (6 :<

206 (7 :< Nil) : Nil)

238 (7 :< Nil) : Nil)

207− : Nil)

239+ : Nil)

208 : Nil

240 : Nil

209 -- log $ showTree tree

241 -- log $ showTree tree

210 let loc = fromTree tree

242 let loc = fromTree tree

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

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

212

244

213 it "Should findDownWhere with 8 nodes and 4 levels" do

245 it "Should findDownWhere with 8 nodes and 4 levels" do

214− let tree = 1 :<

246+ let tree = 1 :<

215− (2 :< Nil)

247+ (2 :< Nil)

216− : (3 :< Nil)

248+ : (3 :< Nil)

217− : (4 :<

249+ : (4 :<

218 (5 :< Nil)

250 (5 :< Nil)

219− : (6 :<

251+ : (6 :<

220 (7 :< Nil) : Nil)

252 (7 :< Nil) : Nil)

221 : (8 :< Nil)

253 : (8 :< Nil)

222− : Nil)

254+ : Nil)

223 : Nil

255 : Nil

224 -- log $ showTree tree

256 -- log $ showTree tree

225 let loc = fromTree tree

257 let loc = fromTree tree

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

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

227

259

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

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

229− let tree = 1 :<

261+ let tree = 1 :<

230− (2 :< Nil)

262+ (2 :< Nil)

231− : (3 :< Nil)

263+ : (3 :< Nil)

232− : (4 :<

264+ : (4 :<

233 (5 :< Nil)

265 (5 :< Nil)

234− : (6 :<

266+ : (6 :<

235 (7 :< Nil) : Nil)

267 (7 :< Nil) : Nil)

236 : (8 :< Nil)

268 : (8 :< Nil)

237− : Nil)

269+ : Nil)

238 : Nil

270 : Nil

239 -- log $ showTree tree

271 -- log $ showTree tree

240 let loc = fromTree tree

272 let loc = fromTree tree

260 --log $ showTree sampleTree

292 --log $ showTree sampleTree

261 --log $ show flat

293 --log $ show flat

262 shouldEqual flat (1 : 2 : 3 : 4 : 5 : 6 : 7 : 8 : Nil)

294 shouldEqual flat (1 : 2 : 3 : 4 : 5 : 6 : 7 : 8 : Nil)

263−

264−

265−