1 (* virt-manager-like graphical management tool.
2 (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
4 $Id: mlvirtmanager_helpers.ml,v 1.1 2007/08/06 10:16:53 rjones Exp $
7 module C = Libvirt.Connect
8 module D = Libvirt.Domain
9 module N = Libvirt.Network
11 (* Given two lists, xs and ys, return a list of items which have been
12 * added to ys, items which are the same, and items which have been
14 * Returns a triplet (list of added, list of same, list of removed).
16 let differences xs ys =
18 | [], [] -> (* Base case. *)
20 | [], ys -> (* All ys have been added. *)
22 | xs, [] -> (* All xs have been removed. *)
24 | (x :: xs), (y :: ys) when x = y -> (* Not added or removed. *)
25 let added, unchanged, removed = d (xs, ys) in
26 added, x :: unchanged, removed
27 | (x :: xs), ((y :: _) as ys) when x < y -> (* x removed. *)
28 let added, unchanged, removed = d (xs, ys) in
29 added, unchanged, x :: removed
30 | ((x :: _) as xs), (y :: ys) (* when x > y *) -> (* y added. *)
31 let added, unchanged, removed = d (xs, ys) in
32 y :: added, unchanged, removed
34 d (List.sort compare xs, List.sort compare ys)
36 let string_of_domain_state = function
37 | D.InfoNoState -> "unknown"
38 | D.InfoRunning -> "running"
39 | D.InfoBlocked -> "blocked"
40 | D.InfoPaused -> "paused"
41 | D.InfoShutdown -> "shutdown"
42 | D.InfoShutoff -> "shutoff"
43 | D.InfoCrashed -> "crashed"
45 (* Filter top level rows (only) in a tree_store. If function f returns
46 * true then the row remains, but if it returns false then the row is
49 let rec filter_top_level_rows (model : GTree.tree_store) f =
50 match model#get_iter_first with
52 | Some iter -> filter_rows model f iter
54 (* Filter rows in a tree_store at a particular level. *)
55 and filter_rows model f row =
57 let iter_still_valid =
58 if not keep then model#remove row else model#iter_next row in
59 if iter_still_valid then filter_rows model f row
61 (* Find the first top level row matching predicate f and return it. *)
62 let rec find_top_level_row (model : GTree.tree_store) f =
63 match model#get_iter_first with
64 | None -> raise Not_found (* no rows *)
65 | Some row -> find_row model f row
67 (* Find the first row matching predicate f at a particular level. *)
68 and find_row model f row =
70 else if model#iter_next row then find_row model f row
73 (* Iterate over top level rows (only) in a tree_store. *)
74 let rec iter_top_level_rows (model : GTree.tree_store) f =
75 match model#get_iter_first with
77 | Some iter -> iter_rows model f iter
79 (* Iterate over rows in a tree_store at a particular level. *)
80 and iter_rows model f row =
82 if model#iter_next row then iter_rows model f row