aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/world/net/http/query.lux
blob: a0854d1e9655b4534c3e9400eff158e96515c56d (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
(.module:
  [lux #*
   [control
    pipe
    [monad (#+ do)]
    ["p" parser
     ["l" text (#+ Parser)]]]
   [data
    ["." error (#+ Error)]
    [number
     ["." nat]]
    ["." text
     ["%" format (#+ format)]]
    [format
     ["." context (#+ Context)]]
    [collection
     ["." dictionary]]]])

(def: component
  (Parser Text)
  (p.rec
   (function (_ component)
     (do p.monad
       [head (l.some (l.none-of "+%&;"))]
       ($_ p.either
           (p.after (p.either l.end
                              (l.this "&"))
                    (wrap head))
           (do @
             [_ (l.this "+")
              tail component]
             (wrap (format head " " tail)))
           (do @
             [_ (l.this "%")
              code (|> (l.exactly 2 l.hexadecimal)
                       (p.codec nat.hex)
                       (:: @ map text.from-code))
              tail component]
             (wrap (format head code tail))))))))

(def: (form context)
  (-> Context (Parser Context))
  ($_ p.either
      (do p.monad
        [_ l.end]
        (wrap context))
      (do p.monad
        [key (l.some (l.none-of "=&;"))
         key (l.local key ..component)]
        (p.either (do @
                    [_ (l.this "=")
                     value ..component]
                    (form (dictionary.put key value context)))
                  (do @
                    [_ ($_ p.or
                           (l.one-of "&;")
                           l.end)]
                    (form (dictionary.put key "" context)))))
      ## if invalid form data, just stop parsing...
      (:: p.monad wrap context)))

(def: #export (parameters raw)
  (-> Text (Error Context))
  (l.run raw (..form context.empty)))