Source file `thing_kind.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
open! Core_kernel

type t =
  | Comment
  | User
  | Link
  | Message
  | Subreddit
  | Award
  | More_comments
  | Modmail_conversation
[@@deriving sexp, equal]

let of_string s =
  match s with
  | "t1" -> Comment
  | "t2" -> User
  | "t3" -> Link
  | "t4" -> Message
  | "t5" -> Subreddit
  | "t6" -> Award
  | "more" -> More_comments
  | "modmail" -> Modmail_conversation
  | _ -> raise_s [%message "Unknown thing kind" s]
;;

let to_string t =
  match t with
  | Comment -> "t1"
  | User -> "t2"
  | Link -> "t3"
  | Message -> "t4"
  | Subreddit -> "t5"
  | Award -> "t6"
  | More_comments -> "more"
  | Modmail_conversation -> "modmail"
;;

let to_string_long t =
  match t with
  | Comment -> "Comment"
  | User -> "User"
  | Link -> "Link"
  | Message -> "Message"
  | Subreddit -> "Subreddit"
  | Award -> "Award"
  | More_comments -> "more"
  | Modmail_conversation -> "modmail"
;;

let of_polymorphic_tag = function
  | `Comment _ -> Comment
  | `User _ -> User
  | `Link _ -> Link
  | `Message _ -> Message
  | `Subreddit _ -> Subreddit
  | `Award _ -> Award
  | `More_comments _ -> More_comments
  | `Modmail_conversation _ -> Modmail_conversation
;;

let of_polymorphic_tag_with_uniform_data = function
  | `Comment data -> Comment, data
  | `User data -> User, data
  | `Link data -> Link, data
  | `Message data -> Message, data
  | `Subreddit data -> Subreddit, data
  | `Award data -> Award, data
  | `More_comments data -> More_comments, data
  | `Modmail_conversation data -> Modmail_conversation, data
;;

let to_polymorphic_tag
    t
    ~data
    ~award
    ~comment
    ~link
    ~message
    ~modmail_conversation
    ~more_comments
    ~subreddit
    ~user
  =
  match t with
  | Comment -> `Comment (comment data)
  | User -> `User (user data)
  | Link -> `Link (link data)
  | Message -> `Message (message data)
  | Subreddit -> `Subreddit (subreddit data)
  | Award -> `Award (award data)
  | More_comments -> `More_comments (more_comments data)
  | Modmail_conversation -> `Modmail_conversation (modmail_conversation data)
;;

let to_polymorphic_tag_uniform t ~data =
  to_polymorphic_tag
    t
    ~data
    ~award:ident
    ~comment:ident
    ~link:ident
    ~message:ident
    ~modmail_conversation:ident
    ~more_comments:ident
    ~subreddit:ident
    ~user:ident
;;