lol took me forever to understand lwt but finally have concurrency in the actor event processing handlers
This commit is contained in:
cqc
180
irc.ml
180
irc.ml
@ -1,109 +1,109 @@
|
||||
(*
|
||||
|
||||
when all you can do is type, making things more complicated than a list is hard?
|
||||
we need to design this somehow before implementing it
|
||||
really the graphical drawing / window management funcitons i think at this point.
|
||||
|
||||
|
||||
features:
|
||||
- message drafts? more like, if you send too many messages to someone all at once it will hold them so you can respond later and not flood people.......
|
||||
- i mean really what you want is an editable stream, so you can stage messages for later
|
||||
- because i mean, if this is a bicycle, and you can make it however you want, you can just fuck with the conversation thread with computer assistance instaed of just relying on your memory.
|
||||
|
||||
*)
|
||||
|
||||
open Lwt
|
||||
module C = Irc_client_tls
|
||||
module M = Irc_message
|
||||
open Lwt_react
|
||||
module F = Fmt
|
||||
|
||||
let host = ref "irc.hackint.org"
|
||||
let port = ref 6697
|
||||
let nick = ref "cqcaml"
|
||||
let channel = ref "#freeside"
|
||||
let message = "Hello, world! This is a test from ocaml-irc-client"
|
||||
module Communicator = struct
|
||||
type msg = {content: string; time: string; mutable seen: bool}
|
||||
|
||||
let output_channel_of_ppf ppf =
|
||||
Lwt_io.make ~mode:Output (fun b o l ->
|
||||
let s = String.sub (Lwt_bytes.to_string b) o l in
|
||||
Fmt.pf ppf "%s" s ;
|
||||
Lwt.return (String.length s) )
|
||||
let create_msg ?(time = "<ts>") content =
|
||||
{content; time; seen= false}
|
||||
|
||||
let callback connection result =
|
||||
match result with
|
||||
| Result.Ok ({M.command= M.Other _; _} as msg) ->
|
||||
Lwt_io.printf "Got unknown message: %s\n" (M.to_string msg)
|
||||
>>= fun () -> Lwt_io.flush Lwt_io.stdout
|
||||
| Result.Ok ({M.command= M.PRIVMSG (_target, data); _} as msg) ->
|
||||
Lwt_io.printf "Got message: %s\n" (M.to_string msg)
|
||||
>>= fun () ->
|
||||
Lwt_io.flush Lwt_io.stdout
|
||||
>>= fun () ->
|
||||
C.send_privmsg ~connection ~target:"cqc"
|
||||
~message:("ack: " ^ data)
|
||||
| Result.Ok msg ->
|
||||
Lwt_io.printf "Got message: %s\n" (M.to_string msg)
|
||||
>>= fun () -> Lwt_io.flush Lwt_io.stdout
|
||||
| Result.Error e -> Lwt_io.printl e
|
||||
type channel =
|
||||
{ mutable name: string
|
||||
; mutable content: msg list
|
||||
; mutable sender: string -> unit }
|
||||
|
||||
let lwt_main () =
|
||||
C.reconnect_loop ~after:30
|
||||
~connect:(fun () ->
|
||||
Lwt_io.printl "Connecting..."
|
||||
>>= fun () ->
|
||||
C.connect_by_name ~server:!host ~port:!port ~nick:!nick () )
|
||||
~f:(fun connection ->
|
||||
Lwt_io.printl "Connected"
|
||||
>>= fun () ->
|
||||
Lwt_io.printl "send join msg"
|
||||
>>= fun () ->
|
||||
C.send_join ~connection ~channel:!channel
|
||||
>>= fun () ->
|
||||
C.send_privmsg ~connection ~target:!channel ~message )
|
||||
~callback ()
|
||||
let add_msg (c : channel) msg = c.content <- msg :: c.content
|
||||
|
||||
type c = {mutable channel: channel; mutable subs: c list}
|
||||
type protocol = Irc | Email | Rss | Mublog
|
||||
|
||||
let make_channel (c : c) ?(sender = fun _ -> ()) name =
|
||||
c.subs <-
|
||||
{channel= {name; content= []; sender}; subs= []} :: c.subs
|
||||
|
||||
let make () : c =
|
||||
let c =
|
||||
{ name= "top"
|
||||
; content= [create_msg "Wecome to the Communicator"]
|
||||
; sender= (fun _ -> ()) } in
|
||||
c.sender <- (fun s -> c.content <- create_msg s :: c.content) ;
|
||||
c.sender "Currently only IRC is implemented" ;
|
||||
{channel= c; subs= []}
|
||||
|
||||
type connection = unit Lwt.t
|
||||
|
||||
module Irc = struct
|
||||
module C = Irc_client_tls
|
||||
module M = Irc_message
|
||||
|
||||
let connection (c : c) server port nick channels : unit Lwt.t =
|
||||
let add_msg cn str = add_msg cn.channel (create_msg str) in
|
||||
C.reconnect_loop ~after:30
|
||||
~connect:(fun () ->
|
||||
Lwt_io.printl "Connecting..."
|
||||
>>= fun () -> C.connect_by_name ~server ~port ~nick () )
|
||||
~f:(fun connection ->
|
||||
Lwt_io.printl "Connected"
|
||||
>>= fun () ->
|
||||
Lwt_list.iter_p
|
||||
(fun channel ->
|
||||
let joiner = C.send_join ~connection ~channel in
|
||||
(* make_channel c ~sender:(fun s ->
|
||||
C.send_privmsg ~target:channel ~message:s) channel ; *)
|
||||
joiner )
|
||||
channels )
|
||||
~callback:(fun _connection result ->
|
||||
match result with
|
||||
| Result.Ok ({M.command= M.Other _; _} as msg) ->
|
||||
add_msg c
|
||||
(F.str "Got unknown message: %s\n" (M.to_string msg)) ;
|
||||
Lwt.return_unit
|
||||
| Result.Ok ({M.command= M.PRIVMSG (target, data); _} as msg)
|
||||
->
|
||||
add_msg c
|
||||
(F.str "Got PRIVMSG: target=%s, data=%s; %s\n" target
|
||||
data (M.to_string msg) ) ;
|
||||
Lwt.return_unit
|
||||
| Result.Ok msg ->
|
||||
add_msg c (M.to_string msg) ;
|
||||
Lwt.return_unit
|
||||
| Result.Error e -> Lwt_io.printl e )
|
||||
()
|
||||
end
|
||||
|
||||
module Panel = struct
|
||||
let panel c =
|
||||
Panel.prettyprint ~height:20. ~tag:"Communicator" (fun pp ->
|
||||
F.pf pp " <><><> COMMUNICATOR <><><> @.@." ;
|
||||
List.iter
|
||||
(fun msg -> F.pf pp "[%s] %s@." msg.time msg.content)
|
||||
c.channel.content )
|
||||
end
|
||||
end
|
||||
|
||||
let _ =
|
||||
Lwt_main.run
|
||||
(Lwt.catch lwt_main (fun e ->
|
||||
Printf.printf "exception: %s\n" (Printexc.to_string e) ;
|
||||
exit 1 ) )
|
||||
let comm = Communicator.make () in
|
||||
let hackint =
|
||||
Communicator.Irc.connection comm "irc.hackint.org" 6697 "cqcaml"
|
||||
["#CQC"] in
|
||||
root_actor := std_actor (Communicator.Panel.panel comm) ;
|
||||
Lwt.async (fun () -> hackint)
|
||||
|
||||
(* ocamlfind ocamlopt -package irc-client.lwt -linkpkg code.ml *)
|
||||
|
||||
(*open Lwt
|
||||
module C = Irc_client_lwt
|
||||
|
||||
let host = "irc.hackint.org"
|
||||
let port = 6697
|
||||
let realname = "Demo IRC bot"
|
||||
let nick = "cqcqcqcqc"
|
||||
let username = nick
|
||||
let channel = "#freeside"
|
||||
let message = "Hello, world! This is a test from ocaml-irc-client"
|
||||
|
||||
let callback oc _connection result =
|
||||
let open Irc_message in
|
||||
match result with
|
||||
| Result.Ok msg ->
|
||||
Fmt.epr "irc msg: msg" ;
|
||||
Lwt_io.fprintf oc "Got message: %s\n" (to_string msg)
|
||||
| Result.Error e -> Lwt_io.fprintl oc e
|
||||
|
||||
let lwt_main =
|
||||
let oc = output_channel_of_ppf !Topinf.ppf in
|
||||
Lwt_unix.gethostbyname host
|
||||
>>= fun he ->
|
||||
C.connect
|
||||
~addr:he.Lwt_unix.h_addr_list.(0)
|
||||
~port ~username ~mode:0 ~realname ~nick ()
|
||||
>>= fun connection ->
|
||||
Lwt_io.fprintl oc "Connected"
|
||||
>>= fun () ->
|
||||
C.send_join ~connection ~channel
|
||||
>>= fun () ->
|
||||
C.send_privmsg ~connection ~target:channel ~message
|
||||
>>= fun () ->
|
||||
C.listen ~connection ~callback:(callback oc) ()
|
||||
>>= fun () -> C.send_quit ~connection ()
|
||||
|
||||
let _ = Lwt_main.run lwt_main
|
||||
*)
|
||||
(**
|
||||
program starts...
|
||||
- spawn connections to servers
|
||||
- these connections will populate the Channel.t in a Channel.tree
|
||||
|
||||
**)
|
||||
|
||||
Reference in New Issue
Block a user