mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-07 11:45:31 -05:00
use oasis to build files, splitted into libraries, including
a Container module that packs everything; ToWeb module (depends on CamlGI) to expoert values on the web
This commit is contained in:
Simon Cruanes
parent
9dc91cec65
commit
7313a258b4
16 changed files with 7637 additions and 44 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -5,3 +5,4 @@ _build
|
||||||
.session
|
.session
|
||||||
TAGS
|
TAGS
|
||||||
*.docdir
|
*.docdir
|
||||||
|
setup.log
|
||||||
|
|
|
||||||
44
META
Normal file
44
META
Normal file
|
|
@ -0,0 +1,44 @@
|
||||||
|
# OASIS_START
|
||||||
|
# DO NOT EDIT (digest: 228a31c6369b1dd4a6ea763cff7e020e)
|
||||||
|
version = "0.1"
|
||||||
|
description = "A bunch of modules, including polymorphic containers."
|
||||||
|
requires = "unix"
|
||||||
|
archive(byte) = "containers.cma"
|
||||||
|
archive(byte, plugin) = "containers.cma"
|
||||||
|
archive(native) = "containers.cmxa"
|
||||||
|
archive(native, plugin) = "containers.cmxs"
|
||||||
|
exists_if = "containers.cma"
|
||||||
|
package "thread" (
|
||||||
|
version = "0.1"
|
||||||
|
description = "A bunch of modules, including polymorphic containers."
|
||||||
|
requires = "containers lwt"
|
||||||
|
archive(byte) = "containers_thread.cma"
|
||||||
|
archive(byte, plugin) = "containers_thread.cma"
|
||||||
|
archive(native) = "containers_thread.cmxa"
|
||||||
|
archive(native, plugin) = "containers_thread.cmxs"
|
||||||
|
exists_if = "containers_thread.cma"
|
||||||
|
)
|
||||||
|
|
||||||
|
package "lwt" (
|
||||||
|
version = "0.1"
|
||||||
|
description = "A bunch of modules, including polymorphic containers."
|
||||||
|
requires = "containers lwt"
|
||||||
|
archive(byte) = "containers_lwt.cma"
|
||||||
|
archive(byte, plugin) = "containers_lwt.cma"
|
||||||
|
archive(native) = "containers_lwt.cmxa"
|
||||||
|
archive(native, plugin) = "containers_lwt.cmxs"
|
||||||
|
exists_if = "containers_lwt.cma"
|
||||||
|
)
|
||||||
|
|
||||||
|
package "cgi" (
|
||||||
|
version = "0.1"
|
||||||
|
description = "A bunch of modules, including polymorphic containers."
|
||||||
|
requires = "containers CamlGI"
|
||||||
|
archive(byte) = "containers_cgi.cma"
|
||||||
|
archive(byte, plugin) = "containers_cgi.cma"
|
||||||
|
archive(native) = "containers_cgi.cmxa"
|
||||||
|
archive(native, plugin) = "containers_cgi.cmxs"
|
||||||
|
exists_if = "containers_cgi.cma"
|
||||||
|
)
|
||||||
|
# OASIS_STOP
|
||||||
|
|
||||||
77
Makefile
77
Makefile
|
|
@ -1,53 +1,52 @@
|
||||||
|
# OASIS_START
|
||||||
|
# DO NOT EDIT (digest: bc1e05bfc8b39b664f29dae8dbd3ebbb)
|
||||||
|
|
||||||
INTERFACE_FILES = $(shell find -name '*.mli')
|
SETUP = ocaml setup.ml
|
||||||
IMPLEMENTATION_FILES = $(shell find -name '*.ml')
|
|
||||||
|
build: setup.data
|
||||||
|
$(SETUP) -build $(BUILDFLAGS)
|
||||||
|
|
||||||
|
doc: setup.data build
|
||||||
|
$(SETUP) -doc $(DOCFLAGS)
|
||||||
|
|
||||||
|
test: setup.data build
|
||||||
|
$(SETUP) -test $(TESTFLAGS)
|
||||||
|
|
||||||
|
all:
|
||||||
|
$(SETUP) -all $(ALLFLAGS)
|
||||||
|
|
||||||
|
install: setup.data
|
||||||
|
$(SETUP) -install $(INSTALLFLAGS)
|
||||||
|
|
||||||
|
uninstall: setup.data
|
||||||
|
$(SETUP) -uninstall $(UNINSTALLFLAGS)
|
||||||
|
|
||||||
|
reinstall: setup.data
|
||||||
|
$(SETUP) -reinstall $(REINSTALLFLAGS)
|
||||||
|
|
||||||
|
clean:
|
||||||
|
$(SETUP) -clean $(CLEANFLAGS)
|
||||||
|
|
||||||
|
distclean:
|
||||||
|
$(SETUP) -distclean $(DISTCLEANFLAGS)
|
||||||
|
|
||||||
|
setup.data:
|
||||||
|
$(SETUP) -configure $(CONFIGUREFLAGS)
|
||||||
|
|
||||||
|
.PHONY: build doc test all install uninstall reinstall clean distclean configure
|
||||||
|
|
||||||
|
# OASIS_STOP
|
||||||
|
|
||||||
TARGETS_LIB = containers.cmxa containers.cma
|
|
||||||
TARGETS_DOC = containers.docdir/index.html
|
|
||||||
EXAMPLES = examples/mem_size.native examples/collatz.native \
|
EXAMPLES = examples/mem_size.native examples/collatz.native \
|
||||||
examples/bencode_write.native # examples/crawl.native
|
examples/bencode_write.native # examples/crawl.native
|
||||||
|
|
||||||
OPTIONS = -use-ocamlfind
|
|
||||||
|
|
||||||
ENABLE_THREAD ?= yes
|
|
||||||
ENABLE_LWT ?= yes
|
|
||||||
|
|
||||||
ifeq ($(ENABLE_THREAD), yes)
|
|
||||||
OPTIONS += -tag thread
|
|
||||||
TARGETS_LIB += thread_containers.cmxa thread_containers.cma
|
|
||||||
TARGETS_DOC += thread_containers.docdir/index.html
|
|
||||||
endif
|
|
||||||
ifeq ($(ENABLE_LWT), yes)
|
|
||||||
OPTIONS += -package lwt -package lwt.unix
|
|
||||||
TARGETS_LIB += lwt_containers.cmxa lwt_containers.cma
|
|
||||||
TARGETS_DOC += lwt_containers.docdir/index.html
|
|
||||||
endif
|
|
||||||
|
|
||||||
all: lib
|
|
||||||
|
|
||||||
lib:
|
|
||||||
ocamlbuild $(OPTIONS) $(TARGETS_LIB) $(TARGETS_DOC)
|
|
||||||
|
|
||||||
doc:
|
|
||||||
ocamlbuild $(OPTIONS) $(TARGETS_DOC)
|
|
||||||
|
|
||||||
examples: all
|
examples: all
|
||||||
ocamlbuild $(OPTIONS) -package unix -I . $(EXAMPLES)
|
ocamlbuild $(OPTIONS) -package unix -I . $(EXAMPLES)
|
||||||
|
|
||||||
tests: lib
|
|
||||||
ocamlbuild $(OPTIONS) -package oUnit -I . tests/run_tests.native
|
|
||||||
|
|
||||||
bench:
|
|
||||||
ocamlbuild $(OPTIONS) -package bench -package unix -I . tests/benchs.native
|
|
||||||
|
|
||||||
push_doc: doc
|
push_doc: doc
|
||||||
scp -r containers.docdir/* cedeela.fr:~/simon/root/software/containers/
|
scp -r containers.docdir/* cedeela.fr:~/simon/root/software/containers/
|
||||||
|
|
||||||
clean:
|
|
||||||
ocamlbuild -clean
|
|
||||||
|
|
||||||
tags:
|
tags:
|
||||||
otags *.ml *.mli
|
otags *.ml *.mli
|
||||||
|
|
||||||
.PHONY: all clean tests tags examples
|
.PHONY: examples push_doc tags
|
||||||
|
|
||||||
|
|
|
||||||
106
_oasis
Normal file
106
_oasis
Normal file
|
|
@ -0,0 +1,106 @@
|
||||||
|
OASISFormat: 0.3
|
||||||
|
Name: containers
|
||||||
|
Version: 0.1
|
||||||
|
Homepage: https://github.com/c-cube/ocaml-containers
|
||||||
|
Authors: Simon Cruanes
|
||||||
|
License: BSD3
|
||||||
|
LicenseFile: LICENSE
|
||||||
|
Plugins: META (0.3), DevFiles (0.3)
|
||||||
|
OCamlVersion: >= 4.00.1
|
||||||
|
BuildTools: ocamlbuild
|
||||||
|
|
||||||
|
Synopsis: A bunch of modules, including polymorphic containers.
|
||||||
|
Description:
|
||||||
|
A bunch of useful modules, including polymorphic containers, graph
|
||||||
|
abstractions, serialization systems, testing systems and various
|
||||||
|
experiments.
|
||||||
|
|
||||||
|
Flag "cgi"
|
||||||
|
Description: Build modules related to FastCGI, depending on CamlGI
|
||||||
|
Default: false
|
||||||
|
|
||||||
|
Flag "lwt"
|
||||||
|
Description: Build modules which depend on Lwt
|
||||||
|
Default: false
|
||||||
|
|
||||||
|
Flag "thread"
|
||||||
|
Description: Build modules that depend on threads
|
||||||
|
Default: true
|
||||||
|
|
||||||
|
Flag "bench"
|
||||||
|
Description: Build and run benchmarks
|
||||||
|
Default: false
|
||||||
|
|
||||||
|
Library "containers"
|
||||||
|
Path: .
|
||||||
|
Pack: true
|
||||||
|
Modules: Cache, Deque, Gen, FHashtbl, FQueue, FlatHashtbl, Hashset,
|
||||||
|
Heap, LazyGraph, PersistentGraph, PersistentHashtbl,
|
||||||
|
PHashtbl, Sequence, SkipList, SplayTree, SplayMap, Univ,
|
||||||
|
Vector, Bij, PiCalculus, Bencode, Sexp, RAL, MultiSet,
|
||||||
|
UnionFind, SmallSet, Leftistheap, AbsSet, CSM, MultiMap,
|
||||||
|
ActionMan, BV, QCheck, BencodeOnDisk, Show
|
||||||
|
BuildDepends: unix
|
||||||
|
|
||||||
|
Library "containers_thread"
|
||||||
|
Path: .
|
||||||
|
Modules: Future
|
||||||
|
FindlibName: thread
|
||||||
|
FindlibParent: containers
|
||||||
|
Build$: flag(thread)
|
||||||
|
Install$: flag(thread)
|
||||||
|
BuildDepends: containers,threads
|
||||||
|
XMETARequires: containers,lwt
|
||||||
|
|
||||||
|
Library "containers_lwt"
|
||||||
|
Path: .
|
||||||
|
Modules: Behavior
|
||||||
|
FindlibName: lwt
|
||||||
|
FindlibParent: containers
|
||||||
|
Build$: flag(lwt)
|
||||||
|
Install$: flag(lwt)
|
||||||
|
BuildDepends: containers,lwt
|
||||||
|
XMETARequires: containers,lwt
|
||||||
|
|
||||||
|
Library "containers_cgi"
|
||||||
|
Path: .
|
||||||
|
Modules: ToWeb
|
||||||
|
FindlibName: cgi
|
||||||
|
FindlibParent: containers
|
||||||
|
Build$: flag(cgi)
|
||||||
|
Install$: flag(cgi)
|
||||||
|
BuildDepends: containers,CamlGI
|
||||||
|
XMETARequires: containers,CamlGI
|
||||||
|
|
||||||
|
Document containers
|
||||||
|
Title: Containers docs
|
||||||
|
Type: ocamlbuild (0.3)
|
||||||
|
BuildTools+: ocamldoc
|
||||||
|
Install: true
|
||||||
|
XOCamlbuildPath: .
|
||||||
|
XOCamlbuildLibraries: containers,containers.lwt
|
||||||
|
|
||||||
|
Executable benchs
|
||||||
|
Path: tests/
|
||||||
|
Install: false
|
||||||
|
CompiledObject: native
|
||||||
|
MainIs: benchs.ml
|
||||||
|
BuildDepends: containers,bench
|
||||||
|
|
||||||
|
Test all
|
||||||
|
Command: $run_tests
|
||||||
|
TestTools: run_tests
|
||||||
|
Run$: flag(tests)
|
||||||
|
|
||||||
|
Executable run_tests
|
||||||
|
Path: tests/
|
||||||
|
Install: false
|
||||||
|
CompiledObject: native
|
||||||
|
MainIs: run_tests.ml
|
||||||
|
Build$: flag(tests) && flag(lwt)
|
||||||
|
BuildDepends: containers, oUnit, lwt
|
||||||
|
|
||||||
|
SourceRepository head
|
||||||
|
Type: git
|
||||||
|
Location: https://github.com/c-cube/ocaml-containers
|
||||||
|
Browser: https://github.com/c-cube/ocaml-containers/tree/master/src
|
||||||
82
_tags
82
_tags
|
|
@ -1,4 +1,78 @@
|
||||||
<**/*future.*>: thread
|
# OASIS_START
|
||||||
<examples/crawl.*>: package(batteries), thread, package(unix)
|
# DO NOT EDIT (digest: 2ccc5fef0936d36155ec2a8d19a2c516)
|
||||||
<behavior.*>: package(lwt), package(unix)
|
# Ignore VCS directories, you can use the same kind of rule outside
|
||||||
<tests/*.native>: thread
|
# OASIS_START/STOP if you want to exclude directories that contains
|
||||||
|
# useless stuff for the build process
|
||||||
|
<**/.svn>: -traverse
|
||||||
|
<**/.svn>: not_hygienic
|
||||||
|
".bzr": -traverse
|
||||||
|
".bzr": not_hygienic
|
||||||
|
".hg": -traverse
|
||||||
|
".hg": not_hygienic
|
||||||
|
".git": -traverse
|
||||||
|
".git": not_hygienic
|
||||||
|
"_darcs": -traverse
|
||||||
|
"_darcs": not_hygienic
|
||||||
|
# Library containers
|
||||||
|
"containers.cmxs": use_containers
|
||||||
|
"cache.cmx": for-pack(Containers)
|
||||||
|
"deque.cmx": for-pack(Containers)
|
||||||
|
"gen.cmx": for-pack(Containers)
|
||||||
|
"fHashtbl.cmx": for-pack(Containers)
|
||||||
|
"fQueue.cmx": for-pack(Containers)
|
||||||
|
"flatHashtbl.cmx": for-pack(Containers)
|
||||||
|
"hashset.cmx": for-pack(Containers)
|
||||||
|
"heap.cmx": for-pack(Containers)
|
||||||
|
"lazyGraph.cmx": for-pack(Containers)
|
||||||
|
"persistentGraph.cmx": for-pack(Containers)
|
||||||
|
"persistentHashtbl.cmx": for-pack(Containers)
|
||||||
|
"pHashtbl.cmx": for-pack(Containers)
|
||||||
|
"sequence.cmx": for-pack(Containers)
|
||||||
|
"skipList.cmx": for-pack(Containers)
|
||||||
|
"splayTree.cmx": for-pack(Containers)
|
||||||
|
"splayMap.cmx": for-pack(Containers)
|
||||||
|
"univ.cmx": for-pack(Containers)
|
||||||
|
"vector.cmx": for-pack(Containers)
|
||||||
|
"bij.cmx": for-pack(Containers)
|
||||||
|
"piCalculus.cmx": for-pack(Containers)
|
||||||
|
"bencode.cmx": for-pack(Containers)
|
||||||
|
"sexp.cmx": for-pack(Containers)
|
||||||
|
"RAL.cmx": for-pack(Containers)
|
||||||
|
"multiSet.cmx": for-pack(Containers)
|
||||||
|
"unionFind.cmx": for-pack(Containers)
|
||||||
|
"smallSet.cmx": for-pack(Containers)
|
||||||
|
"leftistheap.cmx": for-pack(Containers)
|
||||||
|
"absSet.cmx": for-pack(Containers)
|
||||||
|
"CSM.cmx": for-pack(Containers)
|
||||||
|
"multiMap.cmx": for-pack(Containers)
|
||||||
|
"actionMan.cmx": for-pack(Containers)
|
||||||
|
"BV.cmx": for-pack(Containers)
|
||||||
|
"qCheck.cmx": for-pack(Containers)
|
||||||
|
"bencodeOnDisk.cmx": for-pack(Containers)
|
||||||
|
"show.cmx": for-pack(Containers)
|
||||||
|
# Library containers_thread
|
||||||
|
"containers_thread.cmxs": use_containers_thread
|
||||||
|
<*.ml{,i}>: pkg_threads
|
||||||
|
# Library containers_lwt
|
||||||
|
"containers_lwt.cmxs": use_containers_lwt
|
||||||
|
<*.ml{,i}>: pkg_lwt
|
||||||
|
# Library containers_cgi
|
||||||
|
"containers_cgi.cmxs": use_containers_cgi
|
||||||
|
<*.ml{,i}>: use_containers
|
||||||
|
<*.ml{,i}>: pkg_CamlGI
|
||||||
|
<*.ml{,i}>: pkg_unix
|
||||||
|
# Executable benchs
|
||||||
|
"tests/benchs.native": use_containers
|
||||||
|
"tests/benchs.native": pkg_bench
|
||||||
|
"tests/benchs.native": pkg_unix
|
||||||
|
<tests/*.ml{,i}>: pkg_bench
|
||||||
|
# Executable run_tests
|
||||||
|
"tests/run_tests.native": use_containers
|
||||||
|
"tests/run_tests.native": pkg_oUnit
|
||||||
|
"tests/run_tests.native": pkg_lwt
|
||||||
|
"tests/run_tests.native": pkg_unix
|
||||||
|
<tests/*.ml{,i}>: use_containers
|
||||||
|
<tests/*.ml{,i}>: pkg_oUnit
|
||||||
|
<tests/*.ml{,i}>: pkg_lwt
|
||||||
|
<tests/*.ml{,i}>: pkg_unix
|
||||||
|
# OASIS_STOP
|
||||||
|
|
|
||||||
27
configure
vendored
Executable file
27
configure
vendored
Executable file
|
|
@ -0,0 +1,27 @@
|
||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
# OASIS_START
|
||||||
|
# DO NOT EDIT (digest: 425187ed8bfdbdd207fd76392dd243a7)
|
||||||
|
set -e
|
||||||
|
|
||||||
|
FST=true
|
||||||
|
for i in "$@"; do
|
||||||
|
if $FST; then
|
||||||
|
set --
|
||||||
|
FST=false
|
||||||
|
fi
|
||||||
|
|
||||||
|
case $i in
|
||||||
|
--*=*)
|
||||||
|
ARG=${i%%=*}
|
||||||
|
VAL=${i##*=}
|
||||||
|
set -- "$@" "$ARG" "$VAL"
|
||||||
|
;;
|
||||||
|
*)
|
||||||
|
set -- "$@" "$i"
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
done
|
||||||
|
|
||||||
|
ocaml setup.ml -configure "$@"
|
||||||
|
# OASIS_STOP
|
||||||
|
|
@ -1,3 +1,5 @@
|
||||||
|
# OASIS_START
|
||||||
|
# DO NOT EDIT (digest: c71ccfdbd010237adfeae06ed09c46ad)
|
||||||
Cache
|
Cache
|
||||||
Deque
|
Deque
|
||||||
Gen
|
Gen
|
||||||
|
|
@ -33,3 +35,4 @@ BV
|
||||||
QCheck
|
QCheck
|
||||||
BencodeOnDisk
|
BencodeOnDisk
|
||||||
Show
|
Show
|
||||||
|
# OASIS_STOP
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
containers.mllib
|
|
||||||
39
containers.odocl
Normal file
39
containers.odocl
Normal file
|
|
@ -0,0 +1,39 @@
|
||||||
|
# OASIS_START
|
||||||
|
# DO NOT EDIT (digest: 3b0c2006d9fcd3955eb8118014479a19)
|
||||||
|
Cache
|
||||||
|
Deque
|
||||||
|
Gen
|
||||||
|
FHashtbl
|
||||||
|
FQueue
|
||||||
|
FlatHashtbl
|
||||||
|
Hashset
|
||||||
|
Heap
|
||||||
|
LazyGraph
|
||||||
|
PersistentGraph
|
||||||
|
PersistentHashtbl
|
||||||
|
PHashtbl
|
||||||
|
Sequence
|
||||||
|
SkipList
|
||||||
|
SplayTree
|
||||||
|
SplayMap
|
||||||
|
Univ
|
||||||
|
Vector
|
||||||
|
Bij
|
||||||
|
PiCalculus
|
||||||
|
Bencode
|
||||||
|
Sexp
|
||||||
|
RAL
|
||||||
|
MultiSet
|
||||||
|
UnionFind
|
||||||
|
SmallSet
|
||||||
|
Leftistheap
|
||||||
|
AbsSet
|
||||||
|
CSM
|
||||||
|
MultiMap
|
||||||
|
ActionMan
|
||||||
|
BV
|
||||||
|
QCheck
|
||||||
|
BencodeOnDisk
|
||||||
|
Show
|
||||||
|
Behavior
|
||||||
|
# OASIS_STOP
|
||||||
4
containers_cgi.mllib
Normal file
4
containers_cgi.mllib
Normal file
|
|
@ -0,0 +1,4 @@
|
||||||
|
# OASIS_START
|
||||||
|
# DO NOT EDIT (digest: f5192440033c9e32b425a31804bbddaa)
|
||||||
|
ToWeb
|
||||||
|
# OASIS_STOP
|
||||||
4
containers_lwt.mllib
Normal file
4
containers_lwt.mllib
Normal file
|
|
@ -0,0 +1,4 @@
|
||||||
|
# OASIS_START
|
||||||
|
# DO NOT EDIT (digest: b39a035a995fc6597c8eb942210d1527)
|
||||||
|
Behavior
|
||||||
|
# OASIS_STOP
|
||||||
4
containers_thread.mllib
Normal file
4
containers_thread.mllib
Normal file
|
|
@ -0,0 +1,4 @@
|
||||||
|
# OASIS_START
|
||||||
|
# DO NOT EDIT (digest: adff855173c9b92b5478129af7d39e03)
|
||||||
|
Future
|
||||||
|
# OASIS_STOP
|
||||||
497
myocamlbuild.ml
Normal file
497
myocamlbuild.ml
Normal file
|
|
@ -0,0 +1,497 @@
|
||||||
|
(* OASIS_START *)
|
||||||
|
(* DO NOT EDIT (digest: 240e1f430a880e29ecae75f577790609) *)
|
||||||
|
module OASISGettext = struct
|
||||||
|
(* # 21 "src/oasis/OASISGettext.ml" *)
|
||||||
|
|
||||||
|
let ns_ str =
|
||||||
|
str
|
||||||
|
|
||||||
|
let s_ str =
|
||||||
|
str
|
||||||
|
|
||||||
|
let f_ (str : ('a, 'b, 'c, 'd) format4) =
|
||||||
|
str
|
||||||
|
|
||||||
|
let fn_ fmt1 fmt2 n =
|
||||||
|
if n = 1 then
|
||||||
|
fmt1^^""
|
||||||
|
else
|
||||||
|
fmt2^^""
|
||||||
|
|
||||||
|
let init =
|
||||||
|
[]
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
module OASISExpr = struct
|
||||||
|
(* # 21 "src/oasis/OASISExpr.ml" *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
open OASISGettext
|
||||||
|
|
||||||
|
type test = string
|
||||||
|
|
||||||
|
type flag = string
|
||||||
|
|
||||||
|
type t =
|
||||||
|
| EBool of bool
|
||||||
|
| ENot of t
|
||||||
|
| EAnd of t * t
|
||||||
|
| EOr of t * t
|
||||||
|
| EFlag of flag
|
||||||
|
| ETest of test * string
|
||||||
|
|
||||||
|
|
||||||
|
type 'a choices = (t * 'a) list
|
||||||
|
|
||||||
|
let eval var_get t =
|
||||||
|
let rec eval' =
|
||||||
|
function
|
||||||
|
| EBool b ->
|
||||||
|
b
|
||||||
|
|
||||||
|
| ENot e ->
|
||||||
|
not (eval' e)
|
||||||
|
|
||||||
|
| EAnd (e1, e2) ->
|
||||||
|
(eval' e1) && (eval' e2)
|
||||||
|
|
||||||
|
| EOr (e1, e2) ->
|
||||||
|
(eval' e1) || (eval' e2)
|
||||||
|
|
||||||
|
| EFlag nm ->
|
||||||
|
let v =
|
||||||
|
var_get nm
|
||||||
|
in
|
||||||
|
assert(v = "true" || v = "false");
|
||||||
|
(v = "true")
|
||||||
|
|
||||||
|
| ETest (nm, vl) ->
|
||||||
|
let v =
|
||||||
|
var_get nm
|
||||||
|
in
|
||||||
|
(v = vl)
|
||||||
|
in
|
||||||
|
eval' t
|
||||||
|
|
||||||
|
let choose ?printer ?name var_get lst =
|
||||||
|
let rec choose_aux =
|
||||||
|
function
|
||||||
|
| (cond, vl) :: tl ->
|
||||||
|
if eval var_get cond then
|
||||||
|
vl
|
||||||
|
else
|
||||||
|
choose_aux tl
|
||||||
|
| [] ->
|
||||||
|
let str_lst =
|
||||||
|
if lst = [] then
|
||||||
|
s_ "<empty>"
|
||||||
|
else
|
||||||
|
String.concat
|
||||||
|
(s_ ", ")
|
||||||
|
(List.map
|
||||||
|
(fun (cond, vl) ->
|
||||||
|
match printer with
|
||||||
|
| Some p -> p vl
|
||||||
|
| None -> s_ "<no printer>")
|
||||||
|
lst)
|
||||||
|
in
|
||||||
|
match name with
|
||||||
|
| Some nm ->
|
||||||
|
failwith
|
||||||
|
(Printf.sprintf
|
||||||
|
(f_ "No result for the choice list '%s': %s")
|
||||||
|
nm str_lst)
|
||||||
|
| None ->
|
||||||
|
failwith
|
||||||
|
(Printf.sprintf
|
||||||
|
(f_ "No result for a choice list: %s")
|
||||||
|
str_lst)
|
||||||
|
in
|
||||||
|
choose_aux (List.rev lst)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
# 117 "myocamlbuild.ml"
|
||||||
|
module BaseEnvLight = struct
|
||||||
|
(* # 21 "src/base/BaseEnvLight.ml" *)
|
||||||
|
|
||||||
|
module MapString = Map.Make(String)
|
||||||
|
|
||||||
|
type t = string MapString.t
|
||||||
|
|
||||||
|
let default_filename =
|
||||||
|
Filename.concat
|
||||||
|
(Sys.getcwd ())
|
||||||
|
"setup.data"
|
||||||
|
|
||||||
|
let load ?(allow_empty=false) ?(filename=default_filename) () =
|
||||||
|
if Sys.file_exists filename then
|
||||||
|
begin
|
||||||
|
let chn =
|
||||||
|
open_in_bin filename
|
||||||
|
in
|
||||||
|
let st =
|
||||||
|
Stream.of_channel chn
|
||||||
|
in
|
||||||
|
let line =
|
||||||
|
ref 1
|
||||||
|
in
|
||||||
|
let st_line =
|
||||||
|
Stream.from
|
||||||
|
(fun _ ->
|
||||||
|
try
|
||||||
|
match Stream.next st with
|
||||||
|
| '\n' -> incr line; Some '\n'
|
||||||
|
| c -> Some c
|
||||||
|
with Stream.Failure -> None)
|
||||||
|
in
|
||||||
|
let lexer =
|
||||||
|
Genlex.make_lexer ["="] st_line
|
||||||
|
in
|
||||||
|
let rec read_file mp =
|
||||||
|
match Stream.npeek 3 lexer with
|
||||||
|
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
|
||||||
|
Stream.junk lexer;
|
||||||
|
Stream.junk lexer;
|
||||||
|
Stream.junk lexer;
|
||||||
|
read_file (MapString.add nm value mp)
|
||||||
|
| [] ->
|
||||||
|
mp
|
||||||
|
| _ ->
|
||||||
|
failwith
|
||||||
|
(Printf.sprintf
|
||||||
|
"Malformed data file '%s' line %d"
|
||||||
|
filename !line)
|
||||||
|
in
|
||||||
|
let mp =
|
||||||
|
read_file MapString.empty
|
||||||
|
in
|
||||||
|
close_in chn;
|
||||||
|
mp
|
||||||
|
end
|
||||||
|
else if allow_empty then
|
||||||
|
begin
|
||||||
|
MapString.empty
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
failwith
|
||||||
|
(Printf.sprintf
|
||||||
|
"Unable to load environment, the file '%s' doesn't exist."
|
||||||
|
filename)
|
||||||
|
end
|
||||||
|
|
||||||
|
let var_get name env =
|
||||||
|
let rec var_expand str =
|
||||||
|
let buff =
|
||||||
|
Buffer.create ((String.length str) * 2)
|
||||||
|
in
|
||||||
|
Buffer.add_substitute
|
||||||
|
buff
|
||||||
|
(fun var ->
|
||||||
|
try
|
||||||
|
var_expand (MapString.find var env)
|
||||||
|
with Not_found ->
|
||||||
|
failwith
|
||||||
|
(Printf.sprintf
|
||||||
|
"No variable %s defined when trying to expand %S."
|
||||||
|
var
|
||||||
|
str))
|
||||||
|
str;
|
||||||
|
Buffer.contents buff
|
||||||
|
in
|
||||||
|
var_expand (MapString.find name env)
|
||||||
|
|
||||||
|
let var_choose lst env =
|
||||||
|
OASISExpr.choose
|
||||||
|
(fun nm -> var_get nm env)
|
||||||
|
lst
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
# 215 "myocamlbuild.ml"
|
||||||
|
module MyOCamlbuildFindlib = struct
|
||||||
|
(* # 21 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
|
||||||
|
|
||||||
|
(** OCamlbuild extension, copied from
|
||||||
|
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
|
||||||
|
* by N. Pouillard and others
|
||||||
|
*
|
||||||
|
* Updated on 2009/02/28
|
||||||
|
*
|
||||||
|
* Modified by Sylvain Le Gall
|
||||||
|
*)
|
||||||
|
open Ocamlbuild_plugin
|
||||||
|
|
||||||
|
(* these functions are not really officially exported *)
|
||||||
|
let run_and_read =
|
||||||
|
Ocamlbuild_pack.My_unix.run_and_read
|
||||||
|
|
||||||
|
let blank_sep_strings =
|
||||||
|
Ocamlbuild_pack.Lexers.blank_sep_strings
|
||||||
|
|
||||||
|
let split s ch =
|
||||||
|
let x =
|
||||||
|
ref []
|
||||||
|
in
|
||||||
|
let rec go s =
|
||||||
|
let pos =
|
||||||
|
String.index s ch
|
||||||
|
in
|
||||||
|
x := (String.before s pos)::!x;
|
||||||
|
go (String.after s (pos + 1))
|
||||||
|
in
|
||||||
|
try
|
||||||
|
go s
|
||||||
|
with Not_found -> !x
|
||||||
|
|
||||||
|
let split_nl s = split s '\n'
|
||||||
|
|
||||||
|
let before_space s =
|
||||||
|
try
|
||||||
|
String.before s (String.index s ' ')
|
||||||
|
with Not_found -> s
|
||||||
|
|
||||||
|
(* this lists all supported packages *)
|
||||||
|
let find_packages () =
|
||||||
|
List.map before_space (split_nl & run_and_read "ocamlfind list")
|
||||||
|
|
||||||
|
(* this is supposed to list available syntaxes, but I don't know how to do it. *)
|
||||||
|
let find_syntaxes () = ["camlp4o"; "camlp4r"]
|
||||||
|
|
||||||
|
(* ocamlfind command *)
|
||||||
|
let ocamlfind x = S[A"ocamlfind"; x]
|
||||||
|
|
||||||
|
let dispatch =
|
||||||
|
function
|
||||||
|
| Before_options ->
|
||||||
|
(* by using Before_options one let command line options have an higher priority *)
|
||||||
|
(* on the contrary using After_options will guarantee to have the higher priority *)
|
||||||
|
(* override default commands by ocamlfind ones *)
|
||||||
|
Options.ocamlc := ocamlfind & A"ocamlc";
|
||||||
|
Options.ocamlopt := ocamlfind & A"ocamlopt";
|
||||||
|
Options.ocamldep := ocamlfind & A"ocamldep";
|
||||||
|
Options.ocamldoc := ocamlfind & A"ocamldoc";
|
||||||
|
Options.ocamlmktop := ocamlfind & A"ocamlmktop"
|
||||||
|
|
||||||
|
| After_rules ->
|
||||||
|
|
||||||
|
(* When one link an OCaml library/binary/package, one should use -linkpkg *)
|
||||||
|
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
|
||||||
|
|
||||||
|
(* For each ocamlfind package one inject the -package option when
|
||||||
|
* compiling, computing dependencies, generating documentation and
|
||||||
|
* linking. *)
|
||||||
|
List.iter
|
||||||
|
begin fun pkg ->
|
||||||
|
flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg];
|
||||||
|
flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg];
|
||||||
|
flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg];
|
||||||
|
flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg];
|
||||||
|
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg];
|
||||||
|
end
|
||||||
|
(find_packages ());
|
||||||
|
|
||||||
|
(* Like -package but for extensions syntax. Morover -syntax is useless
|
||||||
|
* when linking. *)
|
||||||
|
List.iter begin fun syntax ->
|
||||||
|
flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
|
||||||
|
flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
|
||||||
|
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
|
||||||
|
flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
|
||||||
|
end (find_syntaxes ());
|
||||||
|
|
||||||
|
(* The default "thread" tag is not compatible with ocamlfind.
|
||||||
|
* Indeed, the default rules add the "threads.cma" or "threads.cmxa"
|
||||||
|
* options when using this tag. When using the "-linkpkg" option with
|
||||||
|
* ocamlfind, this module will then be added twice on the command line.
|
||||||
|
*
|
||||||
|
* To solve this, one approach is to add the "-thread" option when using
|
||||||
|
* the "threads" package using the previous plugin.
|
||||||
|
*)
|
||||||
|
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
|
||||||
|
flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
|
||||||
|
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
|
||||||
|
flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"])
|
||||||
|
|
||||||
|
| _ ->
|
||||||
|
()
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
module MyOCamlbuildBase = struct
|
||||||
|
(* # 21 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
|
||||||
|
|
||||||
|
(** Base functions for writing myocamlbuild.ml
|
||||||
|
@author Sylvain Le Gall
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
open Ocamlbuild_plugin
|
||||||
|
module OC = Ocamlbuild_pack.Ocaml_compiler
|
||||||
|
|
||||||
|
type dir = string
|
||||||
|
type file = string
|
||||||
|
type name = string
|
||||||
|
type tag = string
|
||||||
|
|
||||||
|
(* # 56 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
lib_ocaml: (name * dir list) list;
|
||||||
|
lib_c: (name * dir * file list) list;
|
||||||
|
flags: (tag list * (spec OASISExpr.choices)) list;
|
||||||
|
(* Replace the 'dir: include' from _tags by a precise interdepends in
|
||||||
|
* directory.
|
||||||
|
*)
|
||||||
|
includes: (dir * dir list) list;
|
||||||
|
}
|
||||||
|
|
||||||
|
let env_filename =
|
||||||
|
Pathname.basename
|
||||||
|
BaseEnvLight.default_filename
|
||||||
|
|
||||||
|
let dispatch_combine lst =
|
||||||
|
fun e ->
|
||||||
|
List.iter
|
||||||
|
(fun dispatch -> dispatch e)
|
||||||
|
lst
|
||||||
|
|
||||||
|
let tag_libstubs nm =
|
||||||
|
"use_lib"^nm^"_stubs"
|
||||||
|
|
||||||
|
let nm_libstubs nm =
|
||||||
|
nm^"_stubs"
|
||||||
|
|
||||||
|
let dispatch t e =
|
||||||
|
let env =
|
||||||
|
BaseEnvLight.load
|
||||||
|
~filename:env_filename
|
||||||
|
~allow_empty:true
|
||||||
|
()
|
||||||
|
in
|
||||||
|
match e with
|
||||||
|
| Before_options ->
|
||||||
|
let no_trailing_dot s =
|
||||||
|
if String.length s >= 1 && s.[0] = '.' then
|
||||||
|
String.sub s 1 ((String.length s) - 1)
|
||||||
|
else
|
||||||
|
s
|
||||||
|
in
|
||||||
|
List.iter
|
||||||
|
(fun (opt, var) ->
|
||||||
|
try
|
||||||
|
opt := no_trailing_dot (BaseEnvLight.var_get var env)
|
||||||
|
with Not_found ->
|
||||||
|
Printf.eprintf "W: Cannot get variable %s" var)
|
||||||
|
[
|
||||||
|
Options.ext_obj, "ext_obj";
|
||||||
|
Options.ext_lib, "ext_lib";
|
||||||
|
Options.ext_dll, "ext_dll";
|
||||||
|
]
|
||||||
|
|
||||||
|
| After_rules ->
|
||||||
|
(* Declare OCaml libraries *)
|
||||||
|
List.iter
|
||||||
|
(function
|
||||||
|
| nm, [] ->
|
||||||
|
ocaml_lib nm
|
||||||
|
| nm, dir :: tl ->
|
||||||
|
ocaml_lib ~dir:dir (dir^"/"^nm);
|
||||||
|
List.iter
|
||||||
|
(fun dir ->
|
||||||
|
List.iter
|
||||||
|
(fun str ->
|
||||||
|
flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir]))
|
||||||
|
["compile"; "infer_interface"; "doc"])
|
||||||
|
tl)
|
||||||
|
t.lib_ocaml;
|
||||||
|
|
||||||
|
(* Declare directories dependencies, replace "include" in _tags. *)
|
||||||
|
List.iter
|
||||||
|
(fun (dir, include_dirs) ->
|
||||||
|
Pathname.define_context dir include_dirs)
|
||||||
|
t.includes;
|
||||||
|
|
||||||
|
(* Declare C libraries *)
|
||||||
|
List.iter
|
||||||
|
(fun (lib, dir, headers) ->
|
||||||
|
(* Handle C part of library *)
|
||||||
|
flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib]
|
||||||
|
(S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib";
|
||||||
|
A("-l"^(nm_libstubs lib))]);
|
||||||
|
|
||||||
|
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
|
||||||
|
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
|
||||||
|
|
||||||
|
flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
|
||||||
|
(S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
|
||||||
|
|
||||||
|
(* When ocaml link something that use the C library, then one
|
||||||
|
need that file to be up to date.
|
||||||
|
*)
|
||||||
|
dep ["link"; "ocaml"; "program"; tag_libstubs lib]
|
||||||
|
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
|
||||||
|
|
||||||
|
dep ["compile"; "ocaml"; "program"; tag_libstubs lib]
|
||||||
|
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
|
||||||
|
|
||||||
|
(* TODO: be more specific about what depends on headers *)
|
||||||
|
(* Depends on .h files *)
|
||||||
|
dep ["compile"; "c"]
|
||||||
|
headers;
|
||||||
|
|
||||||
|
(* Setup search path for lib *)
|
||||||
|
flag ["link"; "ocaml"; "use_"^lib]
|
||||||
|
(S[A"-I"; P(dir)]);
|
||||||
|
)
|
||||||
|
t.lib_c;
|
||||||
|
|
||||||
|
(* Add flags *)
|
||||||
|
List.iter
|
||||||
|
(fun (tags, cond_specs) ->
|
||||||
|
let spec =
|
||||||
|
BaseEnvLight.var_choose cond_specs env
|
||||||
|
in
|
||||||
|
flag tags & spec)
|
||||||
|
t.flags
|
||||||
|
| _ ->
|
||||||
|
()
|
||||||
|
|
||||||
|
let dispatch_default t =
|
||||||
|
dispatch_combine
|
||||||
|
[
|
||||||
|
dispatch t;
|
||||||
|
MyOCamlbuildFindlib.dispatch;
|
||||||
|
]
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
# 476 "myocamlbuild.ml"
|
||||||
|
open Ocamlbuild_plugin;;
|
||||||
|
let package_default =
|
||||||
|
{
|
||||||
|
MyOCamlbuildBase.lib_ocaml =
|
||||||
|
[
|
||||||
|
("containers", []);
|
||||||
|
("containers_thread", []);
|
||||||
|
("containers_lwt", []);
|
||||||
|
("containers_cgi", [])
|
||||||
|
];
|
||||||
|
lib_c = [];
|
||||||
|
flags = [];
|
||||||
|
includes = [];
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
|
||||||
|
let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
|
||||||
|
|
||||||
|
# 496 "myocamlbuild.ml"
|
||||||
|
(* OASIS_STOP *)
|
||||||
|
Ocamlbuild_plugin.dispatch dispatch_default;;
|
||||||
63
setup.data
Normal file
63
setup.data
Normal file
|
|
@ -0,0 +1,63 @@
|
||||||
|
ocamlfind="/home/simon/.opam/system/bin/ocamlfind"
|
||||||
|
ocamlc="/usr/bin/ocamlc.opt"
|
||||||
|
ocamlopt="/usr/bin/ocamlopt.opt"
|
||||||
|
ocamlbuild="/usr/bin/ocamlbuild"
|
||||||
|
pkg_name="containers"
|
||||||
|
pkg_version="0.1"
|
||||||
|
os_type="Unix"
|
||||||
|
system="linux"
|
||||||
|
architecture="amd64"
|
||||||
|
ccomp_type="cc"
|
||||||
|
ocaml_version="4.00.1"
|
||||||
|
standard_library_default="/usr/lib/ocaml"
|
||||||
|
standard_library="/usr/lib/ocaml"
|
||||||
|
standard_runtime="/usr/bin/ocamlrun"
|
||||||
|
bytecomp_c_compiler="gcc -fno-defer-pop -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT -fPIC"
|
||||||
|
native_c_compiler="gcc -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT"
|
||||||
|
model="default"
|
||||||
|
ext_obj=".o"
|
||||||
|
ext_asm=".s"
|
||||||
|
ext_lib=".a"
|
||||||
|
ext_dll=".so"
|
||||||
|
default_executable_name="a.out"
|
||||||
|
systhread_supported="true"
|
||||||
|
prefix="/usr/local"
|
||||||
|
exec_prefix="$prefix"
|
||||||
|
bindir="$exec_prefix/bin"
|
||||||
|
sbindir="$exec_prefix/sbin"
|
||||||
|
libexecdir="$exec_prefix/libexec"
|
||||||
|
sysconfdir="$prefix/etc"
|
||||||
|
sharedstatedir="$prefix/com"
|
||||||
|
localstatedir="$prefix/var"
|
||||||
|
libdir="$exec_prefix/lib"
|
||||||
|
datarootdir="$prefix/share"
|
||||||
|
datadir="$datarootdir"
|
||||||
|
infodir="$datarootdir/info"
|
||||||
|
localedir="$datarootdir/locale"
|
||||||
|
mandir="$datarootdir/man"
|
||||||
|
docdir="$datarootdir/doc/$pkg_name"
|
||||||
|
htmldir="$docdir"
|
||||||
|
dvidir="$docdir"
|
||||||
|
pdfdir="$docdir"
|
||||||
|
psdir="$docdir"
|
||||||
|
findlib_version="1.4"
|
||||||
|
is_native="true"
|
||||||
|
suffix_program=""
|
||||||
|
rm="rm -f"
|
||||||
|
rmdir="rm -rf"
|
||||||
|
debug="true"
|
||||||
|
profile="false"
|
||||||
|
native_dynlink="true"
|
||||||
|
ocamlbuildflags=""
|
||||||
|
cgi="false"
|
||||||
|
lwt="false"
|
||||||
|
thread="true"
|
||||||
|
bench="false"
|
||||||
|
docs="true"
|
||||||
|
tests="false"
|
||||||
|
ocaml_version_ge_4_00_1="4.00.1"
|
||||||
|
pkg_unix="/usr/lib/ocaml"
|
||||||
|
pkg_threads="/usr/lib/ocaml"
|
||||||
|
ocamldoc="/usr/bin/ocamldoc"
|
||||||
|
pkg_bench="/home/simon/.opam/system/lib/bench"
|
||||||
|
pkg_ounit="/home/simon/.opam/system/lib/oUnit"
|
||||||
341
toWeb.ml
Normal file
341
toWeb.ml
Normal file
|
|
@ -0,0 +1,341 @@
|
||||||
|
|
||||||
|
(*
|
||||||
|
copyright (c) 2013, simon cruanes
|
||||||
|
all rights reserved.
|
||||||
|
|
||||||
|
redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
redistributions of source code must retain the above copyright notice, this
|
||||||
|
list of conditions and the following disclaimer. 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.
|
||||||
|
|
||||||
|
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 HOLDER 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.
|
||||||
|
*)
|
||||||
|
|
||||||
|
(** {1 Expose the State of a Program to the Web}
|
||||||
|
|
||||||
|
We export some values (and associated functions for converting them to
|
||||||
|
html, and update them) as a FastCGI interface.
|
||||||
|
|
||||||
|
This module depends on CamlGI.
|
||||||
|
*)
|
||||||
|
|
||||||
|
(** {2 Some combinators to build HTML documents} *)
|
||||||
|
|
||||||
|
module HTML = struct
|
||||||
|
type t =
|
||||||
|
| Str of string (* content *)
|
||||||
|
| List of t list
|
||||||
|
| Url of url
|
||||||
|
| Img of image
|
||||||
|
| Concat of t list
|
||||||
|
| H of int * t
|
||||||
|
| Link of link
|
||||||
|
| Tag of string * t
|
||||||
|
and url = {
|
||||||
|
url_alt : string option;
|
||||||
|
url_url : string;
|
||||||
|
url_descr : string;
|
||||||
|
}
|
||||||
|
and image = {
|
||||||
|
img_alt : string option;
|
||||||
|
img_url : string;
|
||||||
|
}
|
||||||
|
and link = {
|
||||||
|
link_rel : string;
|
||||||
|
link_url : string;
|
||||||
|
}
|
||||||
|
|
||||||
|
let str s = Str s
|
||||||
|
|
||||||
|
let bprintf format =
|
||||||
|
let buffer = Buffer.create 64 in
|
||||||
|
Printf.kbprintf
|
||||||
|
(fun fmt -> str (Buffer.contents buffer))
|
||||||
|
buffer
|
||||||
|
format
|
||||||
|
|
||||||
|
let bprintf format =
|
||||||
|
let buffer = Buffer.create 64 in
|
||||||
|
Printf.ksprintf
|
||||||
|
str
|
||||||
|
format
|
||||||
|
|
||||||
|
let list l = List l
|
||||||
|
|
||||||
|
let url ?alt ~url ~descr = Url {
|
||||||
|
url_alt = alt;
|
||||||
|
url_url = url;
|
||||||
|
url_descr = descr;
|
||||||
|
}
|
||||||
|
|
||||||
|
let img ?alt url = Img {
|
||||||
|
img_alt = alt;
|
||||||
|
img_url = url;
|
||||||
|
}
|
||||||
|
|
||||||
|
let append a b = Concat [a; b]
|
||||||
|
|
||||||
|
let concat l = Concat l
|
||||||
|
|
||||||
|
let h1 x = H (1, x)
|
||||||
|
|
||||||
|
let h2 x = H (2, x)
|
||||||
|
|
||||||
|
let h3 x = H (3, x)
|
||||||
|
|
||||||
|
let h n x = H (n, x)
|
||||||
|
|
||||||
|
let link ~rel ~url = Link {
|
||||||
|
link_rel = rel;
|
||||||
|
link_url = url;
|
||||||
|
}
|
||||||
|
|
||||||
|
let head x = Tag ("head", x)
|
||||||
|
|
||||||
|
let body x = Tag ("body", x)
|
||||||
|
|
||||||
|
let html x = Tag ("html", x)
|
||||||
|
|
||||||
|
(* XXX UGLY: I copied code from CamlGI because it doesn't provide a way
|
||||||
|
to encode strings with HTML conventions. Bad bad bad. *)
|
||||||
|
module Encode = struct
|
||||||
|
(* Use a table lookup for speed. *)
|
||||||
|
let char_of_hex =
|
||||||
|
let hex = [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9';
|
||||||
|
'A'; 'B'; 'C'; 'D'; 'E'; 'F' |] in
|
||||||
|
fun i -> Array.unsafe_get hex i
|
||||||
|
|
||||||
|
|
||||||
|
let encode_wrt is_special s0 =
|
||||||
|
let len = String.length s0 in
|
||||||
|
let encoded_length = ref len in
|
||||||
|
for i = 0 to len - 1 do
|
||||||
|
if is_special(String.unsafe_get s0 i) then
|
||||||
|
encoded_length := !encoded_length + 2
|
||||||
|
done;
|
||||||
|
let s = String.create !encoded_length in
|
||||||
|
let rec do_enc i0 i = (* copy the encoded string in s *)
|
||||||
|
if i0 < len then begin
|
||||||
|
let s0i0 = String.unsafe_get s0 i0 in
|
||||||
|
if is_special s0i0 then begin
|
||||||
|
let c = Char.code s0i0 in
|
||||||
|
let i1 = succ i in
|
||||||
|
let i2 = succ i1 in
|
||||||
|
String.unsafe_set s i '%';
|
||||||
|
String.unsafe_set s i1 (char_of_hex (c lsr 4));
|
||||||
|
String.unsafe_set s i2 (char_of_hex (c land 0x0F));
|
||||||
|
do_enc (succ i0) (succ i2)
|
||||||
|
end
|
||||||
|
else if s0i0 = ' ' then begin
|
||||||
|
String.unsafe_set s i '+';
|
||||||
|
do_enc (succ i0) (succ i)
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
String.unsafe_set s i s0i0;
|
||||||
|
do_enc (succ i0) (succ i)
|
||||||
|
end
|
||||||
|
end in
|
||||||
|
do_enc 0 0;
|
||||||
|
s
|
||||||
|
|
||||||
|
|
||||||
|
(* Unreserved characters consist of all alphanumeric chars and the
|
||||||
|
following limited set of punctuation marks and symbols: '-' | '_' |
|
||||||
|
'.' | '!' | '~' | '*' | '\'' | '(' | ')'. According to RFC 2396,
|
||||||
|
they should not be escaped unless the context requires it. *)
|
||||||
|
let special_rfc2396 = function
|
||||||
|
| ';' | '/' | '?' | ':' | '@' | '&' | '=' | '+' | '$' | ',' (* Reserved *)
|
||||||
|
| '\000' .. '\031' | '\127' .. '\255' (* Control chars and non-ASCII *)
|
||||||
|
| '<' | '>' | '#' | '%' | '"' (* delimiters *)
|
||||||
|
| '{' | '}' | '|' | '\\' | '^' | '[' | ']' | '`' (* unwise *)
|
||||||
|
-> true
|
||||||
|
| _ -> false
|
||||||
|
(* ' ' must also be encoded but its encoding '+' takes a single char. *)
|
||||||
|
|
||||||
|
let encode = encode_wrt special_rfc2396
|
||||||
|
end
|
||||||
|
|
||||||
|
(* real rendering is always into a buffer (for now) *)
|
||||||
|
let rec to_buf buf x =
|
||||||
|
match x with
|
||||||
|
| Str s -> Buffer.add_string buf (Encode.encode s)
|
||||||
|
| List l ->
|
||||||
|
Buffer.add_string buf "<ul>";
|
||||||
|
List.iter
|
||||||
|
(fun y -> Printf.bprintf buf "<li>%a</li>" to_buf y)
|
||||||
|
l;
|
||||||
|
Buffer.add_string buf "</ul>"
|
||||||
|
| Url url ->
|
||||||
|
begin match url.url_alt with
|
||||||
|
| None ->
|
||||||
|
Printf.bprintf buf "<a href=\"%s\">%s</a>" url.url_url
|
||||||
|
(Encode.encode url.url_descr)
|
||||||
|
| Some alt ->
|
||||||
|
Printf.bprintf buf "<a href=\"%s\" alt=\"%s\">%s</a>"
|
||||||
|
url.url_url (Encode.encode alt) (Encode.encode url.url_descr)
|
||||||
|
end
|
||||||
|
| Img i -> failwith "img: not implemented"
|
||||||
|
| Concat l -> List.iter (to_buf buf) l
|
||||||
|
| H (n, y) ->
|
||||||
|
Printf.bprintf buf "<h%i> %a </h%i>" n to_buf y n
|
||||||
|
| Link _ -> failwith "link: not implemented"
|
||||||
|
| Tag (str, y) -> Printf.bprintf buf "<%s> %a </%s>" str to_buf y str
|
||||||
|
|
||||||
|
let render x =
|
||||||
|
let buf = Buffer.create 256 in
|
||||||
|
to_buf buf x;
|
||||||
|
Buffer.contents buf
|
||||||
|
|
||||||
|
let to_chan oc x =
|
||||||
|
let buf = Buffer.create 256 in
|
||||||
|
to_buf buf x;
|
||||||
|
Buffer.output_buffer oc buf
|
||||||
|
end
|
||||||
|
|
||||||
|
(** {2 Stateful Object on the Web} *)
|
||||||
|
|
||||||
|
module State = struct
|
||||||
|
type 'a t = {
|
||||||
|
mutable content : 'a;
|
||||||
|
mutable callbacks : ('a -> unit) list;
|
||||||
|
id : ('a -> string) option;
|
||||||
|
export : 'a -> HTML.t;
|
||||||
|
update : (string * string) list -> 'a -> 'a;
|
||||||
|
} (** A value that can be exposed to the Web.
|
||||||
|
The [export] function is used to print the current state of
|
||||||
|
the object into HTML (when requested).
|
||||||
|
The [update] optional function can be used to update
|
||||||
|
the value, given a query with parameters. *)
|
||||||
|
|
||||||
|
type wrap = Wrap : 'a t -> wrap
|
||||||
|
(** Hides the type parameter in a GADT. *)
|
||||||
|
|
||||||
|
let create ?(update=fun _ x -> x) ?id ~export content = {
|
||||||
|
content;
|
||||||
|
export;
|
||||||
|
id;
|
||||||
|
callbacks = [];
|
||||||
|
update;
|
||||||
|
}
|
||||||
|
|
||||||
|
let on_change st f =
|
||||||
|
st.callbacks <- f :: st.callbacks
|
||||||
|
|
||||||
|
let handle_request st req =
|
||||||
|
let cgi = new CamlGI.Cgi.cgi req in
|
||||||
|
(* update value? *)
|
||||||
|
try
|
||||||
|
let x = st.content in
|
||||||
|
let params = cgi#params in
|
||||||
|
(* update [x] using the parameters? *)
|
||||||
|
let y = st.update params x in
|
||||||
|
let changed = match st.id with
|
||||||
|
| None -> x != y
|
||||||
|
| Some id -> id x <> id y
|
||||||
|
in
|
||||||
|
(* notify callbacks that we have a new object *)
|
||||||
|
if changed then
|
||||||
|
List.iter (fun f -> f y) st.callbacks;
|
||||||
|
(* now print [y] *)
|
||||||
|
(* TODO: add a head, declaration, etc. *)
|
||||||
|
let html = st.export y in
|
||||||
|
let final_output = HTML.render html in
|
||||||
|
(* render output *)
|
||||||
|
let template = object
|
||||||
|
method output f = f final_output
|
||||||
|
end in
|
||||||
|
cgi#template template
|
||||||
|
with e ->
|
||||||
|
let msg = Printf.sprintf "error: %s" (Printexc.to_string e) in
|
||||||
|
cgi#log msg
|
||||||
|
end
|
||||||
|
|
||||||
|
(** {2 Routing} *)
|
||||||
|
|
||||||
|
module Router = struct
|
||||||
|
type t = {
|
||||||
|
mutable default : State.wrap;
|
||||||
|
log : out_channel option;
|
||||||
|
tbl : (string, State.wrap) Hashtbl.t;
|
||||||
|
}
|
||||||
|
|
||||||
|
let __default =
|
||||||
|
State.Wrap (State.create ~export:HTML.str "<no default handler>")
|
||||||
|
|
||||||
|
let _log router fmt = match router.log with
|
||||||
|
| None ->
|
||||||
|
Printf.ifprintf stdout fmt
|
||||||
|
| Some oc ->
|
||||||
|
Printf.kfprintf
|
||||||
|
(fun oc ->
|
||||||
|
output_char oc '\n';
|
||||||
|
flush oc)
|
||||||
|
oc
|
||||||
|
fmt
|
||||||
|
|
||||||
|
let create ?(default=__default) ?log () =
|
||||||
|
let router = {
|
||||||
|
default;
|
||||||
|
log;
|
||||||
|
tbl = Hashtbl.create 15;
|
||||||
|
} in
|
||||||
|
_log router "new router created";
|
||||||
|
router
|
||||||
|
|
||||||
|
let default router default =
|
||||||
|
router.default <- default
|
||||||
|
|
||||||
|
let unregister router name =
|
||||||
|
Hashtbl.remove router.tbl name
|
||||||
|
|
||||||
|
let register ?(weak=false) router name state =
|
||||||
|
if Hashtbl.mem router.tbl name
|
||||||
|
then failwith "Router: name already registered"
|
||||||
|
else begin
|
||||||
|
Hashtbl.add router.tbl name state;
|
||||||
|
if weak then match state with
|
||||||
|
| State.Wrap st ->
|
||||||
|
Gc.finalise (fun _ -> unregister router name) st.State.content
|
||||||
|
end
|
||||||
|
|
||||||
|
let add_list router l =
|
||||||
|
List.iter
|
||||||
|
(fun (name, state) -> register router name state)
|
||||||
|
l
|
||||||
|
|
||||||
|
let to_list router =
|
||||||
|
Hashtbl.fold
|
||||||
|
(fun name state acc -> (name,state) :: acc)
|
||||||
|
router.tbl []
|
||||||
|
|
||||||
|
let random_id () =
|
||||||
|
CamlGI.Cgi.random_sessionid ()
|
||||||
|
|
||||||
|
let handle_request router req =
|
||||||
|
let cgi = new CamlGI.Cgi.cgi req in
|
||||||
|
let url = cgi#url () in
|
||||||
|
let st =
|
||||||
|
try
|
||||||
|
let last_part_i = String.rindex url '/' in
|
||||||
|
let last_part = String.sub url (last_part_i+1) (String.length url -last_part_i-1) in
|
||||||
|
_log router "received request for url /%s" last_part;
|
||||||
|
Hashtbl.find router.tbl last_part
|
||||||
|
with Not_found ->
|
||||||
|
router.default
|
||||||
|
in
|
||||||
|
match st with
|
||||||
|
| State.Wrap st -> State.handle_request st req
|
||||||
|
end
|
||||||
192
toWeb.mli
Normal file
192
toWeb.mli
Normal file
|
|
@ -0,0 +1,192 @@
|
||||||
|
|
||||||
|
(*
|
||||||
|
copyright (c) 2013, simon cruanes
|
||||||
|
all rights reserved.
|
||||||
|
|
||||||
|
redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
redistributions of source code must retain the above copyright notice, this
|
||||||
|
list of conditions and the following disclaimer. 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.
|
||||||
|
|
||||||
|
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 HOLDER 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.
|
||||||
|
*)
|
||||||
|
|
||||||
|
(** {1 Expose the State of a Program to the Web}
|
||||||
|
|
||||||
|
We export some values (and associated functions for converting them to
|
||||||
|
html, and update them) as a FastCGI interface.
|
||||||
|
|
||||||
|
This module depends on CamlGI.
|
||||||
|
*)
|
||||||
|
|
||||||
|
(** {2 Some combinators to build HTML documents} *)
|
||||||
|
|
||||||
|
module HTML : sig
|
||||||
|
type t
|
||||||
|
(** A html document. Encoding is assumed to be UTF8 for now. *)
|
||||||
|
|
||||||
|
val str : string -> t
|
||||||
|
(** Simple string *)
|
||||||
|
|
||||||
|
val bprintf : ('a, Buffer.t, unit, string) format4 -> t
|
||||||
|
(** Use a buffer printer to render a string. Shortcut for {!str} *)
|
||||||
|
|
||||||
|
val sprintf : ('a, unit, string) format -> t
|
||||||
|
(** Use a string printer to render into a string. Shortcut for {!str} *)
|
||||||
|
|
||||||
|
val list : t list -> t
|
||||||
|
(** Build a list of items *)
|
||||||
|
|
||||||
|
val url : ?alt:string -> url:string -> descr:string -> t
|
||||||
|
(** build an URL tag. *)
|
||||||
|
|
||||||
|
val img : ?alt:string -> string -> t
|
||||||
|
(** Link to an image *)
|
||||||
|
|
||||||
|
val append : t -> t -> t
|
||||||
|
(** Concatenation of two documents *)
|
||||||
|
|
||||||
|
val concat : t list -> t
|
||||||
|
(** Concatenation of html documents *)
|
||||||
|
|
||||||
|
val h1 : t -> t
|
||||||
|
|
||||||
|
val h2 : t -> t
|
||||||
|
|
||||||
|
val h3 : t -> t
|
||||||
|
|
||||||
|
val h : int -> t -> t
|
||||||
|
(** Title of level parametrized by the integer *)
|
||||||
|
|
||||||
|
val link : rel:string -> url:string -> t
|
||||||
|
(** Link (for head) *)
|
||||||
|
|
||||||
|
val head : t -> t
|
||||||
|
(** Head part of a document *)
|
||||||
|
|
||||||
|
val body : t -> t
|
||||||
|
(** Body part of a document *)
|
||||||
|
|
||||||
|
val html : t -> t
|
||||||
|
(** The whole document *)
|
||||||
|
|
||||||
|
val render : t -> string
|
||||||
|
(** Print into a string *)
|
||||||
|
|
||||||
|
val to_buf : Buffer.t -> t -> unit
|
||||||
|
(** Print in the buffer *)
|
||||||
|
|
||||||
|
val to_chan : out_channel -> t -> unit
|
||||||
|
(** Print on the channel *)
|
||||||
|
end
|
||||||
|
|
||||||
|
(** {2 Stateful Object on the Web} *)
|
||||||
|
|
||||||
|
(** This module defines how to bundle an OCaml value (possibly
|
||||||
|
stateful) with functions that export it to HTML,
|
||||||
|
and possibly update it from a CGI request.
|
||||||
|
*)
|
||||||
|
|
||||||
|
module State : sig
|
||||||
|
type 'a t
|
||||||
|
(** A value that can be exposed to the web. *)
|
||||||
|
|
||||||
|
type wrap = Wrap : 'a t -> wrap
|
||||||
|
(** Hides the type parameter in a GADT. Useful for {!Router}. *)
|
||||||
|
|
||||||
|
val create : ?update:((string*string) list -> 'a -> 'a) ->
|
||||||
|
?id:('a -> string) ->
|
||||||
|
export:('a -> HTML.t) ->
|
||||||
|
'a ->
|
||||||
|
'a t
|
||||||
|
(** Create a value that can be exposed to the Web.
|
||||||
|
@param export function used to print the current state of
|
||||||
|
the object into HTML (when requested).
|
||||||
|
@param update optional function that can be used to update
|
||||||
|
the value, given a query with parameters.
|
||||||
|
@param id optional function that maps a value to a (unique)
|
||||||
|
string. Can be used to obtain a unique URL for this value. *)
|
||||||
|
|
||||||
|
val on_change : 'a t -> ('a -> unit) -> unit
|
||||||
|
(** Register a callback that will be called everytime the value
|
||||||
|
is updated. Physical equality is used to determine whether
|
||||||
|
the value changed if no [id] function was provided;
|
||||||
|
otherwise, [id] is used to check whether the old and the new
|
||||||
|
strings are equal. *)
|
||||||
|
|
||||||
|
val handle_request : 'a t -> CamlGI.Cgi.Request.t -> unit
|
||||||
|
(** Handle the incoming request. It replies to the request by
|
||||||
|
possibly updating the local state, and
|
||||||
|
object. *)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
(** {2 Routing} *)
|
||||||
|
|
||||||
|
module Router : sig
|
||||||
|
type t
|
||||||
|
(** An URL router. It dispatches incoming requests to registered
|
||||||
|
{!State.t} values depending on the request's URL. *)
|
||||||
|
|
||||||
|
val create : ?default:State.wrap -> ?log:out_channel -> unit -> t
|
||||||
|
(** New router.
|
||||||
|
@param log a channel on which to log events (incoming requests)
|
||||||
|
@param default a default object to expose, for incorrect routes
|
||||||
|
*)
|
||||||
|
|
||||||
|
val default : t -> State.wrap -> unit
|
||||||
|
(** Set the default handler, for incorrect routes (for which no
|
||||||
|
object is registered) or for routing the root url *)
|
||||||
|
|
||||||
|
val register : ?weak:bool -> t -> string -> State.wrap -> unit
|
||||||
|
(** Register a state object (see {!State}) under a given path.
|
||||||
|
Right now routing only dispatches at one level, there is no
|
||||||
|
tree-like structure, only a flat "directory" of objects.
|
||||||
|
|
||||||
|
@param weak (default false) if true, the object will unregister itself
|
||||||
|
when it's garbage collected. Only works if the type of the wrapped
|
||||||
|
object is heap allocated.
|
||||||
|
|
||||||
|
@raise Failure if the name is already taken
|
||||||
|
@raise Invalid_argument if [weak] is true and no finalizer can be
|
||||||
|
registered. *)
|
||||||
|
|
||||||
|
val unregister : t -> string -> unit
|
||||||
|
(** Remove a stateful value *)
|
||||||
|
|
||||||
|
val add_list : t -> (string * State.wrap) list -> unit
|
||||||
|
(** Register several handlers.
|
||||||
|
@raise Failure if it meets an already registered handler *)
|
||||||
|
|
||||||
|
val to_list : t -> (string * State.wrap) list
|
||||||
|
(** Currently registered objects *)
|
||||||
|
|
||||||
|
val random_id : unit -> string
|
||||||
|
(** Fresh, random ID that can be used for registering temporary objects *)
|
||||||
|
|
||||||
|
val handle_request : t -> CamlGI.Cgi.Request.t -> unit
|
||||||
|
(** Handle the incoming request, by routing to an appropriate
|
||||||
|
object. *)
|
||||||
|
end
|
||||||
|
|
||||||
|
(** {2 Main interface} *)
|
||||||
|
|
||||||
|
val serve_state : ?sockaddr:Unix.sockaddr -> 'a State.t -> unit
|
||||||
|
(** Serve incoming requests using a single object. *)
|
||||||
|
|
||||||
|
val serve_router : ?sockaddr:Unix.sockaddr -> Router.t -> unit
|
||||||
|
(** Shortcut. It calls {!CamlGI.Cgi.register_script} with a callback
|
||||||
|
that forwards requests to the given Router. *)
|
||||||
Loading…
Add table
Reference in a new issue