mlvirtmanager/mlvirtmanager_helpers.ml

   1 (* virt-manager-like graphical management tool.
   2    (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4    $Id: mlvirtmanager_helpers.ml,v 1.1 2007/08/06 10:16:53 rjones Exp $
   5 *)
   6
   7 module C = Libvirt.Connect
   8 module D = Libvirt.Domain
   9 module N = Libvirt.Network
  10
  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
  13  * removed from ys.
  14  * Returns a triplet (list of added, list of same, list of removed).
  15  *)
  16 let differences xs ys =
  17   let rec d = function
  18     | [], [] -> (* Base case. *)
  19         ([], [], [])
  20     | [], ys -> (* All ys have been added. *)
  21         (ys, [], [])
  22     | xs, [] -> (* All xs have been removed. *)
  23         ([], [], xs)
  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
  33   in
  34   d (List.sort compare xs, List.sort compare ys)
  35
  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"
  44
  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
  47  * removed.
  48  *)
  49 let rec filter_top_level_rows (model : GTree.tree_store) f =
  50   match model#get_iter_first with
  51   | None -> ()
  52   | Some iter -> filter_rows model f iter
  53
  54 (* Filter rows in a tree_store at a particular level. *)
  55 and filter_rows model f row =
  56   let keep = f row in
  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
  60
  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
  66
  67 (* Find the first row matching predicate f at a particular level. *)
  68 and find_row model f row =
  69   if f row then row
  70   else if model#iter_next row then find_row model f row
  71   else raise Not_found
  72
  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
  76   | None -> ()
  77   | Some iter -> iter_rows model f iter
  78
  79 (* Iterate over rows in a tree_store at a particular level. *)
  80 and iter_rows model f row =
  81   f row;
  82   if model#iter_next row then iter_rows model f row