rm scfg wip

.ocamlformat

@@ -1,4 +1,4 @@
-version=0.27.0
+version=0.28.1
 assignment-operator=end-line
 break-cases=fit
 break-fun-decl=wrap

geochan.opam

@@ -1,53 +1,44 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-synopsis: "A geo-imageboard written in OCaml"
+synopsis: "OCaml library/executable to TODO"
-description:
+description: "geochan is an OCaml library/executable to TODO."
-  "Geochan is an open source imageboard with threads pinned to a geolocation."
+authors: ["swrup <swrup@protonmail.com>"]
-maintainer: ["swrup <swrup@protonmail.com>" "Léo Andrès <contact@ndrs.fr>"]
-authors: ["swrup <swrup@protonmail.com>" "Léo Andrès <contact@ndrs.fr>"]
 license: "AGPL-3.0-or-later"
 tags: [
-  "imageboard"
+  "permap" "forum" "map" "local-knownledge" "ecology" "permaculture" "plant"
-  "forum"
-  "map"
-  "leaflet"
-  "single-page-application"
-  "functional-reactive-programming"
 ]
-homepage: "https://git.zapashcanon.fr/zapashcanon/geochan"
-doc: "https://doc.zapashcanon.fr/geochan"
-bug-reports: "https://git.zapashcanon.fr/zapashcanon/geochan/issues"
 depends: [
-  "dune" {>= "3.0"}
+  "dune" {>= "2.8"}
-  "bos"
+  "dream"
+  "lwt"
+  "yojson"
   "brr"
+  "leaflet"
+  "js_of_ocaml"
+  "uuidm"
+  "scfg"
+  "crunch"
+  "safepass"
+  "omd"
+  "lambdasoup"
+  "bos"
   "caqti"
   "caqti-driver-sqlite3"
   "conan"
   "conan-database"
-  "crunch"
-  "data-encoding"
-  "digestif"
   "directories"
   "dream"
   "dream-pure"
   "emile"
-  "fmt"
   "fpath"
-  "htmlit"
+  "lambdasoup"
-  "js_of_ocaml"
+  "omd"
-  "leaflet"
-  "lwt"
-  "note"
   "safepass"
   "scfg"
   "uri"
   "uuidm"
-  "alcotest" {with-test}
+  "yojson"
-  "re" {with-test}
+  "ocaml" {>= "4.08"}
-  "ocamlformat" {with-dev-setup}
-  "prelude"
-  "ocaml" {>= "5.1"}
   "odoc" {with-doc}
 ]
 build: [
@@ -64,4 +55,3 @@ build: [
     "@doc" {with-doc}
   ]
 ]
-dev-repo: "git+https://git.zapashcanon.fr/zapashcanon/geochan.git"

src/client/db.ml

@@ -123,7 +123,6 @@ let add_user_404 id =
     | _ -> session
   in
   update_session session;
-  begin
+  begin match find_user id with Some _ -> update_user None | None -> ()
-    match find_user id with Some _ -> update_user None | None -> ()
   end;
   ()

src/client/html_form.ml

@@ -148,9 +148,7 @@ let mk_comment_div t_s =
       t_s
     |> S.changes
     |> E.filter_map (fun rf ->
-           match rf.Post_form_data.is_open with
+        match rf.Post_form_data.is_open with false -> None | true -> Some true )
-           | false -> None
-           | true -> Some true )
   in
   Elr.set_has_focus ~on:focus_e textarea;
   El.div ~at:[ class' "comment-input-div" ] [ label; textarea ]
@@ -258,9 +256,7 @@ let profile user =
       user.avatar_info
       |> Option.map (fun _ ->
           let input_el =
-               El.input
+            El.input ~at:[ type' "hidden"; name "delete-avatar"; value "" ] ()
-                 ~at:[ type' "hidden"; name "delete-avatar"; value "" ]
-                 ()
           in
           let btn = mk_btn "delete current avatar" in
           mk ~btn [ input_el ] )

src/client/model.ml

@@ -258,8 +258,7 @@ let do_action : Client_types.action -> t -> t =
     let quickview =
       opt |> Option.map (fun (rect, v) -> (rect, Loading v)) |> load_quickview
     in
-    begin
+    begin match quickview with
-      match quickview with
     | Some (_, Loading post_id) -> Network.GET.post post_id
     | _ -> ()
     end;
@@ -270,8 +269,7 @@ let do_action : Client_types.action -> t -> t =
 let do_data_update : Client_types.data_update -> t -> t =
  fun action t ->
   Fmt.pr {|do data update: "%a"@.|} pp_data_update action;
-  begin
+  begin match action with
-    match action with
   | Post_update v -> Db.add_post v
   | Thread_update thread_w_reply ->
     Db.update_thread_w_reply (Some thread_w_reply)

src/client/navigation.ml

@@ -72,8 +72,7 @@ let on_link_click () =
   let navigation_handler ev =
     (* TODO rm magick if possible *)
     let el : El.t = Obj.magic (Ev.target ev) in
-    begin
+    begin if Jstr.equal (El.tag_name el) (Jstr.v "a") then
-      if Jstr.equal (El.tag_name el) (Jstr.v "a") then
       match El.at (Jstr.v "href") el with
       | None -> Fmt.failwith "<a> element with no href"
       | Some href -> begin

src/client/network.ml

@@ -81,8 +81,7 @@ module GET = struct
    fun req v ->
     let open Client_types in
     let open Events in
-    begin
+    begin match req with
-      match req with
     | Catalog -> send_data_update (Catalog_update v)
     | Thread _id -> send_data_update (Thread_update v)
     | Post _id -> send_data_update (Post_update v)
@@ -155,8 +154,7 @@ module POST = struct
    fun o v ->
     let open Client_types in
     let open Events in
-    begin
+    begin match o with
-      match o with
     | Home ->
       send_data_update (Thread_update v);
       send_action (Post_form_change Form_reset);

src/virtual/make_config_lib.ml

@@ -1,170 +1,3 @@
-(* TODO
-   custom parameter type
-   print a scfg
-   handle failures *)
-module M = struct
-  open Scfg
-
-  type nil = NIL
-
-  type dir
-
-  type param
-
-  type ('a, 'b) directive =
-    { name : string
-    ; params : 'a
-    ; children : 'b
-    }
-
-  type ('r, _) t =
-    | Bool : (param, bool) t
-    | Int : (param, int) t
-    | Float : (param, float) t
-    | String : (param, string) t
-    | Directive :
-        (string * (param, 'a) t_list * (dir, 'b) t_list)
-        -> (dir, ('a, 'b) directive) t
-    | Leaf : (string * (param, 'a) t_list) -> (dir, ('a, nil) directive) t
-
-  and ('r, _) t_list =
-    | Nil : ('r, nil) t_list
-    | One : ('r, 'a) t -> ('r, 'a) t_list
-    | Cons : (('r, 'a) t * ('r, 'b) t_list) -> ('r, 'a * 'b) t_list
-
-  let error () = Fmt.failwith "invalid schema"
-
-  let conv_param : type a. (param, a) t -> string -> a =
-   fun param_t v ->
-    try
-      match param_t with
-      | Bool -> bool_of_string v
-      | Int -> int_of_string v
-      | Float -> float_of_string v
-      | String -> v
-    with Invalid_argument _ -> error ()
-
-  let rec conv_param_list : type a. (param, a) t_list -> string list -> a =
-   fun param_l_t l ->
-    match param_l_t with
-    | Nil -> ( match l with [] -> NIL | _ -> error () )
-    | One k -> ( match l with [ hd ] -> conv_param k hd | _ -> error () )
-    | Cons (k, k_l) -> (
-      match l with
-      | [] -> error ()
-      | hd :: tl -> (conv_param k hd, conv_param_list k_l tl) )
-
-  let rec conv_dir : type a. (dir, a) t -> Types.directive -> a =
-   fun dir_t dir ->
-    match dir_t with
-    | Directive (name, params, children) -> (
-      match String.equal name dir.name with
-      | false -> error ()
-      | true ->
-        { name
-        ; params = conv_param_list params dir.params
-        ; children = conv children dir.children
-        } )
-    | Leaf (name, params) -> (
-      match String.equal name dir.name with
-      | false -> error ()
-      | true ->
-        { name; params = conv_param_list params dir.params; children = NIL } )
-
-  and conv : type a. (dir, a) t_list -> Types.config -> a =
-   fun dir_l_t l ->
-    match dir_l_t with
-    | Nil -> ( match l with [] -> NIL | _ -> error () )
-    | One k -> ( match l with [ hd ] -> conv_dir k hd | _ -> error () )
-    | Cons (k, k_l) -> (
-      match l with [] -> error () | hd :: tl -> (conv_dir k hd, conv k_l tl) )
-
-  let ( @^ ) = fun a b -> Cons (a, b)
-
-  let ( @+ ) = fun a b -> Cons (a, One b)
-
-  let ( !@ ) = fun a -> One a
-
-  let directive : type a b.
-         string
-      -> (param, a) t_list
-      -> (dir, b) t_list
-      -> (dir, (a, b) directive) t =
-   fun name params children -> Directive (name, params, children)
-
-  let leaf : type a. string -> (param, a) t_list -> (dir, (a, nil) directive) t
-      =
-   fun name params -> Leaf (name, params)
-end
-
-module M_test = struct
-  open M
-
-  module Uuu = struct
-    module Pp = struct
-      let hide_data : (param, 'a) t * ('a ) -> (param, 'a) t =
-        fun (t, _v) ->
-
-      let ( @^ ) = fun a b -> Cons (hide_data a, b)
-
-      let ( @+ ) = fun a b -> Cons (hide_data a, One (hide_data b))
-
-      let ( !@ ) = fun a -> One (hide_data a)
-    end
-
-    open Pp
-
-    let sch = !@(leaf "cc" (!@ (String, "uu" )   ) )
-  end
-
-  let schema_1 = !@(leaf "cc" !@String)
-
-  let schema_2 =
-    !@(directive "salut" (String @^ Bool @+ Float) !@(leaf "euj" !@Int))
-
-  let schema_3 = leaf "cc" !@String @^ leaf "cc" !@String @+ leaf "cc" !@String
-
-  let txt_1 = Scfg.Parse.from_string {|cc param_1
-      |} |> Result.get_ok
-
-  let txt_2 =
-    Scfg.Parse.from_string
-      {|salut param_str true 0.46 {
-    euj 3456
-    }
-      |}
-    |> Result.get_ok
-
-  let txt_3 =
-    Scfg.Parse.from_string {|cc sava
-  cc sava
-  cc sava
-      |}
-    |> Result.get_ok
-
-  let () =
-    let v_1 = conv schema_1 txt_1 in
-    let { name; params; children } = v_1 in
-    assert (name = "cc");
-    assert (params = "param_1");
-    assert (children = NIL);
-
-    let v_2 = conv schema_2 txt_2 in
-    let { name; params; children } = v_2 in
-    assert (name = "salut");
-    assert (params = ("param_str", (true, 0.46)));
-    assert (children.name = "euj");
-    assert (children.params = 3456);
-
-    let v_3 = conv schema_3 txt_3 in
-    let dir1, (dir2, dir3) = v_3 in
-    assert (dir1 = dir2);
-    assert (dir2 = dir3);
-    ()
-end
-
-(* ------ *)
-
 type _ tag =
   | String : string tag
   | Bool : bool tag