objective categorical abstract machine language personal data server
1[@@@ocaml.warning "-26-27"]
2
3open React
4
5type handle_status = Idle | Checking | Valid | Invalid of string
6
7let[@react.component] make ~name ?(label = "handle") ?(sr_only = false)
8 ?(required = false) ?(showIndicator = true) ?(subdomainOnly = false)
9 ?placeholder ?hostname ?value ?onChange () =
10 let internalValue, setInternalValue = useState (fun () -> "") in
11 let handleValue = Option.value value ~default:internalValue in
12 let handleStatus, setHandleStatus = useState (fun () -> Idle) in
13 let checkTimeoutRef = useRef None in
14 let checkHandle =
15 [%browser_only
16 fun handle ->
17 setHandleStatus (fun _ -> Checking) ;
18 let fullHandle =
19 match hostname with
20 | Some host ->
21 handle ^ "." ^ host
22 | None ->
23 handle
24 in
25 let _ =
26 Fetch.fetch
27 ( "/account/signup/check-handle?handle="
28 ^ Js.Global.encodeURIComponent handle )
29 |> Js.Promise.then_ (fun response ->
30 if Fetch.Response.ok response then Fetch.Response.json response
31 else Js.Promise.reject (Js.Exn.raiseError "Request failed") )
32 |> Js.Promise.then_ (fun json ->
33 let valid =
34 Js.Dict.get (Obj.magic json) "valid"
35 |> Option.map Obj.magic
36 |> Option.value ~default:false
37 in
38 let available =
39 Js.Dict.get (Obj.magic json) "available"
40 |> Option.map Obj.magic
41 |> Option.value ~default:false
42 in
43 let error =
44 Option.bind
45 (Js.Dict.get (Obj.magic json) "error" |> Option.map Obj.magic)
46 (fun x ->
47 if Js.Nullable.isNullable (Obj.magic x) then None
48 else Some x )
49 in
50 if valid && available then setHandleStatus (fun _ -> Valid)
51 else
52 setHandleStatus (fun _ ->
53 Invalid (Option.value error ~default:"Invalid handle") ) ;
54 Js.Promise.resolve () )
55 |> Js.Promise.catch (fun _ ->
56 setHandleStatus (fun _ ->
57 Invalid "Couldn't check handle availability" ) ;
58 Js.Promise.resolve () )
59 in
60 ()]
61 in
62 let onHandleChange =
63 [%browser_only
64 fun e ->
65 let inputValue = (Event.Form.target e)##value in
66 ( match onChange with
67 | Some f ->
68 f e
69 | None ->
70 setInternalValue (fun _ -> inputValue) ) ;
71 ( match checkTimeoutRef.current with
72 | Some id ->
73 Js.Global.clearTimeout id
74 | None ->
75 () ) ;
76 if String.length inputValue = 0 then setHandleStatus (fun _ -> Idle)
77 else
78 let id =
79 Js.Global.setTimeout ~f:(fun () -> checkHandle inputValue) 300
80 in
81 checkTimeoutRef.current <- Some id]
82 in
83 let trailing =
84 match hostname with
85 | Some h ->
86 Some
87 <span className="font-serif text-mist-80 whitespace-nowrap">
88 (string ("." ^ h))
89 </span>
90 | _ ->
91 None
92 in
93 <div>
94 <Input
95 sr_only
96 name
97 type_="text"
98 label
99 value=handleValue
100 onChange=onHandleChange
101 required
102 showIndicator
103 ?placeholder
104 ?trailing
105 />
106 ( match handleStatus with
107 | Checking ->
108 <span className="text-mist-80 text-sm mt-1 block">
109 (string "Checking availability...")
110 </span>
111 | Valid ->
112 <span className="inline-flex items-center text-mana-100 text-sm mt-1">
113 <CheckmarkIcon className="w-4 h-4 mr-1" />
114 (string "Handle is available")
115 </span>
116 | Invalid msg ->
117 <span
118 className="inline-flex items-center text-phoenix-100 text-sm mt-1">
119 <CircleAlertIcon className="w-4 h-4 mr-1" /> (string msg)
120 </span>
121 | Idle ->
122 null )
123 </div>