The following code...
type 'a osResult =
Success of 'a
| Error of string
let errorCatcher f =
try
let result = f () in
Success result
with Unix.Unix_error (code, fun_name, arg) ->
Error(String.concat ":" [(Unix.error_message code); fun_name; arg])
let my_getcwd () =
errorCatcher (fun () -> Unix.getcwd ())
let _ =
print_endline "The Start";
let result = my_getcwd () |> function
| Success folder -> Printf.sprintf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.sprintf "getcwd (error):\n\t%s\n" errMessage
in
print_string result ;
print_endline "The End."
;;
...compiles fine:
$ corebuild -tag debug test1.native
...and runs fine:
$ ./test1.native
The Start
getcwd:
/home/ttsiod/work/byePythonHelloOCaml
The End.
But if I change the main body to this:
let _ =
print_endline "The Start";
my_getcwd () |> function
| Success folder -> Printf.printf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.printf "getcwd (error):\n\t%s\n" errMessage
;
print_endline "The End."
;;
... then apparently the last print statement ("The End") gets lost or something...
$ ./test2.native
The Start
getcwd:
/home/ttsiod/work/byePythonHelloOCaml
Initially, I thought this is a case of stdout buffering not being flushed.
But the docs of print_endline clearly claim that it flushes stdout, so I am at a loss - and adding "flush" didn't help, either:
let _ =
print_endline "The Start";
my_getcwd () |> function
| Success folder -> Printf.printf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.printf "getcwd (error):\n\t%s\n" errMessage
;
print_endline "The End." ;
flush stdout
;;
Help?
The print_endline is treated as part of the Error case. From the indentation, this is clearly not what you meant, but unfortunately the OCaml compiler doesn't warn about this.
You can use begin and end (or just parentheses) to make it work:
let () =
print_endline "The Start";
my_getcwd () |> begin function
| Success folder -> Printf.printf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.printf "getcwd (error):\n\t%s\n" errMessage
end;
print_endline "The End." ;
flush stdout
Alternatively, without using ;,
let () =
let () = print_endline "The Start" in
let () = match my_getcwd () with
| Success folder -> Printf.printf "getcwd:\n\t%s\n" folder
| Error errMessage -> Printf.printf "getcwd (error):\n\t%s\n" errMessage
in
let () = print_endline "The End." in
flush stdout
Related
I am trying to understand the following behaviour of OCaml Format module and semantic tags.
My code:
let prepare_ppf ppf =
let original_stag_functions = Format.pp_get_formatter_stag_functions ppf () in
let original_mark_tags_state = Format.pp_get_mark_tags ppf () in
Format.pp_set_mark_tags ppf true;
Format.pp_set_print_tags ppf false;
Format.pp_set_formatter_stag_functions ppf {
mark_open_stag = (fun stag ->
print_endline "MARK-OPEN";
match stag with
| Format.String_tag s -> Printf.sprintf "<open:%s>" s
| _ -> "<UNKNOWN>"
);
mark_close_stag = (fun stag ->
print_endline "MARK-CLOSE";
match stag with
| Format.String_tag s -> Printf.sprintf "</close:%s>" s
| _ -> "</UNKNOWN>"
);
print_open_stag = (fun _ -> print_endline "PRINT-OPEN"; ());
print_close_stag = (fun _ -> print_endline "PRINT-CLOSE"; ());
};
print_endline "PREPARED";
if Format.pp_get_mark_tags ppf () then print_endline "MARK:true";
(fun ppf ->
print_endline "RESET";
Format.pp_set_mark_tags ppf original_mark_tags_state;
Format.pp_set_formatter_stag_functions ppf original_stag_functions;)
let fprintf ppf fmt =
let reset = prepare_ppf ppf in
Format.kfprintf reset ppf fmt
let printf fmt = fprintf Format.std_formatter fmt
If I paste that into: utop version 2.8.0 (using OCaml version 4.12.0)
When I run it:
utop # printf "#{<bold>%s#}" "hello";;
PREPARED
MARK:true
RESET
<bold>hello</bold>- : unit = ()
Why are the mark_open_stag and close functions not called?
If I change line 5 to Format.pp_set_print_tags ppf true; then I see the print_open_stag and close function are called.
This is an interaction between buffering and utop handling of the stdout formatter.
The buffering issue can be seen with
printf "#{<bold>%s#}" "A very very very very very very very very very very very very very very very very very long hello world";;
which prints the half-correct
PREPARED
MARK:true
MARK-OPEN
<open:bold>A very very very very very very very very very very very very very very very very very long hello worldRESET
</bold>
Going on step further, flushing the stdout at the end with
printf "#{<bold>%s#}#." "hello";;
yields the correct output
PREPARED
MARK:true
MARK-OPEN
<open:bold>helloMARK-CLOSE
</close:bold>
RESET
The issue is thus that
printf "#{<bold>%s#}" "hello"
buffers completely all its input.
And it is utop taking the hand on the stdout formatter which triggers the printing by trying to print
- : unit = ()
This yields then
<bold>hello</bold>- : unit = ()
because at the time of the printing utop has reset the formatter configuration to its own default.
In my wrap.ml, I have a function as follows:
Js.Unsafe.global##.test := Js.wrap_callback (
fun params ->
print_endline "params##.a:";
print_endline (Js.to_string params##.a);
print_endline "params##.b:";
print_endline (Js.to_string params##.b);
Js.string ((Js.to_string params##.a) ^ (Js.to_string params##.b))
);
As a result, in a JavaScript file, I could call e.g., test({a: "abc", b:"efg"}).
I would like to know in the OCaml file, is there a way to check if the field b exists in the object params, before evaluating Js.to_string params##.b?
You can see how to do this at the bottom of this page:
https://ocsigen.org/js_of_ocaml/latest/manual/bindings
For this code:
let () =
if Js.Optdef.test ((Js.Unsafe.coerce Dom_html.document)##.URL) then
Printf.printf "document.URL exists\n"
else
Printf.printf "document.URL does not exist\n";
if Js.Optdef.test ((Js.Unsafe.coerce Dom_html.document)##.XXX) then
Printf.printf "document.XXX exists\n"
else
Printf.printf "document.XXX does not exist\n";
I see the following on the Javascript console:
document.URL exists
document.XXX does not exist
can you help me out, i made this program to get an output from some .txt file like this :
john:3:uk
paul:18:us
#load "str.cma"
let f_test = "/home/test.txt" ;;
(*
Recursive Reading function
*)
let read_lines f_test : string list =
if Sys.file_exists (f_test) then
begin
let ic = open_in f_test in
try
let try_read () =
try Some (input_line ic) with End_of_file -> None in
let rec loop acc = match try_read () with
| Some s -> loop (s :: acc)
| None -> close_in_noerr ic; List.rev acc in
loop []
with e ->
close_in_noerr ic;
[]
end
else
[]
;;
(*Using Records*)
type user =
{
name : string;
age : int;
country : string;
};;
(*
Function to separated info in list
*)
let rec splitinfo ?(sep=":") l = match l with
| [] -> []
| x::xs -> (Str.split (Str.regexp ":") x)::splitinfo xs;;
(*
Function to get users position
*)
let get_user l:user =
let age = int_of_string (List.nth l 1) in
let user_name = List.nth l 0 in
{
name = user_name;
age = age ;
country = List.nth l 2;
};;
(*
Function to check some parameter is valid
*)
let par1 u: int =
if (u.age = 3) then
1
else
0;;
(*
Reporting function
*)
let report_statistics list_users =
let child = ref 0 in
let teenager = ref 0 in
let adult = ref 0 in print_string (" ----- -- Stats -- ----- \n" ) ;
List.iter (
fun user_l -> (
match user_l with
| [] -> print_string("> no user <\n")
| _ ->
let user = get_user user_l in
if (par1 user = 1) then (
print_string (" "^ user.name ^" --> Child \n" ) ;
child := !child + 1;
)
else
print_string (" "^ user.name ^" --> Other \n" );
)
) list_users;
print_string ("------- List ---- ");
print_newline();
print_string ("Child " );
print_int(!child);
print_newline();
print_string ("Teenager ") ;
print_int(!teenager);
print_newline();
print_string ("Adult ");
print_int(!adult);
print_newline();
;;
The program compile but doesn't output any result ...
What am i missing ?
I kept the function to check parameters simple so i can understand it better but can't figure it out why it isn't outputing any result
Can you help me out here ?
Thanks in advance :)
The code as given defines some functions such as read_lines and report_statistics. But there are no calls to these functions.
If there is no other OCaml source involved, this is probably your problem. You need to call the functions.
It is fairly customary to have a "main" function that does the work of an OCaml program, and then (this is key) you have to actually call the main function:
let main () =
(* Call the functions that do the work of the program *)
let () = main ()
I have many times forgotten this last line and then nothing happens when I run the program.
Taken from the chapter 18 of the Real World OCaml book, I'm trying to break down the example given.
My scope, to just make the GET call and print something of the JSON we get back.
This is my code ( it's supposed to be a subset of the example given )
(* libraries *)
open Core.Std
open Async.Std
(* Generate a DuckDuckGo search URI from a query string *)
let query_uri query =
let base_uri = Uri.of_string "http://api.duckduckgo.com/?format=json" in
Uri.add_query_param base_uri ("q", [query])
(* Extract the "Definition" or "Abstract" field from the DuckDuckGo results *)
let get_definition_from_json json_string =
match Yojson.Safe.from_string json_string with
| `Assoc kv_list ->
let find key =
begin match List.Assoc.find kv_list key with
| None | Some (`String "") -> None
| Some s -> Some (Yojson.Safe.to_string s)
end
in
begin match find "Abstract" with
| Some _ as x -> x
| None -> find "Definition"
end
| _ -> None
(* Execute the DuckDuckGo search *)
let get_definition word =
print_endline ("get_definition word:" ^ word);
Cohttp_async.Client.get (query_uri word)
>>= fun (_, body) ->
Pipe.to_list (Cohttp_async.Body.to_pipe body)
>>| fun strings ->
(word, get_definition_from_json (String.concat strings))
(* run *)
let () =
get_definition "OCaml"
>>= fun (word, def) ->
print_endline ("- word: " ^ word);
(
match def with
| None -> print_endline "[EMPTY]"
| Some str -> print_endline str
)
My issue is that I get this error when compiling:
ocaml setup.ml -build
Finished, 0 targets (0 cached) in 00:00:00.
+ /Users/antouank/.opam/system/bin/ocamlfind ocamlc -c -g -annot -bin-annot -thread -package yojson -package threads -package textwrap -package re2 -package core -package cohttp.async -I src -o src/main.cmo src/main.ml
File "src/main.ml", line 48, characters 18-41:
Error: This expression has type unit but an expression was expected of type
'a Async.Std.Deferred.t = 'a Async_kernel.Deferred0.t
Command exited with code 2.
Compilation unsuccessful after building 2 targets (0 cached) in 00:00:00.
E: Failure("Command ''/usr/local/bin/ocamlbuild' src/main.native -use-ocamlfind -tag debug' terminated with error code 10")
make: *** [build] Error 1
How can I get the string out of that Deferred, and what does that error mean exactly?
In the book, the example is run with a weird Command wrap, so I cannot see how to pull it out.
The problem in your definition of run is that the anonymous function
fun (word, def) ->
print_endline ("- word: " ^ word);
(
match def with
| None -> print_endline "[EMPTY]"
| Some str -> print_endline str
)
is not correctly typed to be used with a monadic operator >>=. It has type string * string -> unit while the >>= would here expect a function of type string * string -> unit Deferred.t.
If you look at the example of an echo server in the very same chapter, it will suggest the following approach:
let run () =
get_definition "OCaml"
>>= fun (word, def) ->
print_endline ("- word: " ^ word);
(
match def with
| None -> print_endline "[EMPTY]"
| Some str -> print_endline str
);
Deferred.return()
let () =
ignore(run ());
never_returns (Scheduler.go ())
I have some tests on infinite lazy structures that might run indefinitely if the tested function is not correctly implemented, but I can’t find in the OUnit docs how to set a timeout on tests.
If you're using OUnit2, the following should work:
let tests =
"suite" >::: [OUnitTest.TestCase (
OUnitTest.Short,
(fun _ -> assert_equal 2 (1+1))
);
OUnitTest.TestCase (
OUnitTest.Long,
(fun _ -> assert_equal 4 (2+2))
)]
The type test_length is defined as:
type test_length =
| Immediate
| Short
| Long
| Huge
| Custom_length of float
I don't think that oUnit provides this functionality. I remember having to do this a while back and this is the quick hack I've come up with:
let race seconds ~f =
let ch = Event.new_channel () in
let timeout = Thread.create (fun () ->
Thread.delay seconds;
`Time_out |> Event.send ch |> Event.sync
) () in
let tf = Thread.create (fun () ->
`Result (f ()) |> Event.send ch |> Event.sync) () in
let res = ch |> Event.receive |> Event.sync in
try
Thread.kill timeout;
Thread.kill tf;
res
with _ -> res
let () =
let big_sum () =
let arr = Array.init 1_000_000 (fun x -> x) in
Array.fold_left (+) 0 arr in
match race 0.0001 ~f:big_sum with
| `Time_out -> print_endline "time to upgrade";
| `Result x -> Printf.printf "sum is: %d\n" x
This worked well enough for my use case but I'd definitely would not recommend using this if only because race will not work as you'd expect if ~f does no allocations or calls Thread.yield manually.