commit 67d9d68785a8ef3c1b614596d9ad1901c5a022c9 · anil.recoil.org/slop

stack/river/river.opam

···

       17
       17
        
         "cohttp-lwt-unix" {>= "5.0.0"}

     

       18
       18
        
         "ptime"

     

       19
       19
        
         "lwt"

     

       20
       20
       +
         "ocamlnet"

     

       20
       21
        
         "lambdasoup"

     

       21
       22
        
         "odoc" {with-doc}

     

       22
       23
        
       ]

+145

stack/zulip/lib/zulip/lib/jsonu_syntax.ml

···

       1
       1
       +
       (** Syntax module for monadic and applicative JSON parsing *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Error

     

       4
       4
       +
       

     

       5
       5
       +
       type 'a parser = json -> ('a, Error.t) result

     

       6
       6
       +
       

     

       7
       7
       +
       (** Monadic bind operator for sequential parsing with error handling *)

     

       8
       8
       +
       let ( let* ) = Result.bind

     

       9
       9
       +
       

     

       10
       10
       +
       (** Map operator for transforming successful results *)

     

       11
       11
       +
       let ( let+ ) x f = Result.map f x

     

       12
       12
       +
       

     

       13
       13
       +
       (** Applicative parallel composition *)

     

       14
       14
       +
       let ( and+ ) x y =

     

       15
       15
       +
         match x, y with

     

       16
       16
       +
         | Ok x, Ok y -> Ok (x, y)

     

       17
       17
       +
         | Error e, _ | _, Error e -> Error e

     

       18
       18
       +
       

     

       19
       19
       +
       (** Applicative parallel composition for 3 values *)

     

       20
       20
       +
       let ( and++ ) xy z =

     

       21
       21
       +
         match xy, z with

     

       22
       22
       +
         | Ok (x, y), Ok z -> Ok (x, y, z)

     

       23
       23
       +
         | Error e, _ | _, Error e -> Error e

     

       24
       24
       +
       

     

       25
       25
       +
       (** Applicative parallel composition for 4 values *)

     

       26
       26
       +
       let ( and+++ ) xyz w =

     

       27
       27
       +
         match xyz, w with

     

       28
       28
       +
         | Ok (x, y, z), Ok w -> Ok (x, y, z, w)

     

       29
       29
       +
         | Error e, _ | _, Error e -> Error e

     

       30
       30
       +
       

     

       31
       31
       +
       (** Applicative parallel composition for 5 values *)

     

       32
       32
       +
       let ( and++++ ) xyzw v =

     

       33
       33
       +
         match xyzw, v with

     

       34
       34
       +
         | Ok (x, y, z, w), Ok v -> Ok (x, y, z, w, v)

     

       35
       35
       +
         | Error e, _ | _, Error e -> Error e

     

       36
       36
       +
       

     

       37
       37
       +
       (** Alternative operator - try first, if fails try second *)

     

       38
       38
       +
       let ( <|> ) x y =

     

       39
       39
       +
         match x with

     

       40
       40
       +
         | Ok _ -> x

     

       41
       41
       +
         | Error _ -> y

     

       42
       42
       +
       

     

       43
       43
       +
       (** Provide a default value if parsing fails *)

     

       44
       44
       +
       let ( |? ) x default =

     

       45
       45
       +
         match x with

     

       46
       46
       +
         | Ok v -> v

     

       47
       47
       +
         | Error _ -> default

     

       48
       48
       +
       

     

       49
       49
       +
       (** Convert option to result with error message *)

     

       50
       50
       +
       let required name = function

     

       51
       51
       +
         | Some v -> Ok v

     

       52
       52
       +
         | None -> Error (Error.create ~code:(Other "missing_field") ~msg:(Printf.sprintf "Required field '%s' not found" name) ())

     

       53
       53
       +
       

     

       54
       54
       +
       (** Convert option to result with default *)

     

       55
       55
       +
       let default v = function

     

       56
       56
       +
         | Some x -> x

     

       57
       57
       +
         | None -> v

     

       58
       58
       +
       

     

       59
       59
       +
       (** Lift a pure value into parser context *)

     

       60
       60
       +
       let pure x = Ok x

     

       61
       61
       +
       

     

       62
       62
       +
       (** Fail with an error message *)

     

       63
       63
       +
       let fail msg = Error (Error.create ~code:(Other "parse_error") ~msg ())

     

       64
       64
       +
       

     

       65
       65
       +
       (** Map over a list with error handling *)

     

       66
       66
       +
       let traverse f lst =

     

       67
       67
       +
         let rec go acc = function

     

       68
       68
       +
           | [] -> Ok (List.rev acc)

     

       69
       69
       +
           | x :: xs ->

     

       70
       70
       +
               let* v = f x in

     

       71
       71
       +
               go (v :: acc) xs

     

       72
       72
       +
         in

     

       73
       73
       +
         go [] lst

     

       74
       74
       +
       

     

       75
       75
       +
       (** Filter and map over a list, dropping errors *)

     

       76
       76
       +
       let filter_map f lst =

     

       77
       77
       +
         List.filter_map (fun x ->

     

       78
       78
       +
           match f x with

     

       79
       79
       +
           | Ok v -> Some v

     

       80
       80
       +
           | Error _ -> None

     

       81
       81
       +
         ) lst

     

       82
       82
       +
       

     

       83
       83
       +
       (** Parse a field with a custom parser *)

     

       84
       84
       +
       let field fields key parser =

     

       85
       85
       +
         match List.assoc_opt key fields with

     

       86
       86
       +
         | Some json -> parser json

     

       87
       87
       +
         | None -> Error (Jsonu.field_missing_error key)

     

       88
       88
       +
       

     

       89
       89
       +
       (** Parse an optional field with a custom parser *)

     

       90
       90
       +
       let field_opt fields key parser =

     

       91
       91
       +
         match List.assoc_opt key fields with

     

       92
       92
       +
         | Some json ->

     

       93
       93
       +
             (match parser json with

     

       94
       94
       +
              | Ok v -> Ok (Some v)

     

       95
       95
       +
              | Error _ -> Ok None)

     

       96
       96
       +
         | None -> Ok None

     

       97
       97
       +
       

     

       98
       98
       +
       (** Parse a field with a default value if missing or fails *)

     

       99
       99
       +
       let field_or fields key parser default =

     

       100
       100
       +
         match List.assoc_opt key fields with

     

       101
       101
       +
         | Some json ->

     

       102
       102
       +
             (match parser json with

     

       103
       103
       +
              | Ok v -> Ok v

     

       104
       104
       +
              | Error _ -> Ok default)

     

       105
       105
       +
         | None -> Ok default

     

       106
       106
       +
       

     

       107
       107
       +
       (** Common parsers *)

     

       108
       108
       +
       let string = function

     

       109
       109
       +
         | `String s -> Ok s

     

       110
       110
       +
         | _ -> Error (Error.create ~code:(Other "type_error") ~msg:"Expected string" ())

     

       111
       111
       +
       

     

       112
       112
       +
       let int = function

     

       113
       113
       +
         | `Float f -> Ok (int_of_float f)

     

       114
       114
       +
         | `String s ->

     

       115
       115
       +
             (try Ok (int_of_string s)

     

       116
       116
       +
              with _ -> Error (Error.create ~code:(Other "type_error") ~msg:"Expected integer" ()))

     

       117
       117
       +
         | _ -> Error (Error.create ~code:(Other "type_error") ~msg:"Expected integer" ())

     

       118
       118
       +
       

     

       119
       119
       +
       let float = function

     

       120
       120
       +
         | `Float f -> Ok f

     

       121
       121
       +
         | `String s ->

     

       122
       122
       +
             (try Ok (float_of_string s)

     

       123
       123
       +
              with _ -> Error (Error.create ~code:(Other "type_error") ~msg:"Expected float" ()))

     

       124
       124
       +
         | _ -> Error (Error.create ~code:(Other "type_error") ~msg:"Expected float" ())

     

       125
       125
       +
       

     

       126
       126
       +
       let bool = function

     

       127
       127
       +
         | `Bool b -> Ok b

     

       128
       128
       +
         | _ -> Error (Error.create ~code:(Other "type_error") ~msg:"Expected boolean" ())

     

       129
       129
       +
       

     

       130
       130
       +
       let array parser = function

     

       131
       131
       +
         | `A items -> traverse parser items

     

       132
       132
       +
         | _ -> Error (Error.create ~code:(Other "type_error") ~msg:"Expected array" ())

     

       133
       133
       +
       

     

       134
       134
       +
       let object_ = function

     

       135
       135
       +
         | `O fields -> Ok fields

     

       136
       136
       +
         | _ -> Error (Error.create ~code:(Other "type_error") ~msg:"Expected object" ())

     

       137
       137
       +
       

     

       138
       138
       +
       (** Run a parser on JSON *)

     

       139
       139
       +
       let parse parser json = parser json

     

       140
       140
       +
       

     

       141
       141
       +
       (** Run a parser with error context *)

     

       142
       142
       +
       let with_context ctx parser json =

     

       143
       143
       +
         match parser json with

     

       144
       144
       +
         | Ok v -> Ok v

     

       145
       145
       +
         | Error e -> Error (Error.create ~code:(Error.code e) ~msg:(Printf.sprintf "%s: %s" ctx (Error.message e)) ())

+97

stack/zulip/lib/zulip/lib/jsonu_syntax.mli

···

       1
       1
       +
       (** Syntax module for monadic and applicative JSON parsing

     

       2
       2
       +
       

     

       3
       3
       +
           This module provides binding operators and combinators to make JSON parsing

     

       4
       4
       +
           more ergonomic and composable. It enables code like:

     

       5
       5
       +
       

     

       6
       6
       +
           {[

     

       7
       7
       +
             let parse_user json =

     

       8
       8
       +
               with_object "user" @@ fun fields ->

     

       9
       9
       +
               let+ user_id = field fields "user_id" int

     

       10
       10
       +
               and+ email = field fields "email" string

     

       11
       11
       +
               and+ full_name = field fields "full_name" string in

     

       12
       12
       +
               { user_id; email; full_name }

     

       13
       13
       +
           ]}

     

       14
       14
       +
       *)

     

       15
       15
       +
       

     

       16
       16
       +
       open Error

     

       17
       17
       +
       

     

       18
       18
       +
       type 'a parser = json -> ('a, Error.t) result

     

       19
       19
       +
       

     

       20
       20
       +
       (** {1 Binding Operators} *)

     

       21
       21
       +
       

     

       22
       22
       +
       (** Monadic bind operator for sequential parsing with error handling *)

     

       23
       23
       +
       val ( let* ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result

     

       24
       24
       +
       

     

       25
       25
       +
       (** Map operator for transforming successful results *)

     

       26
       26
       +
       val ( let+ ) : ('a, 'e) result -> ('a -> 'b) -> ('b, 'e) result

     

       27
       27
       +
       

     

       28
       28
       +
       (** Applicative parallel composition for independent field extraction *)

     

       29
       29
       +
       val ( and+ ) : ('a, 'e) result -> ('b, 'e) result -> ('a * 'b, 'e) result

     

       30
       30
       +
       val ( and++ ) : ('a * 'b, 'e) result -> ('c, 'e) result -> ('a * 'b * 'c, 'e) result

     

       31
       31
       +
       val ( and+++ ) : ('a * 'b * 'c, 'e) result -> ('d, 'e) result -> ('a * 'b * 'c * 'd, 'e) result

     

       32
       32
       +
       val ( and++++ ) : ('a * 'b * 'c * 'd, 'e) result -> ('f, 'e) result -> ('a * 'b * 'c * 'd * 'f, 'e) result

     

       33
       33
       +
       

     

       34
       34
       +
       (** {1 Alternative and Default Operators} *)

     

       35
       35
       +
       

     

       36
       36
       +
       (** Alternative operator - try first parser, if fails try second *)

     

       37
       37
       +
       val ( <|> ) : ('a, 'e) result -> ('a, 'e) result -> ('a, 'e) result

     

       38
       38
       +
       

     

       39
       39
       +
       (** Provide a default value if parsing fails *)

     

       40
       40
       +
       val ( |? ) : ('a, 'e) result -> 'a -> 'a

     

       41
       41
       +
       

     

       42
       42
       +
       (** {1 Field Extraction} *)

     

       43
       43
       +
       

     

       44
       44
       +
       (** Parse a required field with a custom parser *)

     

       45
       45
       +
       val field : (string * json) list -> string -> 'a parser -> ('a, Error.t) result

     

       46
       46
       +
       

     

       47
       47
       +
       (** Parse an optional field with a custom parser *)

     

       48
       48
       +
       val field_opt : (string * json) list -> string -> 'a parser -> ('a option, Error.t) result

     

       49
       49
       +
       

     

       50
       50
       +
       (** Parse a field with a default value if missing or fails *)

     

       51
       51
       +
       val field_or : (string * json) list -> string -> 'a parser -> 'a -> ('a, Error.t) result

     

       52
       52
       +
       

     

       53
       53
       +
       (** {1 Basic Parsers} *)

     

       54
       54
       +
       

     

       55
       55
       +
       (** Parse a JSON string *)

     

       56
       56
       +
       val string : string parser

     

       57
       57
       +
       

     

       58
       58
       +
       (** Parse a JSON number as integer (handles both int and float) *)

     

       59
       59
       +
       val int : int parser

     

       60
       60
       +
       

     

       61
       61
       +
       (** Parse a JSON number as float *)

     

       62
       62
       +
       val float : float parser

     

       63
       63
       +
       

     

       64
       64
       +
       (** Parse a JSON boolean *)

     

       65
       65
       +
       val bool : bool parser

     

       66
       66
       +
       

     

       67
       67
       +
       (** Parse a JSON array with a parser for elements *)

     

       68
       68
       +
       val array : 'a parser -> 'a list parser

     

       69
       69
       +
       

     

       70
       70
       +
       (** Parse a JSON object to get its fields *)

     

       71
       71
       +
       val object_ : json -> ((string * json) list, Error.t) result

     

       72
       72
       +
       

     

       73
       73
       +
       (** {1 Utility Functions} *)

     

       74
       74
       +
       

     

       75
       75
       +
       (** Convert option to result with error message *)

     

       76
       76
       +
       val required : string -> 'a option -> ('a, Error.t) result

     

       77
       77
       +
       

     

       78
       78
       +
       (** Get value from option with default *)

     

       79
       79
       +
       val default : 'a -> 'a option -> 'a

     

       80
       80
       +
       

     

       81
       81
       +
       (** Lift a pure value into parser context *)

     

       82
       82
       +
       val pure : 'a -> ('a, 'e) result

     

       83
       83
       +
       

     

       84
       84
       +
       (** Fail with an error message *)

     

       85
       85
       +
       val fail : string -> ('a, Error.t) result

     

       86
       86
       +
       

     

       87
       87
       +
       (** Map over a list with error handling *)

     

       88
       88
       +
       val traverse : ('a -> ('b, Error.t) result) -> 'a list -> ('b list, Error.t) result

     

       89
       89
       +
       

     

       90
       90
       +
       (** Filter and map over a list, dropping errors *)

     

       91
       91
       +
       val filter_map : ('a -> ('b, Error.t) result) -> 'a list -> 'b list

     

       92
       92
       +
       

     

       93
       93
       +
       (** Run a parser on JSON *)

     

       94
       94
       +
       val parse : 'a parser -> json -> ('a, Error.t) result

     

       95
       95
       +
       

     

       96
       96
       +
       (** Run a parser with error context *)

     

       97
       97
       +
       val with_context : string -> 'a parser -> 'a parser

+90 -110

stack/zulip/lib/zulip_bot/lib/message.ml

···

       17
       17
        
         let full_name t = t.full_name

     

       18
       18
        
         let short_name t = t.short_name

     

       19
       19
        
       

     

       20
       20
       -
         let of_json json =

     

       21
       21
       -
           Zulip.Jsonu.with_object "user" (fun fields ->

     

       22
       22
       -
             (* Handle both "user_id" and "id" field names *)

     

       23
       23
       -
             let user_id_result =

     

       24
       24
       -
               match Zulip.Jsonu.get_int fields "user_id" with

     

       25
       25
       -
               | Ok id -> Ok id

     

       26
       26
       -
               | Error _ -> Zulip.Jsonu.get_int fields "id"

     

       27
       27
       -
             in

     

       28
       28
       -
             match user_id_result, Zulip.Jsonu.get_string fields "email", Zulip.Jsonu.get_string fields "full_name" with

     

       29
       29
       -
             | Ok user_id, Ok email, Ok full_name ->

     

       30
       30
       -
                 let short_name = Zulip.Jsonu.get_string_opt fields "short_name" in

     

       31
       31
       -
                 Ok { user_id; email; full_name; short_name }

     

       32
       32
       -
             | Error e, _, _ | _, Error e, _ | _, _, Error e -> Error e

     

       33
       33
       -
           ) json

     

       20
       20
       +
         let of_json (json : Zulip.Error.json) : (t, Zulip.Error.t) result =

     

       21
       21
       +
           let open Zulip.Jsonu_syntax in

     

       22
       22
       +
           (Zulip.Jsonu.with_object "user" @@ fun fields ->

     

       23
       23
       +
           let* user_id = (field fields "user_id" int) <|> (field fields "id" int) in

     

       24
       24
       +
           let* email = field fields "email" string in

     

       25
       25
       +
           let* full_name = field fields "full_name" string in

     

       26
       26
       +
           let* short_name = field_opt fields "short_name" string in

     

       27
       27
       +
           Ok { user_id; email; full_name; short_name }) json

     

       34
       28
        
       end

     

       35
       29
        
       

     

       36
       30
        
       (** Reaction representation *)

     
···

       47
       41
        
         let reaction_type t = t.reaction_type

     

       48
       42
        
         let user_id t = t.user_id

     

       49
       43
        
       

     

       50
       50
       -
         let of_json json =

     

       51
       51
       -
           Zulip.Jsonu.with_object "reaction" (fun fields ->

     

       52
       52
       -
             match Zulip.Jsonu.get_string fields "emoji_name",

     

       53
       53
       -
                   Zulip.Jsonu.get_string fields "emoji_code",

     

       54
       54
       -
                   Zulip.Jsonu.get_string fields "reaction_type" with

     

       55
       55
       -
             | Ok emoji_name, Ok emoji_code, Ok reaction_type ->

     

       56
       56
       -
                 (* Try both "user_id" and "user" -> "user_id" patterns *)

     

       57
       57
       -
                 let user_id_result =

     

       58
       58
       -
                   match Zulip.Jsonu.get_int fields "user_id" with

     

       59
       59
       -
                   | Ok id -> Ok id

     

       60
       60
       -
                   | Error _ ->

     

       61
       61
       -
                       match Zulip.Jsonu.get_object fields "user" with

     

       62
       62
       -
                       | Ok user_obj -> Zulip.Jsonu.get_int user_obj "user_id"

     

       63
       63
       -
                       | Error e -> Error e

     

       64
       64
       -
                 in

     

       65
       65
       -
                 (match user_id_result with

     

       66
       66
       -
                  | Ok user_id -> Ok { emoji_name; emoji_code; reaction_type; user_id }

     

       67
       67
       -
                  | Error e -> Error e)

     

       68
       68
       -
             | Error e, _, _ | _, Error e, _ | _, _, Error e -> Error e

     

       69
       69
       -
           ) json

     

       44
       44
       +
         let of_json (json : Zulip.Error.json) : (t, Zulip.Error.t) result =

     

       45
       45
       +
           let open Zulip.Jsonu_syntax in

     

       46
       46
       +
           (Zulip.Jsonu.with_object "reaction" @@ fun fields ->

     

       47
       47
       +
           let* emoji_name = field fields "emoji_name" string in

     

       48
       48
       +
           let* emoji_code = field fields "emoji_code" string in

     

       49
       49
       +
           let* reaction_type = field fields "reaction_type" string in

     

       50
       50
       +
           let* user_id =

     

       51
       51
       +
             (field fields "user_id" int) <|>

     

       52
       52
       +
             (match field fields "user" object_ with

     

       53
       53
       +
              | Ok user_obj -> field user_obj "user_id" int

     

       54
       54
       +
              | Error _ -> fail "user_id not found") in

     

       55
       55
       +
           Ok { emoji_name; emoji_code; reaction_type; user_id }) json

     

       70
       56
        
       end

     

       57
       57
       +
       

     

       58
       58
       +
       let parse_reaction_json json = Reaction.of_json json

     

       59
       59
       +
       let parse_user_json json = User.of_json json

     

       71
       60
        
       

     

       72
       61
        
       (** Common message fields *)

     

       73
       62
        
       type common = {

     
···

       107
       96
        
       

     

       108
       97
        
       (** Helper function to parse common fields *)

     

       109
       98
        
       let parse_common json =

     

       110
       110
       -
         Zulip.Jsonu.parse_with_error "common fields" (fun () ->

     

       111
       111
       -
           Zulip.Jsonu.with_object "message" (fun fields ->

     

       112
       112
       -
             match Zulip.Jsonu.get_int fields "id",

     

       113
       113
       -
                   Zulip.Jsonu.get_int fields "sender_id",

     

       114
       114
       -
                   Zulip.Jsonu.get_string fields "sender_email",

     

       115
       115
       -
                   Zulip.Jsonu.get_string fields "sender_full_name" with

     

       116
       116
       -
             | Ok id, Ok sender_id, Ok sender_email, Ok sender_full_name ->

     

       117
       117
       -
                 let sender_short_name = Zulip.Jsonu.get_string_opt fields "sender_short_name" in

     

       118
       118
       -
                 let timestamp = Zulip.Jsonu.get_float_default fields "timestamp" 0.0 in

     

       119
       119
       -
                 let content = Zulip.Jsonu.get_string_default fields "content" "" in

     

       120
       120
       -
                 let content_type = Zulip.Jsonu.get_string_default fields "content_type" "text/html" in

     

       99
       99
       +
         Zulip.Jsonu.parse_with_error "common fields" @@ fun () ->

     

       100
       100
       +
         (Zulip.Jsonu.with_object "message" @@ fun fields ->

     

       101
       101
       +
         let open Zulip.Jsonu_syntax in

     

       102
       102
       +
         let* id = field fields "id" int in

     

       103
       103
       +
         let* sender_id = field fields "sender_id" int in

     

       104
       104
       +
         let* sender_email = field fields "sender_email" string in

     

       105
       105
       +
         let* sender_full_name = field fields "sender_full_name" string in

     

       106
       106
       +
         let sender_short_name = field_opt fields "sender_short_name" string |? None in

     

       107
       107
       +
         let timestamp = field_or fields "timestamp" float 0.0 |? 0.0 in

     

       108
       108
       +
         let content = field_or fields "content" string "" |? "" in

     

       109
       109
       +
         let content_type = field_or fields "content_type" string "text/html" |? "text/html" in

     

       121
       110
        
       

     

       122
       122
       -
                 let reactions =

     

       123
       123
       -
                   match Zulip.Jsonu.get_array_opt fields "reactions" with

     

       124
       124
       -
                   | Some reactions_json ->

     

       125
       125
       -
                       List.filter_map (fun r ->

     

       126
       126
       -
                         match Reaction.of_json r with

     

       127
       127
       -
                         | Ok reaction -> Some reaction

     

       128
       128
       -
                         | Error err ->

     

       129
       129
       -
                             Log.warn (fun m -> m "Failed to parse reaction: %s" (Zulip.Error.message err));

     

       130
       130
       -
                             None

     

       131
       131
       -
                       ) reactions_json

     

       132
       132
       -
                   | None -> []

     

       133
       133
       -
                 in

     

       111
       111
       +
         let reactions =

     

       112
       112
       +
           match Zulip.Jsonu.get_array_opt fields "reactions" with

     

       113
       113
       +
           | Some reactions_json ->

     

       114
       114
       +
               List.filter_map (fun r ->

     

       115
       115
       +
                 match parse_reaction_json r with

     

       116
       116
       +
                 | Ok reaction -> Some reaction

     

       117
       117
       +
                 | Error err ->

     

       118
       118
       +
                     Log.warn (fun m -> m "Failed to parse reaction: %s" (Zulip.Error.message err));

     

       119
       119
       +
                     None

     

       120
       120
       +
               ) reactions_json

     

       121
       121
       +
           | None -> []

     

       122
       122
       +
         in

     

       134
       123
        
       

     

       135
       135
       -
                 let submessages = Zulip.Jsonu.get_array_opt fields "submessages" |> Option.value ~default:[] in

     

       124
       124
       +
         let submessages = Zulip.Jsonu.get_array_opt fields "submessages" |> Option.value ~default:[] in

     

       136
       125
        
       

     

       137
       137
       -
                 let flags =

     

       138
       138
       -
                   match Zulip.Jsonu.get_array_opt fields "flags" with

     

       139
       139
       -
                   | Some flags_json ->

     

       140
       140
       -
                       List.filter_map Zulip.Jsonu.to_string_safe flags_json

     

       141
       141
       -
                   | None -> []

     

       142
       142
       -
                 in

     

       126
       126
       +
         let flags =

     

       127
       127
       +
           match Zulip.Jsonu.get_array_opt fields "flags" with

     

       128
       128
       +
           | Some flags_json -> List.filter_map Zulip.Jsonu.to_string_safe flags_json

     

       129
       129
       +
           | None -> []

     

       130
       130
       +
         in

     

       143
       131
        
       

     

       144
       144
       -
                 let is_me_message = Zulip.Jsonu.get_bool_default fields "is_me_message" false in

     

       145
       145
       -
                 let client = Zulip.Jsonu.get_string_default fields "client" "" in

     

       146
       146
       -
                 let gravatar_hash = Zulip.Jsonu.get_string_default fields "gravatar_hash" "" in

     

       147
       147
       -
                 let avatar_url = Zulip.Jsonu.get_string_opt fields "avatar_url" in

     

       132
       132
       +
         let is_me_message = field_or fields "is_me_message" bool false |? false in

     

       133
       133
       +
         let client = field_or fields "client" string "" |? "" in

     

       134
       134
       +
         let gravatar_hash = field_or fields "gravatar_hash" string "" |? "" in

     

       135
       135
       +
         let avatar_url = field_opt fields "avatar_url" string |? None in

     

       148
       136
        
       

     

       149
       149
       -
                 Ok {

     

       150
       150
       -
                   id; sender_id; sender_email; sender_full_name; sender_short_name;

     

       151
       151
       -
                   timestamp; content; content_type; reactions; submessages;

     

       152
       152
       -
                   flags; is_me_message; client; gravatar_hash; avatar_url

     

       153
       153
       -
                 }

     

       154
       154
       -
             | Error e, _, _, _ | _, Error e, _, _ | _, _, Error e, _ | _, _, _, Error e -> Error e

     

       155
       155
       -
           ) json

     

       156
       156
       -
         )

     

       137
       137
       +
         Ok {

     

       138
       138
       +
           id; sender_id; sender_email; sender_full_name; sender_short_name;

     

       139
       139
       +
           timestamp; content; content_type; reactions; submessages;

     

       140
       140
       +
           flags; is_me_message; client; gravatar_hash; avatar_url

     

       141
       141
       +
         }) json

     

       157
       142
        
       

     

       158
       143
        
       (** JSON parsing *)

     

       159
       144
        
       let of_json json =

     

       160
       145
        
         Log.debug (fun m -> m "Parsing message JSON: %s" (Zulip.Jsonu.to_string_pretty json));

     

       161
       146
        
       

     

       147
       147
       +
         let open Zulip.Jsonu_syntax in

     

       162
       148
        
         match parse_common json with

     

       163
       149
        
         | Error err -> Error (Zulip.Error.message err)

     

       164
       150
        
         | Ok common ->

     

       165
       165
       -
             Zulip.Jsonu.parse_with_error "message type" (fun () ->

     

       166
       166
       -
               Zulip.Jsonu.with_object "message" (fun fields ->

     

       167
       167
       -
                 match Zulip.Jsonu.get_string fields "type" with

     

       168
       168
       -
                 | Ok "private" ->

     

       169
       169
       -
                     (match Zulip.Jsonu.get_array fields "display_recipient" with

     

       170
       170
       -
                      | Ok recipient_json ->

     

       171
       171
       -
                          let users_results = List.map User.of_json recipient_json in

     

       172
       172
       -
                          let users = List.fold_left (fun acc result ->

     

       173
       173
       -
                            match result with

     

       174
       174
       -
                            | Ok user -> user :: acc

     

       175
       175
       -
                            | Error err ->

     

       176
       176
       -
                                Log.warn (fun m -> m "Failed to parse user in display_recipient: %s" (Zulip.Error.message err));

     

       177
       177
       -
                                acc

     

       178
       178
       -
                          ) [] (List.rev users_results) in

     

       151
       151
       +
             (Zulip.Jsonu.parse_with_error "message type" @@ fun () ->

     

       152
       152
       +
             (Zulip.Jsonu.with_object "message" @@ fun fields ->

     

       153
       153
       +
             match Zulip.Jsonu.get_string fields "type" with

     

       154
       154
       +
             | Ok "private" ->

     

       155
       155
       +
                 let* recipient_json = field fields "display_recipient" (array (fun x -> Ok x)) in

     

       156
       156
       +
                 let users = List.filter_map (fun u ->

     

       157
       157
       +
                   match parse_user_json u with

     

       158
       158
       +
                   | Ok user -> Some user

     

       159
       159
       +
                   | Error err ->

     

       160
       160
       +
                       Log.warn (fun m -> m "Failed to parse user in display_recipient: %s" (Zulip.Error.message err));

     

       161
       161
       +
                       None

     

       162
       162
       +
                 ) recipient_json in

     

       179
       163
        
       

     

       180
       180
       -
                          if List.length users = 0 && List.length users_results > 0 then

     

       181
       181
       -
                            Error (Zulip.Jsonu.json_error "Failed to parse any users in display_recipient")

     

       182
       182
       -
                          else

     

       183
       183
       -
                            Ok (Private { common; display_recipient = users })

     

       184
       184
       -
                      | Error e -> Error e)

     

       164
       164
       +
                 if List.length users = 0 && List.length recipient_json > 0 then

     

       165
       165
       +
                   fail "Failed to parse any users in display_recipient"

     

       166
       166
       +
                 else

     

       167
       167
       +
                   Ok (Private { common; display_recipient = users })

     

       185
       168
        
       

     

       186
       186
       -
                 | Ok "stream" ->

     

       187
       187
       -
                     (match Zulip.Jsonu.get_string fields "display_recipient",

     

       188
       188
       -
                            Zulip.Jsonu.get_int fields "stream_id",

     

       189
       189
       -
                            Zulip.Jsonu.get_string fields "subject" with

     

       190
       190
       -
                      | Ok display_recipient, Ok stream_id, Ok subject ->

     

       191
       191
       -
                          Ok (Stream { common; display_recipient; stream_id; subject })

     

       192
       192
       -
                      | Error e, _, _ | _, Error e, _ | _, _, Error e -> Error e)

     

       169
       169
       +
             | Ok "stream" ->

     

       170
       170
       +
                 let* display_recipient = field fields "display_recipient" string in

     

       171
       171
       +
                 let* stream_id = field fields "stream_id" int in

     

       172
       172
       +
                 let* subject = field fields "subject" string in

     

       173
       173
       +
                 Ok (Stream { common; display_recipient; stream_id; subject })

     

       193
       174
        
       

     

       194
       194
       -
                 | Ok unknown_type ->

     

       195
       195
       -
                     Log.warn (fun m -> m "Unknown message type: %s" unknown_type);

     

       196
       196
       -
                     Ok (Unknown { common; raw_json = json })

     

       175
       175
       +
             | Ok unknown_type ->

     

       176
       176
       +
                 Log.warn (fun m -> m "Unknown message type: %s" unknown_type);

     

       177
       177
       +
                 Ok (Unknown { common; raw_json = json })

     

       197
       178
        
       

     

       198
       198
       -
                 | Error _ ->

     

       199
       199
       -
                     Log.warn (fun m -> m "No message type field found");

     

       200
       200
       -
                     Ok (Unknown { common; raw_json = json })

     

       201
       201
       -
               ) json

     

       202
       202
       -
             ) |> Result.map_error Zulip.Error.message

     

       179
       179
       +
             | Error _ ->

     

       180
       180
       +
                 Log.warn (fun m -> m "No message type field found");

     

       181
       181
       +
                 Ok (Unknown { common; raw_json = json })

     

       182
       182
       +
             ) json) |> Result.map_error Zulip.Error.message

     

       203
       183
        
       

     

       204
       184
        
       (** Accessor functions *)

     

       205
       185
        
       let get_common = function

stack/zulip/lib/zulip_bot/lib/message.mli

···

       13
       13
        
         val email : t -> string

     

       14
       14
        
         val full_name : t -> string

     

       15
       15
        
         val short_name : t -> string option

     

       16
       16
       +
         val of_json : Zulip.Error.json -> (t, Zulip.Error.t) result

     

       16
       17
        
       end

     

       17
       18
        
       

     

       18
       19
        
       (** Reaction representation *)

     
···

       28
       29
        
         val emoji_code : t -> string

     

       29
       30
        
         val reaction_type : t -> string

     

       30
       31
        
         val user_id : t -> int

     

       32
       32
       +
         val of_json : Zulip.Error.json -> (t, Zulip.Error.t) result

     

       31
       33
        
       end

     

       32
       34
        
       

     

       33
       35
        
       (** Common message fields *)

+68

stack/zulip/test_bot.sh

···

       1
       1
       +
       #!/bin/bash

     

       2
       2
       +
       

     

       3
       3
       +
       # Simple test script for Zulip bots

     

       4
       4
       +
       # Ensure you have a .zuliprc file configured first

     

       5
       5
       +
       

     

       6
       6
       +
       echo "Zulip Bot Test Script"

     

       7
       7
       +
       echo "====================="

     

       8
       8
       +
       echo ""

     

       9
       9
       +
       

     

       10
       10
       +
       if [ ! -f "$HOME/.zuliprc" ]; then

     

       11
       11
       +
           echo "Error: ~/.zuliprc not found"

     

       12
       12
       +
           echo ""

     

       13
       13
       +
           echo "Create ~/.zuliprc with the following format:"

     

       14
       14
       +
           echo "[api]"

     

       15
       15
       +
           echo "email = bot@example.com"

     

       16
       16
       +
           echo "key = your-api-key-here"

     

       17
       17
       +
           echo "site = https://your-subdomain.zulipchat.com"

     

       18
       18
       +
           exit 1

     

       19
       19
       +
       fi

     

       20
       20
       +
       

     

       21
       21
       +
       echo "Found .zuliprc configuration"

     

       22
       22
       +
       echo ""

     

       23
       23
       +
       

     

       24
       24
       +
       PS3="Select a bot to test: "

     

       25
       25
       +
       options=("Echo Bot" "Echo Bot (verbose)" "Test Realtime Bot" "Atom Feed Bot (interactive)" "Quit")

     

       26
       26
       +
       

     

       27
       27
       +
       select opt in "${options[@]}"

     

       28
       28
       +
       do

     

       29
       29
       +
           case $opt in

     

       30
       30
       +
               "Echo Bot")

     

       31
       31
       +
                   echo "Starting Echo Bot..."

     

       32
       32
       +
                   echo "The bot will echo all messages it receives"

     

       33
       33
       +
                   echo "Press Ctrl+C to stop"

     

       34
       34
       +
                   echo ""

     

       35
       35
       +
                   dune exec zulip_bot/echo_bot

     

       36
       36
       +
                   break

     

       37
       37
       +
                   ;;

     

       38
       38
       +
               "Echo Bot (verbose)")

     

       39
       39
       +
                   echo "Starting Echo Bot with verbose logging..."

     

       40
       40
       +
                   echo "The bot will echo all messages with detailed logs"

     

       41
       41
       +
                   echo "Press Ctrl+C to stop"

     

       42
       42
       +
                   echo ""

     

       43
       43
       +
                   dune exec zulip_bot/echo_bot -- -vv

     

       44
       44
       +
                   break

     

       45
       45
       +
                   ;;

     

       46
       46
       +
               "Test Realtime Bot")

     

       47
       47
       +
                   echo "Starting Test Realtime Bot..."

     

       48
       48
       +
                   echo "This bot logs all received messages and tests storage"

     

       49
       49
       +
                   echo "Press Ctrl+C to stop"

     

       50
       50
       +
                   echo ""

     

       51
       51
       +
                   dune exec zulip_bot/test_realtime_bot

     

       52
       52
       +
                   break

     

       53
       53
       +
                   ;;

     

       54
       54
       +
               "Atom Feed Bot (interactive)")

     

       55
       55
       +
                   echo "Starting Atom Feed Bot in interactive mode..."

     

       56
       56
       +
                   echo "Use !feed help to see available commands"

     

       57
       57
       +
                   echo "Press Ctrl+C to stop"

     

       58
       58
       +
                   echo ""

     

       59
       59
       +
                   dune exec zulip_bot/atom_feed_bot -- interactive

     

       60
       60
       +
                   break

     

       61
       61
       +
                   ;;

     

       62
       62
       +
               "Quit")

     

       63
       63
       +
                   echo "Exiting..."

     

       64
       64
       +
                   break

     

       65
       65
       +
                   ;;

     

       66
       66
       +
               *) echo "Invalid option $REPLY";;

     

       67
       67
       +
           esac

     

       68
       68
       +
       done