Made sure the "phase" parameter of extensions is always usable (even across language boundaries)

2 files changed, 230 insertions, 75 deletions

diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 8ff1cdc00..e20189fa3 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -10,18 +10,24 @@
     ["." php]
     ["." scheme]]
    [abstract
-    [monad (#+ do)]]
+    ["." monad (#+ do)]]
    [control
     ["." try]
     ["<>" parser
-     ["<c>" code]
-     ["<a>" analysis]
-     ["<s>" synthesis]]]
+     ["<.>" code]
+     ["<.>" analysis]
+     ["<.>" synthesis]]]
    [data
+    ["." product]
     ["." text ("#\." equivalence)
      ["%" format (#+ format)]]
     [collection
-     ["." row]]]
+     ["." row]
+     ["." list ("#\." functor)]]]
+   [math
+    ["." random]
+    [number
+     ["n" nat]]]
    [tool
     [compiler
      ["." phase]
@@ -40,81 +46,96 @@
 (def: my_analysis "my analysis")
 (def: my_synthesis "my synthesis")
 (def: my_generation "my generation")
+(def: dummy_generation "dummy generation")
 (def: my_directive "my directive")
 
 ## Generation
 (for {@.old
       (as_is)}
      
-     (as_is (analysis: (..my_generation self phase archive {parameters (<>.some <c>.any)})
-              (do phase.monad
-                [_ (type.infer .Text)]
-                (wrap (#analysis.Extension self (list)))))
+     (as_is
+      ## Analysis
+      (analysis: (..my_analysis self phase archive {pass_through <code>.any})
+        (phase archive pass_through))
 
-            (synthesis: (..my_generation self phase archive {parameters (<>.some <a>.any)})
-              (do phase.monad
-                []
-                (wrap (#synthesis.Extension self (list)))))
-            ))
+      ## Synthesis
+      (analysis: (..my_synthesis self phase archive {parameters (<>.some <code>.any)})
+        (let [! phase.monad]
+          (|> parameters
+              (monad.map ! (phase archive))
+              (\ ! map (|>> (#analysis.Extension self))))))
 
-(for {@.old
-      (as_is)}
-     
-     (generation: (..my_generation self phase archive {parameters (<>.some <s>.any)})
-       (do phase.monad
-         []
-         (wrap (for {@.jvm
-                     (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self))))
+      (synthesis: (..my_synthesis self phase archive {pass_through <analysis>.any})
+        (phase archive pass_through))
 
-                     @.js (js.string self)
-                     @.python (python.unicode self)
-                     @.lua (lua.string self)
-                     @.ruby (ruby.string self)
-                     @.php (php.string self)
-                     @.scheme (scheme.string self)})))))
+      ## Generation
+      (analysis: (..my_generation self phase archive {parameters (<>.some <code>.any)})
+        (let [! phase.monad]
+          (|> parameters
+              (monad.map ! (phase archive))
+              (\ ! map (|>> (#analysis.Extension self))))))
 
-(for {@.old
-      (as_is)}
-     
-     (as_is (analysis: (..my_analysis self phase archive {parameters (<>.some <c>.any)})
-              (do phase.monad
-                [_ (type.infer .Text)]
-                (wrap (#analysis.Primitive (#analysis.Text self)))))
+      (synthesis: (..my_generation self phase archive {parameters (<>.some <analysis>.any)})
+        (let [! phase.monad]
+          (|> parameters
+              (monad.map ! (phase archive))
+              (\ ! map (|>> (#synthesis.Extension self))))))
+
+      (generation: (..my_generation self phase archive {pass_through <synthesis>.any})
+        (for {@.jvm
+              (\ phase.monad map (|>> #jvm.Embedded row.row)
+                 (phase archive pass_through))}
+             (phase archive pass_through)))
+
+      (analysis: (..dummy_generation self phase archive)
+        (\ phase.monad wrap (#analysis.Extension self (list))))
+
+      (synthesis: (..dummy_generation self phase archive)
+        (\ phase.monad wrap (#synthesis.Extension self (list))))
+
+      (generation: (..dummy_generation self phase archive)
+        (\ phase.monad wrap
+           (for {@.jvm
+                 (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self))))
 
-            ## Synthesis
-            (analysis: (..my_synthesis self phase archive {parameters (<>.some <c>.any)})
-              (do phase.monad
-                [_ (type.infer .Text)]
-                (wrap (#analysis.Extension self (list)))))
+                 @.js (js.string self)
+                 @.python (python.unicode self)
+                 @.lua (lua.string self)
+                 @.ruby (ruby.string self)
+                 @.php (php.string self)
+                 @.scheme (scheme.string self)})))
 
-            (synthesis: (..my_synthesis self phase archive {parameters (<>.some <a>.any)})
-              (do phase.monad
-                []
-                (wrap (synthesis.text self))))
-            
-            ## Directive
-            (directive: (..my_directive self phase archive {parameters (<>.some <c>.any)})
-              (do phase.monad
-                [#let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]]
-                (wrap directive.no_requirements)))
+      ## Directive
+      (directive: (..my_directive self phase archive {parameters (<>.some <code>.any)})
+        (do phase.monad
+          [#let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]]
+          (wrap directive.no_requirements)))
 
-            (`` ((~~ (static ..my_directive))))
-            ))
+      (`` ((~~ (static ..my_directive))))
+      ))
 
 (def: #export test
   Test
   (<| (_.covering /._)
-      (`` ($_ _.and
-              (~~ (template [<macro> <extension>]
-                    [(_.cover [<macro>]
-                              (for {@.old
-                                    false}
-                                   (text\= (`` ((~~ (static <extension>))))
-                                           <extension>)))]
+      (do random.monad
+        [expected random.nat]
+        (`` ($_ _.and
+                (~~ (template [<macro> <extension>]
+                      [(_.cover [<macro>]
+                                (for {@.old
+                                      false}
+                                     (n.= expected
+                                          (`` ((~~ (static <extension>)) expected)))))]
 
-                    [/.analysis: ..my_analysis]
-                    [/.synthesis: ..my_synthesis]
-                    [/.generation: ..my_generation]))
-              (_.cover [/.directive:]
-                       true)
-              ))))
+                      [/.analysis: ..my_analysis]
+                      [/.synthesis: ..my_synthesis]))
+                (_.cover [/.generation:]
+                         (for {@.old
+                               false}
+                              (and (n.= expected
+                                        (`` ((~~ (static ..my_generation)) expected)))
+                                   (text\= ..dummy_generation
+                                           (`` ((~~ (static ..dummy_generation))))))))
+                (_.cover [/.directive:]
+                         true)
+                )))))
diff --git a/stdlib/source/test/lux/time.lux b/stdlib/source/test/lux/time.lux
index cc18c20e0..b22823626 100644
--- a/stdlib/source/test/lux/time.lux
+++ b/stdlib/source/test/lux/time.lux
@@ -1,21 +1,155 @@
 (.module:
   [lux #*
-   ["_" test (#+ Test)]]
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]
+      ["$." order]
+      ["$." enum]
+      ["$." codec]]}]
+   [control
+    [pipe (#+ case>)]
+    ["." try ("#\." functor)]
+    ["." exception]
+    [parser
+     ["<.>" text]]]
+   [data
+    ["." text
+     ["%" format (#+ format)]]]
+   [math
+    ["." random]
+    [number
+     ["n" nat]]]]
   ["." / #_
    ["#." date]
    ["#." day]
    ["#." duration]
    ["#." instant]
    ["#." month]
-   ["#." year]])
+   ["#." year]]
+  {1
+   ["." /
+    ["." duration]]})
 
-(def: #export test
+(def: for_implementation
   Test
   ($_ _.and
-      /date.test
-      /day.test
-      /duration.test
-      /instant.test
-      /month.test
-      /year.test
-      ))
+      (_.for [/.equivalence]
+             ($equivalence.spec /.equivalence random.time))
+      (_.for [/.order]
+             ($order.spec /.order random.time))
+      (_.for [/.enum]
+             ($enum.spec /.enum random.time))
+      (_.for [/.codec]
+             ($codec.spec /.equivalence /.codec random.time))))
+
+(def: for_clock
+  Test
+  (do {! random.monad}
+    [expected random.time]
+    (_.cover [/.clock /.time]
+             (|> expected
+                 /.clock
+                 /.time
+                 (try\map (\ /.equivalence = expected))
+                 (try.default false)))))
+
+(def: for_ranges
+  Test
+  (do {! random.monad}
+    [valid_hour (\ ! map (|>> (n.% /.hours) (n.max 10)) random.nat)
+     valid_minute (\ ! map (|>> (n.% /.minutes) (n.max 10)) random.nat)
+     valid_second (\ ! map (|>> (n.% /.seconds) (n.max 10)) random.nat)
+     valid_milli_second (\ ! map (n.% /.milli_seconds) random.nat)
+
+     #let [invalid_hour (|> valid_hour (n.+ /.hours))
+           invalid_minute (|> valid_minute (n.+ /.minutes) (n.min 99))
+           invalid_second (|> valid_second (n.+ /.seconds) (n.min 99))]]
+    (`` ($_ _.and
+            (~~ (template [<cap> <exception> <prefix> <suffix> <valid> <invalid>]
+                  [(_.cover [<cap> <exception>]
+                            (let [valid!
+                                  (|> <valid>
+                                      %.nat
+                                      (text.prefix <prefix>)
+                                      (text.suffix <suffix>)
+                                      (\ /.codec decode)
+                                      (case> (#try.Success _) true
+                                             (#try.Failure error) false))
+                                  
+                                  invalid!
+                                  (|> <invalid>
+                                      %.nat
+                                      (text.prefix <prefix>)
+                                      (text.suffix <suffix>)
+                                      (\ /.codec decode)
+                                      (case> (#try.Success _)
+                                             false
+                                             
+                                             (#try.Failure error)
+                                             (exception.match? <exception> error)))]
+                              (and valid!
+                                   invalid!)))]
+
+                  [/.hours /.invalid_hour "" ":00:00.000" valid_hour invalid_hour]
+                  [/.minutes /.invalid_minute "00:" ":00.000" valid_minute invalid_minute]
+                  [/.seconds /.invalid_second "00:00:" ".000" valid_second invalid_second]
+                  ))
+            (_.cover [/.milli_seconds]
+                     (|> valid_milli_second
+                         %.nat
+                         (format "00:00:00.")
+                         (\ /.codec decode)
+                         (case> (#try.Success _) true
+                                (#try.Failure error) false)))
+            ))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Time])
+      (do {! random.monad}
+        [#let [day (.nat (duration.to_millis duration.day))]
+         expected random.time
+
+         out_of_bounds (\ ! map (|>> /.to_millis (n.+ day))
+                          random.time)]
+        (`` ($_ _.and
+                ..for_implementation
+
+                (_.cover [/.to_millis /.from_millis]
+                         (|> expected
+                             /.to_millis
+                             /.from_millis
+                             (try\map (\ /.equivalence = expected))
+                             (try.default false)))
+                (_.cover [/.time_exceeds_a_day]
+                         (case (/.from_millis out_of_bounds)
+                           (#try.Success _)
+                           false
+                           
+                           (#try.Failure error)
+                           (exception.match? /.time_exceeds_a_day error)))
+                (_.cover [/.midnight]
+                         (|> /.midnight
+                             /.to_millis
+                             (n.= 0)))
+                (_.cover [/.parser]
+                         (|> expected
+                             (\ /.codec encode)
+                             (<text>.run /.parser)
+                             (try\map (\ /.equivalence = expected))
+                             (try.default false)))
+                ..for_ranges
+                (_.for [/.Clock]
+                       ..for_clock)
+
+                /date.test
+                /day.test
+                /duration.test
+                /instant.test
+                /month.test
+                /year.test
+                )))))