(.module:
  [lux (#- char)
   data/text/format
   ["_" test (#+ Test)]
   [control
    pipe
    [monad (#+ Monad do)]
    ["p" parser]
    {[0 #test]
     [/
      ["$." equivalence]
      ["$." codec]]}]
   [data
    ["." name]
    ["E" error]
    ["." maybe]
    ["." text ("#@." equivalence)]
    [collection
     ["." dictionary]
     ["." list ("#@." functor)]]]
   [math
    ["r" random (#+ Random) ("#@." monad)]]]
  {1
   ["." / (#+ XML)]})

(def: char-range
  Text
  (format "_"
          "abcdefghijklmnopqrstuvwxyz"
          "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))

(def: char
  (Random Nat)
  (do r.monad
    [idx (|> r.nat (:: @ map (n/% (text.size char-range))))]
    (wrap (maybe.assume (text.nth idx char-range)))))

(def: (size bottom top)
  (-> Nat Nat (Random Nat))
  (let [constraint (|>> (n/% top) (n/max bottom))]
    (r@map constraint r.nat)))

(def: (text bottom top)
  (-> Nat Nat (Random Text))
  (do r.monad
    [size (..size bottom top)]
    (r.text ..char size)))

(def: xml-identifier^
  (Random Name)
  (r.and (..text 0 10)
         (..text 1 10)))

(def: #export xml
  (Random XML)
  (r.rec (function (_ xml)
           (r.or (..text 1 10)
                 (do r.monad
                   [size (..size 0 2)]
                   ($_ r.and
                       xml-identifier^
                       (r.dictionary name.hash size xml-identifier^ (..text 0 10))
                       (r.list size xml)))))))

(def: #export test
  Test
  (<| (_.context (%name (name-of /.XML)))
      ($_ _.and
          ($equivalence.spec /.equivalence ..xml)
          ($codec.spec /.equivalence /.codec ..xml)

          (do r.monad
            [text (..text 1 10)
             num-children (|> r.nat (:: @ map (n/% 5)))
             children (r.list num-children (..text 1 10))
             tag xml-identifier^
             attr xml-identifier^
             value (..text 1 10)
             #let [node (#/.Node tag
                                 (dictionary.put attr value /.attrs)
                                 (list@map (|>> #/.Text) children))]]
            ($_ _.and
                (_.test "Can parse text."
                        (E.default #0
                                   (do E.monad
                                     [output (/.run (#/.Text text)
                                                    /.text)]
                                     (wrap (text@= text output)))))
                (_.test "Can parse attributes."
                        (E.default #0
                                   (do E.monad
                                     [output (|> (/.attr attr)
                                                 (p.before /.ignore)
                                                 (/.run node))]
                                     (wrap (text@= value output)))))
                (_.test "Can parse nodes."
                        (E.default #0
                                   (do E.monad
                                     [_ (|> (/.node tag)
                                            (p.before /.ignore)
                                            (/.run node))]
                                     (wrap #1))))
                (_.test "Can parse children."
                        (E.default #0
                                   (do E.monad
                                     [outputs (|> (/.children (p.some /.text))
                                                  (/.run node))]
                                     (wrap (:: (list.equivalence text.equivalence) =
                                               children
                                               outputs)))))
                ))
          )))