Libify ocaml, add buttons to interaction.

7 files changed, 147 insertions, 68 deletions

diff --git a/discocaml/default.nix b/discocaml/default.nix
index 392c146..885a515 100644
--- a/discocaml/default.nix
+++ b/discocaml/default.nix
@@ -1,10 +1,11 @@
 { buildDunePackage, yojson, ocaml-compiler-libs, ppx_deriving
-, ppx_deriving_yojson, ppx_import, ppxlib }:
+, ppx_deriving_yojson, ppx_expect, ppxlib }:
 
 buildDunePackage {
   pname = "discocaml";
   version = "0.1.0";
   minimalOcamlVersion = "5.1";
   src = ./.;
-  buildInputs = [ ppx_deriving ppx_deriving_yojson ppx_import ppxlib yojson ];
+  buildInputs = [ ppx_deriving ppx_deriving_yojson ppx_expect ppxlib yojson ];
+  doCheck = true;
 }
diff --git a/discocaml/discocaml.ml b/discocaml/discocaml.ml
new file mode 100644
index 0000000..cd99c9a
--- /dev/null
+++ b/discocaml/discocaml.ml
@@ -0,0 +1,63 @@
+type command = [ `Roundtrip ]
+
+let command_of_yojson = function
+  | `String "Roundtrip" -> Ok `Roundtrip
+  | _ -> Error "invalid command"
+
+type request = { expr : string; command : command }
+[@@deriving of_yojson { exn = true }]
+
+type response_expr = { expr : string } [@@deriving to_yojson { exn = true }]
+
+type response = [ `Error of string | `Expr of response_expr ]
+[@@deriving to_yojson { exn = true }]
+
+let%expect_test _ =
+  Yojson.Safe.to_channel stdout (response_to_yojson (`Error "foo"));
+  [%expect {| ["Error","foo"] |}]
+
+let%expect_test _ =
+  Yojson.Safe.to_channel stdout (response_to_yojson (`Expr { expr = "foo" }));
+  [%expect {| ["Expr",{"expr":"foo"}] |}]
+(*
+type position = [%import: Lexing.position] [@@deriving show]
+
+type location = [%import: (Location.t[@with Lexing.position := position])]
+[@@deriving show]
+
+type constant = [%import: Parsetree.constant] [@@deriving show]
+type expression_desc = [%import: Parsetree.expression_desc] [@@deriving show]
+type expression = [%import: Parsetree.expression] [@@deriving show]
+
+type structure_item_desc = [%import: Parsetree.structure_item_desc]
+[@@deriving show]
+
+type structure_item = [%import: Parsetree.structure_item] [@@deriving show]
+type structure = [%import: Parsetree.structure] [@@deriving show]
+type toplevel_phrase = [%import: Parsetree.toplevel_phrase] [@@deriving show]
+
+let parse ~path (src : string) =
+  let buf = Lexing.from_string src in
+  buf.lex_start_p <- { buf.lex_start_p with pos_fname = path };
+  buf.lex_curr_p <- { buf.lex_curr_p with pos_fname = path };
+  Parse.expression buf
+
+let () =
+  parse ~path:"main.ml" " print_endline ((\"Hello, world!\") )"
+  |> Format.fprintf Format.std_formatter "\n%a\n" Pprintast.expression
+*)
+
+let handle_request { expr; command } : response =
+  try
+    let buf = Lexing.from_string expr in
+    let expr = Parse.expression buf in
+    match command with
+    | `Roundtrip ->
+        let buf = Buffer.create 16 in
+        (let fmt = Format.formatter_of_buffer buf in
+         Pprintast.expression fmt expr;
+         Format.pp_print_flush fmt ());
+        `Expr { expr = Buffer.contents buf }
+  with
+  | Failure msg -> `Error msg
+  | exn -> `Error ("uncaught exception: " ^ Printexc.to_string exn)
diff --git a/discocaml/dune b/discocaml/dune
index 695d78f..961fe70 100644
--- a/discocaml/dune
+++ b/discocaml/dune
@@ -1,9 +1,17 @@
+(library
+ (name discocaml)
+ (inline_tests)
+ (libraries compiler-libs.common yojson)
+ (modules discocaml)
+ (package discocaml)
+ (preprocess
+  (pps ppx_deriving.show ppx_deriving_yojson ppx_expect)))
+
 (executable
  (flags
   (:standard -cclib -static -cclib -lm))
- (libraries compiler-libs.common yojson)
+ (libraries discocaml yojson)
+ (modules main)
  (name main)
  (package discocaml)
- (preprocess
-  (staged_pps ppx_import ppx_deriving.show ppx_deriving_yojson))
  (public_name discocaml))
diff --git a/discocaml/main.ml b/discocaml/main.ml
index d9895f1..1f325e2 100644
--- a/discocaml/main.ml
+++ b/discocaml/main.ml
@@ -1,44 +1,4 @@
-type command = [ `Roundtrip ]
-
-let command_of_yojson = function
-  | `String "Roundtrip" -> Ok `Roundtrip
-  | _ -> Error "invalid command"
-
-type request = { expr : string; command : command }
-[@@deriving of_yojson { exn = true }]
-
-type response = [ `Error of string ] [@@deriving to_yojson { exn = true }]
-
-(*
-type position = [%import: Lexing.position] [@@deriving show]
-
-type location = [%import: (Location.t[@with Lexing.position := position])]
-[@@deriving show]
-
-type constant = [%import: Parsetree.constant] [@@deriving show]
-type expression_desc = [%import: Parsetree.expression_desc] [@@deriving show]
-type expression = [%import: Parsetree.expression] [@@deriving show]
-
-type structure_item_desc = [%import: Parsetree.structure_item_desc]
-[@@deriving show]
-
-type structure_item = [%import: Parsetree.structure_item] [@@deriving show]
-type structure = [%import: Parsetree.structure] [@@deriving show]
-type toplevel_phrase = [%import: Parsetree.toplevel_phrase] [@@deriving show]
-
-let parse ~path (src : string) =
-  let buf = Lexing.from_string src in
-  buf.lex_start_p <- { buf.lex_start_p with pos_fname = path };
-  buf.lex_curr_p <- { buf.lex_curr_p with pos_fname = path };
-  Parse.expression buf
-
-let () =
-  parse ~path:"main.ml" " print_endline ((\"Hello, world!\") )"
-  |> Format.fprintf Format.std_formatter "\n%a\n" Pprintast.expression
-*)
-
-let handle_request { expr; command } : response =
-  match command with `Roundtrip -> `Error ("TODO: " ^ expr)
+open Discocaml
 
 let () =
   Yojson.Safe.from_channel stdin
diff --git a/sandboxed-discocaml.sh b/sandboxed-discocaml.sh
index 04bd744..142097e 100755
--- a/sandboxed-discocaml.sh
+++ b/sandboxed-discocaml.sh
@@ -11,11 +11,11 @@ cleanup()
 trap cleanup EXIT
 
 rm "$tmp"
-nix build -o "$tmp" .#discocaml
+nix build -L -o "$tmp" .#discocaml
 bindir="$(realpath "$tmp")/bin"
 
 exec \
-timeout 10 \
-env -i \
-"$(which bwrap)" --unshare-all --ro-bind "$bindir" "/" \
-"/discocaml" "$@"
+	timeout 10 \
+	env -i \
+	"$(which bwrap)" --unshare-all --ro-bind "$bindir" "/" \
+	"/discocaml" "$@"
diff --git a/src/commands/discocaml.rs b/src/commands/discocaml.rs
index 93ddfaa..4aaa695 100644
--- a/src/commands/discocaml.rs
+++ b/src/commands/discocaml.rs
@@ -6,7 +6,7 @@ use serenity::{
         CommandDataOptionValue, CommandInteraction, CommandOptionType, CommandType, Member, RoleId,
     },
     builder::{
-        CreateCommand, CreateCommandOption, CreateInteractionResponse,
+        CreateButton, CreateCommand, CreateCommandOption, CreateInteractionResponse,
         CreateInteractionResponseMessage,
     },
     client::Context,
@@ -25,23 +25,53 @@ pub struct DiscocamlConfig {
     pub role: RoleId,
 }
 
-#[derive(Debug, Serialize)]
-struct DiscocamlRequest {
-    expr: String,
-    command: DiscocamlCommand,
+#[derive(Debug, PartialEq, Serialize)]
+pub struct DiscocamlRequest {
+    pub expr: String,
+    pub command: DiscocamlCommand,
 }
 
-#[derive(Debug, Serialize)]
-enum DiscocamlCommand {
+#[derive(Debug, PartialEq, Serialize)]
+pub enum DiscocamlCommand {
     Roundtrip,
 }
 
-#[derive(Debug, Deserialize)]
+/// A response outputted by the discocaml subprocess as a JSON string.
+///
+/// ```
+/// # use lambo::{commands::discocaml::*, utils::EnumAsArray};
+/// # use serde::Deserialize;
+/// # use serde_json::Deserializer;
+///
+/// let example = r#"
+/// [ "Expr"
+/// , { "expr": "1 + 2"
+///   }
+/// ]
+/// "#;
+/// let expected = DiscocamlResponse::Expr(DiscocamlResponseExpr {
+///     expr: "1 + 2".to_string(),
+/// });
+///
+/// let mut de = Deserializer::from_str(&example);
+/// let out = DiscocamlResponse::deserialize(EnumAsArray(&mut de)).unwrap();
+/// de.end().unwrap();
+///
+/// assert_eq!(out, expected);
+/// ```
+#[derive(Debug, Deserialize, PartialEq)]
 #[serde(deny_unknown_fields)]
-enum DiscocamlResponse {
+pub enum DiscocamlResponse {
+    Expr(DiscocamlResponseExpr),
     Error(String),
 }
 
+#[derive(Debug, Deserialize, PartialEq)]
+#[serde(deny_unknown_fields)]
+pub struct DiscocamlResponseExpr {
+    pub expr: String,
+}
+
 pub fn command() -> CreateCommand {
     CreateCommand::new("discocaml")
         .kind(CommandType::ChatInput)
@@ -82,10 +112,10 @@ async fn respond_with_error(ctx: &Context, command: &CommandInteraction, err: &E
     }
 }
 
-async fn run_discocaml(
+pub async fn run_discocaml(
     config: &DiscocamlConfig,
     req: &DiscocamlRequest,
-) -> Result<DiscocamlResponse> {
+) -> Result<DiscocamlResponseExpr> {
     let mut child = Command::new(&config.command[0])
         .args(&config.command)
         .stdin(Stdio::piped())
@@ -120,7 +150,22 @@ async fn run_discocaml(
         .context("failed to parse response from discocaml")?;
     de.end()
         .context("failed to parse response from discocaml")?;
-    Ok(out)
+
+    match out {
+        DiscocamlResponse::Expr(expr) => Ok(expr),
+        DiscocamlResponse::Error(err) => bail!("got an error from discocaml: {:?}", err),
+    }
+}
+
+fn make_response_message(expr: &DiscocamlResponseExpr) -> CreateInteractionResponseMessage {
+    // TODO: Real escaping
+    CreateInteractionResponseMessage::new()
+        .content(format!("```ocaml\n{}\n```", expr.expr))
+        .button(CreateButton::new("step-cbv").label("Step (CBV)"))
+        .button(CreateButton::new("step-cbn").label("Step (CBN)"))
+        .button(CreateButton::new("run-cbv").label("Run (CBV)"))
+        .button(CreateButton::new("run-cbn").label("Run (CBN)"))
+        .button(CreateButton::new("draw-tree").label("Draw Tree"))
 }
 
 pub async fn handle_command(
@@ -163,15 +208,17 @@ pub async fn handle_command(
     let res = match run_discocaml(config, &req).await {
         Ok(res) => res,
         Err(err) => {
-            let err = err.context("failed to run discocaml");
             respond_with_error(ctx, command, &err).await;
-            return Err(err);
+            return Err(err.context("failed to run discocaml"));
         }
     };
 
-    let msg = CreateInteractionResponseMessage::new().content(format!("`{:?}`", res));
+    // Respond with the expression and the buttons.
     command
-        .create_response(&ctx, CreateInteractionResponse::Message(msg))
+        .create_response(
+            &ctx,
+            CreateInteractionResponse::Message(make_response_message(&res)),
+        )
         .await
         .context("failed to respond")
 }
diff --git a/src/commands/mod.rs b/src/commands/mod.rs
index 083b200..899bb8f 100644
--- a/src/commands/mod.rs
+++ b/src/commands/mod.rs
@@ -1,4 +1,4 @@
-mod discocaml;
+pub mod discocaml;
 
 use crate::commands::discocaml::DiscocamlConfig;
 use anyhow::{Context as _, Result};