aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/parser/tree.lux
blob: ad2015624dd90131004050039644b1fbb858ec61 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
(.module:
  [library
   [lux #*
    [abstract
     [monad (#+ do)]]
    [control
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]]
    [data
     [collection
      [tree (#+ Tree)
       ["." zipper (#+ Zipper)]]]]]]
  ["." //])

(type: #export (Parser t a)
  {#.doc (doc "A parser of arbitrary trees.")}
  (//.Parser (Zipper t) a))

(def: #export (run' parser zipper)
  {#.doc (doc "Applies the parser against a tree zipper.")}
  (All [t a] (-> (Parser t a) (Zipper t) (Try a)))
  (do try.monad
    [[zipper output] (//.run parser zipper)]
    (in output)))

(def: #export (run parser tree)
  {#.doc (doc "Applies the parser against a tree.")}
  (All [t a] (-> (Parser t a) (Tree t) (Try a)))
  (run' parser (zipper.zipper tree)))

(def: #export value
  {#.doc (doc "Yields the value inside the current tree node.")}
  (All [t] (Parser t t))
  (function (_ zipper)
    (#try.Success [zipper (zipper.value zipper)])))

(exception: #export cannot_move_further)

(template [<name> <direction> <doc>]
  [(def: #export <name>
     {#.doc (doc <doc>)}
     (All [t] (Parser t []))
     (function (_ zipper)
       (case (<direction> zipper)
         #.None
         (exception.except ..cannot_move_further [])

         (#.Some next)
         (#try.Success [next []]))))]

  [down      zipper.down
   "Move down."]
  [up        zipper.up
   "Move up."]

  [right     zipper.right
   "Move to the right."]
  [rightmost zipper.rightmost
   "Move to the rightmost node."]

  [left      zipper.left
   "Move to the left."]
  [leftmost  zipper.leftmost
   "Move to the leftmost node."]
  
  [next      zipper.next
   "Move to the next node."]
  [end       zipper.end
   "Move to the last node."]
  
  [previous  zipper.previous
   "Move to the previous node."]
  [start     zipper.start
   "Move to the root node."]
  )