Flatten deps.

examples/decode.ml

@@ -69,11 +69,10 @@ let process () =
   in
   let process, info, comments =
     if not !ogg then (
-      let h = Flac.Decoder.File.create_from_fd write fd in
+      let h = Flac.Decoder.File.create_from_fd ~write fd in
       let process () =
-        Flac.Decoder.process h.Flac.Decoder.File.dec
-          h.Flac.Decoder.File.callbacks;
-        Flac.Decoder.state h.Flac.Decoder.File.dec h.Flac.Decoder.File.callbacks
+        Flac.Decoder.process h.Flac.Decoder.File.dec;
+        Flac.Decoder.state h.Flac.Decoder.File.dec
       in
       (process, h.Flac.Decoder.File.info, h.Flac.Decoder.File.comments))
     else (
@@ -96,19 +95,11 @@ let process () =
           let page = Ogg.Sync.read sync in
           if Ogg.Page.serialno page = serial then Ogg.Stream.put_page os page
         in
-        let callbacks = Flac_ogg.Decoder.get_callbacks os write in
-        let dec = Flac.Decoder.create callbacks in
-        let rec info () =
-          try Flac.Decoder.init dec callbacks
-          with Ogg.Not_enough_data ->
-            fill ();
-            info ()
-        in
-        let dec, info, meta = info () in
+        let dec, info, meta = Flac_ogg.Decoder.create ~fill ~write os in
         let rec process () =
           try
-            Flac.Decoder.process dec callbacks;
-            Flac.Decoder.state dec callbacks
+            Flac.Decoder.process dec;
+            Flac.Decoder.state dec
           with Ogg.Not_enough_data -> (
             try
               fill ();

examples/encode.ml

@@ -74,13 +74,9 @@ let _ =
   let encode, finish =
     if not !ogg then (
       let enc = Flac.Encoder.File.create ~comments params !dst in
-      let encode buf =
-        Flac.Encoder.process enc.Flac.Encoder.File.enc
-          enc.Flac.Encoder.File.callbacks buf
-      in
+      let encode buf = Flac.Encoder.process enc.Flac.Encoder.File.enc buf in
       let finish () =
-        Flac.Encoder.finish enc.Flac.Encoder.File.enc
-          enc.Flac.Encoder.File.callbacks;
+        Flac.Encoder.finish enc.Flac.Encoder.File.enc;
         Unix.close enc.Flac.Encoder.File.fd
       in
       (encode, finish))
@@ -91,12 +87,12 @@ let _ =
         output_string oc body
       in
       let serialno = Random.nativeint Nativeint.max_int in
-      let { Flac_ogg.Encoder.encoder; callbacks; first_pages } =
-        Flac_ogg.Encoder.create ~comments ~serialno params write_page
+      let { Flac_ogg.Encoder.encoder; first_pages } =
+        Flac_ogg.Encoder.create ~comments ~serialno ~write:write_page params
       in
       List.iter write_page first_pages;
-      let encode = Flac.Encoder.process encoder callbacks in
-      let finish () = Flac.Encoder.finish encoder callbacks in
+      let encode = Flac.Encoder.process encoder in
+      let finish () = Flac.Encoder.finish encoder in
       (encode, finish))
   in
   let start = Unix.time () in

src/dune

@@ -2,7 +2,7 @@
  (name flac)
  (public_name flac)
  (synopsis "OCaml bindings for libflac")
- (modules flac flac_impl)
+ (modules flac)
  (libraries unix)
  (foreign_stubs
   (language c)

src/flac.ml

@@ -1 +1,240 @@
-include Flac_impl
+(*
+ * Copyright 2003-2011 Savonet team
+ *
+ * This file is part of Ocaml-flac.
+ *
+ * Ocaml-flac is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * Ocaml-flac is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Ocaml-flac; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *)
+
+(* Author; Romain Beauxis <[email protected]> *)
+
+exception Internal
+
+let () = Callback.register_exception "flac_exn_internal" Internal
+
+module Decoder = struct
+  type t
+
+  (** Possible states of a decoder. *)
+  type state =
+    [ `Search_for_metadata
+    | `Read_metadata
+    | `Search_for_frame_sync
+    | `Read_frame
+    | `End_of_stream
+    | `Ogg_error
+    | `Seek_error
+    | `Aborted
+    | `Memory_allocation_error
+    | `Uninitialized ]
+
+  exception Lost_sync
+  exception Bad_header
+  exception Frame_crc_mismatch
+  exception Unparseable_stream
+  exception Not_flac
+
+  let () =
+    Callback.register_exception "flac_dec_exn_lost_sync" Lost_sync;
+    Callback.register_exception "flac_dec_exn_bad_header" Bad_header;
+    Callback.register_exception "flac_dec_exn_crc_mismatch" Frame_crc_mismatch;
+    Callback.register_exception "flac_dec_exn_unparseable_stream"
+      Unparseable_stream
+
+  type info = {
+    sample_rate : int;
+    channels : int;
+    bits_per_sample : int;
+    total_samples : int64;
+    md5sum : string;
+  }
+
+  type comments = string * (string * string) list
+  type comments_array = string * string array
+
+  external info : t -> info * comments_array option = "ocaml_flac_decoder_info"
+
+  let split_comment comment =
+    try
+      let equal_pos = String.index_from comment 0 '=' in
+      let c1 = String.uppercase_ascii (String.sub comment 0 equal_pos) in
+      let c2 =
+        String.sub comment (equal_pos + 1)
+          (String.length comment - equal_pos - 1)
+      in
+      (c1, c2)
+    with Not_found -> (comment, "")
+
+  let _comments cmts =
+    match cmts with
+      | None -> None
+      | Some (vd, cmts) ->
+          Some (vd, Array.to_list (Array.map split_comment cmts))
+
+  let info x =
+    try
+      let info, comments = info x in
+      (info, _comments comments)
+    with Internal -> raise Not_flac
+
+  external alloc :
+    seek:(int64 -> unit) option ->
+    tell:(unit -> int64) option ->
+    length:(unit -> int64) option ->
+    eof:(unit -> bool) option ->
+    read:(bytes -> int -> int -> int) ->
+    write:(float array array -> unit) ->
+    unit ->
+    t = "ocaml_flac_decoder_alloc_bytecode" "ocaml_flac_decoder_alloc_native"
+
+  external cleanup : t -> unit = "ocaml_flac_cleanup_decoder"
+  external init : t -> unit = "ocaml_flac_decoder_init"
+
+  let create ?seek ?tell ?length ?eof ~read ~write () =
+    let dec = alloc ~seek ~tell ~length ~eof ~read ~write () in
+    Gc.finalise cleanup dec;
+    init dec;
+    let info, comments = info dec in
+    (dec, info, comments)
+
+  external state : t -> state = "ocaml_flac_decoder_state"
+  external process : t -> unit = "ocaml_flac_decoder_process"
+  external seek : t -> Int64.t -> bool = "ocaml_flac_decoder_seek"
+  external flush : t -> bool = "ocaml_flac_decoder_flush"
+  external reset : t -> bool = "ocaml_flac_decoder_reset"
+  external to_s16le : float array array -> string = "caml_flac_float_to_s16le"
+
+  module File = struct
+    type handle = {
+      fd : Unix.file_descr;
+      dec : t;
+      info : info;
+      comments : (string * (string * string) list) option;
+    }
+
+    let create_from_fd ~write fd =
+      let read = Unix.read fd in
+      let seek n =
+        let n = Int64.to_int n in
+        ignore (Unix.lseek fd n Unix.SEEK_SET)
+      in
+      let tell () = Int64.of_int (Unix.lseek fd 0 Unix.SEEK_CUR) in
+      let length () =
+        let stats = Unix.fstat fd in
+        Int64.of_int stats.Unix.st_size
+      in
+      let eof () =
+        let stats = Unix.fstat fd in
+        Unix.lseek fd 0 Unix.SEEK_CUR = stats.Unix.st_size
+      in
+      let dec, info, comments =
+        create ~seek ~tell ~length ~eof ~write ~read ()
+      in
+      { fd; comments; dec; info }
+
+    let create ~write filename =
+      let fd = Unix.openfile filename [Unix.O_RDONLY] 0o640 in
+      try create_from_fd ~write fd
+      with e ->
+        Unix.close fd;
+        raise e
+  end
+end
+
+module Encoder = struct
+  type priv
+
+  type params = {
+    channels : int;
+    bits_per_sample : int;
+    sample_rate : int;
+    compression_level : int option;
+    total_samples : int64 option;
+  }
+
+  type comments = (string * string) list
+  type t = priv * params
+
+  exception Invalid_data
+  exception Invalid_metadata
+
+  let () =
+    Callback.register_exception "flac_enc_exn_invalid_metadata" Invalid_metadata
+
+  external vorbiscomment_entry_name_is_legal : string -> bool
+    = "ocaml_flac_encoder_vorbiscomment_entry_name_is_legal"
+
+  external vorbiscomment_entry_value_is_legal : string -> bool
+    = "ocaml_flac_encoder_vorbiscomment_entry_value_is_legal"
+
+  external alloc :
+    (string * string) array ->
+    seek:(int64 -> unit) option ->
+    tell:(unit -> int64) option ->
+    write:(bytes -> unit) ->
+    params ->
+    priv = "ocaml_flac_encoder_alloc"
+
+  external cleanup : priv -> unit = "ocaml_flac_cleanup_encoder"
+  external init : priv -> unit = "ocaml_flac_encoder_init"
+
+  let create ?(comments = []) ?seek ?tell ~write p =
+    if p.channels <= 0 then raise Invalid_data;
+    let comments = Array.of_list comments in
+    let enc = alloc comments ~seek ~tell ~write p in
+    Gc.finalise cleanup enc;
+    init enc;
+    (enc, p)
+
+  external process : priv -> float array array -> int -> unit
+    = "ocaml_flac_encoder_process"
+
+  let process (enc, p) data =
+    if Array.length data <> p.channels then raise Invalid_data;
+    process enc data p.bits_per_sample
+
+  external finish : priv -> unit = "ocaml_flac_encoder_finish"
+
+  let finish (enc, _) = finish enc
+
+  external from_s16le : string -> int -> float array array
+    = "caml_flac_s16le_to_float"
+
+  module File = struct
+    type handle = { fd : Unix.file_descr; enc : t }
+
+    let create_from_fd ?comments params fd =
+      let write s =
+        let len = Bytes.length s in
+        let rec f pos =
+          if pos < len then (
+            let ret = Unix.write fd s pos (len - pos) in
+            f (pos + ret))
+        in
+        f 0
+      in
+      let seek n =
+        let n = Int64.to_int n in
+        ignore (Unix.lseek fd n Unix.SEEK_SET)
+      in
+      let tell () = Int64.of_int (Unix.lseek fd 0 Unix.SEEK_CUR) in
+      let enc = create ?comments ~seek ~tell ~write params in
+      { fd; enc }
+
+    let create ?comments params filename =
+      let fd = Unix.openfile filename [Unix.O_CREAT; Unix.O_RDWR] 0o640 in
+      create_from_fd ?comments params fd
+  end
+end