(.with-expansions [<host-modules> (.as-is [runtime (#+)]
                                          [primitive (#+)]
                                          [structure (#+)]
                                          [reference (#+)]
                                          [case (#+)]
                                          [loop (#+)]
                                          [function (#+)]
                                          [extension (#+)
                                           [common (#+)]
                                           [host (#+)]])]
  (.module:
    [lux #*
     [cli (#+ program:)]
     ["." io (#+ io)]
     [control
      [monad (#+ do)]
      [predicate (#+ Predicate)]]
     [data
      [number
       ["." i64]]]
     ["." function]
     ["." math
      ["r" random (#+ Random) ("#/." functor)]]
     ["_" test (#+ Test)]
     ## These modules do not need to be tested.
     [type
      [variance (#+)]]
     [locale (#+)
      [language (#+)]
      [territory (#+)]]
     ## TODO: Test these modules
     [data
      [format
       [css (#+)]
       [markdown (#+)]]]
     [host
      [js (#+)]
      [scheme (#+)]]
     [tool
      [compiler
       [phase
        [generation
         [scheme (#+)
          <host-modules>]
         [js (#+)
          <host-modules>]]]]]
     ## [control
     ##  ["._" contract]
     ##  ["._" concatenative]
     ##  ["._" predicate]
     ##  [monad
     ##   ["._" free]]]
     ## [data
     ##  ["._" env]
     ##  ["._" trace]
     ##  ["._" store]
     ##  [format
     ##   ["._" context]
     ##   ["._" html]
     ##   ["._" css]
     ##   ["._" binary]]
     ##  [collection
     ##   [tree
     ##    [rose
     ##     ["._" parser]]]
     ##   [dictionary
     ##    ["._" plist]]
     ##   [set
     ##    ["._" multi]]]
     ##  [text
     ##   ["._" buffer]]]
     ## ["._" macro
     ##  [poly
     ##   ["._" json]]]
     ## [type
     ##  ["._" unit]
     ##  ["._" refinement]
     ##  ["._" quotient]]
     ## [world
     ##  ["._" environment]
     ##  ["._" console]]
     ## [compiler
     ##  ["._" cli]
     ##  ["._" default
     ##   ["._" evaluation]
     ##   [phase
     ##    ["._" generation
     ##     [scheme
     ##      ["._scheme" function]
     ##      ["._scheme" loop]
     ##      ["._scheme" case]
     ##      ["._scheme" extension]
     ##      ["._scheme" extension/common]
     ##      ["._scheme" expression]]]
     ##    [extension
     ##     ["._" statement]]]
     ##   ["._default" cache]]
     ##  [meta
     ##   ["._meta" io
     ##    ["._meta_io" context]
     ##    ["._meta_io" archive]]
     ##   ["._meta" archive]
     ##   ["._meta" cache]]]
     ## ["._" interpreter
     ##  ["._interpreter" type]]
     ]
    ## TODO: Must have 100% coverage on tests.
    [/
     ["/." cli]
     ["/." io]
     ["/." host
      ["/." jvm]]
     ["/." control]]
    ## [control
    ##  [concurrency
    ##   [promise (#+)]
    ##   [stm (#+)]
    ##   ## [semaphore (#+)]
    ##   ]]
    ## [data
    ##  [bit (#+)]
    ##  [color (#+)]
    ##  [error (#+)]
    ##  [name (#+)]
    ##  [identity (#+)]
    ##  [lazy (#+)]
    ##  [maybe (#+)]
    ##  [product (#+)]
    ##  [sum (#+)]
    ##  [number (#+) ## TODO: FIX Specially troublesome...
    ##   [i64 (#+)]
    ##   [ratio (#+)]
    ##   [complex (#+)]]
    ##  [text (#+)
    ##   ## [format (#+)]
    ##   [lexer (#+)]
    ##   [regex (#+)]]
    ##  [format
    ##   ## [json (#+)]
    ##   [xml (#+)]]
    ##  ## [collection
    ##  ##  [array (#+)]
    ##  ##  [bits (#+)]
    ##  ##  [list (#+)]
    ##  ##  [stack (#+)]
    ##  ##  [row (#+)]
    ##  ##  [sequence (#+)]
    ##  ##  [dictionary (#+)
    ##  ##   ["dictionary_." ordered]]
    ##  ##  [set (#+)
    ##  ##   ["set_." ordered]]
    ##  ##  [queue (#+)
    ##  ##   [priority (#+)]]
    ##  ##  [tree
    ##  ##   [rose (#+)
    ##  ##    [zipper (#+)]]]]
    ##  ]
    ## [math (#+)
    ##  [random (#+)]
    ##  [modular (#+)]
    ##  [logic
    ##   [continuous (#+)]
    ##   [fuzzy (#+)]]]
    ## [macro
    ##  [code (#+)]
    ##  [syntax (#+)]
    ##  [poly
    ##   ["poly_." equivalence]
    ##   ["poly_." functor]]]
    ## [type ## (#+)
    ##  ## [check (#+)]
    ##  ## [implicit (#+)] ## TODO: FIX Specially troublesome...
    ##  ## [resource (#+)]
    ##  [dynamic (#+)]]
    ## [time
    ##  [instant (#+)]
    ##  [duration (#+)]
    ##  [date (#+)]]
    ## [compiler
    ##  [default
    ##   ["_default/." syntax]
    ##   [phase
    ##    [analysis
    ##     ["_.A" primitive]
    ##     ["_.A" structure]
    ##     ["_.A" reference]
    ##     ["_.A" case]
    ##     ["_.A" function]
    ##     [procedure
    ##      ["_.A" common]]]
    ##    [synthesis
    ##     ["_.S" primitive]
    ##     ["_.S" structure]
    ##     ["_.S" case]
    ##     ["_.S" function]]]]]
    ## [world
    ##  [binary (#+)]
    ##  [file (#+)]
    ##  [net
    ##   [tcp (#+)]
    ##   [udp (#+)]]]
    ))

(def: identity
  Test
  (do r.monad
    [self (r.unicode 1)]
    ($_ _.and
        (_.test "Every value is identical to itself."
                (is? self self))
        (_.test "The identity function doesn't change values in any way."
                (is? self (function.identity self)))
        (do @
          [other (r.unicode 1)]
          (_.test "Values created separately can't be identical."
                  (not (is? self other))))
        )))

(def: increment-and-decrement
  Test
  (do r.monad
    [value r.i64]
    ($_ _.and
        (_.test "'inc' and 'dec' are opposites."
                (and (|> value inc dec (n/= value))
                     (|> value dec inc (n/= value))))
        (_.test "'inc' and 'dec' shift the number by 1."
                (and (|> (inc value) (n/- value) (n/= 1))
                     (|> value (n/- (dec value)) (n/= 1)))))))

(def: (check-neighbors has-property? value)
  (All [a] (-> (Predicate (I64 a)) (I64 a) Bit))
  (and (|> value inc has-property?)
       (|> value dec has-property?)))

(def: (even-or-odd rand-gen even? odd?)
  (All [a] (-> (Random (I64 a)) (Predicate (I64 a)) (Predicate (I64 a)) Test))
  (do r.monad
    [value rand-gen]
    ($_ _.and
        (_.test "Every number is either even or odd."
                (if (even? value)
                  (not (odd? value))
                  (odd? value)))
        (_.test "Every odd/even number is surrounded by two of the other kind."
                (if (even? value)
                  (check-neighbors odd? value)
                  (check-neighbors even? value))))))

(type: (Choice a)
  (-> a a a))

(type: (Order a)
  (-> a a Bit))

(type: (Equivalence a)
  (-> a a Bit))

(def: (choice rand-gen = [< choose])
  (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test))
  (do r.monad
    [left rand-gen
     right rand-gen
     #let [choice (choose left right)]]
    ($_ _.and
        (_.test "The choice between 2 values is one of them."
                (or (= left choice)
                    (= right choice)))
        (_.test "The choice between 2 values implies an order relationship between them."
                (if (= left choice)
                  (< right choice)
                  (< left choice))))))

(def: (minimum-and-maximum rand-gen = min' max')
  (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] [(Order a) (Choice a)] Test))
  ($_ _.and
      (<| (_.context "Minimum.")
          (choice rand-gen = min'))
      (<| (_.context "Maximum.")
          (choice rand-gen = max'))))

(def: (conversion rand-gen forward backward =)
  (All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test))
  (do r.monad
    [value rand-gen]
    (_.test "Can convert between types in a lossless way."
            (|> value forward backward (= value)))))

(def: frac-rev
  (r.Random Rev)
  (|> r.rev
      (:: r.functor map (|>> (i64.left-shift 11) (i64.logic-right-shift 11)))))

(def: prelude-macros
  Test
  ($_ _.and
      (do r.monad
        [factor (r/map (|>> (n/% 10) (n/max 1)) r.nat)
         iterations (r/map (n/% 100) r.nat)
         #let [expected (n/* factor iterations)]]
        (_.test "Can write loops."
                (n/= expected
                     (loop [counter 0
                            value 0]
                       (if (n/< iterations counter)
                         (recur (inc counter) (n/+ factor value))
                         value)))))

      (do r.monad
        [first r.nat
         second r.nat
         third r.nat]
        (_.test "Can create lists easily through macros."
                (and (case (list first second third)
                       (#.Cons first' (#.Cons second' (#.Cons third' #.Nil)))
                       (and (n/= first first')
                            (n/= second second')
                            (n/= third third'))

                       _
                       false)
                     (case (list& first (list second third))
                       (#.Cons first' (#.Cons second' (#.Cons third' #.Nil)))
                       (and (n/= first first')
                            (n/= second second')
                            (n/= third third'))

                       _
                       false)
                     (case (list& first second (list third))
                       (#.Cons first' (#.Cons second' (#.Cons third' #.Nil)))
                       (and (n/= first first')
                            (n/= second second')
                            (n/= third third'))

                       _
                       false))))
      ))

(template: (hypotenuse cat0 cat1)
  (n/+ (n/* cat0 cat0) (n/* cat1 cat1)))

(def: template
  Test
  (do r.monad
    [cat0 r.nat
     cat1 r.nat]
    (_.test "Template application is a stand-in for the templated code."
            (n/= (n/+ (n/* cat0 cat0) (n/* cat1 cat1))
                 (hypotenuse cat0 cat1)))))

(def: cross-platform-support
  Test
  (do r.monad
    [on-default r.nat
     on-fake-host r.nat
     on-valid-host r.nat]
    ($_ _.and
        (_.test "Can provide default in case there is no particular host/platform support."
                (n/= on-default
                     (for {"" on-fake-host}
                          on-default)))
        (_.test "Can pick code depending on the host/platform being targeted."
                (n/= on-valid-host
                     (for {"JVM" on-valid-host
                           "JS" on-valid-host}
                          on-default))))))

(def: test
  ($_ _.and
      (<| (_.context "Identity.")
          ..identity)
      (<| (_.context "Increment & decrement.")
          ..increment-and-decrement)
      (<| (_.context "Even or odd.")
          ($_ _.and
              (<| (_.context "Natural numbers.")
                  (..even-or-odd r.nat n/even? n/odd?))
              (<| (_.context "Integers.")
                  (..even-or-odd r.int i/even? i/odd?))))
      (<| (_.context "Minimum and maximum.")
          (`` ($_ _.and
                  (~~ (do-template [<=> <lt> <min> <gt> <max> <gen> <context>]
                        [(<| (_.context <context>)
                             (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))]

                        [i/= i/< i/min i/> i/max r.int "Integers."]
                        [n/= n/< n/min n/> n/max r.nat "Natural numbers."]
                        [r/= r/< r/min r/> r/max r.rev "Revolutions."]
                        [f/= f/< f/min f/> f/max r.frac "Fractions."]
                        )))))
      (<| (_.context "Conversion.")
          (`` ($_ _.and
                  (~~ (do-template [<context> <=> <forward> <backward> <gen>]
                        [(<| (_.context <context>)
                             (..conversion <gen> <forward> <backward> <=>))]

                        ["Int -> Nat"
                         i/= .nat        .int        (r/map (i/%  +1,000,000) r.int)]
                        ["Nat -> Int"
                         n/= .int        .nat        (r/map (n/% 1,000,000) r.nat)]
                        ["Int -> Frac"
                         i/= int-to-frac frac-to-int (r/map (i/%  +1,000,000) r.int)]
                        ["Frac -> Int"
                         f/= frac-to-int int-to-frac (r/map math.floor r.frac)]
                        ["Rev -> Frac"
                         r/= rev-to-frac frac-to-rev frac-rev]
                        )))))
      (<| (_.context "Prelude macros.")
          ..prelude-macros)
      (<| (_.context "Templates.")
          ..template)
      (<| (_.context "Cross-platform support.")
          ..cross-platform-support)
      (<| (_.context "/cli Command-Line Interface.")
          /cli.test)
      (<| (_.context "/io I/O (input/output)")
          /io.test)
      (<| (_.context "/host Host-platform interoperation")
          ($_ _.and
              /host.test
              (<| (_.context "/jvm JVM (Java Virtual Machine)")
                  /jvm.test)))
      (<| (_.context "/control")
          /control.test)
      ))

(program: args
  (io (_.run! (<| (_.times 100)
                  ..test))))