(.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: safe
  (-> 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 (..safe <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 (..safe "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.only (|>> ("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 (..safe <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 (..safe <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.only (|>> (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 (..safe <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 (..safe <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 (..safe <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 (..safe "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.only (|>> (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 (..safe "lux text ="))
                         (case> (#try.Success valueV)
                                (:as Bit valueV)

                                _
                                false))
                     (|> (#synthesis.Extension "lux text =" (list sample_upperS sample_lowerS))
                         (run (..safe "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 (..safe "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 (..safe "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 (..safe "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 (..safe "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 (..safe "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 (..safe "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 (..safe "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 (..safe "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 (..safe "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 (..safe "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 (..safe "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)
      ))