From 50a979fbd5e40b4374a0fd3376c6e16b2949f628 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Thu, 25 Jul 2024 15:47:52 +0200 Subject: [PATCH] feat: Reenable asak (using pin-depends for compat patch with OCaml 5) --- learn-ocaml.opam | 5 ++ learn-ocaml.opam.locked | 4 ++ src/server/dune | 3 +- src/server/learnocaml_server.ml | 16 +++--- src/state/dune | 3 +- src/state/learnocaml_api.ml | 22 ++++----- src/state/learnocaml_api.mli | 4 +- src/state/learnocaml_data.ml | 86 ++++++++++++++++----------------- src/state/learnocaml_data.mli | 26 +++++----- src/utils/dune | 14 +++--- 10 files changed, 96 insertions(+), 87 deletions(-) diff --git a/learn-ocaml.opam b/learn-ocaml.opam index 10803b0c9..951a03daf 100644 --- a/learn-ocaml.opam +++ b/learn-ocaml.opam @@ -65,6 +65,7 @@ depends: [ "uutf" {>= "1.0" } "vg" "yojson" {>= "1.4.0" } + "asak" {= "0.5"} ] build: [ [make "static"] @@ -86,4 +87,8 @@ pin-depends: [ "ocp-indent-nlfork.1.5.5" "git+https://git@github.com/OCamlPro/ocp-indent.git#nlfork" ] + [ + "asak.0.5" + "git+https://github.com/AltGr/asak#ocaml5" + ] ] diff --git a/learn-ocaml.opam.locked b/learn-ocaml.opam.locked index d29fd40a1..f52cdefab 100644 --- a/learn-ocaml.opam.locked +++ b/learn-ocaml.opam.locked @@ -19,6 +19,7 @@ bug-reports: "https://github.com/ocaml-sf/learn-ocaml/issues" dev-repo: "git+https://github.com/ocaml-sf/learn-ocaml" depends: [ "angstrom" {= "0.15.0"} + "asak" {= "0.5"} "asn1-combinators" {= "0.2.6"} "astring" {= "0.8.5"} "base" {= "v0.16.3"} @@ -173,6 +174,9 @@ the common files. A demo exercise repository is also provided as example. run-test: [make "test"] depexts: ["lsof"] {os-distribution = "alpine"} pin-depends: [ + ["asak.0.5" "git+https://github.com/AltGr/asak#ocaml5"] + [ "ocp-indent-nlfork.1.5.5" "git+https://git@github.com/OCamlPro/ocp-indent.git#nlfork" ] +] diff --git a/src/server/dune b/src/server/dune index e45992e4c..2efd24516 100644 --- a/src/server/dune +++ b/src/server/dune @@ -16,6 +16,5 @@ learnocaml_data learnocaml_api learnocaml_store - ;; learnocaml_partition_create - ) + learnocaml_partition_create) ) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 049c3b7c3..364b5088a 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -496,14 +496,14 @@ module Request_handler = struct status >>= respond_json cache - (* | Api.Partition (token, eid, fid, prof) -> - * lwt_catch_fail (fun () -> - * verify_teacher_token token - * >?= fun () -> - * Learnocaml_partition_create.partition eid fid prof - * >>= respond_json cache - * ) - * (fun exn -> (`Not_found, Printexc.to_string exn)) *) + | Api.Partition (token, eid, fid, prof) -> + lwt_catch_fail (fun () -> + verify_teacher_token token + >?= fun () -> + Learnocaml_partition_create.partition eid fid prof + >>= respond_json cache + ) + (fun exn -> (`Not_found, Printexc.to_string exn)) | Api.Invalid_request body -> lwt_fail (`Bad_request, body) diff --git a/src/state/dune b/src/state/dune index cd00363b5..4f03db743 100644 --- a/src/state/dune +++ b/src/state/dune @@ -8,7 +8,8 @@ (name learnocaml_data) (wrapped false) (modules Learnocaml_data) - (libraries sha + (libraries asak + sha unix learnocaml_toplevel_history learnocaml_report diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 4c47e0481..655b7f0f9 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -145,8 +145,8 @@ type _ request = | Set_exercise_status: teacher token * (Exercise.Status.t * Exercise.Status.t) list -> unit request - (* | Partition: - * teacher token * Exercise.id * string * int -> Partition.t request *) + | Partition: + teacher token * Exercise.id * string * int -> Partition.t request | Invalid_request: string -> string request @@ -177,7 +177,7 @@ let supported_versions | Exercise_status_index _ | Exercise_status (_, _) | Set_exercise_status (_, _) - (* | Partition (_, _, _, _) *) + | Partition (_, _, _, _) | Invalid_request _ -> Compat.(Since (v "0.12")) let is_supported @@ -266,8 +266,8 @@ module Conversions (Json: JSON_CODEC) = struct | Set_exercise_status _ -> json J.unit - (* | Partition _ -> - * json Partition.enc *) + | Partition _ -> + json Partition.enc | Invalid_request _ -> str @@ -372,9 +372,9 @@ module Conversions (Json: JSON_CODEC) = struct (J.list (J.tup2 Exercise.Status.enc Exercise.Status.enc)) status) - (* | Partition (token, eid, fid, prof) -> - * get ~token - * ["partition"; eid; fid; string_of_int prof] *) + | Partition (token, eid, fid, prof) -> + get ~token + ["partition"; eid; fid; string_of_int prof] | Invalid_request s -> failwith ("Error request "^s) @@ -504,9 +504,9 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct | `GET, ["playgrounds"; f], _ when Filename.check_suffix f ".json" -> Playground (Filename.chop_suffix f ".json") |> k - (* | `GET, ["partition"; eid; fid; prof], Some token - * when Token.is_teacher token -> - * Partition (token, eid, fid, int_of_string prof) |> k *) + | `GET, ["partition"; eid; fid; prof], Some token + when Token.is_teacher token -> + Partition (token, eid, fid, int_of_string prof) |> k | `GET, ["teacher"; "exercise-status.json"], Some token when Token.is_teacher token -> diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 532ea7f54..984a3277a 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -137,8 +137,8 @@ type _ request = (** The two Status.t correspond to the states before and after changes, used for three-way merge *) - (* | Partition: - * teacher token * Exercise.id * string * int -> Partition.t request *) + | Partition: + teacher token * Exercise.id * string * int -> Partition.t request | Invalid_request: string -> string request diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index 38752b6ce..211ee9928 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -1403,49 +1403,49 @@ module Tutorial = struct end end -(* module Partition = struct - * type t = - * { - * not_graded : Token.t list; - * bad_type : Token.t list; - * partition_by_grade : - * (int * - * (((Token.t * string) list) Asak.Wtree.wtree list)) - * list; - * } - * - * let token_list = J.list Token.enc - * - * let tree_enc leaf_enc = - * let open Asak.Wtree in - * J.mu "tree" @@ fun self -> - * J.union - * [ J.case (J.obj1 (J.req "leaf" leaf_enc)) - * (function Leaf x -> Some x | Node _ -> None) - * (fun x -> Leaf x) ; - * J.case (J.obj3 (J.req "coef" J.int) (J.req "left" self) (J.req "right" self)) - * (function Node (t,l,r) -> Some (t,l,r) | Leaf _ -> None) - * (fun (t,l,r) -> Node (t,l,r)) ] - * - * let leaf_enc = - * J.list (J.tup2 Token.enc J.string) - * - * let innerlist = J.list (tree_enc leaf_enc) - * - * let int_assoc = - * J.tup2 J.int innerlist - * - * let enc = - * J.conv - * (fun t -> - * (t.not_graded, t.bad_type, t.partition_by_grade)) - * (fun (not_graded, bad_type, partition_by_grade) -> - * {not_graded; bad_type; partition_by_grade}) @@ - * J.obj3 - * J.(req "not_graded" token_list) - * J.(req "bad_type" token_list) - * J.(req "patition_by_grade" (J.list int_assoc)) - * end *) +module Partition = struct + type t = + { + not_graded : Token.t list; + bad_type : Token.t list; + partition_by_grade : + (int * + (((Token.t * string) list) Asak.Wtree.wtree list)) + list; + } + + let token_list = J.list Token.enc + + let tree_enc leaf_enc = + let open Asak.Wtree in + J.mu "tree" @@ fun self -> + J.union + [ J.case (J.obj1 (J.req "leaf" leaf_enc)) + (function Leaf x -> Some x | Node _ -> None) + (fun x -> Leaf x) ; + J.case (J.obj3 (J.req "coef" J.int) (J.req "left" self) (J.req "right" self)) + (function Node (t,l,r) -> Some (t,l,r) | Leaf _ -> None) + (fun (t,l,r) -> Node (t,l,r)) ] + + let leaf_enc = + J.list (J.tup2 Token.enc J.string) + + let innerlist = J.list (tree_enc leaf_enc) + + let int_assoc = + J.tup2 J.int innerlist + + let enc = + J.conv + (fun t -> + (t.not_graded, t.bad_type, t.partition_by_grade)) + (fun (not_graded, bad_type, partition_by_grade) -> + {not_graded; bad_type; partition_by_grade}) @@ + J.obj3 + J.(req "not_graded" token_list) + J.(req "bad_type" token_list) + J.(req "patition_by_grade" (J.list int_assoc)) +end module Playground = struct type id = string diff --git a/src/state/learnocaml_data.mli b/src/state/learnocaml_data.mli index 757147395..2af6ed0a3 100644 --- a/src/state/learnocaml_data.mli +++ b/src/state/learnocaml_data.mli @@ -453,19 +453,19 @@ module Tutorial: sig end -(* module Partition : sig - * type t = - * { - * not_graded : Token.t list; - * bad_type : Token.t list; - * partition_by_grade : - * (int * - * (((Token.t * string) list) Asak.Wtree.wtree list)) - * list; - * } - * - * val enc: t Json_encoding.encoding - * end *) +module Partition : sig + type t = + { + not_graded : Token.t list; + bad_type : Token.t list; + partition_by_grade : + (int * + (((Token.t * string) list) Asak.Wtree.wtree list)) + list; + } + + val enc: t Json_encoding.encoding +end module Playground : sig type id = string diff --git a/src/utils/dune b/src/utils/dune index d245e1f1e..6d170487c 100644 --- a/src/utils/dune +++ b/src/utils/dune @@ -41,10 +41,10 @@ (modules sha) ) -;; (library -;; (name learnocaml_partition_create) -;; (wrapped false) -;; (flags :standard -warn-error A-4-42-44-45-48) -;; (libraries lwt learnocaml_store learnocaml_data) -;; (modules learnocaml_partition_create) -;; ) +(library + (name learnocaml_partition_create) + (wrapped false) + (flags :standard -warn-error A-4-42-44-45-48) + (libraries asak lwt learnocaml_store learnocaml_data) + (modules learnocaml_partition_create) +)