path: root/stdlib/source/test/lux.lux

(.with-expansions [<host-modules> (.as-is [runtime (#+)]
                                          [primitive (#+)]
                                          [structure (#+)]
                                          [reference (#+)]
                                          [case (#+)]
                                          [function (#+)]
                                          [loop (#+)]
                                          [extension (#+)
                                           [common (#+)]
                                           [host (#+)]])]
  (.module:
    ["/" lux #*
     [abstract
      [monad (#+ do)]
      [predicate (#+ Predicate)]]
     [control
      [cli (#+ program:)]
      ["." io (#+ io)]
      ["." function]]
     [data
      [number
       ["." i64]]]
     ["." math]
     ["_" test (#+ Test)]
     ## These modules do not need to be tested.
     [type
      [variance (#+)]]
     [locale (#+)
      [language (#+)]
      [territory (#+)]]
     data/text/format
     ["r" math/random (#+ Random) ("#@." functor)]
     ## TODO: Test these modules
     [data
      [format
       [css (#+)]
       [markdown (#+)]]]
     [host
      [js (#+)]
      [python (#+)]
      [ruby (#+)]
      [scheme (#+)]]
     [tool
      [compiler
       [phase
        [generation
         [js (#+)
          <host-modules>]
         [python (#+)
          <host-modules>]
         [ruby (#+)
          <host-modules>]
         [scheme (#+)
          <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.
    ["." / #_
     ["#." abstract]
     ["#." control]
     ["#." data]
     ["#." macro]
     ["#." math]
     ["#." time]
     ["#." type]
     ["#." world]
     ["#." host
      ["#/." jvm]]]
    ## [control
    ##  [concurrency
    ##   ## [semaphore (#+)]
    ##   ]]
    ## [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]]]]]
    ))

(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)
  (let [bits-to-ignore 11]
    (:: r.functor map (i64.left-shift bits-to-ignore) r.rev)))

(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: (quadrance cat0 cat1)
  (n/+ (n/* cat0 cat0) (n/* cat1 cat1)))

(def: templates
  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))
                 (quadrance 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
  (<| (_.context (%name (name-of /._)))
      ($_ _.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
                      (~~ (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
                      (~~ (template [<=> <forward> <backward> <gen>]
                            [(<| (_.context (format (%name (name-of <forward>))
                                                    " " (%name (name-of <backward>))))
                                 (..conversion <gen> <forward> <backward> <=>))]

                            [i/= .nat         .int         (r@map (i/% +1,000,000) r.int)]
                            [n/= .int         .nat         (r@map (n/%  1,000,000) r.nat)]
                            [i/= .int-to-frac .frac-to-int (r@map (i/% +1,000,000) r.int)]
                            [f/= .frac-to-int .int-to-frac (r@map (|>> (i/% +1,000,000) .int-to-frac) r.int)]
                            [r/= .rev-to-frac .frac-to-rev frac-rev]
                            )))))
          (<| (_.context "Prelude macros.")
              ..prelude-macros)
          (<| (_.context "Templates.")
              ..templates)
          (<| (_.context "Cross-platform support.")
              ..cross-platform-support)
          (<| (_.context "/abstract")
              /abstract.test)
          (<| (_.context "/control")
              /control.test)
          (<| (_.context "/data")
              /data.test)
          /macro.test
          /math.test
          (<| (_.context "/time")
              /time.test)
          /type.test
          /world.test
          (<| (_.context "/host")
              ($_ _.and
                  /host.test
                  (<| (_.context "/jvm")
                      /host/jvm.test)))
          )))

(program: args
  (<| io
      _.run!
      (_.times 100)
      ## (_.seed 16966479879996440699)
      ## (_.seed 16140950815046933697)
      ## (_.seed 8804587020128699091)
      ..test))