Commit 3218a86b authored by Glen Mével's avatar Glen Mével

remove warnings for `parse-json`

parent 7a13e6a7
......@@ -99,10 +99,10 @@ let parse_json stream =
| s ->
begin try
Base (Int (Int64.of_string s))
with Failure "Int64.of_string" ->
with Failure _ ->
begin try
Base (Float (float_of_string s))
with Failure "float_of_string" ->
with Failure _ ->
failwith @@ "unrecognized token: " ^ s
end
end
......@@ -281,7 +281,10 @@ let () =
*)
(*
* a more specific use case
* a more elaborate application:
*
* dump a Firefox session backup in a much more concise and readable form (such
* backups can be found under ~/.mozilla/firefox/my.profile/sessionstore-backups/)
*)
let has_field record name' =
......@@ -293,31 +296,43 @@ let get_field record name =
|> List.map (fun { name; value } -> name, value)
|> List.assoc (String name)
let get_default record name f ~default =
let get_field_opt record name =
try
get_field record name |> f
Some (get_field record name)
with Not_found ->
default
None
let as_bool = function
| Base (Bool b) -> b
| _ -> raise @@ Invalid_argument "as_bool"
let as_int = function
| Base (Int i) -> Int64.to_int i
| _ -> raise @@ Invalid_argument "as_int"
let as_string = function
| Base (String str) -> str
| _ -> raise @@ Invalid_argument "as_string"
let as_list = function
| List li -> li
| List li -> li
| Base Null -> []
| _ -> raise @@ Invalid_argument "as_list"
let as_record = function
| Record r -> r
| Record r -> r
| Base Null -> []
| _ -> raise @@ Invalid_argument "as_record"
let opt_map ~default f = function
| Some x -> f x
| None -> default
let ( |? ) = has_field
let ( |. ) = get_field
let ( |.? ) = get_field_opt
let ( >>= ) o f = opt_map ~default:None f o
let opt_do f o = opt_map ~default:() f o
type tab = {
url : string ;
......@@ -342,37 +357,37 @@ let () =
parse_json_file stdin |> as_record |. "windows" |> as_list
|> List.iter (fun window ->
window |> as_record |. "tabs" |> as_list
|> List.iter (fun tab ->
let tab = tab |> as_record in
(*let pinned = get_default tab "pinned" as_bool ~default:false
and hidden = get_default tab "hidden" as_bool ~default:false in*)
|> List.iter (as_record %> fun tab ->
(*let pinned = tab |.? "pinned" |> opt_map as_bool ~default:false
and hidden = tab |.? "hidden" |> opt_map as_bool ~default:false in*)
let entries = tab |. "entries" |> as_list in
let index = get_default tab "index" as_int ~default:(List.length entries) in
let index = tab |.? "index" |> opt_map as_int ~default:(List.length entries) in
let entry = List.nth entries (index-1) |> as_record in
let url = get_default entry "url" as_string ~default:"[no url]"
and title = get_default entry "title" as_string ~default:"[no title]" in
let url = entry |.? "url" |> opt_map as_string ~default:"[no url]"
and title = entry |.? "title" |> opt_map as_string ~default:"[no title]" in
let group_id =
get_default tab "extData" (as_record %> fun extdata ->
get_default extdata "tabview-tab" (as_string %> parse_json_string %> as_record %> fun tabview ->
get_default tabview "groupID" (as_int %> some) ~default:None
tab |.? "extData" >>= (as_record %> fun extdata ->
extdata |.? "tabview-tab" >>= (as_string %> parse_json_string %> as_record %> fun tabview ->
tabview |.? "groupID" >>= (as_int %> some)
)
~default:None
)
~default:None
in
let tab = { url ; title (*pinned ; hidden*) } in
add_to_group group_id tab
) ;
window |> as_record |. "extData" |> as_record |. "tabview-group" |> as_string |> parse_json_string |> as_record
|> List.iter (fun field ->
let id = Base field.name |> as_string |> int_of_string
and title = field.value |> as_record |. "title" |> as_string in
tabgroup_titles := (id, title) :: !tabgroup_titles
window |> as_record |.? "extData" |> opt_do (as_record %> fun extdata ->
extdata |.? "tabview-group" |> opt_do (as_string %> parse_json_string %> as_record %>
List.iter (fun field ->
let id = Base field.name |> as_string |> int_of_string
and title = field.value |> as_record |. "title" |> as_string in
tabgroup_titles := (id, title) :: !tabgroup_titles
)
)
)
) ;
Hashtbl.iter (fun group_id tabs ->
begin match group_id with
| None -> Printf.printf "\n-- pinned\n\n"
| None -> Printf.printf "\n-- pinned or not grouped\n\n"
| Some id -> Printf.printf "\n-- group %i: %s\n\n" id (List.assoc id !tabgroup_titles)
end ;
let tabs = List.rev tabs in
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment