From 09ac7506ee000c437cd464254d2c8dbd0c1697b4 Mon Sep 17 00:00:00 2001
From: Nathan McCarty <thatonelutenist@stranger.systems>
Date: Tue, 31 Dec 2024 18:12:35 -0500
Subject: [PATCH] Implement support for IO Bool tests

---
 bin/iutils                  |  6 ++++--
 lib/IUtils.rakumod          | 13 ++++++++++++-
 lib/IUtils/Compiler.rakumod | 29 ++++++++++++++++++++++++-----
 lib/IUtils/Regexes.rakumod  | 12 +++++++++---
 4 files changed, 49 insertions(+), 11 deletions(-)

diff --git a/bin/iutils b/bin/iutils
index 31aa9fe..75ba450 100755
--- a/bin/iutils
+++ b/bin/iutils
@@ -43,10 +43,10 @@ multi MAIN(
                 for $module.tests -> $test {
                     try {
                         # FIXME this doesn't actually capture the exit code
-                        idris-exec $test.expr, $module.source.relative;
+                        idris-exec $test.expr, $module.source.relative, $test.output-type;
                     }
                     my $testf = colored $test.name, 'underline';
-                    if $! {
+                    if $! ~~ ExpressionError {
                         # TODO: Don't show stdout if its empty
                         $module-failures += 1;
                         say "{colored '+', 'red'} $testf: {colored 'FAIL', 'red bold'}"
@@ -55,6 +55,8 @@ multi MAIN(
                         say $!.err.lines.map(*.indent(8)).join("\n");
                         say (colored 'exit code', 'red').indent(6),
                             ": {$!.exit-code}";
+                    } elsif $! {
+                        die $!;
                     } else {
                         say "{colored '+', 'green'} $testf: {colored 'pass', 'green'}"
                         .indent(4);
diff --git a/lib/IUtils.rakumod b/lib/IUtils.rakumod
index 620c700..64f5464 100644
--- a/lib/IUtils.rakumod
+++ b/lib/IUtils.rakumod
@@ -4,6 +4,7 @@ unit module IUtils;
 need IUtils::IDEMode;
 
 use IUtils::Regexes;
+use IUtils::Compiler;
 
 use paths;
 
@@ -13,6 +14,8 @@ class Test {
     has Str:D $.name is required;
     #| The expression name of the test
     has Str:D $.expr is required;
+    #| The output type of the test
+    has ExprOutput:D $.output-type is required;
 }
 
 #| Structure representing the tests in a module
@@ -51,9 +54,17 @@ class PackageInfo {
                 my $module-name = $<name>.Str;
                 my @tests;
                 for $contents.match(&flagged-expression, :g) -> $match {
+                    my $output-type = do
+                        given $match<output-type> {
+                            when * eq '()' {succeed Unit};
+                            when * eq 'Bool' {succeed Boolean};
+                            when * eq 'Either' {succeed Either};
+                        };
+                    say $output-type;
                     my $test =
                         Test.new(name => $match<test-name>.Str,
-                                 expr => $match<expression-name>.Str);
+                                 expr => $match<expression-name>.Str,
+                                 output-type => $output-type);
                     @tests.push($test);
                 }
                 if @tests.elems > 0 {
diff --git a/lib/IUtils/Compiler.rakumod b/lib/IUtils/Compiler.rakumod
index a4cddad..544cc0a 100644
--- a/lib/IUtils/Compiler.rakumod
+++ b/lib/IUtils/Compiler.rakumod
@@ -1,6 +1,9 @@
 #| Utilities for interacting with the idris compiler and package manager
 unit module IUtils::Compiler;
 
+# Represents the output of an Expr that we need to run
+enum ExprOutput is export <Unit Boolean Either>;
+
 # Utility functions for pack
 
 #| Invoke a pack command
@@ -53,7 +56,7 @@ class IdrisError is Exception {
 }
 
 #| An error coming from a compiled expression
-class ExpressionError is Exception {
+class ExpressionError is Exception is export {
     has Str $.out;
     has Str $.err;
     has Int $.exit-code;
@@ -81,11 +84,27 @@ sub idris-run(*@cmd) is export {
     return $out;
 }
 
-# TODO: Special handling for IO Bool to make this eaiser
-#| Exec the expression with the given name in the given file
-sub idris-exec($expr, $file) is export {
+my constant $bool-lambda =
+    '(\x => if x then exitSuccess else exitFailure)';
+
+# TODO: Implemenent support for the Either case
+# TODO: Use the ide protocol to drive this so we can avoid the user needing to
+# import anything
+# Exec the expression with the given name in the given file
+sub idris-exec($expr, $file, $output-type? = Unit) is export {
     # Have idris compile an executable for the expression,
-    idris-run '--find-ipkg', '--client', ":c iutils_out $expr", $file;
+    given $output-type {
+        when Unit {
+            idris-run '--find-ipkg', '--client', ":c iutils_out $expr", $file;
+        }
+        when Boolean {
+            idris-run '--find-ipkg', '--client',
+                ":c iutils_out ($expr >>= $bool-lambda)", $file;
+        }
+        default {
+            die "Unsupported output type encountered: $_";
+        }
+    }
     # Run the expression
     my $proc = run 'build/exec/iutils_out', :out, :err;
     my $out = $proc.out.slurp(:close);
diff --git a/lib/IUtils/Regexes.rakumod b/lib/IUtils/Regexes.rakumod
index 2b9cc71..d9e2ee7 100644
--- a/lib/IUtils/Regexes.rakumod
+++ b/lib/IUtils/Regexes.rakumod
@@ -1,16 +1,22 @@
 unit module IUtils::Regexes;
 
-my token comment-start { \- \- }
 my token type {
     'test' | 'bench'
 }
+my token output-type {
+    '()' | 'Bool' | 'Either'
+}
+
+my token comment-start { \- \- }
 my token flag { \@ \@ <type> }
 my token name { <[\w \-]>+ }
 
+my token comment-line { <&comment-start> \V* \v }
+
 my regex flagged-expression is export {
     <&comment-start> \h* <flag> \h* <test-name=&name> \V* \v
-    [<&comment-start> \V* \v]*
-    <expression-name=&name> \h+ \: \V* \v
+    <comment-line>*
+    <expression-name=&name> \h+ \: \h+ 'IO' \h+ <output-type> \V* \v
 }
 
 my regex module-name is export {