feat: Reenable asak (using pin-depends for compat patch with OCaml 5)

ocaml-sf · Jul 25, 2024 · 50a979f · 50a979f
1 parent acbc895
commit 50a979f
Show file tree

Hide file tree

Showing 10 changed files with 96 additions and 87 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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)
+)