[Pkg-ocaml-maint-commits] [react] 02/07: Imported Upstream version 1.0.1
Stéphane Glondu
glondu at moszumanska.debian.org
Wed Oct 28 14:54:10 UTC 2015
This is an automated email from the git hooks/post-receive script.
glondu pushed a commit to branch master
in repository react.
commit 96085d3868a7416d93475f218ce763ab24fa40f4
Author: Stephane Glondu <steph at glondu.net>
Date: Wed Oct 28 15:11:39 2015 +0100
Imported Upstream version 1.0.1
---
.ocamlinit | 2 +-
CHANGES.md | 6 +
README.md | 2 +-
TODO.md | 28 +++++
_tags | 2 +-
doc/React.S.html | 2 +-
doc/React.html | 2 +-
doc/index_values.html | 2 +-
opam | 9 +-
pkg/META | 2 +-
pkg/build | 28 -----
pkg/build.ml | 15 +++
pkg/config | 3 -
pkg/config.ml | 11 ++
pkg/git.ml | 13 +++
pkg/pkg-builder | 108 ------------------
pkg/pkg-git | 16 ---
pkg/pkg-varsubsts | 24 ----
pkg/topkg-ext.ml | 272 ++++++++++++++++++++++++++++++++++++++++++++
pkg/topkg.ml | 303 ++++++++++++++++++++++++++++++++++++++++++++++++++
src/react.ml | 4 +-
src/react.mli | 6 +-
test/test.ml | 17 +++
test/tests.itarget | 2 +-
24 files changed, 683 insertions(+), 196 deletions(-)
diff --git a/.ocamlinit b/.ocamlinit
index 89ca28d..39e2d55 100644
--- a/.ocamlinit
+++ b/.ocamlinit
@@ -1,2 +1,2 @@
#directory "_build/src"
-#load "react.cmo"
+#load "react.cmo"
\ No newline at end of file
diff --git a/CHANGES.md b/CHANGES.md
index 3f3f50f..cda8703 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,9 @@
+v1.0.1 2014-04-21 La Forclaz (VS)
+---------------------------------
+
+- Fix `S.bind`.
+- Use package builder topkg for distribution.
+
v1.0.0 2014-04-02 La Forclaz (VS)
---------------------------------
diff --git a/README.md b/README.md
index 8226c90..aeda6f5 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
React — Declarative events and signals for OCaml
-------------------------------------------------------------------------------
-Release 1.0.0
+Release 1.0.1
React is an OCaml module for functional reactive programming (FRP). It
provides support to program with time varying values : declarative
diff --git a/TODO.md b/TODO.md
new file mode 100644
index 0000000..b5a613a
--- /dev/null
+++ b/TODO.md
@@ -0,0 +1,28 @@
+
+# New event combinators
+
+```ocaml
+E.Option.some : 'a option event -> 'a event
+(** [some e] is [E.fmap (fun v -> v) e] *)
+
+S.Option.some : 'a -> 'a option signal -> 'a signal
+```
+
+
+
+# New signal combinators.
+
+To avoid uses of S.value we need better ways to access a
+signal's current value and inject it in an efficient
+way in the graph.
+
+```ocaml
+S.freeze : 'a signal -> 'a signal
+(** [freeze s]_{t} = [s]_{t'} where t' is freeze's creation time. *)
+```
+
+See if we can return a const and if what happens when used with
+bind and/or provide an alternative S.bind for bootstraping.
+
+
+
diff --git a/_tags b/_tags
index fa3cd82..b927a62 100644
--- a/_tags
+++ b/_tags
@@ -5,4 +5,4 @@
<test/breakout.{native,byte}> : use_unix
<test/js_test.{ml,native,byte}> : package(js_of_ocaml), \
package(js_of_ocaml.syntax), \
- syntax(camlp4o)
+ syntax(camlp4o)
\ No newline at end of file
diff --git a/doc/React.S.html b/doc/React.S.html
index 3a10534..cc829e7 100644
--- a/doc/React.S.html
+++ b/doc/React.S.html
@@ -244,7 +244,7 @@ The type for signals of type <code class="code"><span class="keywordsign">'</spa
</div>
<pre><span id="VALbind"><span class="keyword">val</span> bind</span> : <code class="type">?eq:('b -> 'b -> bool) -><br> 'a <a href="React.html#TYPEsignal">React.signal</a> -> ('a -> 'b <a href="React.html#TYPEsignal">React.signal</a>) -> 'b <a href="React.html#TYPEsignal">React.signal</a></code></pre><div class="info ">
-<code class="code">bind s sf</code> is <code class="code">switch (map sf s)</code>.<br>
+<code class="code">bind s sf</code> is <code class="code">switch (map ~eq:( == ) sf s)</code>.<br>
</div>
<pre><span id="VALfix"><span class="keyword">val</span> fix</span> : <code class="type">?eq:('a -> 'a -> bool) -><br> 'a -> ('a <a href="React.html#TYPEsignal">React.signal</a> -> 'a <a href="React.html#TYPEsignal">React.signal</a> * 'b) -> 'b</code></pre><div class="info ">
diff --git a/doc/React.html b/doc/React.html
index 9380b29..48784d0 100644
--- a/doc/React.html
+++ b/doc/React.html
@@ -47,7 +47,7 @@ Declarative events and signals.
types and modules in your scope.
<p>
- <em>Release 1.0.0 - Daniel Bünzli <daniel.buenzl i at erratique.ch> </em><br>
+ <em>Release 1.0.1 - Daniel Bünzli <daniel.buenzl i at erratique.ch> </em><br>
</div>
<hr width="100%">
<br>
diff --git a/doc/index_values.html b/doc/index_values.html
index a7addd0..f5e3791 100644
--- a/doc/index_values.html
+++ b/doc/index_values.html
@@ -115,7 +115,7 @@
<td></td></tr>
<tr><td><a href="React.S.html#VALbind">bind</a> [<a href="React.S.html">React.S</a>]</td>
<td><div class="info">
-<code class="code">bind s sf</code> is <code class="code">switch (map sf s)</code>.
+<code class="code">bind s sf</code> is <code class="code">switch (map ~eq:( == ) sf s)</code>.
</div>
</td></tr>
<tr><td align="left"><br>C</td></tr>
diff --git a/opam b/opam
index 2417d37..757d077 100644
--- a/opam
+++ b/opam
@@ -1,7 +1,7 @@
opam-version: "1"
maintainer: "Daniel Bünzli <daniel.buenzl i at erratique.ch>"
homepage: "http://erratique.ch/software/react"
-authors: ["Daniel Bünzli <daniel.buenzli i at erratique.ch>"]
+authors: ["Daniel Bünzli <daniel.buenzl i at erratique.ch>"]
doc: "http://erratique.ch/software/react/doc/React"
tags: [ "reactive" "declarative" "signal" "event" "frp" ]
license: "BSD3"
@@ -9,6 +9,7 @@ depends: ["ocamlfind"]
ocaml-version: [>= "3.11.0"]
build:
[
- ["./pkg/pkg-git" ]
- ["./pkg/build" "true" ]
-]
+ [ "ocaml" "pkg/git.ml" ]
+ [ "ocaml" "pkg/build.ml" "native=%{ocaml-native}%"
+ "native-dynlink=%{ocaml-native}%" ] # TODO FIXME
+]
\ No newline at end of file
diff --git a/pkg/META b/pkg/META
index 0001b75..9410ba5 100644
--- a/pkg/META
+++ b/pkg/META
@@ -1,4 +1,4 @@
-version = "1.0.0"
+version = "1.0.1"
description = "Declarative events and signals for OCaml"
archive(byte) = "react.cma"
archive(byte, plugin) = "react.cma"
diff --git a/pkg/build b/pkg/build
deleted file mode 100755
index 5c32123..0000000
--- a/pkg/build
+++ /dev/null
@@ -1,28 +0,0 @@
-#!/bin/sh
-
-# Usage: build has_native
-
-set -e
-LOC=`dirname $0`
-
-. $LOC/pkg-builder
-
-NATIVE=$1
-
-add lib pkg/META
-add lib src/react.mli
-add lib src/react.cmti
-add lib src/react.cmi
-add lib src/react.cmx
-add lib src/react.cma
-add lib src/react.a
-add lib src/react.cmxa
-add lib src/react.cmxs
-
-add doc README.md
-add doc CHANGES.md
-add doc test/breakout.ml
-add doc test/clock.ml
-
-build
-install react
diff --git a/pkg/build.ml b/pkg/build.ml
new file mode 100755
index 0000000..1ab82dd
--- /dev/null
+++ b/pkg/build.ml
@@ -0,0 +1,15 @@
+#!/usr/bin/env ocaml
+#directory "pkg";;
+#use "topkg.ml";;
+
+let () =
+ Pkg.describe "react" ~builder:`OCamlbuild [
+ Pkg.lib "pkg/META";
+ Pkg.lib ~exts:Exts.module_library "src/react";
+ Pkg.doc "README.md";
+ Pkg.doc "CHANGES.md";
+ Pkg.doc "test/breakout.ml";
+ Pkg.doc "test/clock.ml"; ]
+
+
+
diff --git a/pkg/config b/pkg/config
deleted file mode 100644
index a19c529..0000000
--- a/pkg/config
+++ /dev/null
@@ -1,3 +0,0 @@
-NAME=react
-VERSION=`git describe master | sed "s/^.//"`
-MAINTAINER="Daniel Bünzli <daniel.buenzl i\\\@erratique.ch>"
diff --git a/pkg/config.ml b/pkg/config.ml
new file mode 100644
index 0000000..19ecc23
--- /dev/null
+++ b/pkg/config.ml
@@ -0,0 +1,11 @@
+#!/usr/bin/env ocaml
+#directory "pkg"
+#use "topkg-ext.ml"
+
+module Config = struct
+ include Config_default
+ let vars =
+ [ "NAME", "react";
+ "VERSION", Git.describe ~chop_v:true "master";
+ "MAINTAINER", "Daniel Bünzli <daniel.buenzl i\\@erratique.ch>" ]
+end
diff --git a/pkg/git.ml b/pkg/git.ml
new file mode 100755
index 0000000..4169980
--- /dev/null
+++ b/pkg/git.ml
@@ -0,0 +1,13 @@
+#!/usr/bin/env ocaml
+#directory "pkg"
+#use "config.ml"
+
+(* This is only for git checkout builds, it can be ignored
+ for distribution builds. *)
+
+let () =
+ if Dir.exists ".git" then begin
+ Vars.subst ~skip:Config.subst_skip ~vars:Config.vars ~dir:"." &>>= fun () ->
+ Cmd.exec_hook Config.git_hook &>>= fun () -> ()
+ end
+
diff --git a/pkg/pkg-builder b/pkg/pkg-builder
deleted file mode 100755
index 872644e..0000000
--- a/pkg/pkg-builder
+++ /dev/null
@@ -1,108 +0,0 @@
-#!/bin/sh
-
-# Should be included by a script. The includer should set the variable
-# $NATIVE to "false" if it doesn't want native code compilation.
-
-OCAMLBUILD=${OCAMLBUILD:="ocamlbuild -use-ocamlfind -classic-display"}
-B="_build"
-NL="
-"
-
-LIBS=""; ILIBS=""
-BINS=""; IBINS=""
-SBIS=""; ISBIS=""
-TOPS=""; ITOPS=""
-SHRS=""; ISHRS=""
-ETCS=""; IETCS=""
-DOCS=""; IDOCS=""
-MISC=""; IMISC=""
-STBS=""; ISTBS=""
-MANS=""; IMANS=""
-
-add_lib () { LIBS="$LIBS $1"; ILIBS="$ILIBS$NL \"$B/$1\" {\"$2\"}"; }
-add_lib_nobuild () { ILIBS="$ILIBS$NL \"?$B/$1\" {\"$2\"}"; }
-add_bin () { BINS="$BINS $1"; IBINS="$IBINS$NL \"$B/$1\" {\"$2\"}"; }
-add_sbin () { SBIS="$SBIS $1"; ISBIS="$ISBIS$NL \"$B/$1\" {\"$2\"}"; }
-add_toplevel () { TOPS="$TOPS $1"; ITOPS="$ITOPS$NL \"$B/$1\" {\"$2\"}"; }
-add_share () { SHRS="$SHRS $1"; ISHRS="$ISHRS$NL \"$B/$1\" {\"$2\"}"; }
-add_etc () { ETCS="$ETCS $1"; IETCS="$IETCS$NL \"$B/$1\" {\"$2\"}"; }
-add_doc () { DOCS="$DOCS $1"; IDOCS="$IDOCS$NL \"$B/$1\" {\"$2\"}"; }
-add_misc () { MISC="$MISC $1"; IMISC="$IMISC$NL \"$B/$1\" {\"$2\"}"; }
-add_stublibs () { STBS="$STBS $1"; ISTBS="$ISTBS$NL \"$B/$1\" {\"$2\"}"; }
-add_man () { MANS="$MANS $1"; IMANS="$IMANS$NL \"$B/$1\" {\"$2\"}"; }
-add ()
-{
- SRC=$2
- DST=$3
- if [ "$DST" = "" ]; then
- DST=`basename $SRC`
- fi
- case $1 in
- lib)
- if [ "$NATIVE" != "false" ]; then
- case $2 in
- *.cmti | *.cmt) add_lib_nobuild $SRC $DST ;;
- *) add_lib $SRC $DST ;;
- esac
- else
- case $2 in
- *.a | *.cmx | *.cmxa | *.cmxs) ;;
- *.cmti | *.cmt) add_lib_nobuild $SRC $DST ;;
- *) add_lib $SRC $DST ;;
- esac
- fi
- ;;
- bin)
- if [ "$NATIVE" != "false" ]; then
- add_bin $SRC.native $DST
- else
- add_bin $SRC.byte $DST
- fi
- ;;
- sbin)
- if [ "$NATIVE" != "false" ]; then
- add_sbin $SRC.native $DST
- else
- add_sbin $SRC.byte $DST
- fi
- ;;
- share) add_share $SRC $DST ;;
- etc) add_etc $SRC $DST ;;
- toplevel) add_top $SRC.top $DST ;;
- doc) add_doc $SRC $DST ;;
- misc) add_misc $SRC $DST ;;
- stublibs) add_stublibs $SRC $DST ;;
- man) add_man $SRC $DST ;;
- esac
-}
-
-build ()
-{
- $OCAMLBUILD $LIBS $BINS $SBIS $DOCS $TOPS $SHRS $ETCS $MISC $STBS $MANS;
-}
-
-install ()
-{
- cat > $1.install <<EOF
-lib: [$ILIBS
-]
-bin: [$IBINS
-]
-sbin: [$ISBIS
-]
-toplevel: [$ITOPS
-]
-share: [$ISHRS
-]
-etc: [$IETCS
-]
-doc: [$IDOCS
-]
-misc: [$IMISC
-]
-stublibs: [$ISTBS
-]
-man: [$IMANS
-]
-EOF
-}
diff --git a/pkg/pkg-git b/pkg/pkg-git
deleted file mode 100755
index 44e0e2b..0000000
--- a/pkg/pkg-git
+++ /dev/null
@@ -1,16 +0,0 @@
-#!/bin/sh
-
-## Usage: pkg-git
-## Prepare package for an opam git/pinned package.
-
-set -e
-LOC=`dirname $0`
-
-if [ -d ".git" ]; then
- . $LOC/config
- . $LOC/pkg-varsubsts
-
- if [ -f $LOC/hook-pkg-git ]; then
- . $LOC/hook-pkg-git
- fi
-fi
diff --git a/pkg/pkg-varsubsts b/pkg/pkg-varsubsts
deleted file mode 100755
index 40c2d54..0000000
--- a/pkg/pkg-varsubsts
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/bin/sh
-
-# To add other variable substitutions already predefine $VARSUBST in
-# config.
-
-set -e
-LOC=`dirname $0`
-
-SED=${SED:="sed"}
-
-VARSUBSTS="$VARSUBST s|%%NAME%%|$NAME|g; \
- s|%%VERSION%%|$VERSION|g; \
- s|%%MAINTAINER%%|$MAINTAINER|g;"
-
-for file in `git ls-files`; do
- if [ ! -x "$file" ]; then # skip scripts
- $SED "$VARSUBSTS" $file > $file.tmp
- mv -f $file.tmp $file
- fi
-done
-
-if [ -f $LOC/hook-pkg-varsubsts ]; then
- . $LOC/hook-pkg-varsubsts
-fi
diff --git a/pkg/topkg-ext.ml b/pkg/topkg-ext.ml
new file mode 100644
index 0000000..4aa5e0b
--- /dev/null
+++ b/pkg/topkg-ext.ml
@@ -0,0 +1,272 @@
+(*---------------------------------------------------------------------------
+ Copyright (c) 2014 Daniel C. Bünzli. All rights reserved.
+ Distributed under the BSD3 license, see license at the end of the file.
+ react release 1.0.1
+ ---------------------------------------------------------------------------*)
+
+let ( >>= ) v f = match v with `Ok v -> f v | `Error _ as e -> e
+let ( &>>= ) v f = match v with
+| `Ok v -> f v | `Error e -> Printf.eprintf "%s: %s\n%!" Sys.argv.(0) e; exit 1
+
+type 'a result = [ `Ok of 'a | `Error of string ]
+
+(** Working with files *)
+module File : sig
+ val exists : string -> bool
+ (** [exists file] is [true] if [file] exists. *)
+
+ val read : string -> string result
+ (** [read file] is [file]'s contents. *)
+
+ val write : string -> string -> unit result
+ (** [write file content] writes [contents] to [file]. *)
+
+ val write_subst : string -> (string * string) list -> string -> unit result
+ (** [write_subst file vars content] writes [contents] to [file]
+ substituting variables of the form [%%ID%%] by their definition.
+ The [ID]'s are [List.map fst vars] and their definition content
+ is found with [List.assoc]. *)
+
+ val delete : ?maybe:bool -> string -> unit result
+ (** [delete maybe file] deletes file [file]. If [maybe] is [true] (defaults
+ to false) no error is reported if the file doesn't exist. *)
+
+ val temp : unit -> string result
+ (** [temp ()] creates a temporary file and returns its name. The file
+ is destroyed at the end of program execution. *)
+end = struct
+ let exists = Sys.file_exists
+ let read file = try
+ let ic = open_in file in
+ let len = in_channel_length ic in
+ let s = String.create len in
+ really_input ic s 0 len; close_in ic; `Ok s
+ with Sys_error e -> `Error e
+
+ let write f s = try
+ let oc = open_out f in
+ output_string oc s; close_out oc; `Ok ()
+ with Sys_error e -> `Error e
+
+ let write_subst f vars s = try
+ let oc = open_out f in
+ let start = ref 0 in
+ let last = ref 0 in
+ let len = String.length s in
+ while (!last < len - 2) do
+ if not (s.[!last] = '%' && s.[!last + 1] = '%') then incr last else
+ begin
+ let start_subst = !last in
+ let last_id = ref (!last + 2) in
+ let stop = ref false in
+ while (!last_id < len - 1 && not !stop) do
+ if not (s.[!last_id] = '%' && s.[!last_id + 1] = '%') then begin
+ if s.[!last_id] <> ' ' then (incr last_id) else
+ (stop := true; last := !last_id)
+ end else begin
+ let id_start = start_subst + 2 in
+ let id = String.sub s (id_start) (!last_id - id_start) in
+ try
+ let subst = List.assoc id vars in
+ output oc s !start (start_subst - !start);
+ output_string oc subst;
+ stop := true;
+ start := !last_id + 2;
+ last := !last_id + 2;
+ with Not_found ->
+ stop := true;
+ last := !last_id
+ end
+ done
+ end
+ done;
+ output oc s !start (len - !start); close_out oc; `Ok ()
+ with Sys_error e -> `Error e
+
+ let delete ?(maybe = false) file = try
+ if maybe && not (exists file) then `Ok () else
+ `Ok (Sys.remove file)
+ with Sys_error e -> `Error e
+
+ let temp () = try
+ let f = Filename.temp_file (Filename.basename Sys.argv.(0)) "topkg" in
+ at_exit (fun () -> ignore (delete f)); `Ok f
+ with Sys_error e -> `Error e
+end
+
+(** Working with directories. *)
+module Dir : sig
+ val exists : string -> bool
+ (** [exists dir] is [true] if directory [dir] exists. *)
+
+ val change_cwd : string -> unit result
+ (** [change_cwd dir] changes the current working directory to [dir]. *)
+
+ val fold_files_rec : ?skip:string list -> (string -> 'a -> 'a result) ->
+ 'a -> string list -> 'a result
+ (** [fold_files_rec skip f acc paths] folds [f] over the files
+ found in [paths]. Files and directories whose suffix matches an
+ element of [skip] are skipped. *)
+end = struct
+ let exists dir = Sys.file_exists dir && Sys.is_directory dir
+ let change_cwd dir = try `Ok (Sys.chdir dir) with Sys_error e -> `Error e
+ let fold_files_rec ?(skip = []) f acc paths =
+ let is_dir d = try Sys.is_directory d with Sys_error _ -> false in
+ let readdir d = try Array.to_list (Sys.readdir d) with Sys_error _ -> [] in
+ let keep p = not (List.exists (fun s -> Filename.check_suffix p s) skip) in
+ let process acc file = match acc with
+ | `Error _ as e -> e
+ | `Ok acc -> f file acc
+ in
+ let rec aux f acc = function
+ | (d :: ds) :: up ->
+ let paths = List.rev_map (Filename.concat d) (readdir d) in
+ let paths = List.find_all keep paths in
+ let dirs, files = List.partition is_dir paths in
+ begin match List.fold_left process acc files with
+ | `Error _ as e -> e
+ | `Ok _ as acc -> aux f acc (dirs :: ds :: up)
+ end
+ | [] :: [] -> acc
+ | [] :: up -> aux f acc up
+ | _ -> assert false
+ in
+ let paths = List.find_all keep paths in
+ let dirs, files = List.partition is_dir paths in
+ let acc = List.fold_left process (`Ok acc) files in
+ aux f acc (dirs :: [])
+end
+
+(** Command invocation. *)
+module Cmd : sig
+ val exec : string -> unit result
+ (** [exec cmd] executes [cmd]. *)
+
+ val exec_hook : string option -> unit result
+ (** [exec_hook args] is [exec ("ocaml " ^ "args")] if [args] is some. *)
+
+ val read : string -> string result
+ (** [read cmd] executes [cmd] and returns the contents of its stdout. *)
+end = struct
+ let exec cmd =
+ let code = Sys.command cmd in
+ if code = 0 then `Ok () else
+ `Error (Printf.sprintf "invocation `%s' exited with %d" cmd code)
+
+ let exec_hook args = match args with
+ | None -> `Ok ()
+ | Some args -> exec (Printf.sprintf "ocaml %s" args)
+
+ let read cmd =
+ File.temp () >>= fun file ->
+ exec (Printf.sprintf "%s > %s" cmd file) >>= fun () ->
+ File.read file >>= fun v ->
+ `Ok v
+end
+
+(** Variable substitution. *)
+module Vars : sig
+ val subst : skip:string list -> vars:(string * string) list ->
+ dir:string -> unit result
+ (** [subst skip vars dir] substitutes [vars] in all files
+ in [dir] except those that are [skip]ped (see {!Dir.fold_files_rec}). *)
+
+ val get : string -> (string * string) list -> string result
+ (** [get v] lookup variable [v] in [vars]. Returns an error if [v] is
+ absent or if it is the empty string. *)
+
+end = struct
+ let subst ~skip ~vars ~dir =
+ let subst f () =
+ File.read f >>= fun contents ->
+ File.write_subst f vars contents >>= fun () -> `Ok ()
+ in
+ Dir.fold_files_rec ~skip subst () [dir]
+
+ let get v vars =
+ let v = try List.assoc v vars with Not_found -> "" in
+ if v <> "" then `Ok v else
+ `Error (Printf.sprintf "empty or undefined variable %s in Config.vars" v)
+end
+
+(** Git invocations. *)
+module Git : sig
+ val describe : ?chop_v:bool -> string -> string
+ (** [describe chop_v branch] invokes [git describe branch]. If [chop_v]
+ is [true] (defaults to [false]) an initial ['v'] in the result
+ is chopped. *)
+end = struct
+ let describe ?(chop_v = false) branch =
+ if not (Dir.exists ".git") then "not-a-git-checkout" else
+ Cmd.read (Printf.sprintf "git describe %s" branch) &>>= fun d ->
+ let len = String.length d in
+ if chop_v && len > 0 && d.[0] = 'v' then String.sub d 1 (len - 2) else
+ String.sub d 0 (len - 1) (* remove \n *)
+end
+
+(** Default configuration. *)
+module Config_default : sig
+ val subst_skip : string list
+ (** [subst_skip] is a list of suffixes that are automatically
+ skipped during variable substitution. *)
+
+ val vars : (string * string) list
+ (** [vars] is the list of variables to substitute, empty. *)
+
+ val git_hook : string option
+ (** [git_start_hook] is an ocaml script to invoke before a git package
+ build, after variable substitution occured. *)
+
+ val distrib_remove : string list
+ (** [distrib_remove] is a list of files to remove before making
+ the distributino tarball. *)
+
+ val distrib_hook : string option
+ (** [distrib_hook] is an ocaml script to invoke before trying
+ to build the distribution. *)
+
+ val www_demos : string list
+ (** [www_demos] is a list of build targets that represent single page
+ js_of_ocaml demo. *)
+end = struct
+ let subst_skip = [".git"; ".png"; ".jpeg"; ".otf"; ".ttf"; ".pdf" ]
+ let vars = []
+ let git_hook = None
+ let distrib_remove = [".git"; ".gitignore"; "build"]
+ let distrib_hook = None
+ let www_demos = []
+end
+
+
+(*---------------------------------------------------------------------------
+ Copyright (c) 2014 Daniel C. Bünzli.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ 3. Neither the name of Daniel C. Bünzli nor the names of
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ ---------------------------------------------------------------------------*)
diff --git a/pkg/topkg.ml b/pkg/topkg.ml
new file mode 100644
index 0000000..e539992
--- /dev/null
+++ b/pkg/topkg.ml
@@ -0,0 +1,303 @@
+(*---------------------------------------------------------------------------
+ Copyright (c) 2014 Daniel C. Bünzli. All rights reserved.
+ Distributed under the BSD3 license, see license at the end of the file.
+ react release 1.0.1
+ ---------------------------------------------------------------------------*)
+
+(* Public api *)
+
+(** Build environment access *)
+module type Env = sig
+ val bool : string -> bool
+ (** [bool key] declares [key] as being a boolean key in the environment.
+ Specifing key=(true|false) on the command line becomes mandatory. *)
+
+ val native : bool
+ (** [native] is [bool "native"]. *)
+
+ val native_dynlink : bool
+ (** [native_dylink] is [bool "native-dynlink"] *)
+end
+
+(** Exts defines sets of file extensions. *)
+module type Exts = sig
+ val interface : string list
+ (** [interface] is [[".mli"; ".cmi"; ".cmti"]] *)
+
+ val interface_opt : string list
+ (** [interface_opt] is [".cmx" :: interface] *)
+
+ val library : string list
+ (** [library] is [[".cma"; ".cmxa"; ".cmxs"; ".a"]] *)
+
+ val module_library : string list
+ (** [module_library] is [(interface_opt @ library)]. *)
+end
+
+(** Package description. *)
+module type Pkg = sig
+ type builder = [ `OCamlbuild | `Other of string * string ]
+ (** The type for build tools. Either [`OCamlbuild] or an
+ [`Other (tool, bdir)] tool [tool] that generates its build artefacts
+ in [bdir]. *)
+
+ type moves
+ (** The type for install moves. *)
+
+ type field = ?cond:bool -> ?exts:string list -> ?dst:string -> string -> moves
+ (** The type for field install functions. A call
+ [field cond exts dst path] generates install moves as follows:
+ {ul
+ {- If [cond] is [false] (defaults to [true]), no move is generated.}
+ {- If [exts] is present, generates a move for each path in
+ the list [List.map (fun e -> path ^ e) exts].}
+ {- If [dst] is present this path is used as the move destination
+ (allows to install in subdirectories). If absent [dst] is
+ [Filename.basename path].} *)
+
+ val lib : field
+ val bin : ?auto:bool -> field
+ (** If [auto] is true (defaults to false) generates
+ [path ^ ".native"] if {!Env.native} is [true] and
+ [path ^ ".byte"] if {!Env.native} is [false]. *)
+ val sbin : ?auto:bool -> field (** See {!bin}. *)
+ val toplevel : field
+ val share : field
+ val share_root : field
+ val etc : field
+ val doc : field
+ val misc : field
+ val stublibs : field
+ val man : field
+ val describe : string -> builder:builder -> moves list -> unit
+ (** [describe name builder moves] describes a package named [name] with
+ builder [builder] and install moves [moves]. *)
+end
+
+(* Implementation *)
+
+module Topkg : sig
+ val cmd : [`Build | `Explain | `Help ]
+ val env : (string * bool) list
+ val err_parse : string -> 'a
+ val err_mdef : string -> 'a
+ val err_miss : string -> 'a
+ val err_file : string -> string -> 'a
+ val warn_unused : string -> unit
+end = struct
+
+ (* Parses the command line. The actual cmd execution occurs in the call
+ to Pkg.describe. *)
+
+ let err fmt =
+ let k _ = exit 1 in
+ Format.kfprintf k Format.err_formatter ("%s: " ^^ fmt ^^ "@.") Sys.argv.(0)
+
+ let err_parse a = err "argument `%s' is not of the form key=(true|false)" a
+ let err_mdef a = err "bool `%s' is defined more than once" a
+ let err_miss a = err "argument `%s=(true|false)' is missing" a
+ let err_file f e = err "%s: %s" f e
+ let warn_unused k =
+ Format.eprintf "%s: warning: environment key `%s` unused. at ." Sys.argv.(0) k
+
+ let cmd, env =
+ let rec parse_env acc = function (* not t.r. *)
+ | arg :: args ->
+ begin try
+ (* String.cut ... *)
+ let len = String.length arg in
+ let eq = String.index arg '=' in
+ let bool = bool_of_string (String.sub arg (eq + 1) (len - eq - 1)) in
+ let key = String.sub arg 0 eq in
+ if key = "" then raise Exit else
+ try ignore (List.assoc key acc); err_mdef key with
+ | Not_found -> parse_env ((key, bool) :: acc) args
+ with
+ | Invalid_argument _ | Not_found | Exit -> err_parse arg
+ end
+ | [] -> acc
+ in
+ match List.tl (Array.to_list Sys.argv) with
+ | "explain" :: args -> `Explain, parse_env [] args
+ | ("help" | "-h" | "--help" | "-help") :: args -> `Help, parse_env [] args
+ | args -> `Build, parse_env [] args
+end
+
+module Env : sig
+ include Env
+ val get : unit -> (string * bool) list
+end = struct
+ let env = ref []
+ let get () = !env
+ let add_bool key b = env := (key, b) :: !env
+ let bool key =
+ let b = try List.assoc key Topkg.env with
+ | Not_found -> if Topkg.cmd = `Build then Topkg.err_miss key else true
+ in
+ add_bool key b; b
+
+ let native = bool "native"
+ let native_dynlink = bool "native-dynlink"
+end
+
+module Exts : Exts = struct
+ let interface = [".mli"; ".cmi"; ".cmti"]
+ let interface_opt = ".cmx" :: interface
+ let library = [".cma"; ".cmxa"; ".cmxs"; ".a"]
+ let module_library = (interface_opt @ library)
+end
+
+module Pkg : Pkg = struct
+ type builder = [ `OCamlbuild | `Other of string * string ]
+ type moves = (string * (string * string)) list
+ type field = ?cond:bool -> ?exts:string list -> ?dst:string -> string -> moves
+
+ let str = Printf.sprintf
+ let warn_unused () =
+ let keys = List.map fst Topkg.env in
+ let keys_used = List.map fst (Env.get ()) in
+ let unused = List.find_all (fun k -> not (List.mem k keys_used)) keys in
+ List.iter Topkg.warn_unused unused
+
+ let has_suffix = Filename.check_suffix
+ let build_strings ?(exec_sep = " ") btool bdir mvs =
+ let no_build = [ ".cmti"; ".cmt" ] in
+ let install = Buffer.create 1871 in
+ let exec = Buffer.create 1871 in
+ let rec add_mvs current = function
+ | (field, (src, dst)) :: mvs when field = current ->
+ if List.exists (has_suffix src) no_build then
+ Buffer.add_string install (str "\n \"?%s/%s\" {\"%s\"}" bdir src dst)
+ else begin
+ Buffer.add_string exec (str "%s%s" exec_sep src);
+ Buffer.add_string install (str "\n \"%s/%s\" {\"%s\"}" bdir src dst);
+ end;
+ add_mvs current mvs
+ | (((field, _) :: _) as mvs) ->
+ if current <> "" (* first *) then Buffer.add_string install " ]\n";
+ Buffer.add_string install (str "%s: [" field);
+ add_mvs field mvs
+ | [] -> ()
+ in
+ Buffer.add_string exec btool;
+ add_mvs "" mvs;
+ Buffer.add_string install " ]\n";
+ Buffer.contents install, Buffer.contents exec
+
+ let pr = Format.printf
+ let pr_explanation btool bdir pkg mvs =
+ let env = Env.get () in
+ let install, exec = build_strings ~exec_sep:" \\\n " btool bdir mvs in
+ pr "@[<v>";
+ pr "Package name: %s@," pkg;
+ pr "Build tool: %s@," btool;
+ pr "Build directory: %s@," bdir;
+ pr "Environment:@, ";
+ List.iter (fun (k,v) -> pr "%s=%b@, " k v) (List.sort compare env);
+ pr "@,Build invocation:@,";
+ pr " %s@,@," exec;
+ pr "Install file:@,";
+ pr "%s@," install;
+ pr "@]";
+ ()
+
+ let pr_help () =
+ pr "Usage example:@\n %s" Sys.argv.(0);
+ List.iter (fun (k,v) -> pr " %s=%b" k v) (List.sort compare (Env.get ()));
+ pr "@."
+
+ let build btool bdir pkg mvs =
+ let install, exec = build_strings btool bdir mvs in
+ let e = Sys.command exec in
+ if e <> 0 then exit e else
+ let install_file = pkg ^ ".install" in
+ try
+ let oc = open_out install_file in
+ output_string oc install; flush oc; close_out oc
+ with Sys_error e -> Topkg.err_file install_file e
+
+ let mvs ?(drop_exts = []) field ?(cond = true) ?(exts = []) ?dst src =
+ if not cond then [] else
+ let mv src dst = (field, (src, dst)) in
+ let expand exts s d = List.map (fun e -> mv (s ^ e) (d ^ e)) exts in
+ let dst = match dst with None -> Filename.basename src | Some dst -> dst in
+ let files = if exts = [] then [mv src dst] else expand exts src dst in
+ let keep (_, (src, _)) = not (List.exists (has_suffix src) drop_exts) in
+ List.find_all keep files
+
+ let lib =
+ let drop_exts =
+ if Env.native && not Env.native_dynlink then [ ".cmxs" ] else
+ if not Env.native then [ ".a"; ".cmx"; ".cmxa"; ".cmxs" ] else []
+ in
+ mvs ~drop_exts "lib"
+
+ let share = mvs "share"
+ let share_root = mvs "share_root"
+ let etc = mvs "etc"
+ let toplevel = mvs "toplevel"
+ let doc = mvs "doc"
+ let misc = mvs "misc"
+ let stublibs = mvs "stublib"
+ let man = mvs "man"
+
+ let bin_drops = if not Env.native then [ ".native" ] else []
+ let bin_mvs field ?(auto = false) ?cond ?exts ?dst src =
+ let src, dst =
+ if not auto then src, dst else
+ let dst = match dst with
+ | None -> Some (Filename.basename src)
+ | Some _ as dst -> dst
+ in
+ let src = if Env.native then src ^ ".native" else src ^ ".byte" in
+ src, dst
+ in
+ mvs ~drop_exts:bin_drops field ?cond ?dst src
+
+ let bin = bin_mvs "bin"
+ let sbin = bin_mvs "sbin"
+
+ let describe pkg ~builder mvs =
+ let mvs = List.sort compare (List.flatten mvs) in
+ let btool, bdir = match builder with
+ | `OCamlbuild -> "ocamlbuild -use-ocamlfind -classic-display", "_build"
+ | `Other (btool, bdir) -> btool, bdir
+ in
+ match Topkg.cmd with
+ | `Explain -> pr_explanation btool bdir pkg mvs
+ | `Help -> pr_help ()
+ | `Build -> warn_unused (); build btool bdir pkg mvs
+end
+
+(*---------------------------------------------------------------------------
+ Copyright (c) 2014 Daniel C. Bünzli.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ 3. Neither the name of Daniel C. Bünzli nor the names of
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ ---------------------------------------------------------------------------*)
diff --git a/src/react.ml b/src/react.ml
index aab46d0..f69a682 100644
--- a/src/react.ml
+++ b/src/react.ml
@@ -1,7 +1,7 @@
(*---------------------------------------------------------------------------
Copyright (c) 2009 Daniel C. Bünzli. All rights reserved.
Distributed under a BSD3 license, see license at the end of the file.
- react release 1.0.0
+ react release 1.0.1
---------------------------------------------------------------------------*)
let err_max_rank = "maximal rank exceeded"
@@ -1107,7 +1107,7 @@ module S = struct
| Const i -> signal ~i m' p u
| Smut m -> Node.add_dep m.snode m'.snode; signal m' p u
- let bind ?eq s sf = switch ?eq (map sf s)
+ let bind ?eq s sf = switch ?eq (map ~eq:( == ) sf s)
let fix ?(eq = ( = )) i f =
let update_delayed n p u nl =
diff --git a/src/react.mli b/src/react.mli
index 50837ce..ff6045a 100644
--- a/src/react.mli
+++ b/src/react.mli
@@ -1,7 +1,7 @@
(*---------------------------------------------------------------------------
Copyright (c) 2009 Daniel C. Bünzli. All rights reserved.
Distributed under a BSD3 license, see license at the end of the file.
- react release 1.0.0
+ react release 1.0.1
---------------------------------------------------------------------------*)
(** Declarative events and signals.
@@ -16,7 +16,7 @@
{{!ex}examples}. Open the module to use it, this defines only two
types and modules in your scope.
- {e Release 1.0.0 - Daniel Bünzli <daniel.buenzl i\@erratique.ch> } *)
+ {e Release 1.0.1 - Daniel Bünzli <daniel.buenzl i\@erratique.ch> } *)
(** {1 Interface} *)
@@ -419,7 +419,7 @@ module S : sig
val bind : ?eq:('b -> 'b -> bool) -> 'a signal -> ('a -> 'b signal) ->
'b signal
- (** [bind s sf] is [switch (map sf s)]. *)
+ (** [bind s sf] is [switch (map ~eq:( == ) sf s)]. *)
val fix : ?eq:('a -> 'a -> bool) -> 'a -> ('a signal -> 'a signal * 'b) -> 'b
(** [fix i sf] allow to refer to the value a signal had an
diff --git a/test/test.ml b/test/test.ml
index 7e6a37e..8643213 100644
--- a/test/test.ml
+++ b/test/test.ml
@@ -933,6 +933,22 @@ let test_esswitch4 () = (* test_esswitch3 + high rank. *)
List.iter set_y [1; 1; 2; 2]; List.iter set_x [7; 7; 8; 8; 9; 9];
List.iter empty [assert_s; !assert_d1; !assert_d2; !assert_d3]
+let test_bind () =
+ let e, set_e = E.create () in
+ let a = S.hold 0 e in
+ let b = S.hold 1 e in
+ let s, set_s = S.create true in
+ let next = function
+ | true -> b
+ | false -> a
+ in
+ let f = S.bind s next in
+ let assert_bind = vals f [1; 0; 3;] in
+ set_s false;
+ set_e 3;
+ set_s true;
+ List.iter empty [assert_bind]
+
let test_fix () =
let s, set_s = S.create 0 in
let history s =
@@ -1085,6 +1101,7 @@ let test_signals () =
test_esswitch3 ();
test_switch4 ();
test_esswitch4 ();
+ test_bind ();
test_fix ();
test_fix' ();
test_lifters ();
diff --git a/test/tests.itarget b/test/tests.itarget
index 1771929..443ae9c 100644
--- a/test/tests.itarget
+++ b/test/tests.itarget
@@ -1,3 +1,3 @@
test.native
clock.native
-breakout.native
+breakout.native
\ No newline at end of file
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/react.git
More information about the Pkg-ocaml-maint-commits
mailing list