diff options
Diffstat (limited to 'stdlib/source/test/lux/debug.lux')
-rw-r--r-- | stdlib/source/test/lux/debug.lux | 254 |
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)) + ))) |