Update code to be compatible with Ocaml 4.13.1

.gitignore

@@ -0,0 +1 @@
+_build/*

Makefile

@@ -2,7 +2,7 @@
 documentation :
 	dune build @doc
 	find _build/default/_doc/_html/libmpdclient/ -type f |xargs sed -i 's/\.\.\/odoc\.css/odoc\.css/g'
-	mv _build/default/_doc/_html/odoc.css _build/default/_doc/_html/libmpdclient/
+	mv _build/default/_doc/_html/odoc.support/odoc.css _build/default/_doc/_html/libmpdclient/
 	rm -rf docs/*
 	cp -rf _build/default/_doc/_html/libmpdclient/* docs/
 	dune clean

bin/Ompdc_common.ml

@@ -22,44 +22,55 @@ open Mpd.Protocol
 let version = "not.yet"
 let sdocs = Manpage.s_common_options
 let docs = Manpage.s_common_options
-let exits = Term.default_exits
+let exits = Cmd.Exit.defaults
 
-let help _copts man_format cmds topic = match topic with
-| None -> `Help (`Pager, None) (* help about the program. *)
-| Some topic ->
-    let topics = "topics" :: "patterns" :: "environment" :: cmds in
-    let conv, _ = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in
-    match conv topic with
-    | `Error e -> `Error (false, e)
-    | `Ok t when t = "topics" -> List.iter print_endline topics; `Ok ()
-    | `Ok t when List.mem t cmds -> `Help (man_format, Some t)
-    | `Ok _ ->
-        let page = (topic, 7, "", "", ""), [`S topic; `P "Say something";] in
-        `Ok (Cmdliner.Manpage.print man_format Format.std_formatter page)
+let help _copts man_format cmds topic =
+  match topic with
+  | None -> `Help (`Pager, None) (* help about the program. *)
+  | Some topic -> (
+      let topics = "topics" :: "patterns" :: "environment" :: cmds in
+      let conv, _ = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in
+      match conv topic with
+      | `Error e -> `Error (false, e)
+      | `Ok t when t = "topics" ->
+          List.iter print_endline topics;
+          `Ok ()
+      | `Ok t when List.mem t cmds -> `Help (man_format, Some t)
+      | `Ok _ ->
+          let page =
+            ((topic, 7, "", "", ""), [ `S topic; `P "Say something" ])
+          in
+          `Ok (Cmdliner.Manpage.print man_format Format.std_formatter page))
 
-let help_section = [
-  `S Manpage.s_common_options;
-  `P "These options are common to all commands.";
-  `S Manpage.s_bugs; `P "Check bug reports at https://github.com/cedlemo/OCaml-libmpdclient/issues";
-  `S Manpage.s_authors; `P "Cedric Le Moigne <cedlemo at gmx dot com>"
-        ]
+let help_section =
+  [
+    `S Manpage.s_common_options;
+    `P "These options are common to all commands.";
+    `S Manpage.s_bugs;
+    `P
+      "Check bug reports at \
+       https://github.com/cedlemo/OCaml-libmpdclient/issues";
+    `S Manpage.s_authors;
+    `P "Cedric Le Moigne <cedlemo at gmx dot com>";
+  ]
 
 (* Options common to all commands *)
-type mpd_opts = {host : string; port : int}
+type mpd_opts = { host : string; port : int }
 
-let common_opts host port =
-  {host; port}
+let common_opts host port = { host; port }
 
 let common_opts_t =
   let host =
     let doc = "Set the address of the Mpd server." in
-    let env = Arg.env_var "OMPDC_HOST" ~doc in
-    Arg.(value & opt string "127.0.0.1" & info ["h"; "host"] ~docs ~env ~docv:"HOST")
+    let env = Cmd.Env.info "OMPDC_HOST" ~doc in
+    Arg.(
+      value & opt string "127.0.0.1"
+      & info [ "h"; "host" ] ~docs ~env ~docv:"HOST")
   in
   let port =
     let doc = "Set the port of the Mpd server." in
-    let env = Arg.env_var "OMPDC_PORT" ~doc in
-    Arg.(value & opt int 6600 & info ["p"; "port"] ~docs ~env ~docv:"PORT")
+    let env = Cmd.Env.info "OMPDC_PORT" ~doc in
+    Arg.(value & opt int 6600 & info [ "p"; "port" ] ~docs ~env ~docv:"PORT")
   in
   Term.(const common_opts $ host $ port)
 
@@ -70,34 +81,35 @@ let help_cmd =
   in
   let doc = "display help about ompdc and ompdc commands" in
   let man =
-    [`S Manpage.s_description;
-     `P "Prints help about ompdc commands and other subjects...";
-     `Blocks help_section; ]
+    [
+      `S Manpage.s_description;
+      `P "Prints help about ompdc commands and other subjects...";
+      `Blocks help_section;
+    ]
   in
-  Term.(ret
-          (const help $ common_opts_t $ Arg.man_format $ Term.choice_names $topic)),
-  Term.info "help" ~doc ~exits ~man
+  ( Term.(
+      ret
+        (const help $ common_opts_t $ Arg.man_format $ Term.choice_names $ topic)),
+    Cmd.info "help" ~doc ~exits ~man )
 
-
-let initialize_client {host; port} =
-   let connection = Mpd.Connection.initialize host port in
-   let client = Mpd.Client.initialize connection in
-   let _ = print_endline ("Mpd server : " ^ (Mpd.Client.mpd_banner client)) in
-   client
+let initialize_client { host; port } =
+  let connection = Mpd.Connection.initialize host port in
+  let client = Mpd.Client.initialize connection in
+  let _ = print_endline ("Mpd server : " ^ Mpd.Client.mpd_banner client) in
+  client
 
 let check_for_mpd_error mpd_response =
-  let response = (
+  let response =
     match mpd_response with
     | Ok msg -> (
-      match msg with
-      | None -> ""
-      | Some str -> "Mpd response: " ^ str
-    )
+        match msg with None -> "" | Some str -> "Mpd response: " ^ str)
     | Error (ack_error, _ack_cmd_num, _ack_cmd, ack_message) ->
-        String.concat " " ["Error type:";
-                           Mpd.Protocol.error_name ack_error;
-                           "-- error message:";
-                           ack_message]
-  )
+        String.concat " "
+          [
+            "Error type:";
+            Mpd.Protocol.error_name ack_error;
+            "-- error message:";
+            ack_message;
+          ]
   in
   print_endline response

bin/Ompdc_idle.ml

@@ -19,7 +19,6 @@
 open Lwt.Infix
 open Notty
 open Ompdc_common
-
 module Terminal = Notty_lwt.Term
 
 type status = {
@@ -31,30 +30,29 @@ type status = {
 }
 
 let fetch_status client =
-  Mpd.Client_lwt.status client
-  >>= fun response ->
-    match response with
-    | Error message -> Lwt.return (Error message)
-    | Ok s ->
-        let timestamp = Unix.time () in
-        let state = Mpd.Status.state s in
-        let volume = Mpd.Status.volume s in
-        let song = Mpd.Status.song s in
-        Mpd.Queue_lwt.playlist client
-        >>= fun queue ->
-          Lwt.return (Ok {timestamp; state; volume; queue; song})
+  Mpd.Client_lwt.status client >>= fun response ->
+  match response with
+  | Error message -> Lwt.return (Error message)
+  | Ok s ->
+      let timestamp = Unix.time () in
+      let state = Mpd.Status.state s in
+      let volume = Mpd.Status.volume s in
+      let song = Mpd.Status.song s in
+      Mpd.Queue_lwt.playlist client >>= fun queue ->
+      Lwt.return (Ok { timestamp; state; volume; queue; song })
 
 let update_status status client =
   match status with
   | Error _ -> Lwt.return status
-  | Ok s -> Mpd.Client_lwt.noidle client
-      >>= fun _ ->
-        let now = Unix.time () in
-        if ((now -. s.timestamp) > 4.0) then fetch_status client
-        else Lwt.return status
+  | Ok s ->
+      Mpd.Client_lwt.noidle client >>= fun _ ->
+      let now = Unix.time () in
+      if now -. s.timestamp > 4.0 then fetch_status client
+      else Lwt.return status
 
 let gen_state_img status =
-  let state_img = match status.state with
+  let state_img =
+    match status.state with
     | Mpd.Status.Play -> I.(string A.(fg green) "play")
     | Mpd.Status.Pause -> I.(string A.(fg lightblack) "Pause")
     | Mpd.Status.Stop -> I.(string A.(fg black ++ bg lightblack) "Stop")
@@ -63,111 +61,109 @@ let gen_state_img status =
   I.(string A.(fg white) "[state ] : " <|> state_img)
 
 let gen_volume_img status =
-  I.(strf ~attr:A.(fg white)   "[volume] : %d" status.volume)
+  I.(strf ~attr:A.(fg white) "[volume] : %d" status.volume)
 
 let gen_playlist_img status (w, _h) =
   match status.queue with
-  | PlaylistError message -> Lwt.return I.(strf ~attr:A.(fg red) "Error: %s" message)
+  | PlaylistError message ->
+      Lwt.return I.(strf ~attr:A.(fg red) "Error: %s" message)
   | Playlist songs ->
-    let gen_song_img i song =
-      let title = Mpd.Song.title song in
-      let artist = Mpd.Song.artist song in
-      if status.song = i then
-        I.(strf ~attr:A.(fg lightred ++ bg lightblack) "+ %s : %s" title artist)
-      else
-        I.(strf ~attr:A.(fg lightblack) "- %s : %s" title artist)
-    in
-    let song_imgs = List.mapi gen_song_img songs in
-    let lines = List.map (fun i ->
-      let left_margin = 4 in
-      let i_w = I.width i in
-      let remain = let r = w - (i_w + left_margin) in (max r 0) in
-      I.hpad left_margin remain i)
-      song_imgs in
-    Lwt.return I.(vcat lines)
+      let gen_song_img i song =
+        let title = Mpd.Song.title song in
+        let artist = Mpd.Song.artist song in
+        if status.song = i then
+          I.(
+            strf ~attr:A.(fg lightred ++ bg lightblack) "+ %s : %s" title artist)
+        else I.(strf ~attr:A.(fg lightblack) "- %s : %s" title artist)
+      in
+      let song_imgs = List.mapi gen_song_img songs in
+      let lines =
+        List.map
+          (fun i ->
+            let left_margin = 4 in
+            let i_w = I.width i in
+            let remain =
+              let r = w - (i_w + left_margin) in
+              max r 0
+            in
+            I.hpad left_margin remain i)
+          song_imgs
+      in
+      Lwt.return I.(vcat lines)
 
 let render status (w, h) =
-    match status with
-    | Error message -> Lwt.return I.(strf ~attr:A.(fg red) "[there is a pb %s]" message)
-    | Ok status -> let state_img = gen_state_img status in
+  match status with
+  | Error message ->
+      Lwt.return I.(strf ~attr:A.(fg red) "[there is a pb %s]" message)
+  | Ok status ->
+      let state_img = gen_state_img status in
       let volume_img = gen_volume_img status in
-      gen_playlist_img status (w, h)
-      >>= fun songs_img ->
+      gen_playlist_img status (w, h) >>= fun songs_img ->
       Lwt.return I.(state_img <-> volume_img <-> songs_img)
 
 let listen_mpd_event client =
   Mpd.Client_lwt.idle client >|= fun evt -> `Mpd_event evt
 
-let event term = Lwt_stream.get (Terminal.events term) >|= function
-  | Some (`Resize _ | #Unescape.event as x) -> x
+let event term =
+  Lwt_stream.get (Terminal.events term) >|= function
+  | Some ((`Resize _ | #Unescape.event) as x) -> x
   | None -> `End
 
 let rec loop term (e, t) dim client status =
-  (e <?> t) >>= function
-  | `End | `Key (`Escape, []) | `Key (`ASCII 'C', [`Ctrl]) ->
+  e <?> t >>= function
+  | `End | `Key (`Escape, []) | `Key (`ASCII 'C', [ `Ctrl ]) ->
       Mpd.Client_lwt.close client
   | `Mpd_event _event_name ->
-      fetch_status client
-      >>= fun status' ->
-        render status' dim
-        >>= fun img ->
-          Terminal.image term img
-          >>= fun () ->
-            loop term (e, listen_mpd_event client) dim client status'
+      fetch_status client >>= fun status' ->
+      render status' dim >>= fun img ->
+      Terminal.image term img >>= fun () ->
+      loop term (e, listen_mpd_event client) dim client status'
   | `Resize dim ->
-      update_status status client
-      >>= fun status' ->
-        render status' dim
-        >>= fun img ->
-          Terminal.image term img
-          >>= fun () ->
-            loop term (event term, t) dim client status'
+      update_status status client >>= fun status' ->
+      render status' dim >>= fun img ->
+      Terminal.image term img >>= fun () ->
+      loop term (event term, t) dim client status'
   | _ ->
-      update_status status client
-      >>= fun status' ->
-        render status' dim
-        >>= fun img ->
-          Terminal.image term img
-          >>= fun () ->
-            loop term (event term, t) dim client status'
+      update_status status client >>= fun status' ->
+      render status' dim >>= fun img ->
+      Terminal.image term img >>= fun () ->
+      loop term (event term, t) dim client status'
 
 let interface client =
   let term = Terminal.create () in
   let size = Terminal.size term in
-  fetch_status client
-  >>= fun result_status ->
-    render result_status size
-    >>= fun img ->
-      Terminal.image term img
-      >>= fun () ->
-        loop term (event term, listen_mpd_event client) size client result_status
+  fetch_status client >>= fun result_status ->
+  render result_status size >>= fun img ->
+  Terminal.image term img >>= fun () ->
+  loop term (event term, listen_mpd_event client) size client result_status
 
 let idle common_opts =
   let open Mpd in
-  let {host; port} = common_opts in
+  let { host; port } = common_opts in
   let main_thread =
-    Connection_lwt.initialize host port
-    >>= fun connection ->
-      Client_lwt.initialize connection
-      >>= fun client ->
-        interface client
+    Connection_lwt.initialize host port >>= fun connection ->
+    Client_lwt.initialize connection >>= fun client -> interface client
   in
-  Lwt_main.run (
-    Lwt.catch
-      (fun () -> main_thread)
-      (function
-        | Mpd.Connection_lwt.Lwt_unix_exn message ->
-            Lwt_io.write_line Lwt_io.stderr message
-        | _ -> Lwt_io.write_line Lwt_io.stderr "Exception not handled. Exit ..."
-      )
-  )
+  Lwt_main.run
+    (Lwt.catch
+       (fun () -> main_thread)
+       (function
+         | Mpd.Connection_lwt.Lwt_unix_exn message ->
+             Lwt_io.write_line Lwt_io.stderr message
+         | _ ->
+             Lwt_io.write_line Lwt_io.stderr "Exception not handled. Exit ..."))
 
 open Cmdliner
+
 let cmd =
-  let doc = "Use Ompdc as an Mpd server events listener. Quit with Ctl+Alt+C." in
-  let man = [ `S Manpage.s_description;
-              `P "Idle command that display events of the Mpd server.";
-              `Blocks help_section
-  ] in
-  Term.(const idle $ common_opts_t),
-  Term.info "idle" ~doc ~sdocs ~exits ~man
+  let doc =
+    "Use Ompdc as an Mpd server events listener. Quit with Ctl+Alt+C."
+  in
+  let man =
+    [
+      `S Manpage.s_description;
+      `P "Idle command that display events of the Mpd server.";
+      `Blocks help_section;
+    ]
+  in
+  (Term.(const idle $ common_opts_t), Cmd.info "idle" ~doc ~sdocs ~exits ~man)