From 497e30a1b9417b47b20a785551615e40ffac30a6 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Sat, 23 May 2009 01:24:06 +0100
Subject: [PATCH] Add a small class for Nodes and Instances
Since both nodes and instances support some common functionality (names
and indices), we add a class so that we can access these attributes in a
generic way.
---
Ganeti/HTools/IAlloc.hs | 4 ++--
Ganeti/HTools/Instance.hs | 4 ++++
Ganeti/HTools/Loader.hs | 8 ++++----
Ganeti/HTools/Node.hs | 5 +++++
Ganeti/HTools/Rapi.hs | 4 ++--
Ganeti/HTools/Text.hs | 13 +++++++------
Ganeti/HTools/Types.hs | 21 +++++++++++++++++++++
7 files changed, 45 insertions(+), 14 deletions(-)
diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
index f6a273370..241bbd850 100644
--- a/Ganeti/HTools/IAlloc.hs
+++ b/Ganeti/HTools/IAlloc.hs
@@ -82,12 +82,12 @@ parseData body = do
nlist <- fromObj "nodes" obj
let ndata = fromJSObject nlist
nobj <- (mapM (\(x,y) -> asJSObject y >>= parseNode x)) ndata
- let (ktn, nl) = assignIndices Node.setIdx nobj
+ let (ktn, nl) = assignIndices nobj
-- existing instance parsing
ilist <- fromObj "instances" obj
let idata = fromJSObject ilist
iobj <- (mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x)) idata
- let (kti, il) = assignIndices Instance.setIdx iobj
+ let (kti, il) = assignIndices iobj
optype <- fromObj "type" request
rqtype <-
case optype of
diff --git a/Ganeti/HTools/Instance.hs b/Ganeti/HTools/Instance.hs
index f7b9b42d4..8aecf72b4 100644
--- a/Ganeti/HTools/Instance.hs
+++ b/Ganeti/HTools/Instance.hs
@@ -62,3 +62,7 @@ setIdx :: Instance -- ^ the original instance
-> Int -- ^ new index
-> Instance -- ^ the modified instance
setIdx t i = t { idx = i }
+
+-- | Changes the name
+-- This is used only during the building of the data structures.
+setName t s = t {name = s}
diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs
index 11f73b532..4b9bc7b49 100644
--- a/Ganeti/HTools/Loader.hs
+++ b/Ganeti/HTools/Loader.hs
@@ -28,11 +28,11 @@ lookupNode ktn inst node =
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
Just idx -> return idx
-assignIndices :: (a -> Int -> a)
- -> [(String, a)]
+assignIndices :: (Element a) =>
+ [(String, a)]
-> (NameAssoc, [(Int, a)])
-assignIndices set_fn =
- unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx)))
+assignIndices =
+ unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
. zip [0..]
-- | For each instance, add its index to its primary and secondary nodes
diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs
index 228107e5b..9f54f0370 100644
--- a/Ganeti/HTools/Node.hs
+++ b/Ganeti/HTools/Node.hs
@@ -14,6 +14,7 @@ module Ganeti.HTools.Node
-- ** Finalization after data loading
, buildPeers
, setIdx
+ , setName
, setOffline
, setXmem
, setFmem
@@ -102,6 +103,10 @@ create name_init mem_t_init mem_n_init mem_f_init
setIdx :: Node -> Int -> Node
setIdx t i = t {idx = i}
+-- | Changes the name
+-- This is used only during the building of the data structures.
+setName t s = t {name = s}
+
-- | Sets the offline attribute
setOffline :: Node -> Bool -> Node
setOffline t val = t { offline = val }
diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs
index 6f20e7bf4..ac0ff44fa 100644
--- a/Ganeti/HTools/Rapi.hs
+++ b/Ganeti/HTools/Rapi.hs
@@ -92,7 +92,7 @@ loadData master = do -- IO monad
inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
return $ do -- Result monad
node_data <- node_body >>= getNodes
- let (node_names, node_idx) = assignIndices Node.setIdx node_data
+ let (node_names, node_idx) = assignIndices node_data
inst_data <- inst_body >>= getInstances node_names
- let (inst_names, inst_idx) = assignIndices Instance.setIdx inst_data
+ let (inst_names, inst_idx) = assignIndices inst_data
return (node_names, node_idx, inst_names, inst_idx)
diff --git a/Ganeti/HTools/Text.hs b/Ganeti/HTools/Text.hs
index 03ff5cf6b..7c85db3fe 100644
--- a/Ganeti/HTools/Text.hs
+++ b/Ganeti/HTools/Text.hs
@@ -64,13 +64,14 @@ This function converts a text in tabular format as generated by
supplied conversion function.
-}
-loadTabular :: (Monad m) => String -> ([String] -> m (String, a))
- -> (a -> Int -> a) -> m ([(String, Int)], [(Int, a)])
-loadTabular text_data convert_fn set_fn = do
+loadTabular :: (Monad m, Element a) =>
+ String -> ([String] -> m (String, a))
+ -> m ([(String, Int)], [(Int, a)])
+loadTabular text_data convert_fn = do
let lines_data = lines text_data
rows = map (sepSplit '|') lines_data
kerows <- mapM convert_fn rows
- return $ assignIndices set_fn kerows
+ return $ assignIndices kerows
loadData :: String -- ^ Node data in string format
-> String -- ^ Instance data in string format
@@ -81,7 +82,7 @@ loadData nfile ifile = do -- IO monad
idata <- readFile ifile
return $ do
{- node file: name t_mem n_mem f_mem t_disk f_disk -}
- (ktn, nl) <- loadTabular ndata loadNode Node.setIdx
+ (ktn, nl) <- loadTabular ndata loadNode
{- instance file: name mem disk status pnode snode -}
- (kti, il) <- loadTabular idata (loadInst ktn) Instance.setIdx
+ (kti, il) <- loadTabular idata (loadInst ktn)
return (ktn, nl, kti, il)
diff --git a/Ganeti/HTools/Types.hs b/Ganeti/HTools/Types.hs
index 0a248028e..8bae7c3d0 100644
--- a/Ganeti/HTools/Types.hs
+++ b/Ganeti/HTools/Types.hs
@@ -39,3 +39,24 @@ instance Monad Result where
(>>=) (Ok x) fn = fn x
return = Ok
fail = Bad
+
+-- | A generic class for nodes and instances
+class Element a where
+ name :: a -> String
+ idx :: a -> Int
+ setName :: a -> String -> a
+ setIdx :: a -> Int -> a
+
+-- Let's make nodes elements of the cluster
+instance Element Node.Node where
+ name = Node.name
+ idx = Node.idx
+ setName = Node.setName
+ setIdx = Node.setIdx
+
+-- And instances too
+instance Element Instance.Instance where
+ name = Instance.name
+ idx = Instance.idx
+ setName = Instance.setName
+ setIdx = Instance.setIdx
--
GitLab