aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--discocaml/default.nix5
-rw-r--r--discocaml/discocaml.ml63
-rw-r--r--discocaml/dune14
-rw-r--r--discocaml/main.ml42
-rwxr-xr-xsandboxed-discocaml.sh10
-rw-r--r--src/commands/discocaml.rs79
-rw-r--r--src/commands/mod.rs2
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};
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-28 18:21:44 +0000