aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/debug.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/debug.lux254
1 files changed, 254 insertions, 0 deletions
diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux
new file mode 100644
index 000000000..508f9fd6d
--- /dev/null
+++ b/stdlib/source/test/lux/debug.lux
@@ -0,0 +1,254 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try ("#\." functor)]
+ ["." exception]]
+ [data
+ ["." text ("#\." equivalence)
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#\." functor)]]
+ [format
+ [json (#+ JSON)]
+ [xml (#+ XML)]]]
+ ["." macro
+ [syntax (#+ syntax:)]
+ ["." code]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ [ratio (#+ Ratio)]]]
+ [time (#+ Time)
+ [instant (#+ Instant)]
+ [date (#+ Date)]
+ [duration (#+ Duration)]
+ [month (#+ Month)]
+ [day (#+ Day)]]]
+ {1
+ ["." /]}
+ ["$." // #_
+ ["#." type]
+ [data
+ ["#." name]
+ [format
+ ["#." json]
+ ["#." xml]]]
+ [macro
+ ["#." code]]
+ [math
+ [number
+ ["#." ratio]]]
+ [meta
+ ["#." location]]])
+
+(def: can_represent_simple_types
+ (Random Bit)
+ (do random.monad
+ [sample_bit random.bit
+ sample_int random.int
+ sample_frac random.frac
+ sample_text (random.ascii/upper 10)
+ sample_nat random.nat
+ sample_rev random.rev]
+ (wrap (`` (and (~~ (template [<type> <format> <sample>]
+ [(|> (/.represent <type> <sample>)
+ (try\map (text\= (<format> <sample>)))
+ (try.default false))]
+
+ [Bit %.bit sample_bit]
+ [Nat %.nat sample_nat]
+ [Int %.int sample_int]
+ [Rev %.rev sample_rev]
+ [Frac %.frac sample_frac]
+ [Text %.text sample_text]))
+ )))))
+
+(def: can_represent_structure_types
+ (Random Bit)
+ (do random.monad
+ [sample_bit random.bit
+ sample_int random.int
+ sample_frac random.frac]
+ (wrap (`` (and (case (/.represent (type [Bit Int Frac])
+ [sample_bit sample_int sample_frac])
+ (#try.Success actual)
+ (text\= (format "[" (%.bit sample_bit)
+ " " (%.int sample_int)
+ " " (%.frac sample_frac)
+ "]")
+ actual)
+
+ (#try.Failure error)
+ false)
+ ## TODO: Uncomment after switching from the old (tag+last?) to the new (lefts+right?) representation for variants
+ ## (~~ (template [<lefts> <right?> <value> <format>]
+ ## [(|> (/.represent (type (| Bit Int Frac))
+ ## (: (| Bit Int Frac)
+ ## (<lefts> <right?> <value>)))
+ ## (try\map (text\= (format "(" (%.nat <lefts>)
+ ## " " (%.bit <right?>)
+ ## " " (<format> <value>) ")")))
+ ## (try.default false))]
+
+ ## [0 #0 sample_bit %.bit]
+ ## [1 #0 sample_int %.int]
+ ## [1 #1 sample_frac %.frac]
+ ## ))
+ )))))
+
+(def: can_represent_complex_types
+ (Random Bit)
+ (do random.monad
+ [sample_ratio $//ratio.random
+ sample_name ($//name.random 5 5)
+ sample_location $//location.random
+ sample_type $//type.random
+ sample_code $//code.random
+ sample_xml $//xml.random
+ sample_json $//json.random]
+ (wrap (`` (and (~~ (template [<type> <format> <sample>]
+ [(|> (/.represent <type> <sample>)
+ (try\map (text\= (<format> <sample>)))
+ (try.default false))]
+
+ [Ratio %.ratio sample_ratio]
+ [Name %.name sample_name]
+ [Location %.location sample_location]
+ [Code %.code sample_code]
+ [Type %.type sample_type]
+ [XML %.xml sample_xml]
+ [JSON %.json sample_json]))
+ )))))
+
+(def: can_represent_time_types
+ (Random Bit)
+ (do random.monad
+ [sample_instant random.instant
+ sample_duration random.duration
+ sample_date random.date
+ sample_month random.month
+ sample_time random.time
+ sample_day random.day]
+ (wrap (`` (and (~~ (template [<type> <format> <sample>]
+ [(|> (/.represent <type> <sample>)
+ (try\map (text\= (<format> <sample>)))
+ (try.default false))]
+
+ [Instant %.instant sample_instant]
+ [Duration %.duration sample_duration]
+ [Date %.date sample_date]
+ [Month %.month sample_month]
+ [Time %.time sample_time]
+ [Day %.day sample_day]))
+ )))))
+
+(def: representation
+ Test
+ (do random.monad
+ [sample_bit random.bit
+ sample_nat random.nat
+ sample_int random.int
+ sample_frac random.frac
+
+ can_represent_simple_types! ..can_represent_simple_types
+ can_represent_structure_types! ..can_represent_structure_types
+ can_represent_complex_types! ..can_represent_complex_types
+ can_represent_time_types! ..can_represent_time_types]
+ ($_ _.and
+ (_.cover [/.represent]
+ (`` (and can_represent_simple_types!
+ can_represent_structure_types!
+ can_represent_complex_types!
+ can_represent_time_types!
+
+ (|> (/.represent .Any sample_frac)
+ (try\map (text\= "[]"))
+ (try.default false))
+ (|> (/.represent (type (List Nat)) (: (List Nat) (list sample_nat)))
+ (try\map (text\= (%.list %.nat (list sample_nat))))
+ (try.default false))
+ (~~ (template [<sample>]
+ [(|> (/.represent (type (Maybe Nat)) (: (Maybe Nat) <sample>))
+ (try\map (text\= (%.maybe %.nat <sample>)))
+ (try.default false))]
+
+ [(#.Some sample_nat)]
+ [#.None]
+ ))
+ )))
+ (_.cover [/.cannot_represent_value]
+ (case (/.represent (-> Nat Nat) (|>>))
+ (#try.Success representation)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.cannot_represent_value error)))
+ )))
+
+(def: inspection
+ Test
+ (do random.monad
+ [sample_bit random.bit
+ sample_int random.int
+ sample_frac random.frac
+ sample_text (random.ascii/upper 10)]
+ (_.cover [/.inspect]
+ (`` (and (~~ (template [<format> <sample>]
+ [(text\= (<format> <sample>) (/.inspect <sample>))]
+
+ [%.bit sample_bit]
+ [%.int sample_int]
+ [%.frac sample_frac]
+ [%.text sample_text]
+ ))
+ (text\= (|> (list sample_bit sample_int sample_frac sample_text)
+ (: (List Any))
+ (list\map /.inspect)
+ (text.join_with " ")
+ (text.enclose ["[" "]"]))
+ (/.inspect [sample_bit sample_int sample_frac sample_text])))))))
+
+(syntax: (macro_error macro)
+ (function (_ compiler)
+ (case ((macro.expand macro) compiler)
+ (#try.Failure error)
+ (#try.Success [compiler (list (code.text error))])
+
+ (#try.Success _)
+ (#try.Failure "OOPS!"))))
+
+(type: My_Text
+ Text)
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ ($_ _.and
+ ..inspection
+ ..representation
+ (_.cover [/.:hole /.type_hole]
+ (let [error (: My_Text (..macro_error (/.:hole)))]
+ (and (exception.match? /.type_hole error)
+ (text.contains? (%.type My_Text) error))))
+ (do random.monad
+ [foo (random.ascii/upper 10)
+ bar random.nat
+ baz random.bit]
+ (_.cover [/.here]
+ (exec
+ (/.here)
+ (/.here foo
+ {bar %.nat})
+ true)))
+ (_.cover [/.unknown_local_binding]
+ (exception.match? /.unknown_local_binding
+ (..macro_error (/.here yolo))))
+ (_.cover [/.private]
+ (exec
+ (: (/.private /.Inspector)
+ /.inspect)
+ true))
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 09:16:49 +0000