I am trying to build a loop with Lwt that will push a frame to a Websocket, wait for the response, print it to the screen, wait 60 seconds and then repeat the process again. I have been able to get something that compiles but I do not have it 100% right yet. The first time through the loop everything works fine, then every time after that I receive the error message "Invalid UTF8 data". I must have something wrong in my Lwt loop or in my understanding of Websocket protocols. My code:
#require "websocket";;
#require "lwt";;
#require "lwt.syntax";;
open Lwt
(* Set up the websocket uri address *)
let ws_addr = Uri.of_string "websocket_address"
(* Set up the websocket connection *)
let ws_conn = Websocket.open_connection ws_addr
(* Set up a frame *)
let ws_frame = Websocket.Frame.of_string "json_string_to_server"
(* push function *)
let push frame () =
ws_conn
>>= fun (_, ws_pushfun) ->
ws_pushfun (Some frame);
Lwt.return ()
(* get stream element and print to screen *)
let get_element () =
let print_reply (x : Websocket.Frame.t) =
let s = Websocket.Frame.content x in
Lwt_io.print s; Lwt_io.flush Lwt_io.stdout;
in
ws_conn
>>= fun(ws_stream, _) ->
Lwt_stream.next ws_stream
>>= print_reply
let rec main () =
Lwt_unix.sleep 60.0
>>= (push ws_frame)
>>= get_element
>>= main
Lwt_main.run(main ())
I'm not sure what particularly incorrect with your code. It even doesn't compiles on my system. It looks like you were experimenting with it in a top-level and created some strange context. I've rewritten your code in a somewhat more cleaner way. First of all I pass a connection to the function, so that it is more cleaner, what your functions do. Also it is not a good idea to wait for the same thread again and again. This is not how things are done is Lwt.
open Lwt
(* Set up the websocket uri address *)
let ws_addr = Uri.of_string "websocket_address"
(* Set up a frame *)
let ws_frame = Websocket.Frame.of_string "json_string_to_server"
(* push function *)
let push (_,push) frame =
push (Some frame);
return_unit
(* get stream element and print to screen *)
let get_element (stream,_) =
let print_reply (x : Websocket.Frame.t) =
let s = Websocket.Frame.content x in
Lwt_io.printlf "%s%!" s in
Lwt_stream.next stream
>>= print_reply
let rec main conn : unit t =
Lwt_unix.sleep 60.0
>>= fun () -> push conn ws_frame
>>= fun () -> get_element conn
>>= fun () -> main conn
let () = Lwt_main.run (
Websocket.open_connection ws_addr >>= main)
Related
I'm trying to stop an event from subscribing to an event twice with this:
let ex = new Event<int>()
let lst = new ResizeArray<obj>()
let subscribe f =
if (lst.Contains f) then // <- doesn't work, can't compare functions
failwith ("subscribed twice!!")
else
lst.Add(f)
let obs = ex.Publish :> System.IObservable<_>
obs |> Observable.subscribe f
Unfortunately, it doesn't work. For example
let foo x = printfn "%d" x
subscribe foo
subscribe foo
ex.Trigger 42 // Produces 42 42
Looks like we can't compare functions in F#.
if (foo = foo) then () // won't compile
(foo :>obj) = (foo :> obj) // = false
Is there a way to compare functions or is there another way to stop multiple subscriptions on Events/IObservables?
I am not sure how to fully use the OCaml Websocket library. I was hoping that somebody could help me out with a simple example. I am trying to test the library out on websocket.org. I am just trying to send a message and then print the response. I'm confused as to how to use/access the functions returned by ws_conn. I thought that I could do something like let push,print = ws_conn in or let push,print = Websocket.open_connection ~tls:false ws_addr in but that does not seem to be correct. Here is what I have so far.
#require "websocket";;
(* Set up the websocket uri address *)
let ws_addr = Uri.of_string "ws://echo.websocket.org"
(* Set up the websocket connection *)
let ws_conn = Websocket.open_connection ~tls:false ws_addr
(* Set up a frame *)
let ws_frame = Websocket.Frame.of_string "Rock it with HTML5 WebSocket"
(* Function to handle replies *)
let with_reply s =
match s with
| Some x ->
let line = Websocket.Frame.content x in
print_string line
| None ->
print_string "Error Recieved no reply ..."
Thanks nlucaroni, after further reading I have created a concrete example as an answer to my question.
#require "websocket";;
#require "lwt";;
#require "lwt.syntax";;
(* Set up the uri address *)
let ws_addr = Uri.of_string "ws://echo.websocket.org"
(* Set up the websocket connection *)
let ws_conn = Websocket.open_connection ~tls:false ws_addr
(* Function to print a frame reply *)
let f (x : Websocket.Frame.t) =
let s = Websocket.Frame.content x in
print_string s;
Lwt.return ()
(* push a string *)
let push_msg =
ws_conn
>>= fun (_, ws_pushfun) ->
let ws_frame = Websocket.Frame.of_string msg in
ws_pushfun (Some ws_frame);
Lwt.return ()
(* print stream element *)
let print_element () =
ws_conn
>>= fun (ws_stream, _) ->
Lwt_stream.next ws_stream
>>= f
(* push string and print response *)
let push_print msg =
ws_conn
>>= fun(ws_stream, ws_pushfun) ->
let ws_frame = Websocket.Frame.of_string msg in
ws_pushfun (Some ws_frame);
Lwt_stream.next ws_stream >>= f
The open_connection function returns,
(Frame.t Lwt_stream.t * (Frame.t option -> unit)) Lwt.t
the 'a Lwt.t is a thread that returns the pair of a print stream and a push function for your use. You use the 'a Lwt.t in a monadic way, and a simple tutorial can be found http://ocsigen.org/lwt/manual/ .
Anyone can tell how to print a Stack data structure in OCaml?
The build-in Stack type definition is like :
type 'a t = { mutable c : 'a list }
exception Empty
let create () = { c = [] }
let clear s = s.c <- []
let push x s = s.c <- x :: s.c
let pop s = match s.c with hd::tl -> s.c <- tl; hd | [] -> raise Empty
let length s = List.length s.c
let iter f s = List.iter f s.c
Want to print and keep its elements in place, which means do not use pop and push.
Better to use the pattern matching to complete the problem.
Code should be like:
let print_stack stack =???
This looks like it could be homework. You should show something you've tried that didn't work, and explain why you think it didn't work. This is a lot more valuable that just having somebody give you the answer.
If it's not homework: if you think about it, you can find a good implementation at another place in the standard library. The implementation of Stack.iter tells you where to look.
It seems like the function Stack.iter does exactly what you want:
let print_stack print_elem stack = Stack.iter print_elem
Where. print_elem prints one element of the stack.
e.g. let print_elem_int n = (print_int n; print_newline ())
Finally get the answer:
let rec print_s {c=l}=
match l with
| [] -> raise Empty
| [x] -> print_int x; print_string " "
| h :: ts -> print_int h; print_string " "; print_s {c=ts}
;;
Improved version:
let print_s2 {c=l}=
let rec print_l list =
match list with
| [] -> raise Empty
| [x] -> print_int x; print_string " "
| h :: ts -> print_int h; print_string " "; print_l ts
in
print_l l
;;
How to modify below code to Return "string" so that returned output displayed on my MVC page and also would like to accept enteredChar from user.
Is there better way to do create this pyramid?
Current code:
let enteredChar = 'F' // As Interactive window doesn't support to Read Input
let mylist = ['A'..enteredChar]
let mylistlength = mylist |> List.length
let myfunc i x tlist1 =
(for j = 0 to mylistlength-i-2 do printf "%c" ' ')
let a1 = [for p in tlist1 do if p < x then yield p]
for p in a1 do printf "%c" p
printf "%c" x
let a2 = List.rev a1
for p in a2 do printf "%c" p
printfn "%s" " "
mylist |> List.iteri(fun i x -> myfunc i x mylist)
Output:
A
ABA
ABCBA
ABCDCBA
ABCDEDCBA
ABCDEFEDCBA
A few small optimizations could be:
Use StringBuilder instead of printf which is quite slow with long strings.
Use Array instead of List since Array works better with String.
Here is a version producing a pyramid string, which is kept closely to your code:
open System
open System.Text
let generateString c =
let sb = StringBuilder()
let generate i x arr =
String.replicate (Array.length arr-i-1) " " |> sb.Append |> ignore
let a1 = Array.filter (fun p -> p < x) arr
String(a1) |> sb.Append |> ignore
sb.Append x |> ignore
String(Array.rev a1) |> sb.Append |> ignore
sb.AppendLine " " |> ignore
let arr = [|'A'..c|]
arr |> Array.iteri(fun i x -> generate i x arr)
sb.ToString()
generateString 'F' |> printfn "%s"
As an alternative to Daniel's solution, you can achieve what you want with minimal changes to the code logic. Instead of using printf that writes the output to the console, you can use Printf.bprintf which writes the output to a specified StringBuilder. Then you can simply get the resulting string from the StringBuilder.
The modified function will look like this. I added parameter str and replaced printf with Printf.bprintf str (and printfn with bprintf together with additional \n char):
let myfunc i x tlist1 str =
(for j = 0 to mylistlength-i-2 do Printf.bprintf str "%c" ' ')
let a1 = [for p in tlist1 do if p < x then yield p]
for p in a1 do Printf.bprintf str "%c" p
Printf.bprintf str "%c" x
let a2 = List.rev a1
for p in a2 do Printf.bprintf str "%c" p
Printf.bprintf str "%s\n" " "
To call the function, you first create StringBuilder and then pass it to myfunc in every call. At the end, you can get the result using ToString method:
let str = StringBuilder()
mylist |> List.iteri(fun i x -> myfunc i x mylist str)
str.ToString()
I think Daniel's solution looks nicer, but this is the most direct way to tunr your printing code into a string-building code (and it can be done, pretty much, using Search & Replace).
If I understand your question (this likely belongs on Code Review) here's one way to rewrite your function:
let showPyramid (output: TextWriter) lastChar =
let chars = [|'A' .. lastChar|]
let getRowChars n =
let rec loop acc i =
[|
if i < n then let c = chars.[i] in yield c; yield! loop (c::acc) (i+1)
else yield! List.tail acc
|]
loop [] 0
let n = chars.Length
for r = 1 to n do
output.WriteLine("{0}{1}{0}", String(' ', n - r), String(getRowChars r))
Example
showPyramid Console.Out 'F'
or, to output to a string
use output = new StringWriter()
showPyramid output 'F'
let pyramid = output.ToString()
EDIT
After seeing Tomas' answer I realized I skipped over "return a string" in your question. I updated the code and added examples to show how you could do that.
let pyramid (ch:char) =
let ar = [| 'A'..ch |]
let len = ar.Length
Array.mapi
(fun i ch ->
let ar = ar.[0..i]
String.replicate (len - i - 1) " " + new string(ar) + new string((Array.rev ar).[1..]))
ar
|> String.concat "\n"
pyramid 'F' |> printfn "%s"
Here's another approach that seems to be a good demonstration of functional composition. I bet it's the shortest solution among the answers here. :)
let charsToString = Seq.map string >> String.concat String.Empty
let pyramid lastChar =
let src = '-'::['A'..lastChar] |> List.toArray
let len = Array.length src - 1
fun row col -> row-abs(col-len+1)+1 |> max 0 |> Array.get src // (1)
>> Seq.init (len*2-1) >> charsToString // (2)
|> Seq.init len // (3)
pyramid 'X' |> Seq.iter (printfn "%s")
First, we generate an unusual array of initial data. Its element [0] contains a space or whatever separator you want to have; I preferred dash (-) for debugging purposes.
The (1) line makes a function that calculates what character to be placed. The result of row-abs(col-len+1)+1 can be either positive (and there is a char to be placed) or zeronegative, and there should be a space. Note that there is no if statement: it is hidden within the max function;
The (2) line composes a function int -> string for generating an individual row;
The (3) line passes the function above as argument for sequence initializer.
The three lines can be written in a more verbose way:
let genCell row col = row-abs(col-len+1)+1 |> max 0 |> Array.get src
let genRow = genCell >> Seq.init (len*2-1) >> charsToString
Seq.init len genRow
Note genRow needs no formal argument due to functional composition: the argument is being bound into genCell, returning a function of a single argument, exactly what Seq.init needs.
I'm having a lot of trouble with the test_modifier method in lablgtk2. I can test for Shift, but that isn't very useful for my purposes. Whenever I test if control and another key is pressed nothing happens. I've also tried this:
view#event#connect#key_press ~callback:(fun ev ->
let m = GdkEvent.Key.state ev in
let k = GdkEvent.Key.keyval ev in
if (m = [`CONTROL] && k = _F) then
...
It worked for awhile and then it stopped. What is wrong with the above code that it wouldn't do anything? How can I properly test for a Control key press in lablgtk2?
There can be several modifiers at once so comparing to [`CONTROL] is not valid.
let pr fmt = Printf.ksprintf print_endline fmt
let button label packing f =
let b = GButton.button ~label ~packing () in
let _ = b#connect#clicked ~callback:f in
()
let () =
let locale = GtkMain.Main.init () in
let window = GWindow.window ~title:"test" ~border_width:10 () in
let _ = window#connect#destroy ~callback:GMain.quit in
let mainbox = GPack.vbox ~packing:window#add () in
button "quit" mainbox#pack window#destroy;
let _ = window#event#connect#key_press ~callback:begin fun ev ->
let m = GdkEvent.Key.state ev in
let k = GdkEvent.Key.keyval ev in
if (List.mem `CONTROL m && k = GdkKeysyms._F) then pr "WOO HOO";
if (List.mem `CONTROL m && k = GdkKeysyms._f) then pr "woo hoo";
false
end in
window#event#add [`KEY_PRESS];
window#show ();
GMain.main ()