(;module:
  lux
  (lux [io]
       (control [monad #+ do]
                pipe)
       (data text/format
             [product]
             ["R" result]
             [bool "B/" Eq<Bool>]
             [text "T/" Eq<Text>]
             (coll ["a" array]
                   [list "L/" Functor<List>]
                   ["S" set]))
       ["r" math/random "r/" Monad<Random>]
       [macro #+ Monad<Lux>]
       (macro [code])
       [host]
       test)
  (luxc (lang ["ls" synthesis])
        [analyser]
        [synthesizer]
        (generator ["@" case]
                   ["@;" eval]
                   ["@;" runtime]
                   ["@;" common]))
  (test/luxc common))

(def: struct-limit Nat +10)

(def: (tail? size idx)
  (-> Nat Nat Bool)
  (n.= (n.dec size) idx))

(def: gen-case
  (r;Random [ls;Synthesis ls;Path])
  (<| r;rec (function [gen-case])
      (with-expansions [<simple> (do-template [<gen> <synth> <path>]
                                   [(do r;Monad<Random>
                                      [value <gen>]
                                      (wrap [(<synth> value) (<path> value)]))]

                                   [r;bool #ls;Bool #ls;BoolP]
                                   [r;nat #ls;Nat #ls;NatP]
                                   [r;int #ls;Int #ls;IntP]
                                   [r;deg #ls;Deg #ls;DegP]
                                   [r;frac #ls;Frac #ls;FracP]
                                   [(r;text +5) #ls;Text #ls;TextP])]
        ($_ r;either
            (r/wrap [#ls;Unit #ls;UnitP])
            <simple>
            (do r;Monad<Random>
              [size (|> r;nat (:: @ map (|>. (n.% struct-limit) (n.max +2))))
               idx (|> r;nat (:: @ map (n.% size)))
               [subS subP] gen-case
               #let [dummyS (list;repeat (n.dec size) #ls;Unit)
                     caseS (#ls;Tuple (list;concat (list (list;take idx dummyS)
                                                         (list subS)
                                                         (list;drop idx dummyS))))
                     caseP (#ls;TupleP (if (tail? idx idx)
                                         (#;Right idx)
                                         (#;Left idx))
                                       subP)]]
              (wrap [caseS caseP]))
            (do r;Monad<Random>
              [size (|> r;nat (:: @ map (|>. (n.% struct-limit) (n.max +2))))
               idx (|> r;nat (:: @ map (n.% size)))
               [subS subP] gen-case
               #let [caseS (#ls;Variant idx (tail? idx idx) subS)
                     caseP (#ls;VariantP (if (tail? idx idx)
                                           (#;Right idx)
                                           (#;Left idx))
                                         subP)]]
              (wrap [caseS caseP]))
            ))))

(context: "Pattern-matching."
  [[valueS path] gen-case
   to-bind r;nat]
  ($_ seq
      (test "Can generate pattern-matching."
            (|> (do Monad<Lux>
                  [runtime-bytecode @runtime;generate
                   sampleI (@;generate valueS
                                       (#ls;AltP (#ls;SeqP path (#ls;ExecP (#ls;Bool true)))
                                                 (#ls;SeqP (#ls;BindP +0) (#ls;ExecP (#ls;Bool false)))))]
                  (@eval;eval sampleI))
                (macro;run (init-compiler []))
                (case> (#R;Success valueG)
                       (:! Bool valueG)

                       _
                       false)))
      (test "Can bind values."
            (|> (do Monad<Lux>
                  [runtime-bytecode @runtime;generate
                   sampleI (@;generate (#ls;Nat to-bind)
                                       (#ls;SeqP (#ls;BindP +1) (#ls;ExecP (#ls;Variable 1))))]
                  (@eval;eval sampleI))
                (macro;run (init-compiler []))
                (case> (#R;Success valueG)
                       (n.= to-bind (:! Nat valueG))

                       _
                       false)))))