(.module:
  [lux (#- i64)
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]]
   [control
    [pipe (#+ case>)]
    ["." try (#+ Try)]]
   [data
    ["." bit ("#\." equivalence)]
    [number
     ["." i64]
     ["n" nat]
     ["i" int]
     ["f" frac]]
    ["." text ("#\." equivalence)
     ["%" format (#+ format)]]
    [collection
     ["." list]]]
   [math
    ["r" random (#+ Random)]]
   [tool
    [compiler
     ["." reference]
     ["." synthesis]]]]
  ["." // #_
   ["#." case]
   [//
    [common (#+ Runner)]]])

(def: sanitize
  (-> Text Text)
  (text.replace-all " " "_"))

(def: (bit run)
  (-> Runner Test)
  (do r.monad
    [param r.i64
     subject r.i64]
    (with-expansions [<binary> (template [<extension> <reference> <param-expr>]
                                 [(_.test <extension>
                                          (|> (#synthesis.Extension <extension> (list (synthesis.i64 param)
                                                                                      (synthesis.i64 subject)))
                                              (run (..sanitize <extension>))
                                              (case> (#try.Success valueT)
                                                     (n.= (<reference> param subject) (:as Nat valueT))

                                                     (#try.Failure _)
                                                     false)
                                              (let [param <param-expr>])))]

                                 ["lux i64 and"                 i64.and               param]
                                 ["lux i64 or"                  i64.or                param]
                                 ["lux i64 xor"                 i64.xor               param]
                                 ["lux i64 left-shift"          i64.left-shift        (n.% 64 param)]
                                 ["lux i64 logical-right-shift" i64.logic-right-shift (n.% 64 param)]
                                 )]
                     ($_ _.and
                         <binary>
                         (_.test "lux i64 arithmetic-right-shift"
                                 (|> (#synthesis.Extension "lux i64 arithmetic-right-shift"
                                                           (list (synthesis.i64 subject)
                                                                 (synthesis.i64 param)))
                                     (run (..sanitize "lux i64 arithmetic-right-shift"))
                                     (case> (#try.Success valueT)
                                            ("lux i64 ="
                                             (i64.arithmetic-right-shift param subject)
                                             (:as I64 valueT))

                                            (#try.Failure _)
                                            false)
                                     (let [param (n.% 64 param)])))
                         ))))

(def: (i64 run)
  (-> Runner Test)
  (do r.monad
    [param (|> r.i64 (r.filter (|>> ("lux i64 =" 0) not)))
     subject r.i64]
    (`` ($_ _.and
            (~~ (template [<extension> <type> <prepare> <comp> <subject-expr>]
                  [(_.test <extension>
                           (|> (#synthesis.Extension <extension> (list (synthesis.i64 subject)))
                               (run (..sanitize <extension>))
                               (case> (#try.Success valueT)
                                      (<comp> (<prepare> subject) (:as <type> valueT))

                                      (#try.Failure _)
                                      false)
                               (let [subject <subject-expr>])))]

                  ["lux i64 f64"  Frac i.frac f.= subject]
                  ["lux i64 char" Text (|>> (:as Nat) text.from-code) text\= (|> subject
                                                                                 (:as Nat)
                                                                                 (n.% (i64.left-shift 8 1))
                                                                                 (:as Int))]
                  ))
            (~~ (template [<extension> <reference> <outputT> <comp>]
                  [(_.test <extension>
                           (|> (#synthesis.Extension <extension> (list (synthesis.i64 param)
                                                                       (synthesis.i64 subject)))
                               (run (..sanitize <extension>))
                               (case> (#try.Success valueT)
                                      (<comp> (<reference> param subject) (:as <outputT> valueT))

                                      (#try.Failure _)
                                      false)))]

                  ["lux i64 +" i.+ Int  i.=]
                  ["lux i64 -" i.- Int  i.=]
                  ["lux i64 *" i.* Int  i.=]
                  ["lux i64 /" i./ Int  i.=]
                  ["lux i64 %" i.% Int  i.=]
                  ["lux i64 =" i.= Bit bit\=]
                  ["lux i64 <" i.< Bit bit\=]
                  ))
            ))))

(def: simple-frac
  (Random Frac)
  (|> r.nat (\ r.monad map (|>> (n.% 1000) .int i.frac))))

(def: (f64 run)
  (-> Runner Test)
  (do r.monad
    [param (|> ..simple-frac (r.filter (|>> (f.= +0.0) not)))
     subject ..simple-frac]
    (`` ($_ _.and
            (~~ (template [<extension> <reference> <comp>]
                  [(_.test <extension>
                           (|> (#synthesis.Extension <extension> (list (synthesis.f64 param)
                                                                       (synthesis.f64 subject)))
                               (run (..sanitize <extension>))
                               (//case.verify (<reference> param subject))))]

                  ["lux f64 +" f.+ f.=]
                  ["lux f64 -" f.- f.=]
                  ["lux f64 *" f.* f.=]
                  ["lux f64 /" f./ f.=]
                  ["lux f64 %" f.% f.=]
                  ))
            (~~ (template [<extension> <text>]
                  [(_.test <extension>
                           (|> (#synthesis.Extension <extension> (list (synthesis.f64 param)
                                                                       (synthesis.f64 subject)))
                               (run (..sanitize <extension>))
                               (case> (#try.Success valueV)
                                      (bit\= (<text> param subject)
                                             (:as Bit valueV))

                                      _
                                      false)))]

                  ["lux f64 =" f.=]
                  ["lux f64 <" f.<]
                  ))
            (~~ (template [<extension> <reference>]
                  [(_.test <extension>
                           (|> (#synthesis.Extension <extension> (list))
                               (run (..sanitize <extension>))
                               (//case.verify <reference>)))]

                  ["lux f64 min"      ("lux f64 min")]
                  ["lux f64 max"      ("lux f64 max")]
                  ["lux f64 smallest" ("lux f64 smallest")]
                  ))
            (_.test "'lux f64 i64 && 'lux i64 f64'"
                    (|> (run (..sanitize "lux f64 i64")
                             (|> subject synthesis.f64
                                 (list) (#synthesis.Extension "lux f64 i64")
                                 (list) (#synthesis.Extension "lux i64 f64")))
                        (//case.verify subject)))
            ))))

(def: (text run)
  (-> Runner Test)
  (do {! r.monad}
    [sample-size (|> r.nat (\ ! map (|>> (n.% 10) (n.max 1))))
     sample-lower (r.ascii/lower-alpha sample-size)
     sample-upper (r.ascii/upper-alpha sample-size)
     sample-alpha (|> (r.ascii/alpha sample-size)
                      (r.filter (|>> (text\= sample-upper) not)))
     char-idx (|> r.nat (\ ! map (n.% sample-size)))
     #let [sample-lowerS (synthesis.text sample-lower)
           sample-upperS (synthesis.text sample-upper)
           sample-alphaS (synthesis.text sample-alpha)
           concatenatedS (#synthesis.Extension "lux text concat" (list sample-lowerS sample-upperS))
           pre-rep-once (format sample-lower sample-upper)
           post-rep-once (format sample-lower sample-alpha)
           pre-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-upper))
           post-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-alpha))]]
    ($_ _.and
        (_.test "Can compare texts for equality."
                (and (|> (#synthesis.Extension "lux text =" (list sample-lowerS sample-lowerS))
                         (run (..sanitize "lux text ="))
                         (case> (#try.Success valueV)
                                (:as Bit valueV)

                                _
                                false))
                     (|> (#synthesis.Extension "lux text =" (list sample-upperS sample-lowerS))
                         (run (..sanitize "lux text ="))
                         (case> (#try.Success valueV)
                                (not (:as Bit valueV))

                                _
                                false))))
        (_.test "Can compare texts for order."
                (|> (#synthesis.Extension "lux text <" (list sample-lowerS sample-upperS))
                    (run (..sanitize "lux text <"))
                    (case> (#try.Success valueV)
                           (:as Bit valueV)

                           (#try.Failure _)
                           false)))
        (_.test "Can get length of text."
                (|> (#synthesis.Extension "lux text size" (list sample-lowerS))
                    (run (..sanitize "lux text size"))
                    (case> (#try.Success valueV)
                           (n.= sample-size (:as Nat valueV))

                           _
                           false)))
        (_.test "Can concatenate text."
                (|> (#synthesis.Extension "lux text size" (list concatenatedS))
                    (run (..sanitize "lux text size"))
                    (case> (#try.Success valueV)
                           (n.= (n.* 2 sample-size) (:as Nat valueV))

                           _
                           false)))
        (_.test "Can find index of sub-text."
                (and (|> (#synthesis.Extension "lux text index"
                                               (list concatenatedS sample-lowerS
                                                     (synthesis.i64 +0)))
                         (run (..sanitize "lux text index"))
                         (case> (^multi (#try.Success valueV)
                                        [(:as (Maybe Nat) valueV) (#.Some valueV)])
                                (n.= 0 valueV)

                                _
                                false))
                     (|> (#synthesis.Extension "lux text index"
                                               (list concatenatedS sample-upperS
                                                     (synthesis.i64 +0)))
                         (run (..sanitize "lux text index"))
                         (case> (^multi (#try.Success valueV)
                                        [(:as (Maybe Nat) valueV) (#.Some valueV)])
                                (n.= sample-size valueV)

                                _
                                false))))
        (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit)
                           (function (_ offset length expected)
                             (|> (#synthesis.Extension "lux text clip"
                                                       (list concatenatedS
                                                             (synthesis.i64 offset)
                                                             (synthesis.i64 length)))
                                 (run (..sanitize "lux text clip"))
                                 (case> (^multi (#try.Success valueV)
                                                [(:as (Maybe Text) valueV) (#.Some valueV)])
                                        (text\= expected valueV)

                                        _
                                        false))))]
          (_.test "Can clip text to extract sub-text."
                  (and (test-clip 0 sample-size sample-lower)
                       (test-clip sample-size sample-size sample-upper))))
        (_.test "Can extract individual characters from text."
                (|> (#synthesis.Extension "lux text char"
                                          (list sample-lowerS
                                                (synthesis.i64 char-idx)))
                    (run (..sanitize "lux text char"))
                    (case> (^multi (#try.Success valueV)
                                   [(:as (Maybe Int) valueV) (#.Some valueV)])
                           (text.contains? ("lux i64 char" valueV)
                                           sample-lower)

                           _
                           false)))
        )))

(def: (io run)
  (-> Runner Test)
  (do r.monad
    [message (r.ascii/alpha 5)]
    ($_ _.and
        (_.test "Can log messages."
                (|> (#synthesis.Extension "lux io log"
                                          (list (synthesis.text (format "LOG: " message))))
                    (run (..sanitize "lux io log"))
                    (case> (#try.Success valueV)
                           true

                           (#try.Failure _)
                           false)))
        (_.test "Can throw runtime errors."
                (and (|> (#synthesis.Extension "lux try"
                                               (list (synthesis.function/abstraction
                                                      {#synthesis.environment (list)
                                                       #synthesis.arity 1
                                                       #synthesis.body (#synthesis.Extension "lux io error"
                                                                                             (list (synthesis.text message)))})))
                         (run (..sanitize "lux try"))
                         (case> (^multi (#try.Success valueV)
                                        [(:as (Try Text) valueV) (#try.Failure error)])
                                (text.contains? message error)

                                _
                                false))
                     (|> (#synthesis.Extension "lux try"
                                               (list (synthesis.function/abstraction
                                                      {#synthesis.environment (list)
                                                       #synthesis.arity 1
                                                       #synthesis.body (synthesis.text message)})))
                         (run (..sanitize "lux try"))
                         (case> (^multi (#try.Success valueV)
                                        [(:as (Try Text) valueV) (#try.Success valueV)])
                                (text\= message valueV)

                                _
                                false))))
        (_.test "Can obtain current time in milli-seconds."
                (|> (synthesis.tuple (list (#synthesis.Extension "lux io current-time" (list))
                                           (#synthesis.Extension "lux io current-time" (list))))
                    (run (..sanitize "lux io current-time"))
                    (case> (#try.Success valueV)
                           (let [[pre post] (:as [Nat Nat] valueV)]
                             (n.>= pre post))

                           (#try.Failure _)
                           false)))
        )))

(def: #export (spec runner)
  (-> Runner Test)
  ($_ _.and
      (..bit runner)
      (..i64 runner)
      (..f64 runner)
      (..text runner)
      (..io runner)
      ))