├── .gitignore
├── .vimrc
├── ChangeLog.md
├── LICENSE
├── Makefile
├── README.md
├── README_DEV.md
├── Setup.hs
├── doctests.hs
├── gfm.css
├── src
    ├── Control
    │   └── Applicative
    │   │   └── Phases.hs
    └── Data
    │   ├── BinaryTree.hs
    │   ├── Monoid
    │       └── TreeDiagram.hs
    │   └── Traversable
    │       └── TreeLike.hs
└── tree-traversals.cabal


/.gitignore:
--------------------------------------------------------------------------------
1 | # generated by cabal via `make build`, `make doc`
2 | dist/
3 | dist-newstyle/
4 | # generated by cabal via `cabal sandbox init`
5 | cabal.sandbox.config
6 | .cabal-sandbox/
7 | 


--------------------------------------------------------------------------------
/.vimrc:
--------------------------------------------------------------------------------
 1 | nnoremap <Leader>t :make test<CR>
 2 | nnoremap <Leader>d :make doc<CR>
 3 | nnoremap <Leader>m :make build<CR>
 4 | 
 5 | " recognize test error locations
 6 | let &errorformat="### Failure in %f:%l: %m," . &errorformat
 7 | 
 8 | " highlight haskell blocks in markdown files
 9 | let g:markdown_fenced_languages=['haskell']
10 | 


--------------------------------------------------------------------------------
/ChangeLog.md:
--------------------------------------------------------------------------------
1 | # Revision history for tree-traversals
2 | 
3 | ## 0.1.0.0  -- YYYY-mm-dd
4 | 
5 | * First version. Released on an unsuspecting world.
6 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
  1 | CC0 1.0 Universal
  2 | 
  3 |      CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE LEGAL
  4 |      SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN ATTORNEY-CLIENT
  5 |      RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS INFORMATION ON AN "AS-IS"
  6 |      BASIS. CREATIVE COMMONS MAKES NO WARRANTIES REGARDING THE USE OF THIS
  7 |      DOCUMENT OR THE INFORMATION OR WORKS PROVIDED HEREUNDER, AND DISCLAIMS
  8 |      LIABILITY FOR DAMAGES RESULTING FROM THE USE OF THIS DOCUMENT OR THE
  9 |      INFORMATION OR WORKS PROVIDED HEREUNDER. 
 10 | 
 11 | Statement of Purpose
 12 | 
 13 | The laws of most jurisdictions throughout the world automatically confer
 14 | exclusive Copyright and Related Rights (defined below) upon the creator and
 15 | subsequent owner(s) (each and all, an "owner") of an original work of
 16 | authorship and/or a database (each, a "Work").
 17 | 
 18 | Certain owners wish to permanently relinquish those rights to a Work for the
 19 | purpose of contributing to a commons of creative, cultural and scientific works
 20 | ("Commons") that the public can reliably and without fear of later claims of
 21 | infringement build upon, modify, incorporate in other works, reuse and
 22 | redistribute as freely as possible in any form whatsoever and for any purposes,
 23 | including without limitation commercial purposes. These owners may contribute
 24 | to the Commons to promote the ideal of a free culture and the further
 25 | production of creative, cultural and scientific works, or to gain reputation or
 26 | greater distribution for their Work in part through the use and efforts of
 27 | others.
 28 | 
 29 | For these and/or other purposes and motivations, and without any expectation of
 30 | additional consideration or compensation, the person associating CC0 with a
 31 | Work (the "Affirmer"), to the extent that he or she is an owner of Copyright
 32 | and Related Rights in the Work, voluntarily elects to apply CC0 to the Work and
 33 | publicly distribute the Work under its terms, with knowledge of his or her
 34 | Copyright and Related Rights in the Work and the meaning and intended legal
 35 | effect of CC0 on those rights.
 36 | 
 37 | 1. Copyright and Related Rights. A Work made available under CC0 may be
 38 |    protected by copyright and related or neighboring rights ("Copyright and
 39 |    Related Rights"). Copyright and Related Rights include, but are not limited
 40 |    to, the following:
 41 | 
 42 |     the right to reproduce, adapt, distribute, perform, display, communicate,
 43 |     and translate a Work;
 44 | 
 45 |     moral rights retained by the original author(s) and/or performer(s);
 46 | 
 47 |     publicity and privacy rights pertaining to a person's image or likeness
 48 |     depicted in a Work;
 49 | 
 50 |     rights protecting against unfair competition in regards to a Work, subject
 51 |     to the limitations in paragraph 4(a), below;
 52 | 
 53 |     rights protecting the extraction, dissemination, use and reuse of data in a
 54 |     Work;
 55 | 
 56 |     database rights (such as those arising under Directive 96/9/EC of the
 57 |     European Parliament and of the Council of 11 March 1996 on the legal
 58 |     protection of databases, and under any national implementation thereof,
 59 |     including any amended or successor version of such directive); and
 60 | 
 61 |     other similar, equivalent or corresponding rights throughout the world
 62 |     based on applicable law or treaty, and any national implementations
 63 |     thereof.
 64 | 
 65 | 2. Waiver. To the greatest extent permitted by, but not in contravention of,
 66 |    applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and
 67 |    unconditionally waives, abandons, and surrenders all of Affirmer's Copyright
 68 |    and Related Rights and associated claims and causes of action, whether now
 69 |    known or unknown (including existing as well as future claims and causes of
 70 |    action), in the Work (i) in all territories worldwide, (ii) for the maximum
 71 |    duration provided by applicable law or treaty (including future time
 72 |    extensions), (iii) in any current or future medium and for any number of
 73 |    copies, and (iv) for any purpose whatsoever, including without limitation
 74 |    commercial, advertising or promotional purposes (the "Waiver"). Affirmer
 75 |    makes the Waiver for the benefit of each member of the public at large and
 76 |    to the detriment of Affirmer's heirs and successors, fully intending that
 77 |    such Waiver shall not be subject to revocation, rescission, cancellation,
 78 |    termination, or any other legal or equitable action to disrupt the quiet
 79 |    enjoyment of the Work by the public as contemplated by Affirmer's express
 80 |    Statement of Purpose.
 81 | 
 82 | 3. Public License Fallback. Should any part of the Waiver for any reason be
 83 |    judged legally invalid or ineffective under applicable law, then the Waiver
 84 |    shall be preserved to the maximum extent permitted taking into account
 85 |    Affirmer's express Statement of Purpose. In addition, to the extent the
 86 |    Waiver is so judged Affirmer hereby grants to each affected person a
 87 |    royalty-free, non transferable, non sublicensable, non exclusive,
 88 |    irrevocable and unconditional license to exercise Affirmer's Copyright and
 89 |    Related Rights in the Work (i) in all territories worldwide, (ii) for the
 90 |    maximum duration provided by applicable law or treaty (including future time
 91 |    extensions), (iii) in any current or future medium and for any number of
 92 |    copies, and (iv) for any purpose whatsoever, including without limitation
 93 |    commercial, advertising or promotional purposes (the "License"). The License
 94 |    shall be deemed effective as of the date CC0 was applied by Affirmer to the
 95 |    Work. Should any part of the License for any reason be judged legally
 96 |    invalid or ineffective under applicable law, such partial invalidity or
 97 |    ineffectiveness shall not invalidate the remainder of the License, and in
 98 |    such case Affirmer hereby affirms that he or she will not (i) exercise any
 99 |    of his or her remaining Copyright and Related Rights in the Work or (ii)
100 |    assert any associated claims and causes of action with respect to the Work,
101 |    in either case contrary to Affirmer's express Statement of Purpose.
102 | 
103 | 4. Limitations and Disclaimers.
104 | 
105 |     No trademark or patent rights held by Affirmer are waived, abandoned,
106 |     surrendered, licensed or otherwise affected by this document.
107 | 
108 |     Affirmer offers the Work as-is and makes no representations or warranties
109 |     of any kind concerning the Work, express, implied, statutory or otherwise,
110 |     including without limitation warranties of title, merchantability, fitness
111 |     for a particular purpose, non infringement, or the absence of latent or
112 |     other defects, accuracy, or the present or absence of errors, whether or
113 |     not discoverable, all to the greatest extent permissible under applicable
114 |     law.
115 | 
116 |     Affirmer disclaims responsibility for clearing rights of other persons that
117 |     may apply to the Work or any use thereof, including without limitation any
118 |     person's Copyright and Related Rights in the Work. Further, Affirmer
119 |     disclaims responsibility for obtaining any necessary consents, permissions
120 |     or other rights required for any use of the Work.
121 | 
122 |     Affirmer understands and acknowledges that Creative Commons is not a party
123 |     to this document and has no duty or obligation with respect to this CC0 or
124 |     use of the Work.
125 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | default:
 2 | 
 3 | all: install-dependencies configure build doc test
 4 | 
 5 | configure:
 6 | 	cabal configure --enable-tests -f development
 7 | 
 8 | install-dependencies: .cabal-sandbox install-global-dependencies
 9 | 	cabal install --enable-tests --dependencies-only
10 | 
11 | install-global-dependencies:
12 | 	which happy || ( cd .. && cabal install happy )
13 | 	which pandoc || ( cd .. && cabal install pandoc )
14 | 
15 | build:
16 | 	cabal build
17 | 
18 | test:
19 | 	cabal test --show-details=always
20 | 
21 | doc: dist/doc/html/tree-traversals \
22 | 	$(addprefix dist/doc/html/,$(addsuffix .html,$(basename $(wildcard *.md))))
23 | 
24 | .cabal-sandbox:
25 | 	cabal sandbox init
26 | 
27 | dist/doc/html/tree-traversals: tree-traversals.cabal $(shell find src -type f)
28 | 	cabal haddock
29 | 	touch $@
30 | 
31 | dist/doc/html/%.html: %.md dist/doc/html/gfm.css
32 | 	pandoc $< -o $@ --css gfm.css --standalone --from gfm --to html --metadata=title:$*
33 | 
34 | dist/doc/html/gfm.css: gfm.css
35 | 	mkdir -p $(dir $@)
36 | 	cp $< $@
37 | 
38 | .PHONY: default all example install-dependencies build doc test
39 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | The tree-traversals package defines [in-order, pre-order, post-order, level-order, and reversed level-order traversals](https://en.wikipedia.org/wiki/Tree_traversal#Types) for tree-like types:
 2 | 
 3 | ```haskell
 4 | inorder, preorder, postorder, levelorder, rlevelorder
 5 |   :: (TreeLike tree, Applicative f) => (a -> f b) -> tree a -> f (tree b) 
 6 | ```
 7 | 
 8 | The package also provides newtype wrappers for the various traversals so they
 9 | may be used with `traverse`, i.e.
10 | 
11 | ```haskell
12 | traverse f (InOrder tree) = inorder f tree
13 | traverse f (PreOrder tree) = preorder f tree
14 | traverse f (PostOrder tree) = postorder f tree
15 | traverse f (LevelOrder tree) = levelorder f tree
16 | traverse f (RLevelOrder tree) = rlevelorder f tree
17 | ```
18 | 
19 | To implement the various orders, the tree-traversals package provides the `Phases` applicative transformer for organizing effects into distinct phases.
20 | 
21 | Instances of `TreeLike` are provided for rose trees (`Tree` from [`Data.Tree`](http://hackage.haskell.org/package/containers/docs/Data-Tree.html)), binary trees (`BinaryTree` from this package's `Data.BinaryTree`), forests (`Forest` from this package's `Data.Traversable.TreeLike`),
22 | and algebraic combinations of trees (`Compose outerTree innerTree`, `Product fstTree sndTree`, `Sum leftTree rightTree`).
23 | 


--------------------------------------------------------------------------------
/README_DEV.md:
--------------------------------------------------------------------------------
 1 | Ad hoc traversals
 2 | -----------------
 3 | Is there a way to specify the order of traversal during
 4 | the traversal? How could this be implemented?
 5 | 
 6 | ```haskell
 7 | search :: TreeLike tree 
 8 |        => (forall r subtree. TreeLike subtree
 9 |           => Phases f (subtree b -> r)
10 |           -> subtree a
11 |           -> Phases f r
12 |           )
13 |        -> tree a
14 |        -> f (tree b)
15 | search f = runPhasesForwards . f (pure id)
16 | ```
17 | 


--------------------------------------------------------------------------------
/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | main = defaultMain
3 | 


--------------------------------------------------------------------------------
/doctests.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 | import Test.DocTest
3 | 
4 | main :: IO ()
5 | main = doctest $ words "--preserve-it src/"
6 | 


--------------------------------------------------------------------------------
/gfm.css:
--------------------------------------------------------------------------------
  1 | */
  2 | /*! normalize.css v2.1.3 | MIT License | git.io/normalize */
  3 | 
  4 | /* ==========================================================================
  5 |    HTML5 display definitions
  6 |    ========================================================================== */
  7 | 
  8 | /**
  9 |  * Correct `block` display not defined in IE 8/9.
 10 |  */
 11 | 
 12 | article,
 13 | aside,
 14 | details,
 15 | figcaption,
 16 | figure,
 17 | footer,
 18 | header,
 19 | hgroup,
 20 | main,
 21 | nav,
 22 | section,
 23 | summary {
 24 |     display: block;
 25 | }
 26 | 
 27 | /**
 28 |  * Correct `inline-block` display not defined in IE 8/9.
 29 |  */
 30 | 
 31 | audio,
 32 | canvas,
 33 | video {
 34 |     display: inline-block;
 35 | }
 36 | 
 37 | /**
 38 |  * Prevent modern browsers from displaying `audio` without controls.
 39 |  * Remove excess height in iOS 5 devices.
 40 |  */
 41 | 
 42 | audio:not([controls]) {
 43 |     display: none;
 44 |     height: 0;
 45 | }
 46 | 
 47 | /**
 48 |  * Address `[hidden]` styling not present in IE 8/9.
 49 |  * Hide the `template` element in IE, Safari, and Firefox < 22.
 50 |  */
 51 | 
 52 | [hidden],
 53 | template {
 54 |     display: none;
 55 | }
 56 | 
 57 | /* ==========================================================================
 58 |    Base
 59 |    ========================================================================== */
 60 | 
 61 | /**
 62 |  * 1. Set default font family to sans-serif.
 63 |  * 2. Prevent iOS text size adjust after orientation change, without disabling
 64 |  *    user zoom.
 65 |  */
 66 | 
 67 | html {
 68 |     font-family: sans-serif; /* 1 */
 69 |     -ms-text-size-adjust: 100%; /* 2 */
 70 |     -webkit-text-size-adjust: 100%; /* 2 */
 71 | }
 72 | 
 73 | /**
 74 |  * Remove default margin.
 75 |  */
 76 | 
 77 | body {
 78 |     margin: 0;
 79 | }
 80 | 
 81 | /* ==========================================================================
 82 |    Links
 83 |    ========================================================================== */
 84 | 
 85 | /**
 86 |  * Remove the gray background color from active links in IE 10.
 87 |  */
 88 | 
 89 | a {
 90 |     background: transparent;
 91 | }
 92 | 
 93 | /**
 94 |  * Address `outline` inconsistency between Chrome and other browsers.
 95 |  */
 96 | 
 97 | a:focus {
 98 |     outline: thin dotted;
 99 | }
100 | 
101 | /**
102 |  * Improve readability when focused and also mouse hovered in all browsers.
103 |  */
104 | 
105 | a:active,
106 | a:hover {
107 |     outline: 0;
108 | }
109 | 
110 | /* ==========================================================================
111 |    Typography
112 |    ========================================================================== */
113 | 
114 | /**
115 |  * Address variable `h1` font-size and margin within `section` and `article`
116 |  * contexts in Firefox 4+, Safari 5, and Chrome.
117 |  */
118 | 
119 | h1 {
120 |     font-size: 2em;
121 |     margin: 0.67em 0;
122 | }
123 | 
124 | /**
125 |  * Address styling not present in IE 8/9, Safari 5, and Chrome.
126 |  */
127 | 
128 | abbr[title] {
129 |     border-bottom: 1px dotted;
130 | }
131 | 
132 | /**
133 |  * Address style set to `bolder` in Firefox 4+, Safari 5, and Chrome.
134 |  */
135 | 
136 | b,
137 | strong {
138 |     font-weight: bold;
139 | }
140 | 
141 | /**
142 |  * Address styling not present in Safari 5 and Chrome.
143 |  */
144 | 
145 | dfn {
146 |     font-style: italic;
147 | }
148 | 
149 | /**
150 |  * Address differences between Firefox and other browsers.
151 |  */
152 | 
153 | hr {
154 |     -moz-box-sizing: content-box;
155 |     box-sizing: content-box;
156 |     height: 0;
157 | }
158 | 
159 | /**
160 |  * Address styling not present in IE 8/9.
161 |  */
162 | 
163 | mark {
164 |     background: #ff0;
165 |     color: #000;
166 | }
167 | 
168 | /**
169 |  * Correct font family set oddly in Safari 5 and Chrome.
170 |  */
171 | 
172 | code,
173 | kbd,
174 | pre,
175 | samp {
176 |     font-family: monospace, serif;
177 |     font-size: 1em;
178 | }
179 | 
180 | /**
181 |  * Improve readability of pre-formatted text in all browsers.
182 |  */
183 | 
184 | pre {
185 |     white-space: pre-wrap;
186 | }
187 | 
188 | /**
189 |  * Set consistent quote types.
190 |  */
191 | 
192 | q {
193 |     quotes: "\201C" "\201D" "\2018" "\2019";
194 | }
195 | 
196 | /**
197 |  * Address inconsistent and variable font size in all browsers.
198 |  */
199 | 
200 | small {
201 |     font-size: 80%;
202 | }
203 | 
204 | /**
205 |  * Prevent `sub` and `sup` affecting `line-height` in all browsers.
206 |  */
207 | 
208 | sub,
209 | sup {
210 |     font-size: 75%;
211 |     line-height: 0;
212 |     position: relative;
213 |     vertical-align: baseline;
214 | }
215 | 
216 | sup {
217 |     top: -0.5em;
218 | }
219 | 
220 | sub {
221 |     bottom: -0.25em;
222 | }
223 | 
224 | /* ==========================================================================
225 |    Embedded content
226 |    ========================================================================== */
227 | 
228 | /**
229 |  * Remove border when inside `a` element in IE 8/9.
230 |  */
231 | 
232 | img {
233 |     border: 0;
234 | }
235 | 
236 | /**
237 |  * Correct overflow displayed oddly in IE 9.
238 |  */
239 | 
240 | svg:not(:root) {
241 |     overflow: hidden;
242 | }
243 | 
244 | /* ==========================================================================
245 |    Figures
246 |    ========================================================================== */
247 | 
248 | /**
249 |  * Address margin not present in IE 8/9 and Safari 5.
250 |  */
251 | 
252 | figure {
253 |     margin: 0;
254 | }
255 | 
256 | /* ==========================================================================
257 |    Forms
258 |    ========================================================================== */
259 | 
260 | /**
261 |  * Define consistent border, margin, and padding.
262 |  */
263 | 
264 | fieldset {
265 |     border: 1px solid #c0c0c0;
266 |     margin: 0 2px;
267 |     padding: 0.35em 0.625em 0.75em;
268 | }
269 | 
270 | /**
271 |  * 1. Correct `color` not being inherited in IE 8/9.
272 |  * 2. Remove padding so people aren't caught out if they zero out fieldsets.
273 |  */
274 | 
275 | legend {
276 |     border: 0; /* 1 */
277 |     padding: 0; /* 2 */
278 | }
279 | 
280 | /**
281 |  * 1. Correct font family not being inherited in all browsers.
282 |  * 2. Correct font size not being inherited in all browsers.
283 |  * 3. Address margins set differently in Firefox 4+, Safari 5, and Chrome.
284 |  */
285 | 
286 | button,
287 | input,
288 | select,
289 | textarea {
290 |     font-family: inherit; /* 1 */
291 |     font-size: 100%; /* 2 */
292 |     margin: 0; /* 3 */
293 | }
294 | 
295 | /**
296 |  * Address Firefox 4+ setting `line-height` on `input` using `!important` in
297 |  * the UA stylesheet.
298 |  */
299 | 
300 | button,
301 | input {
302 |     line-height: normal;
303 | }
304 | 
305 | /**
306 |  * Address inconsistent `text-transform` inheritance for `button` and `select`.
307 |  * All other form control elements do not inherit `text-transform` values.
308 |  * Correct `button` style inheritance in Chrome, Safari 5+, and IE 8+.
309 |  * Correct `select` style inheritance in Firefox 4+ and Opera.
310 |  */
311 | 
312 | button,
313 | select {
314 |     text-transform: none;
315 | }
316 | 
317 | /**
318 |  * 1. Avoid the WebKit bug in Android 4.0.* where (2) destroys native `audio`
319 |  *    and `video` controls.
320 |  * 2. Correct inability to style clickable `input` types in iOS.
321 |  * 3. Improve usability and consistency of cursor style between image-type
322 |  *    `input` and others.
323 |  */
324 | 
325 | button,
326 | html input[type="button"], /* 1 */
327 | input[type="reset"],
328 | input[type="submit"] {
329 |     -webkit-appearance: button; /* 2 */
330 |     cursor: pointer; /* 3 */
331 | }
332 | 
333 | /**
334 |  * Re-set default cursor for disabled elements.
335 |  */
336 | 
337 | button[disabled],
338 | html input[disabled] {
339 |     cursor: default;
340 | }
341 | 
342 | /**
343 |  * 1. Address box sizing set to `content-box` in IE 8/9/10.
344 |  * 2. Remove excess padding in IE 8/9/10.
345 |  */
346 | 
347 | input[type="checkbox"],
348 | input[type="radio"] {
349 |     box-sizing: border-box; /* 1 */
350 |     padding: 0; /* 2 */
351 | }
352 | 
353 | /**
354 |  * 1. Address `appearance` set to `searchfield` in Safari 5 and Chrome.
355 |  * 2. Address `box-sizing` set to `border-box` in Safari 5 and Chrome
356 |  *    (include `-moz` to future-proof).
357 |  */
358 | 
359 | input[type="search"] {
360 |     -webkit-appearance: textfield; /* 1 */
361 |     -moz-box-sizing: content-box;
362 |     -webkit-box-sizing: content-box; /* 2 */
363 |     box-sizing: content-box;
364 | }
365 | 
366 | /**
367 |  * Remove inner padding and search cancel button in Safari 5 and Chrome
368 |  * on OS X.
369 |  */
370 | 
371 | input[type="search"]::-webkit-search-cancel-button,
372 | input[type="search"]::-webkit-search-decoration {
373 |     -webkit-appearance: none;
374 | }
375 | 
376 | /**
377 |  * Remove inner padding and border in Firefox 4+.
378 |  */
379 | 
380 | button::-moz-focus-inner,
381 | input::-moz-focus-inner {
382 |     border: 0;
383 |     padding: 0;
384 | }
385 | 
386 | /**
387 |  * 1. Remove default vertical scrollbar in IE 8/9.
388 |  * 2. Improve readability and alignment in all browsers.
389 |  */
390 | 
391 | textarea {
392 |     overflow: auto; /* 1 */
393 |     vertical-align: top; /* 2 */
394 | }
395 | 
396 | /* ==========================================================================
397 |    Tables
398 |    ========================================================================== */
399 | 
400 | /**
401 |  * Remove most spacing between table cells.
402 |  */
403 | 
404 | table {
405 |     border-collapse: collapse;
406 |     border-spacing: 0;
407 | }
408 | 
409 | .go-top {
410 | position: fixed;
411 | bottom: 2em;
412 | right: 2em;
413 | text-decoration: none;
414 | background-color: #E0E0E0;
415 | font-size: 12px;
416 | padding: 1em;
417 | display: inline;
418 | }
419 | 
420 | /* Github css */
421 | 
422 | html,body{
423 |     margin: auto;
424 |     padding-right: 1em;
425 |     padding-left: 1em;
426 |     max-width: 44em; color:black;
427 | }
428 | *:not('#mkdbuttons'){margin:0;padding:0}
429 | body{font:13.34px helvetica,arial,freesans,clean,sans-serif;-webkit-font-smoothing:subpixel-antialiased;line-height:1.4;padding:3px;background:#fff;border-radius:3px;-moz-border-radius:3px;-webkit-border-radius:3px}
430 | p{margin:1em 0}
431 | a{color:#4183c4;text-decoration:none}
432 | body{background-color:#fff;padding:30px;margin:15px;font-size:14px;line-height:1.6}
433 | body>*:first-child{margin-top:0!important}
434 | body>*:last-child{margin-bottom:0!important}
435 | @media screen{body{box-shadow:0 0 0 1px #cacaca,0 0 0 4px #eee}
436 | }
437 | h1,h2,h3,h4,h5,h6{margin:20px 0 10px;padding:0;font-weight:bold;-webkit-font-smoothing:subpixel-antialiased;cursor:text}
438 | h1{font-size:28px;color:#000}
439 | h2{font-size:24px;border-bottom:1px solid #ccc;color:#000}
440 | h3{font-size:18px;color:#333}
441 | h4{font-size:16px;color:#333}
442 | h5{font-size:14px;color:#333}
443 | h6{color:#777;font-size:14px}
444 | p,blockquote,table,pre{margin:15px 0}
445 | ul{padding-left:30px}
446 | ol{padding-left:30px}
447 | ol li ul:first-of-type{margin-top:0}
448 | hr{background:transparent url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAYAAAAECAYAAACtBE5DAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJbWFnZVJlYWR5ccllPAAAAyJpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdpbj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuMC1jMDYwIDYxLjEzNDc3NywgMjAxMC8wMi8xMi0xNzozMjowMCAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvIiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RSZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpDcmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENTNSBNYWNpbnRvc2giIHhtcE1NOkluc3RhbmNlSUQ9InhtcC5paWQ6OENDRjNBN0E2NTZBMTFFMEI3QjRBODM4NzJDMjlGNDgiIHhtcE1NOkRvY3VtZW50SUQ9InhtcC5kaWQ6OENDRjNBN0I2NTZBMTFFMEI3QjRBODM4NzJDMjlGNDgiPiA8eG1wTU06RGVyaXZlZEZyb20gc3RSZWY6aW5zdGFuY2VJRD0ieG1wLmlpZDo4Q0NGM0E3ODY1NkExMUUwQjdCNEE4Mzg3MkMyOUY0OCIgc3RSZWY6ZG9jdW1lbnRJRD0ieG1wLmRpZDo4Q0NGM0E3OTY1NkExMUUwQjdCNEE4Mzg3MkMyOUY0OCIvPiA8L3JkZjpEZXNjcmlwdGlvbj4gPC9yZGY6UkRGPiA8L3g6eG1wbWV0YT4gPD94cGFja2V0IGVuZD0iciI/PqqezsUAAAAfSURBVHjaYmRABcYwBiM2QSA4y4hNEKYDQxAEAAIMAHNGAzhkPOlYAAAAAElFTkSuQmCC) repeat-x 0 0;border:0 none;color:#ccc;height:4px;padding:0}
449 | body>h2:first-child{margin-top:0;padding-top:0}
450 | body>h1:first-child{margin-top:0;padding-top:0}
451 | body>h1:first-child+h2{margin-top:0;padding-top:0}
452 | body>h3:first-child,body>h4:first-child,body>h5:first-child,body>h6:first-child{margin-top:0;padding-top:0}
453 | a:first-child h1,a:first-child h2,a:first-child h3,a:first-child h4,a:first-child h5,a:first-child h6{margin-top:0;padding-top:0}
454 | h1+p,h2+p,h3+p,h4+p,h5+p,h6+p,ul li>:first-child,ol li>:first-child{margin-top:0}
455 | dl{padding:0}
456 | dl dt{font-size:14px;font-weight:bold;font-style:italic;padding:0;margin:15px 0 5px}
457 | dl dt:first-child{padding:0}
458 | dl dt>:first-child{margin-top:0}
459 | dl dt>:last-child{margin-bottom:0}
460 | dl dd{margin:0 0 15px;padding:0 15px}
461 | dl dd>:first-child{margin-top:0}
462 | dl dd>:last-child{margin-bottom:0}
463 | blockquote{border-left:4px solid #DDD;padding:0 15px;color:#777}
464 | blockquote>:first-child{margin-top:0}
465 | blockquote>:last-child{margin-bottom:0}
466 | table{border-collapse:collapse;border-spacing:0;font-size:100%;font:inherit}
467 | table th{font-weight:bold;border:1px solid #ccc;padding:6px 13px}
468 | table td{border:1px solid #ccc;padding:6px 13px}
469 | table tr{border-top:1px solid #ccc;background-color:#fff}
470 | table tr:nth-child(2n){background-color:#f8f8f8}
471 | img{max-width:100%}
472 | code,tt{margin:0 2px;padding:0 5px;white-space:nowrap;border:1px solid #eaeaea;background-color:#f8f8f8;border-radius:3px;font-family:Consolas,'Liberation Mono',Courier,monospace;font-size:12px;color:#333}
473 | pre>code{margin:0;padding:0;white-space:pre;border:0;background:transparent}
474 | .highlight pre{background-color:#f8f8f8;border:1px solid #ccc;font-size:13px;line-height:19px;overflow:auto;padding:6px 10px;border-radius:3px}
475 | pre{background-color:#f8f8f8;border:1px solid #ccc;font-size:13px;line-height:19px;overflow:auto;padding:6px 10px;border-radius:3px}
476 | pre code,pre tt{background-color:transparent;border:0}
477 | .poetry pre{font-family:Georgia,Garamond,serif!important;font-style:italic;font-size:110%!important;line-height:1.6em;display:block;margin-left:1em}
478 | .poetry pre code{font-family:Georgia,Garamond,serif!important;word-break:break-all;word-break:break-word;-webkit-hyphens:auto;-moz-hyphens:auto;hyphens:auto;white-space:pre-wrap}
479 | sup,sub,a.footnote{font-size:1.4ex;height:0;line-height:1;vertical-align:super;position:relative}
480 | sub{vertical-align:sub;top:-1px}
481 | @media print{body{background:#fff}
482 | img,pre,blockquote,table,figure{page-break-inside:avoid}
483 | body{background:#fff;border:0}
484 | code{background-color:#fff;color:#333!important;padding:0 .2em;border:1px solid #dedede}
485 | pre{background:#fff}
486 | pre code{background-color:white!important;overflow:visible}
487 | }
488 | @media screen{body.inverted{color:#eee!important;border-color:#555;box-shadow:none}
489 | .inverted body,.inverted hr .inverted p,.inverted td,.inverted li,.inverted h1,.inverted h2,.inverted h3,.inverted h4,.inverted h5,.inverted h6,.inverted th,.inverted .math,.inverted caption,.inverted dd,.inverted dt,.inverted blockquote{color:#eee!important;border-color:#555;box-shadow:none}
490 | .inverted td,.inverted th{background:#333}
491 | .inverted h2{border-color:#555}
492 | .inverted hr{border-color:#777;border-width:1px!important}
493 | ::selection{background:rgba(157,193,200,0.5)}
494 | h1::selection{background-color:rgba(45,156,208,0.3)}
495 | h2::selection{background-color:rgba(90,182,224,0.3)}
496 | h3::selection,h4::selection,h5::selection,h6::selection,li::selection,ol::selection{background-color:rgba(133,201,232,0.3)}
497 | code::selection{background-color:rgba(0,0,0,0.7);color:#eee}
498 | code span::selection{background-color:rgba(0,0,0,0.7)!important;color:#eee!important}
499 | a::selection{background-color:rgba(255,230,102,0.2)}
500 | .inverted a::selection{background-color:rgba(255,230,102,0.6)}
501 | td::selection,th::selection,caption::selection{background-color:rgba(180,237,95,0.5)}
502 | .inverted{background:#0b2531;background:#252a2a}
503 | .inverted body{background:#252a2a}
504 | .inverted a{color:#acd1d5}
505 | }
506 | .highlight .c{color:#998;font-style:italic}
507 | .highlight .err{color:#a61717;background-color:#e3d2d2}
508 | .highlight .k,.highlight .o{font-weight:bold}
509 | .highlight .cm{color:#998;font-style:italic}
510 | .highlight .cp{color:#999;font-weight:bold}
511 | .highlight .c1{color:#998;font-style:italic}
512 | .highlight .cs{color:#999;font-weight:bold;font-style:italic}
513 | .highlight .gd{color:#000;background-color:#fdd}
514 | .highlight .gd .x{color:#000;background-color:#faa}
515 | .highlight .ge{font-style:italic}
516 | .highlight .gr{color:#a00}
517 | .highlight .gh{color:#999}
518 | .highlight .gi{color:#000;background-color:#dfd}
519 | .highlight .gi .x{color:#000;background-color:#afa}
520 | .highlight .go{color:#888}
521 | .highlight .gp{color:#555}
522 | .highlight .gs{font-weight:bold}
523 | .highlight .gu{color:#800080;font-weight:bold}
524 | .highlight .gt{color:#a00}
525 | .highlight .kc,.highlight .kd,.highlight .kn,.highlight .kp,.highlight .kr{font-weight:bold}
526 | .highlight .kt{color:#458;font-weight:bold}
527 | .highlight .m{color:#099}
528 | .highlight .s{color:#d14}
529 | .highlight .na{color:#008080}
530 | .highlight .nb{color:#0086b3}
531 | .highlight .nc{color:#458;font-weight:bold}
532 | .highlight .no{color:#008080}
533 | .highlight .ni{color:#800080}
534 | .highlight .ne,.highlight .nf{color:#900;font-weight:bold}
535 | .highlight .nn{color:#555}
536 | .highlight .nt{color:#000080}
537 | .highlight .nv{color:#008080}
538 | .highlight .ow{font-weight:bold}
539 | .highlight .w{color:#bbb}
540 | .highlight .mf,.highlight .mh,.highlight .mi,.highlight .mo{color:#099}
541 | .highlight .sb,.highlight .sc,.highlight .sd,.highlight .s2,.highlight .se,.highlight .sh,.highlight .si,.highlight .sx{color:#d14}
542 | .highlight .sr{color:#009926}
543 | .highlight .s1{color:#d14}
544 | .highlight .ss{color:#990073}
545 | .highlight .bp{color:#999}
546 | .highlight .vc,.highlight .vg,.highlight .vi{color:#008080}
547 | .highlight .il{color:#099}
548 | .highlight .gc{color:#999;background-color:#eaf2f5}
549 | .type-csharp .highlight .k,.type-csharp .highlight .kt{color:#00F}
550 | .type-csharp .highlight .nf{color:#000;font-weight:normal}
551 | .type-csharp .highlight .nc{color:#2b91af}
552 | .type-csharp .highlight .nn{color:#000}
553 | .type-csharp .highlight .s,.type-csharp .highlight .sc{color:#a31515}
554 | 


--------------------------------------------------------------------------------
/src/Control/Applicative/Phases.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE GADTs #-}
 2 | -- | Defines 'Phases', an 'Applicative' transformer for scheduling
 3 | -- effects during different phases of execution.
 4 | module Control.Applicative.Phases 
 5 |   ( Phases(..)
 6 |   , runPhasesForwards, runPhasesBackwards
 7 |   , now, later, delay
 8 |   ) where
 9 | 
10 | import Control.Applicative (liftA2, (<**>))
11 | 
12 | -- | An applicative transformer to organize effects into an arbitrary number of
13 | -- phases of execution.
14 | --
15 | -- Use 'now' to schedule actions for the current phase of execution:
16 | --
17 | -- >>> say name = putStrLn name *> pure name
18 | -- >>> runPhasesForwards $ (,,) <$> now (say "Huey") <*> now (say "Dewey") <*> now (say "Louie")
19 | -- Huey
20 | -- Dewey
21 | -- Louie
22 | -- ("Huey","Dewey","Louie")
23 | --
24 | -- Or 'later' to schedule it for the next phase of execution:
25 | --
26 | -- >>> runPhasesForwards $ (,,) <$> later (say "Huey") <*> now (say "Dewey") <*> now (say "Louie")
27 | -- Dewey
28 | -- Louie
29 | -- Huey
30 | -- ("Huey","Dewey","Louie")
31 | --
32 | -- And 'delay' to delay a set of phased actions by one phase:
33 | -- 
34 | -- >>> runPhasesForwards $ delay ((,,) <$> later (say "Huey") <*> now (say "Dewey")) <*> now (say "Louie")
35 | -- Louie
36 | -- Dewey
37 | -- Huey
38 | -- ("Huey","Dewey","Louie")
39 | --
40 | -- Phases can also be run in reverse, but all actions in the same phase still occur in the same order:
41 | --
42 | -- >>> runPhasesBackwards $ (,,) <$> later (say "Huey") <*> now (say "Dewey") <*> now (say "Louie")
43 | -- Huey
44 | -- Dewey
45 | -- Louie
46 | -- ("Huey","Dewey","Louie")
47 | data Phases f a where
48 |   Lift :: f a -> Phases f a
49 |   (:<*>) :: f (a -> b) -> Phases f a -> Phases f b
50 | 
51 | -- | run the phased actions in forwards order
52 | --
53 | -- >>> runPhasesForwards $ now (putStrLn "hello") *> later (putStrLn "world")
54 | -- hello
55 | -- world
56 | -- >>> runPhasesForwards $ later (putStrLn "hello") *> now (putStrLn "world")
57 | -- world
58 | -- hello
59 | runPhasesForwards :: Applicative f => Phases f a -> f a
60 | runPhasesForwards (Lift ma) = ma
61 | runPhasesForwards (mg :<*> tx) = mg <*> runPhasesForwards tx
62 | 
63 | -- | run the phased actions in backwards order
64 | --
65 | -- >>> runPhasesBackwards $ now (putStrLn "hello") *> later (putStrLn "world")
66 | -- world
67 | -- hello
68 | -- >>> runPhasesBackwards $ later (putStrLn "hello") *> now (putStrLn "world")
69 | -- hello
70 | -- world
71 | runPhasesBackwards :: Applicative f => Phases f a -> f a
72 | runPhasesBackwards (Lift ma) = ma
73 | runPhasesBackwards (mg :<*> tx) = runPhasesBackwards tx <**> mg
74 | 
75 | -- | schedule an action to run in the current phase
76 | now :: f a -> Phases f a
77 | now = Lift
78 | 
79 | -- | schedule  an action to run in the next phase
80 | later :: Applicative f => f a -> Phases f a
81 | later = delay . now
82 | 
83 | -- | delay all actions by a phase
84 | delay :: Applicative f => Phases f a -> Phases f a
85 | delay ta = pure id :<*> ta
86 | 
87 | instance Functor f => Functor (Phases f) where
88 |   fmap f (Lift ma) = Lift (fmap f ma)
89 |   fmap f (mg :<*> tx) = fmap (f.) mg :<*> tx
90 | 
91 | instance Applicative f => Applicative (Phases f) where
92 |   pure = now . pure
93 |   Lift mf <*> Lift ma = Lift $ mf <*> ma 
94 |   Lift mf <*> (mh :<*> ty) = liftA2 (.) mf mh :<*> ty
95 |   (mg :<*> tx) <*> Lift ma = liftA2 flip mg ma :<*> tx
96 |   (mg :<*> tx) <*> (mh :<*> ty) = liftA2 (\g h ~(x,y) -> g x (h y)) mg mh :<*> liftA2 (,) tx ty
97 | 


--------------------------------------------------------------------------------
/src/Data/BinaryTree.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE DeriveFunctor #-}
 2 | -- | A simple binary tree type, 'BinaryTree'.
 3 | module Data.BinaryTree 
 4 |   ( BinaryTree(..)
 5 |   ) where
 6 | 
 7 | -- | A binary tree
 8 | --
 9 | -- Since there are multiple ways to traverse a 'BinaryTree', see 
10 | -- "Data.Traversable.TreeLike" for newtype-wrappers with 'Traversable' instances.
11 | data BinaryTree a = Leaf | Branch (BinaryTree a) a (BinaryTree a)
12 |   deriving (Show, Functor, Eq)
13 | 


--------------------------------------------------------------------------------
/src/Data/Monoid/TreeDiagram.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE RecordWildCards #-}
  2 | -- | Tools for working with the 'TreeDiagram' monoid to draw tree diagrams.
  3 | module Data.Monoid.TreeDiagram
  4 |   ( TreeDiagram
  5 |   , showTreeDiagram
  6 |   , printTreeDiagram
  7 |   , singleton
  8 |   , subtree
  9 |   , width
 10 |   , height
 11 |   ) where
 12 | 
 13 | import Data.List (intersperse)
 14 | import Data.Semigroup (Semigroup(..))
 15 | 
 16 | -- | combine difference-strings into one
 17 | concatShowS :: [ShowS] -> ShowS
 18 | concatShowS = foldr (.) id
 19 | 
 20 | -- | repeat a character a given number of times
 21 | replicateChar :: Int -> Char -> ShowS
 22 | replicateChar n = concatShowS . replicate n . showChar
 23 | 
 24 | -- | A monoid for generating tree diagrams
 25 | data TreeDiagram = Empty | NonEmpty
 26 |   { graph       :: GraphEnvironment -> ShowS -- ^ the top line of the diagram
 27 |   , graphWidth  :: Int -- ^ number of characters in the graph
 28 |   , graphIndent :: Int -- ^ left whitespace needed to align graph with rows underneath
 29 |   , graphDedent :: Int -- ^ right whitespace needed to pad graph to maximum row width
 30 |   , rows        :: [(Int,ShowS)] -- ^ width and definition of each row under the graph line
 31 |   , leftLimit   :: (Int,Int) -- ^ index of lines without any left whitespace
 32 |   , rightLimit  :: (Int,Int) -- ^ index of lines of maximum row width
 33 |   }
 34 | 
 35 | -- | TreeDiagram settings when rendering the graph line
 36 | data GraphEnvironment = GraphEnvironment
 37 |   { isLeftmost  :: !Bool -- ^ whether this part of the graph is the leftmost part of the graph
 38 |   , isRightmost :: !Bool -- ^ whether this part of the graph is the rightmost part of the graph
 39 |   , uptickIndex :: !Int -- ^ index  of the uptick, relative to this part of the graph
 40 |   }
 41 | 
 42 | -- | render a tree diagram as a function that prepends a multi-line string
 43 | showTreeDiagram :: TreeDiagram -> ShowS
 44 | showTreeDiagram Empty = id
 45 | showTreeDiagram NonEmpty{..} = 
 46 |   let graphLine =
 47 |         replicateChar graphIndent ' ' .
 48 |         graph GraphEnvironment
 49 |           { isLeftmost = True
 50 |           , isRightmost = True
 51 |           , uptickIndex = graphWidth -- don't show the uptick
 52 |           }
 53 |       rowLines = snd <$> rows
 54 |   in concatShowS . intersperse (showChar '\n') $ graphLine : rowLines
 55 | 
 56 | -- | print a tree diagram
 57 | printTreeDiagram :: TreeDiagram -> IO ()
 58 | printTreeDiagram = putStrLn . ($ []) . showTreeDiagram
 59 | 
 60 | -- | draw a value as a simple, single-line tree diagram
 61 | --
 62 | -- >>> printTreeDiagram $ singleton 'a'
 63 | -- 'a'
 64 | singleton :: Show a => a -> TreeDiagram
 65 | singleton a = NonEmpty
 66 |   { graph = const $ shows a
 67 |   , graphWidth = length $ show a
 68 |   , graphIndent = 0
 69 |   , graphDedent = 0
 70 |   , rows = []
 71 |   , leftLimit = (0,0)
 72 |   , rightLimit = (0,0)
 73 |   }
 74 | 
 75 | -- |
 76 | -- '<>' composes two tree diagrams horizontally, connecting them via horizontal line
 77 | --
 78 | -- >>> printTreeDiagram $ singleton 'a' <> singleton 'b'
 79 | -- 'a'─'b'
 80 | instance Semigroup TreeDiagram where
 81 |   Empty <> d = d
 82 |   d <> Empty = d
 83 |   a <> b = NonEmpty
 84 |     { graph = \o -> 
 85 |         let uptickIndex' = uptickIndex o - graphWidth a
 86 |             midline = if 0 <= uptickIndex' && uptickIndex' < graphPadding
 87 |                         then replicateChar uptickIndex' '─' . 
 88 |                              showChar '┴' . 
 89 |                              replicateChar (graphPadding - 1 - uptickIndex') '─'
 90 |                         else replicateChar graphPadding '─'
 91 |         in
 92 |         graph a o{ isRightmost = False } . 
 93 |         midline .
 94 |         graph b o{ isLeftmost = False, uptickIndex = uptickIndex' - graphPadding }
 95 |     , graphWidth = graphWidth a + graphPadding + graphWidth b
 96 |     , graphIndent = graphIndent a
 97 |     , graphDedent = graphDedent b
 98 |     , rows = alongside (width a + padding) (rows a) (rows b)
 99 |     , leftLimit = leftLimit a
100 |     , rightLimit = rightLimit b
101 |     }
102 |     where graphPadding = graphDedent a + padding + graphIndent b
103 |           padding = fromEnum (blo <= ahi && alo <= bhi)
104 |           (alo,ahi) = rightLimit a
105 |           (blo,bhi) = leftLimit b
106 | -- |
107 | -- 'mempty' is the empty tree diagram
108 | --
109 | -- >>> printTreeDiagram mempty
110 | -- <BLANKLINE>
111 | -- >>> printTreeDiagram $ mempty <> singleton 'a' <> mempty
112 | -- 'a'
113 | instance Monoid TreeDiagram where
114 |   mempty = Empty
115 |   mappend = (<>)
116 | 
117 | 
118 | -- | Full width of a tree diagram
119 | --
120 | -- >>> let d = singleton 'a' <> subtree (subtree (singleton 'b') <> singleton 'c')
121 | -- >>> printTreeDiagram d
122 | -- 'a'───┐
123 | --       │
124 | --     ┌─'c'
125 | --     │
126 | --    'b'
127 | -- >>> width d
128 | -- 9
129 | width :: TreeDiagram -> Int
130 | width Empty = 0
131 | width d = graphIndent d + graphWidth d + graphDedent d
132 | 
133 | -- | Full height of a tree diagram
134 | --
135 | -- >>> let d = singleton 'a' <> subtree (subtree (singleton 'b') <> singleton 'c')
136 | -- >>> printTreeDiagram d
137 | -- 'a'───┐
138 | --       │
139 | --     ┌─'c'
140 | --     │
141 | --    'b'
142 | -- >>> height d
143 | -- 5
144 | height :: TreeDiagram -> Int
145 | height Empty = 0
146 | height d = 1 + length (rows d)
147 | 
148 | -- | open zip of two blocks of text, padding the left block to a set width
149 | alongside :: Int -> [(Int,ShowS)] -> [(Int,ShowS)] -> [(Int,ShowS)]
150 | alongside n ((mx,dx):xs) ((my,dy):ys) = (n + my, dx . replicateChar (n - mx) ' ' . dy) : alongside n xs ys
151 | alongside _ xs [] = xs
152 | alongside n [] ys = [(n + my, replicateChar n ' '. dy) | (my,dy) <- ys]
153 | 
154 | -- | Pick a downtick character, based on the current environment.
155 | downtick :: GraphEnvironment -> ShowS
156 | downtick GraphEnvironment{..} = case (isLeftmost, isRightmost, uptickIndex == 0) of
157 |   (False, False, False) -> showChar '┬'
158 |   (False, False, True)  -> showChar '┼'
159 |   (False, True, False)  -> showChar '┐'
160 |   (False, True, True)   -> showChar '┤'
161 |   (True, False, False)  -> showChar '┌'
162 |   (True, False, True)   -> showChar '├'
163 |   (True, True, False)   -> showChar '╷'
164 |   (True, True, True)    -> showChar '│'
165 | 
166 | -- | Move a tree diagram to the subtree level, dropping a line
167 | -- down from the graph line to connect it to the new toplevel.
168 | --
169 | -- >>> printTreeDiagram $ subtree (singleton 'a') <> singleton 'b' <> subtree (singleton 'c')
170 | --  ┌─'b'─┐
171 | --  │     │
172 | -- 'a'   'c'
173 | -- >>> printTreeDiagram $ subtree mempty
174 | -- ╷
175 | -- │
176 | -- ╵
177 | subtree :: TreeDiagram -> TreeDiagram
178 | subtree Empty = NonEmpty
179 |   { graph = downtick
180 |   , graphWidth = 1
181 |   , graphIndent = 0
182 |   , graphDedent = 0
183 |   , rows = [(1, showChar '│'),(1, showChar '╵')]
184 |   , leftLimit = (1,2)
185 |   , rightLimit = (1,2)
186 |   }
187 | subtree NonEmpty{..} = NonEmpty
188 |   { graph = downtick
189 |   , graphWidth = 1
190 |   , graphIndent = uptickIndent
191 |   , graphDedent = graphIndent + graphWidth + graphDedent - 1 - uptickIndent
192 |   , rows  = (uptickIndent + 1, replicateChar uptickIndent ' ' . showChar '│') 
193 |           : (graphIndent + graphWidth, replicateChar graphIndent ' ' . graphLine)
194 |           : rows
195 |   , leftLimit = (if llo > 1 then llo + 2 else if graphWidth > 1 then 2 else 1, lhi + 2)
196 |   , rightLimit = (if rlo > 1 then rlo + 2 else if graphWidth > 2 then 2 else 1, rhi + 2)
197 |   }
198 |   where uptickIndent = graphIndent + uptickIndex
199 |         uptickIndex = graphWidth `div` 2
200 |         (llo,lhi) = leftLimit
201 |         (rlo,rhi) = rightLimit
202 |         graphLine = graph GraphEnvironment
203 |           { isLeftmost = True
204 |           , isRightmost = True
205 |           , uptickIndex = uptickIndex
206 |           }
207 | 


--------------------------------------------------------------------------------
/src/Data/Traversable/TreeLike.hs:
--------------------------------------------------------------------------------
   1 | {-# OPTIONS_GHC -Wno-name-shadowing #-}
   2 | {-# LANGUAGE RankNTypes #-}
   3 | {-# LANGUAGE ViewPatterns #-}
   4 | {-# LANGUAGE DataKinds #-}
   5 | {-# LANGUAGE GADTs #-}
   6 | {-# LANGUAGE TypeOperators #-}
   7 | {-# LANGUAGE DeriveFunctor #-}
   8 | {-# LANGUAGE ScopedTypeVariables #-}
   9 | 
  10 | -- | By providing a 'TreeLike' instance, a functor can be traversed in several
  11 | -- orders:
  12 | --
  13 | -- ['inorder' / 'InOrder']
  14 | --    Viewing a 'TreeLike' functor as a sequence of values and subtrees, an
  15 | --    /__inorder__/ traversal iterates through this sequence visiting values and
  16 | --    traversing subtrees in the order they are given.
  17 | --
  18 | --        >>> printTree (label inorder exampleBinaryTree)
  19 | --              ┌──────6───┐
  20 | --              │          │
  21 | --          ┌──2┴───┐   ┌7─┴──┐
  22 | --          │       │   │     │
  23 | --        ┌0┴┐    ┌─┴5┐ ╵  ┌─9┴─┐
  24 | --        │  │    │   │    │    │
  25 | --        ╵ ┌1┐ ┌3┴┐  ╵   ┌8┐ ┌10┐
  26 | --          │ │ │  │      │ │ │  │
  27 | --          ╵ ╵ ╵ ┌4┐     ╵ ╵ ╵  ╵
  28 | --                │ │
  29 | --                ╵ ╵
  30 | --
  31 | -- ['preorder' / 'PreOrder']
  32 | --  Viewing a 'TreeLike' functor as a sequence of values and subtrees, a
  33 | --  /__preorder__/ traversal visits all the values in the sequence before
  34 | --  traversing the subtrees.
  35 | --
  36 | --        >>> printTree (label preorder exampleBinaryTree)
  37 | --              ┌──────0───┐
  38 | --              │          │
  39 | --          ┌──1┴───┐   ┌7─┴──┐
  40 | --          │       │   │     │
  41 | --        ┌2┴┐    ┌─┴4┐ ╵  ┌─8┴─┐
  42 | --        │  │    │   │    │    │
  43 | --        ╵ ┌3┐ ┌5┴┐  ╵   ┌9┐ ┌10┐
  44 | --          │ │ │  │      │ │ │  │
  45 | --          ╵ ╵ ╵ ┌6┐     ╵ ╵ ╵  ╵
  46 | --                │ │
  47 | --                ╵ ╵
  48 | --
  49 | -- ['postorder' / 'PostOrder']
  50 | --  Viewing a 'TreeLike' functor as a sequence of values and subtrees, a
  51 | --  /__postorder__/ traversal traverses all the subtrees in the sequence
  52 | --  before visiting the values in the sequence before
  53 | --  traversing the subtrees.
  54 | --
  55 | --        >>> printTree (label postorder exampleBinaryTree)
  56 | --              ┌──────10───┐
  57 | --              │           │
  58 | --          ┌──5┴───┐    ┌9─┴─┐
  59 | --          │       │    │    │
  60 | --        ┌1┴┐    ┌─┴4┐  ╵  ┌─8─┐
  61 | --        │  │    │   │     │   │
  62 | --        ╵ ┌0┐ ┌3┴┐  ╵    ┌6┐ ┌7┐
  63 | --          │ │ │  │       │ │ │ │
  64 | --          ╵ ╵ ╵ ┌2┐      ╵ ╵ ╵ ╵
  65 | --                │ │
  66 | --                ╵ ╵
  67 | --
  68 | -- ['levelorder' / 'LevelOrder']
  69 | --  Similar to a preorder traversal, a /__levelorder__/ traversal first visits
  70 | --  all the values at the root level before traversing any of the subtrees.
  71 | --  Instead of traversing the subtrees one by one, though, a levelorder
  72 | --  traversal interweaves their traversals, next visiting all the values at the
  73 | --  root of each subtree, then visiting all the values at the roots of each
  74 | --  subtree's subtrees, and so on. This is also known as a breadth-first
  75 | --  traversal.
  76 | --
  77 | --        >>> printTree (label levelorder exampleBinaryTree)
  78 | --               ┌──────0───┐
  79 | --               │          │
  80 | --          ┌──1─┴───┐   ┌2─┴─┐
  81 | --          │        │   │    │
  82 | --        ┌3┴┐    ┌──┴4┐ ╵  ┌─5─┐
  83 | --        │  │    │    │    │   │
  84 | --        ╵ ┌6┐ ┌7┴─┐  ╵   ┌8┐ ┌9┐
  85 | --          │ │ │   │      │ │ │ │
  86 | --          ╵ ╵ ╵ ┌10┐     ╵ ╵ ╵ ╵
  87 | --                │  │
  88 | --                ╵  ╵
  89 | --
  90 | -- ['rlevelorder' / 'RLevelOrder']
  91 | --  Similar to a postlevel traversal, a /__reversed levelorder__/ traversal
  92 | --  only visits all the values at the root level after traversing all of the
  93 | --  subtrees.  Instead of traversing the subtrees one by one, though, a
  94 | --  reversed levelorder traversal interweaves their traversals, working
  95 | --  from the deepest level up, though still in left-to-right order.
  96 | --
  97 | --        >>> printTree (label rlevelorder exampleBinaryTree)
  98 | --              ┌──────10───┐
  99 | --              │           │
 100 | --          ┌──8┴───┐    ┌9─┴─┐
 101 | --          │       │    │    │
 102 | --        ┌5┴┐    ┌─┴6┐  ╵  ┌─7─┐
 103 | --        │  │    │   │     │   │
 104 | --        ╵ ┌1┐ ┌2┴┐  ╵    ┌3┐ ┌4┐
 105 | --          │ │ │  │       │ │ │ │
 106 | --          ╵ ╵ ╵ ┌0┐      ╵ ╵ ╵ ╵
 107 | --                │ │
 108 | --                ╵ ╵
 109 | --
 110 | module Data.Traversable.TreeLike 
 111 |   ( TreeLike(..), treeFoldMap
 112 |   -- | = TreeLike wrappers
 113 |   -- These @newtype@s define 'TreeLike' instances for 'Traversable' types.
 114 |   , Forest(..), Flat(..), List(..)
 115 |   -- | = Traversals
 116 |   -- Each 'TreeLike' type admits multiple traversal orders:
 117 |   --
 118 |   -- > inorder, preorder, postorder, levelorder, rlevelorder
 119 |   -- >   :: TreeLike tree => Traversal (tree a) (tree b) a b
 120 |   --
 121 |   -- Using the definition of 'Control.Lens.Traversal.Traversal' from
 122 |   -- "Control.Lens.Traversal":
 123 |   --
 124 |   -- > type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t 
 125 |   --
 126 |   , inorder, preorder, postorder, levelorder, rlevelorder
 127 |   -- | = Traversable wrappers
 128 |   -- These @newtype@s define 'Traversable' instances for 'TreeLike' types.
 129 |   , InOrder(..), PreOrder(..), PostOrder(..), LevelOrder(..), RLevelOrder(..)
 130 |   -- | = Convenience functions
 131 |   , showTree, printTree
 132 |   ) where
 133 | 
 134 | import Data.Functor.Compose (Compose(..))
 135 | import Data.Functor.Const (Const(..))
 136 | import Data.Functor.Product (Product(..))
 137 | import Data.Functor.Sum (Sum(..))
 138 | import Data.Traversable (foldMapDefault)
 139 | import Data.Tree hiding (Forest)
 140 | 
 141 | import Control.Applicative.Phases
 142 | import Data.BinaryTree
 143 | import Data.Monoid.TreeDiagram
 144 | 
 145 | -- | Render the tree as a string, using the 'TreeDiagram' monoid.
 146 | showTree :: (TreeLike tree, Show a) => tree a -> ShowS
 147 | showTree = showTreeDiagram . treeFoldMap singleton subtree
 148 | 
 149 | -- | Print the tree, using the 'TreeDiagram' monoid.
 150 | printTree :: (TreeLike tree, Show a) => tree a -> IO ()
 151 | printTree = putStrLn . ($ []) . showTree
 152 | 
 153 | -- | Notionally, functors are 'TreeLike' if any values and 'TreeLike'
 154 | -- substructure they contain can be traversed distinctly.
 155 | --
 156 | -- For example, given the 'TreeDiagram' monoid, one can use 'treeTraverse' with
 157 | -- the  'Const' applicative to recursively create a drawing of any tree,
 158 | -- rendering values inline with 'singleton' and dropping a line to drawings of
 159 | -- subtrees with 'subtree':
 160 | --
 161 | -- >>> :{
 162 | -- printTree :: (Show a, TreeLike tree) => tree a -> IO ()
 163 | -- printTree = printTreeDiagram . drawTree where
 164 | --   drawTree :: (Show a, TreeLike tree) => tree a -> TreeDiagram
 165 | --   drawTree = getConst . treeTraverse (Const . singleton) (Const . subtree . drawTree)
 166 | -- :}
 167 | --
 168 | -- This common pattern of mapping each element to a monoid and then modifying
 169 | -- each monoidal value generated from a subtree is captured by 'treeFoldMap', which
 170 | -- gives a slightly less verbose implementation of @printTree@.
 171 | --
 172 | -- >>> printTree = printTreeDiagram . treeFoldMap singleton subtree
 173 | --
 174 | -- Instances of 'TreeLike' are encouraged to avoid recursively defining
 175 | -- 'treeTraverse' in terms of itself, and to instead traverse subtrees
 176 | -- using the provided argument.
 177 | --
 178 | -- For example, given this definition for balanced binary trees:
 179 | --
 180 | -- >>> :{
 181 | -- data BBT a = Nil | a `Cons` BBT (a,a)
 182 | --   deriving Functor
 183 | -- infixr 4 `Cons`
 184 | -- :}
 185 | --
 186 | -- Its 'TreeLike' instance can be defined as:
 187 | --
 188 | -- >>> :{
 189 | -- instance TreeLike BBT where
 190 | --   treeTraverse = \f g t -> case t of
 191 | --      Nil          -> pure Nil
 192 | --      a `Cons` at  -> branch <$> g (fst <$> at) <*> f a <*> g (snd <$> at)
 193 | --    where
 194 | --      branch :: BBT b -> b -> BBT b -> BBT b
 195 | --      branch Nil b ~Nil = b `Cons` Nil
 196 | --      branch (x `Cons` xt) b ~(y `Cons` yt) = b `Cons` branch xt (x,y) yt
 197 | -- :}
 198 | --
 199 | -- This definition exposes the substructure in a way that can be used
 200 | -- by functions implemented in terms of 'treeTraverse', such as @printTree@:
 201 | --
 202 | -- >>> printTree $ 1 `Cons` (2,3) `Cons` ((4,5),(6,7)) `Cons` Nil
 203 | --    ┌───1───┐
 204 | --    │       │
 205 | --  ┌─2─┐   ┌─3─┐
 206 | --  │   │   │   │
 207 | -- ┌4┐ ┌6┐ ┌5┐ ┌7┐
 208 | -- │ │ │ │ │ │ │ │
 209 | -- ╵ ╵ ╵ ╵ ╵ ╵ ╵ ╵
 210 | class Functor tree => TreeLike tree where
 211 |   treeTraverse :: Applicative f 
 212 |                => (a -> f b)
 213 |                -> (forall subtree. TreeLike subtree => subtree a -> f (subtree b))
 214 |                -> tree a -> f (tree b)
 215 | 
 216 | -- | Recursively fold a tree into a monoid, using the given functions to
 217 | -- transform values and folded subtrees.
 218 | --
 219 | -- For example, one can find the maximum depth of a tree:
 220 | --
 221 | -- >>> printTree exampleTree
 222 | -- []─┬─────┬───────────┬─────────────────────────────┐
 223 | --    │     │           │                             │
 224 | --   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
 225 | --            │       │       │            │       │                 │
 226 | --          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
 227 | --                                │                    │           │          │
 228 | --                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
 229 | --                                                                                 │
 230 | --                                                                             [3,2,1,0]
 231 | -- >>> :set -XGeneralizedNewtypeDeriving
 232 | -- >>> import GHC.Natural
 233 | -- >>> import Data.Semigroup
 234 | -- >>> :{
 235 | -- newtype Max = Max { getMax :: Natural } deriving (Num, Enum)
 236 | -- instance Semigroup Max where
 237 | --   Max a <> Max b = Max $ a `max` b
 238 | -- instance Monoid Max where
 239 | --   mempty = Max 0
 240 | --   mappend = (<>)
 241 | -- :}
 242 | --
 243 | -- >>> getMax $ treeFoldMap (const 0) succ exampleTree
 244 | -- 4
 245 | treeFoldMap :: (Monoid m, TreeLike tree) => (a -> m) -> (m -> m) -> tree a -> m
 246 | treeFoldMap f g = getConst . treeTraverse (Const . f) (Const . g . treeFoldMap f g)
 247 | 
 248 | instance TreeLike Tree where
 249 |   treeTraverse f g (Node a as) = Node <$> f a <*> traverse g as
 250 | 
 251 | instance TreeLike BinaryTree where
 252 |   treeTraverse _ _ Leaf = pure Leaf
 253 |   treeTraverse f g (Branch l a r) = Branch <$> g l <*> f a <*> g r
 254 | 
 255 | -- |
 256 | -- Use 'Product' to combine a pair of 'TreeLike' values into a single tree.
 257 | --
 258 | -- >>> smallBinaryTree = Branch (Branch Leaf [0,1] Leaf) [0] (Branch Leaf [0,2] Leaf)
 259 | -- >>> smallRoseTree = Node [1] [Node [1,0] [], Node [1,1] [], Node [1,2] [], Node [1,3] []]
 260 | -- >>> printTree $ Pair smallBinaryTree smallRoseTree
 261 | --         ┌────────────────────┐
 262 | --         │                    │
 263 | --    ┌───[0]───┐   [1]──┬─────┬┴────┬─────┐
 264 | --    │         │        │     │     │     │
 265 | -- ┌[0,1]┐   ┌[0,2]┐   [1,0] [1,1] [1,2] [1,3]
 266 | -- │     │   │     │
 267 | -- ╵     ╵   ╵     ╵
 268 | -- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
 269 | -- >>> traversed <- postorder visit (Pair smallBinaryTree smallRoseTree) `evalStateT` 0
 270 | -- [0,1]
 271 | -- [0,2]
 272 | -- [0]
 273 | -- [1,0]
 274 | -- [1,1]
 275 | -- [1,2]
 276 | -- [1,3]
 277 | -- [1]
 278 | -- >>> printTree traversed
 279 | --    ┌───────┐
 280 | --    │       │
 281 | --  ┌─2─┐ 7┬─┬┴┬─┐
 282 | --  │   │  │ │ │ │
 283 | -- ┌0┐ ┌1┐ 3 4 5 6
 284 | -- │ │ │ │
 285 | -- ╵ ╵ ╵ ╵
 286 | instance (TreeLike fst, TreeLike snd) => TreeLike (Product fst snd) where
 287 |   treeTraverse _ g (Pair x y) = Pair <$> g x <*> g y
 288 | 
 289 | -- | Use 'Sum' to unify two different types of trees into a single type.
 290 | --
 291 | -- >>> smallBinaryTree = Branch (Branch Leaf [0,1] Leaf) [0] (Branch Leaf [0,2] Leaf)
 292 | -- >>> smallRoseTree = Node [1] [Node [1,0] [], Node [1,1] [], Node [1,2] [], Node [1,3] []]
 293 | -- >>> someTree b = if not b then InL smallBinaryTree else InR smallRoseTree
 294 | -- >>> :t someTree
 295 | -- someTree :: Num a => Bool -> Sum BinaryTree Tree [a]
 296 | -- >>> printTree (someTree False)
 297 | --         ╷
 298 | --         │
 299 | --    ┌───[0]───┐
 300 | --    │         │
 301 | -- ┌[0,1]┐   ┌[0,2]┐
 302 | -- │     │   │     │
 303 | -- ╵     ╵   ╵     ╵
 304 | -- >>> printTree (someTree True)
 305 | --             ╷
 306 | --             │
 307 | -- [1]──┬─────┬┴────┬─────┐
 308 | --      │     │     │     │
 309 | --    [1,0] [1,1] [1,2] [1,3]
 310 | instance (TreeLike left, TreeLike right) => TreeLike (Sum left right) where
 311 |   treeTraverse _ g (InL x) = InL <$> g x
 312 |   treeTraverse _ g (InR y) = InR <$> g y
 313 | 
 314 | -- |
 315 | -- A newtype wrapper to allow traversing an entire traversable of trees
 316 | -- simultaneously.
 317 | --
 318 | -- >>> printTree $ Forest exampleTrees
 319 | --  ┌─────┬───────────┬─────────────────────────────┐
 320 | --  │     │           │                             │
 321 | -- [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
 322 | --          │       │       │            │       │                 │
 323 | --        [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
 324 | --                              │                    │           │          │
 325 | --                           [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
 326 | --                                                                               │
 327 | --                                                                           [3,2,1,0]
 328 | -- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
 329 | -- >>> traversed <- levelorder visit (Forest exampleTrees) `evalStateT` 0
 330 | -- [0]
 331 | -- [1]
 332 | -- [2]
 333 | -- [3]
 334 | -- [1,0]
 335 | -- [2,0]
 336 | -- [2,1]
 337 | -- [3,0]
 338 | -- [3,1]
 339 | -- [3,2]
 340 | -- [2,1,0]
 341 | -- [3,1,0]
 342 | -- [3,2,0]
 343 | -- [3,2,1]
 344 | -- [3,2,1,0]
 345 | -- >>> printTree traversed
 346 | -- ┌──┬───┬────────┐
 347 | -- │  │   │        │
 348 | -- 0 1┤ 2┬┴─┐ 3┬──┬┴────┐
 349 | --    │  │  │  │  │     │
 350 | --    4  5 6┴┐ 7 8┴┐ 9─┬┴──┐
 351 | --           │     │   │   │
 352 | --          10    11  12 13┴┐
 353 | --                          │
 354 | --                         14
 355 | --
 356 | -- This is more of a convenience than a necessity, as @'Forest' t tree ~
 357 | -- 'Compose' ('Flat' t) tree@
 358 | --
 359 | -- >>> printTree . Compose $ Flat exampleTrees
 360 | --  ┌─────┬───────────┬─────────────────────────────┐
 361 | --  │     │           │                             │
 362 | -- [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
 363 | --          │       │       │            │       │                 │
 364 | --        [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
 365 | --                              │                    │           │          │
 366 | --                           [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
 367 | --                                                                               │
 368 | --                                                                           [3,2,1,0]
 369 | newtype Forest t tree a = Forest { getForest :: t (tree a) }
 370 |   deriving Functor
 371 | 
 372 | instance (Traversable t, TreeLike tree) => TreeLike (Forest t tree) where
 373 |   treeTraverse _ g = fmap Forest . traverse g . getForest
 374 | 
 375 | -- |
 376 | -- A newtype wrapper for @[a]@ whose `TreeLike` instance
 377 | -- treats each cons-cell as a tree containing one value and one subtree.
 378 | --
 379 | -- >>> printTree $ List [1..5]
 380 | -- 1─┐
 381 | --   │
 382 | --  2┴┐
 383 | --    │
 384 | --   3┴┐
 385 | --     │
 386 | --    4┴┐
 387 | --      │
 388 | --     5┤
 389 | --      │
 390 | --      ╵
 391 | -- >>> import Data.Foldable (toList)
 392 | -- >>> toList . PostOrder $ List [1..5]
 393 | -- [5,4,3,2,1]
 394 | -- 
 395 | -- Contrast with @'Flat' [] a@:
 396 | --
 397 | -- >>> printTree $ Flat [1..5]
 398 | -- 1─2─3─4─5
 399 | -- >>> toList . PostOrder $ Flat [1..5]
 400 | -- [1,2,3,4,5]
 401 | --
 402 | newtype List a = List { getList :: [a] }
 403 |   deriving Functor
 404 | 
 405 | instance TreeLike List where
 406 |   treeTraverse f g (List as) = List <$> case as of
 407 |     []    -> pure []
 408 |     a:as  -> (:) <$> f a <*> (fmap getList . g .List) as
 409 | 
 410 | 
 411 | -- |
 412 | -- A newtype wraper for @t a@ whose `TreeLike` instance treats
 413 | -- the @t a@ as a flat structure with no subtrees.
 414 | --
 415 | -- >>> printTree $ Flat [1..5]
 416 | -- 1─2─3─4─5
 417 | -- >>> import Data.Foldable (toList)
 418 | -- >>> toList . PostOrder $ Flat [1..5]
 419 | -- [1,2,3,4,5]
 420 | newtype Flat t a = Flat { getFlat :: t a }
 421 |   deriving Functor
 422 | 
 423 | instance Traversable t => TreeLike (Flat t) where
 424 |   treeTraverse f _ (Flat ta) = Flat <$> traverse f ta
 425 | 
 426 | 
 427 | -- |
 428 | -- Treat subtrees and values of @outer (inner a)@ as subtrees of
 429 | -- @'Compose' outer inner a@.
 430 | --
 431 | -- For example 
 432 | --
 433 | -- >>> :{
 434 | -- exampleCompose =  Compose $ 
 435 | --    Branch 
 436 | --      (Branch Leaf (Node 'a' [Node 'b' [], Node 'c' [], Node 'd' []]) Leaf)
 437 | --      (Node 'e' [Node 'f' [Node 'g' [], Node 'h' []]]) 
 438 | --      (Branch Leaf (Node 'i' [Node 'i' [Node 'j' [Node 'k' []]]]) Leaf)
 439 | -- :}
 440 | -- 
 441 | -- >>> printTree exampleCompose
 442 | --         ┌─────────────┬───────────────┐
 443 | --         │             │               │
 444 | -- ┌───────┼───────┐ 'e'─┴──┐     ┌────┬─┴──────┐
 445 | -- │       │       │        │     │    │        │
 446 | -- ╵ 'a'─┬─┴─┬───┐ ╵    'f'─┼───┐ ╵ 'i'┴──┐     ╵
 447 | --       │   │   │          │   │         │
 448 | --      'b' 'c' 'd'        'g' 'h'     'i'┴─┐
 449 | --                                          │
 450 | --                                        'j'─┐
 451 | --                                            │
 452 | --                                           'k'
 453 | -- >>> treeFoldMap (const ["value"]) (const ["subtree"]) exampleCompose
 454 | -- ["subtree","subtree","subtree"]
 455 | instance (TreeLike outer, TreeLike inner) => TreeLike (Compose outer inner) where
 456 |   treeTraverse _ g (Compose trees) = Compose <$> treeTraverse g (fmap getCompose . g . Compose) trees
 457 |   
 458 | -- | Traverse all the values in a tree in left-to-right order.
 459 | --
 460 | -- >>> printTree exampleBinaryTree
 461 | --                     ┌──────────────────────[]────────┐
 462 | --                     │                                │
 463 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
 464 | --      │                            │          │              │
 465 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
 466 | -- │         │              │                │          │             │
 467 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
 468 | --       │       │   │            │                 │       │     │       │
 469 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
 470 | --                           │         │
 471 | --                           ╵         ╵
 472 | -- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
 473 | -- >>> traversed <- inorder visit exampleBinaryTree `evalStateT` 0
 474 | -- [L,L]
 475 | -- [L,L,R]
 476 | -- [L]
 477 | -- [L,R,L]
 478 | -- [L,R,L,R]
 479 | -- [L,R]
 480 | -- []
 481 | -- [R]
 482 | -- [R,R,L]
 483 | -- [R,R]
 484 | -- [R,R,R]
 485 | -- >>> printTree traversed
 486 | --       ┌──────6───┐
 487 | --       │          │
 488 | --   ┌──2┴───┐   ┌7─┴──┐
 489 | --   │       │   │     │
 490 | -- ┌0┴┐    ┌─┴5┐ ╵  ┌─9┴─┐
 491 | -- │  │    │   │    │    │
 492 | -- ╵ ┌1┐ ┌3┴┐  ╵   ┌8┐ ┌10┐
 493 | --   │ │ │  │      │ │ │  │
 494 | --   ╵ ╵ ╵ ┌4┐     ╵ ╵ ╵  ╵
 495 | --         │ │
 496 | --         ╵ ╵
 497 | -- >>> printTree exampleTree
 498 | -- []─┬─────┬───────────┬─────────────────────────────┐
 499 | --    │     │           │                             │
 500 | --   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
 501 | --            │       │       │            │       │                 │
 502 | --          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
 503 | --                                │                    │           │          │
 504 | --                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
 505 | --                                                                                 │
 506 | --                                                                             [3,2,1,0]
 507 | -- >>> traversed <- inorder visit exampleTree `evalStateT` 0
 508 | -- []
 509 | -- [0]
 510 | -- [1]
 511 | -- [1,0]
 512 | -- [2]
 513 | -- [2,0]
 514 | -- [2,1]
 515 | -- [2,1,0]
 516 | -- [3]
 517 | -- [3,0]
 518 | -- [3,1]
 519 | -- [3,1,0]
 520 | -- [3,2]
 521 | -- [3,2,0]
 522 | -- [3,2,1]
 523 | -- [3,2,1,0]
 524 | -- >>> printTree traversed
 525 | -- 0┬──┬───┬─────────┐
 526 | --  │  │   │         │
 527 | --  1 2┤ 4┬┴─┐ 8┬───┬┴─────┐
 528 | --     │  │  │  │   │      │
 529 | --     3  5 6┤  9 10┴┐ 12─┬┴──┐
 530 | --           │       │    │   │
 531 | --           7      11   13 14┴┐
 532 | --                             │
 533 | --                            15
 534 | inorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
 535 | inorder f = treeTraverse f (inorder f)
 536 | 
 537 | -- | Traverse all the values of a node, then recurse into each of its subtrees
 538 | -- in left-to-right order.
 539 | --
 540 | -- >>> printTree exampleBinaryTree
 541 | --                     ┌──────────────────────[]────────┐
 542 | --                     │                                │
 543 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
 544 | --      │                            │          │              │
 545 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
 546 | -- │         │              │                │          │             │
 547 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
 548 | --       │       │   │            │                 │       │     │       │
 549 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
 550 | --                           │         │
 551 | --                           ╵         ╵
 552 | -- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
 553 | -- >>> traversed <- preorder visit exampleBinaryTree `evalStateT` 0
 554 | -- []
 555 | -- [L]
 556 | -- [L,L]
 557 | -- [L,L,R]
 558 | -- [L,R]
 559 | -- [L,R,L]
 560 | -- [L,R,L,R]
 561 | -- [R]
 562 | -- [R,R]
 563 | -- [R,R,L]
 564 | -- [R,R,R]
 565 | -- >>> printTree traversed
 566 | --       ┌──────0───┐
 567 | --       │          │
 568 | --   ┌──1┴───┐   ┌7─┴──┐
 569 | --   │       │   │     │
 570 | -- ┌2┴┐    ┌─┴4┐ ╵  ┌─8┴─┐
 571 | -- │  │    │   │    │    │
 572 | -- ╵ ┌3┐ ┌5┴┐  ╵   ┌9┐ ┌10┐
 573 | --   │ │ │  │      │ │ │  │
 574 | --   ╵ ╵ ╵ ┌6┐     ╵ ╵ ╵  ╵
 575 | --         │ │
 576 | --         ╵ ╵
 577 | -- >>> printTree exampleTree
 578 | -- []─┬─────┬───────────┬─────────────────────────────┐
 579 | --    │     │           │                             │
 580 | --   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
 581 | --            │       │       │            │       │                 │
 582 | --          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
 583 | --                                │                    │           │          │
 584 | --                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
 585 | --                                                                                 │
 586 | --                                                                             [3,2,1,0]
 587 | -- >>> traversed <- inorder visit exampleTree `evalStateT` 0
 588 | -- []
 589 | -- [0]
 590 | -- [1]
 591 | -- [1,0]
 592 | -- [2]
 593 | -- [2,0]
 594 | -- [2,1]
 595 | -- [2,1,0]
 596 | -- [3]
 597 | -- [3,0]
 598 | -- [3,1]
 599 | -- [3,1,0]
 600 | -- [3,2]
 601 | -- [3,2,0]
 602 | -- [3,2,1]
 603 | -- [3,2,1,0]
 604 | -- >>> printTree traversed
 605 | -- 0┬──┬───┬─────────┐
 606 | --  │  │   │         │
 607 | --  1 2┤ 4┬┴─┐ 8┬───┬┴─────┐
 608 | --     │  │  │  │   │      │
 609 | --     3  5 6┤  9 10┴┐ 12─┬┴──┐
 610 | --           │       │    │   │
 611 | --           7      11   13 14┴┐
 612 | --                             │
 613 | --                            15
 614 | preorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
 615 | preorder f = runPhasesForwards . treeTraverse (now . f) (later . preorder f)
 616 | 
 617 | -- | Traverse all the values of a node after recursing into each of its
 618 | -- subtrees in left-to-right order.
 619 | --
 620 | -- >>> printTree exampleBinaryTree
 621 | --                     ┌──────────────────────[]────────┐
 622 | --                     │                                │
 623 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
 624 | --      │                            │          │              │
 625 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
 626 | -- │         │              │                │          │             │
 627 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
 628 | --       │       │   │            │                 │       │     │       │
 629 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
 630 | --                           │         │
 631 | --                           ╵         ╵
 632 | -- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
 633 | -- >>> traversed <- postorder visit exampleBinaryTree `evalStateT` 0
 634 | -- [L,L,R]
 635 | -- [L,L]
 636 | -- [L,R,L,R]
 637 | -- [L,R,L]
 638 | -- [L,R]
 639 | -- [L]
 640 | -- [R,R,L]
 641 | -- [R,R,R]
 642 | -- [R,R]
 643 | -- [R]
 644 | -- []
 645 | -- >>> printTree traversed
 646 | --       ┌──────10───┐
 647 | --       │           │
 648 | --   ┌──5┴───┐    ┌9─┴─┐
 649 | --   │       │    │    │
 650 | -- ┌1┴┐    ┌─┴4┐  ╵  ┌─8─┐
 651 | -- │  │    │   │     │   │
 652 | -- ╵ ┌0┐ ┌3┴┐  ╵    ┌6┐ ┌7┐
 653 | --   │ │ │  │       │ │ │ │
 654 | --   ╵ ╵ ╵ ┌2┐      ╵ ╵ ╵ ╵
 655 | --         │ │
 656 | --         ╵ ╵
 657 | -- >>> printTree exampleTree
 658 | -- []─┬─────┬───────────┬─────────────────────────────┐
 659 | --    │     │           │                             │
 660 | --   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
 661 | --            │       │       │            │       │                 │
 662 | --          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
 663 | --                                │                    │           │          │
 664 | --                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
 665 | --                                                                                 │
 666 | --                                                                             [3,2,1,0]
 667 | -- >>> traversed <- postorder visit exampleTree `evalStateT` 0
 668 | -- [0]
 669 | -- [1,0]
 670 | -- [1]
 671 | -- [2,0]
 672 | -- [2,1,0]
 673 | -- [2,1]
 674 | -- [2]
 675 | -- [3,0]
 676 | -- [3,1,0]
 677 | -- [3,1]
 678 | -- [3,2,0]
 679 | -- [3,2,1,0]
 680 | -- [3,2,1]
 681 | -- [3,2]
 682 | -- [3]
 683 | -- []
 684 | -- >>> printTree traversed
 685 | -- 15┬──┬───┬─────────┐
 686 | --   │  │   │         │
 687 | --   0 2┤ 6┬┴─┐ 14┬──┬┴────┐
 688 | --      │  │  │   │  │     │
 689 | --      1  3 5┤   7 9┤ 13─┬┴──┐
 690 | --            │      │    │   │
 691 | --            4      8   10 12┴┐
 692 | --                             │
 693 | --                            11
 694 | postorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
 695 | postorder f = runPhasesBackwards . treeTraverse (now . f) (later . postorder f)
 696 | 
 697 | -- | Traverse all the values of a tree in left-to-right breadth-first order.
 698 | -- (i.e. all nodes of depth @0@, then all nodes of depth @1@, then all nodes of
 699 | -- depth @2@, etc.)
 700 | --
 701 | -- >>> printTree exampleBinaryTree
 702 | --                     ┌──────────────────────[]────────┐
 703 | --                     │                                │
 704 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
 705 | --      │                            │          │              │
 706 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
 707 | -- │         │              │                │          │             │
 708 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
 709 | --       │       │   │            │                 │       │     │       │
 710 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
 711 | --                           │         │
 712 | --                           ╵         ╵
 713 | -- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
 714 | -- >>> traversed <- levelorder visit exampleBinaryTree `evalStateT` 0
 715 | -- []
 716 | -- [L]
 717 | -- [R]
 718 | -- [L,L]
 719 | -- [L,R]
 720 | -- [R,R]
 721 | -- [L,L,R]
 722 | -- [L,R,L]
 723 | -- [R,R,L]
 724 | -- [R,R,R]
 725 | -- [L,R,L,R]
 726 | -- >>> printTree traversed
 727 | --        ┌──────0───┐
 728 | --        │          │
 729 | --   ┌──1─┴───┐   ┌2─┴─┐
 730 | --   │        │   │    │
 731 | -- ┌3┴┐    ┌──┴4┐ ╵  ┌─5─┐
 732 | -- │  │    │    │    │   │
 733 | -- ╵ ┌6┐ ┌7┴─┐  ╵   ┌8┐ ┌9┐
 734 | --   │ │ │   │      │ │ │ │
 735 | --   ╵ ╵ ╵ ┌10┐     ╵ ╵ ╵ ╵
 736 | --         │  │
 737 | --         ╵  ╵
 738 | -- >>> printTree exampleTree
 739 | -- []─┬─────┬───────────┬─────────────────────────────┐
 740 | --    │     │           │                             │
 741 | --   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
 742 | --            │       │       │            │       │                 │
 743 | --          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
 744 | --                                │                    │           │          │
 745 | --                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
 746 | --                                                                                 │
 747 | --                                                                             [3,2,1,0]
 748 | -- >>> traversed <- levelorder visit exampleTree `evalStateT` 0
 749 | -- []
 750 | -- [0]
 751 | -- [1]
 752 | -- [2]
 753 | -- [3]
 754 | -- [1,0]
 755 | -- [2,0]
 756 | -- [2,1]
 757 | -- [3,0]
 758 | -- [3,1]
 759 | -- [3,2]
 760 | -- [2,1,0]
 761 | -- [3,1,0]
 762 | -- [3,2,0]
 763 | -- [3,2,1]
 764 | -- [3,2,1,0]
 765 | -- >>> printTree traversed
 766 | -- 0┬──┬───┬─────────┐
 767 | --  │  │   │         │
 768 | --  1 2┤ 3┬┴─┐ 4┬──┬─┴────┐
 769 | --     │  │  │  │  │      │
 770 | --     5  6 7┴┐ 8 9┴┐ 10─┬┴──┐
 771 | --            │     │    │   │
 772 | --           11    12   13 14┴┐
 773 | --                            │
 774 | --                           15
 775 | levelorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
 776 | levelorder = \f -> runPhasesForwards . schedule f where
 777 |   schedule :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> Phases f (tree b)
 778 |   schedule f = treeTraverse (now . f) (delay . schedule f)
 779 | 
 780 | -- | Traverse all the values of a tree in left-to-right inverse breadth-first order.
 781 | -- (i.e. all nodes of @n@, then all nodes of depth @n-1@, then all nodes of
 782 | -- depth @n-2@, etc.)
 783 | --
 784 | -- >>> printTree exampleBinaryTree
 785 | --                     ┌──────────────────────[]────────┐
 786 | --                     │                                │
 787 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
 788 | --      │                            │          │              │
 789 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
 790 | -- │         │              │                │          │             │
 791 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
 792 | --       │       │   │            │                 │       │     │       │
 793 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
 794 | --                           │         │
 795 | --                           ╵         ╵
 796 | -- >>> visit a = StateT $ \e -> print a >> return (e, succ e)
 797 | -- >>> traversed <- rlevelorder visit exampleBinaryTree `evalStateT` 0
 798 | -- [L,R,L,R]
 799 | -- [L,L,R]
 800 | -- [L,R,L]
 801 | -- [R,R,L]
 802 | -- [R,R,R]
 803 | -- [L,L]
 804 | -- [L,R]
 805 | -- [R,R]
 806 | -- [L]
 807 | -- [R]
 808 | -- []
 809 | -- >>> printTree traversed
 810 | --       ┌──────10───┐
 811 | --       │           │
 812 | --   ┌──8┴───┐    ┌9─┴─┐
 813 | --   │       │    │    │
 814 | -- ┌5┴┐    ┌─┴6┐  ╵  ┌─7─┐
 815 | -- │  │    │   │     │   │
 816 | -- ╵ ┌1┐ ┌2┴┐  ╵    ┌3┐ ┌4┐
 817 | --   │ │ │  │       │ │ │ │
 818 | --   ╵ ╵ ╵ ┌0┐      ╵ ╵ ╵ ╵
 819 | --         │ │
 820 | --         ╵ ╵
 821 | -- >>> printTree exampleTree
 822 | -- []─┬─────┬───────────┬─────────────────────────────┐
 823 | --    │     │           │                             │
 824 | --   [0] [1]┴─┐  [2]──┬─┴─────┐       [3]──┬───────┬──┴──────────────┐
 825 | --            │       │       │            │       │                 │
 826 | --          [1,0]   [2,0] [2,1]───┐      [3,0] [3,1]───┐   [3,2]───┬─┴────────┐
 827 | --                                │                    │           │          │
 828 | --                             [2,1,0]              [3,1,0]     [3,2,0] [3,2,1]────┐
 829 | --                                                                                 │
 830 | --                                                                             [3,2,1,0]
 831 | -- >>> traversed <- rlevelorder visit exampleTree `evalStateT` 0
 832 | -- [3,2,1,0]
 833 | -- [2,1,0]
 834 | -- [3,1,0]
 835 | -- [3,2,0]
 836 | -- [3,2,1]
 837 | -- [1,0]
 838 | -- [2,0]
 839 | -- [2,1]
 840 | -- [3,0]
 841 | -- [3,1]
 842 | -- [3,2]
 843 | -- [0]
 844 | -- [1]
 845 | -- [2]
 846 | -- [3]
 847 | -- []
 848 | -- >>> printTree traversed
 849 | -- 15─┬──┬─────┬────────┐
 850 | --    │  │     │        │
 851 | --   11 12┐ 13┬┴─┐ 14┬──┼────┐
 852 | --        │   │  │   │  │    │
 853 | --        5   6 7┤   8 9┤ 10┬┴─┐
 854 | --               │      │   │  │
 855 | --               1      2   3 4┤
 856 | --                             │
 857 | --                             0
 858 | rlevelorder :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> f (tree b)
 859 | rlevelorder = \f -> runPhasesBackwards . schedule f where
 860 |   schedule :: (Applicative f, TreeLike tree) => (a -> f b) -> tree a -> Phases f (tree b)
 861 |   schedule f = treeTraverse (now . f) (delay . schedule f)
 862 | 
 863 | -- | 'Tree' wrapper to use 'inorder' traversal
 864 | --
 865 | -- >>> printTree exampleBinaryTree
 866 | --                     ┌──────────────────────[]────────┐
 867 | --                     │                                │
 868 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
 869 | --      │                            │          │              │
 870 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
 871 | -- │         │              │                │          │             │
 872 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
 873 | --       │       │   │            │                 │       │     │       │
 874 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
 875 | --                           │         │
 876 | --                           ╵         ╵
 877 | -- >>> _ <- traverse print $ InOrder exampleBinaryTree
 878 | -- [L,L]
 879 | -- [L,L,R]
 880 | -- [L]
 881 | -- [L,R,L]
 882 | -- [L,R,L,R]
 883 | -- [L,R]
 884 | -- []
 885 | -- [R]
 886 | -- [R,R,L]
 887 | -- [R,R]
 888 | -- [R,R,R]
 889 | newtype InOrder tree a = InOrder { getInOrder :: tree a }
 890 |   deriving Functor
 891 | instance TreeLike tree => Foldable (InOrder tree) where
 892 |   foldMap = foldMapDefault
 893 | instance TreeLike tree => Traversable (InOrder tree) where
 894 |   traverse f = fmap InOrder . inorder f . getInOrder
 895 | 
 896 | -- | 'Tree' wrapper to use 'preorder' traversal
 897 | --
 898 | -- >>> printTree exampleBinaryTree
 899 | --                     ┌──────────────────────[]────────┐
 900 | --                     │                                │
 901 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
 902 | --      │                            │          │              │
 903 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
 904 | -- │         │              │                │          │             │
 905 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
 906 | --       │       │   │            │                 │       │     │       │
 907 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
 908 | --                           │         │
 909 | --                           ╵         ╵
 910 | -- >>> _ <- traverse print $ PreOrder exampleBinaryTree
 911 | -- []
 912 | -- [L]
 913 | -- [L,L]
 914 | -- [L,L,R]
 915 | -- [L,R]
 916 | -- [L,R,L]
 917 | -- [L,R,L,R]
 918 | -- [R]
 919 | -- [R,R]
 920 | -- [R,R,L]
 921 | -- [R,R,R]
 922 | newtype PreOrder tree a = PreOrder { getPreOrder :: tree a }
 923 |   deriving Functor
 924 | instance TreeLike tree => Foldable (PreOrder tree) where
 925 |   foldMap = foldMapDefault
 926 | instance TreeLike tree => Traversable (PreOrder tree) where
 927 |   traverse f = fmap PreOrder . preorder f . getPreOrder
 928 | 
 929 | -- | 'Tree' wrapper to use 'postorder' traversal
 930 | --
 931 | -- >>> printTree exampleBinaryTree
 932 | --                     ┌──────────────────────[]────────┐
 933 | --                     │                                │
 934 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
 935 | --      │                            │          │              │
 936 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
 937 | -- │         │              │                │          │             │
 938 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
 939 | --       │       │   │            │                 │       │     │       │
 940 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
 941 | --                           │         │
 942 | --                           ╵         ╵
 943 | -- >>> _ <- traverse print $ PostOrder exampleBinaryTree
 944 | -- [L,L,R]
 945 | -- [L,L]
 946 | -- [L,R,L,R]
 947 | -- [L,R,L]
 948 | -- [L,R]
 949 | -- [L]
 950 | -- [R,R,L]
 951 | -- [R,R,R]
 952 | -- [R,R]
 953 | -- [R]
 954 | -- []
 955 | newtype PostOrder tree a = PostOrder { getPostOrder :: tree a }
 956 |   deriving Functor
 957 | instance TreeLike tree => Foldable (PostOrder tree) where
 958 |   foldMap = foldMapDefault
 959 | instance TreeLike tree => Traversable (PostOrder tree) where
 960 |   traverse f = fmap PostOrder . postorder f . getPostOrder
 961 | 
 962 | -- | 'Tree' wrapper to use 'levelorder' traversal
 963 | --
 964 | -- >>> printTree exampleBinaryTree
 965 | --                     ┌──────────────────────[]────────┐
 966 | --                     │                                │
 967 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
 968 | --      │                            │          │              │
 969 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
 970 | -- │         │              │                │          │             │
 971 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
 972 | --       │       │   │            │                 │       │     │       │
 973 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
 974 | --                           │         │
 975 | --                           ╵         ╵
 976 | -- >>> _ <- traverse print $ LevelOrder exampleBinaryTree
 977 | -- []
 978 | -- [L]
 979 | -- [R]
 980 | -- [L,L]
 981 | -- [L,R]
 982 | -- [R,R]
 983 | -- [L,L,R]
 984 | -- [L,R,L]
 985 | -- [R,R,L]
 986 | -- [R,R,R]
 987 | -- [L,R,L,R]
 988 | newtype LevelOrder tree a = LevelOrder { getLevelOrder :: tree a }
 989 |   deriving Functor
 990 | instance TreeLike tree => Foldable (LevelOrder tree) where
 991 |   foldMap = foldMapDefault
 992 | instance TreeLike tree => Traversable (LevelOrder tree) where
 993 |   traverse f = fmap LevelOrder . levelorder f . getLevelOrder
 994 | 
 995 | -- | 'Tree' wrapper to use 'rlevelorder' traversal
 996 | --
 997 | -- >>> printTree exampleBinaryTree
 998 | --                     ┌──────────────────────[]────────┐
 999 | --                     │                                │
1000 | --      ┌─────────[L]──┴─────────────┐          ┌[R]────┴──────┐
1001 | --      │                            │          │              │
1002 | -- ┌[L,L]────┐              ┌────────┴──[L,R]┐  ╵       ┌────[R,R]────┐
1003 | -- │         │              │                │          │             │
1004 | -- ╵     ┌[L,L,R]┐   ┌[L,R,L]─────┐          ╵      ┌[R,R,L]┐     ┌[R,R,R]┐
1005 | --       │       │   │            │                 │       │     │       │
1006 | --       ╵       ╵   ╵       ┌[L,R,L,R]┐            ╵       ╵     ╵       ╵
1007 | --                           │         │
1008 | --                           ╵         ╵
1009 | -- >>> _ <- traverse print $ RLevelOrder exampleBinaryTree
1010 | -- [L,R,L,R]
1011 | -- [L,L,R]
1012 | -- [L,R,L]
1013 | -- [R,R,L]
1014 | -- [R,R,R]
1015 | -- [L,L]
1016 | -- [L,R]
1017 | -- [R,R]
1018 | -- [L]
1019 | -- [R]
1020 | -- []
1021 | newtype RLevelOrder tree a = RLevelOrder { getRLevelOrder :: tree a }
1022 |   deriving Functor
1023 | instance TreeLike tree => Foldable (RLevelOrder tree) where
1024 |   foldMap = foldMapDefault
1025 | instance TreeLike tree => Traversable (RLevelOrder tree) where
1026 |   traverse f = fmap RLevelOrder . rlevelorder f . getRLevelOrder
1027 | 
1028 | -- $setup
1029 | -- >>> :set -XDeriveFunctor
1030 | -- >>> import Control.Monad.State
1031 | -- >>> data Direction = L | R deriving Show
1032 | -- >>> :{
1033 | -- next :: a -> State Int Int
1034 | -- next = const . state $ \n -> (n, n+1)
1035 | -- label :: ((a -> State Int Int) -> tree a -> State Int (tree Int)) -> tree a -> tree Int
1036 | -- label traversal tree = traversal next tree `evalState` (0 :: Int)
1037 | -- :}
1038 | --
1039 | -- >>> :{
1040 | -- exampleTrees :: [Tree [Int]]
1041 | -- exampleTrees =
1042 | --   [ Node [0] []
1043 | --   , Node [1] [Node [1,0] []]
1044 | --   , Node [2] [Node [2,0] [], Node [2,1] [Node [2,1,0] []]]
1045 | --   , Node [3]
1046 | --     [ Node [3,0] []
1047 | --     , Node [3,1] [Node [3,1,0] []]
1048 | --     , Node [3,2] [Node [3,2,0] [], Node [3,2,1] [Node [3,2,1,0] []]]
1049 | --     ]
1050 | --   ]
1051 | -- exampleTree :: Tree [Int]
1052 | -- exampleTree = Node [] exampleTrees
1053 | -- exampleBinaryTree :: BinaryTree [Direction]
1054 | -- exampleBinaryTree = 
1055 | --   Branch
1056 | --   ( Branch
1057 | --       ( Branch
1058 | --           Leaf
1059 | --           [L,L]
1060 | --           (Branch Leaf [L,L,R] Leaf)
1061 | --       )
1062 | --       [L]
1063 | --       ( Branch
1064 | --           ( Branch 
1065 | --               Leaf
1066 | --               [L,R,L]
1067 | --               (Branch Leaf [L,R,L,R] Leaf)
1068 | --           )
1069 | --           [L,R]
1070 | --           Leaf
1071 | --       )
1072 | --   )
1073 | --   []
1074 | --   ( Branch
1075 | --       Leaf
1076 | --       [R]
1077 | --       ( Branch
1078 | --           (Branch Leaf [R,R,L] Leaf)
1079 | --           [R,R]
1080 | --           (Branch Leaf [R,R,R] Leaf)
1081 | --       )
1082 | --   )
1083 | -- :}
1084 | 


--------------------------------------------------------------------------------
/tree-traversals.cabal:
--------------------------------------------------------------------------------
 1 | cabal-version:       2.2
 2 | name:                tree-traversals
 3 | version:             0.1.3.0
 4 | synopsis:            Functions and newtype wrappers for traversing Trees
 5 | description:         
 6 |   The tree-traversals package defines
 7 |   <https://en.wikipedia.org/wiki/Tree_traversal#Types in-order, pre-order, post-order, level-order, and reversed level-order traversals>
 8 |   for tree-like types:
 9 |   .
10 |   > inorder, preorder, postorder, levelorder, rlevelorder
11 |   >   :: (TreeLike tree, Applicative f) => (a -> f b) -> tree a -> f (tree b) 
12 |   .
13 |   The package also provides newtype wrappers for the various traversals so they
14 |   may be used with @traverse@, i.e.
15 |   .
16 |   > traverse f (InOrder tree) = inorder f tree
17 |   > traverse f (PreOrder tree) = preorder f tree
18 |   > traverse f (PostOrder tree) = postorder f tree
19 |   > traverse f (LevelOrder tree) = levelorder f tree
20 |   > traverse f (RLevelOrder tree) = rlevelorder f tree
21 |   .
22 |   To implement the various orders, the tree-traversals package provides the
23 |   'Control.Applicative.Phases.Phases' applicative transformer for organizing effects
24 |   into distinct phases.
25 |   .
26 |   Instances of 'Data.Traversable.TreeLike.TreeLike' are provided for
27 |   rose trees ('Data.Tree.Tree'), 
28 |   binary trees ('Data.BinaryTree.BinaryTree'),
29 |   forests ('Data.Traversable.TreeLike.Forest'),
30 |   and algebraic combinations of trees (@'Data.Functor.Compose.Compose' outerTree innerTree@,
31 |   @'Data.Functor.Product' fstTree sndTree@, @'Data.Functor.Sum' leftTree rightTree@).
32 | 
33 | homepage:            https://github.com/rampion/tree-traversals
34 | license:             CC0-1.0
35 | license-file:        LICENSE
36 | author:              Noah Luck Easterly
37 | maintainer:          noah.easterly@gmail.com
38 | category:            Data
39 | build-type:          Simple
40 | extra-source-files:  ChangeLog.md
41 |                   ,  README.md
42 | 
43 | source-repository head
44 |   type: git
45 |   location: git://github.com/rampion/tree-traversals.git
46 | 
47 | source-repository this
48 |   type: git
49 |   location: git://github.com/rampion/tree-traversals.git
50 |   tag: v0.1.0.0
51 | 
52 | flag Development
53 |   description: Enable all warnings and upgrade warnings to errors
54 |   default: False
55 |   manual: True
56 | 
57 | library
58 |   exposed-modules: Control.Applicative.Phases
59 |                  , Data.BinaryTree
60 |                  , Data.Monoid.TreeDiagram
61 |                  , Data.Traversable.TreeLike
62 |   -- other-extensions:    
63 |   build-depends:       base >=4.10 && <4.20
64 |                ,       containers
65 |   hs-source-dirs:      src
66 |   default-language:    Haskell2010
67 |   if flag(development)
68 |     ghc-options: -Wall -Wextra -Werror
69 | 
70 | test-suite doctests
71 |   type: exitcode-stdio-1.0
72 |   main-is: doctests.hs
73 |   build-depends: base >=4.10
74 |                , doctest >=0.13
75 |                , containers
76 |                , mtl >=2.2.1
77 |   default-language: Haskell2010
78 |   if flag(development)
79 |     ghc-options: -Wall -Wextra -Werror
80 | 


--------------------------------------------------------------------------------