Add 'Read' instances for most objects

[ganeti-local] / Ganeti / HTools / Cluster.hs

diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index 13a7487..1a22866 100644 (file)
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -51,6 +51,7 @@ module Ganeti.HTools.Cluster
     , doNextBalance
     , tryBalance
     , compCV
+    , compDetailedCV
     , printStats
     , iMoveToJob
     -- * IAllocator functions
@@ -62,11 +63,14 @@ module Ganeti.HTools.Cluster
     -- * Allocation functions
     , iterateAlloc
     , tieredAlloc
+    , tieredSpecMap
+     -- * Node group functions
     , instanceGroup
     , findSplitInstances
     , splitCluster
     ) where
 
+import Data.Function (on)
 import Data.List
 import Data.Ord (comparing)
 import Text.Printf (printf)
@@ -99,7 +103,7 @@ emptySolution = AllocSolution { asFailures = [], asAllocs = 0
 
 -- | The complete state for the balancing solution
 data Table = Table Node.List Instance.List Score [Placement]
-             deriving (Show)
+             deriving (Show, Read)
 
 data CStats = CStats { csFmem :: Int    -- ^ Cluster free mem
                      , csFdsk :: Int    -- ^ Cluster free disk
@@ -123,7 +127,7 @@ data CStats = CStats { csFmem :: Int    -- ^ Cluster free mem
                      , csScore :: Score -- ^ The cluster score
                      , csNinst :: Int   -- ^ The total number of instances
                      }
-            deriving (Show)
+            deriving (Show, Read)
 
 -- | Currently used, possibly to allocate, unallocable
 type AllocStats = (RSpec, RSpec, RSpec)
@@ -247,16 +251,16 @@ compDetailedCV nl =
         mem_l = map Node.pMem nodes
         dsk_l = map Node.pDsk nodes
         -- metric: memory covariance
-        mem_cv = varianceCoeff mem_l
+        mem_cv = stdDev mem_l
         -- metric: disk covariance
-        dsk_cv = varianceCoeff dsk_l
+        dsk_cv = stdDev dsk_l
         -- metric: count of instances living on N1 failing nodes
         n1_score = fromIntegral . sum . map (\n -> length (Node.sList n) +
                                                    length (Node.pList n)) .
                    filter Node.failN1 $ nodes :: Double
         res_l = map Node.pRem nodes
         -- metric: reserved memory covariance
-        res_cv = varianceCoeff res_l
+        res_cv = stdDev res_l
         -- offline instances metrics
         offline_ipri = sum . map (length . Node.pList) $ offline
         offline_isec = sum . map (length . Node.sList) $ offline
@@ -268,7 +272,7 @@ compDetailedCV nl =
         off_pri_score = fromIntegral offline_ipri::Double
         cpu_l = map Node.pCpu nodes
         -- metric: covariance of vcpu/pcpu ratio
-        cpu_cv = varianceCoeff cpu_l
+        cpu_cv = stdDev cpu_l
         -- metrics: covariance of cpu, memory, disk and network load
         (c_load, m_load, d_load, n_load) = unzip4 $
             map (\n ->
@@ -280,8 +284,7 @@ compDetailedCV nl =
         pri_tags_inst = sum $ map Node.conflictingPrimaries nodes
         pri_tags_score = fromIntegral pri_tags_inst::Double
     in [ mem_cv, dsk_cv, n1_score, res_cv, off_score, off_pri_score, cpu_cv
-       , varianceCoeff c_load, varianceCoeff m_load
-       , varianceCoeff d_load, varianceCoeff n_load
+       , stdDev c_load, stdDev m_load , stdDev d_load, stdDev n_load
        , pri_tags_score ]
 
 -- | Compute the /total/ variance.
@@ -762,6 +765,7 @@ iterateAlloc nl il newinst nreq ixes =
                  _ -> Bad "Internal error: multiple solutions for single\
                           \ allocation"
 
+-- | The core of the tiered allocation mode
 tieredAlloc :: Node.List
             -> Instance.List
             -> Instance.Instance
@@ -779,6 +783,18 @@ tieredAlloc nl il newinst nreq ixes =
             Ok newinst' ->
                 tieredAlloc nl' il' newinst' nreq ixes'
 
+-- | Compute the tiered spec string description from a list of
+-- allocated instances.
+tieredSpecMap :: [Instance.Instance]
+              -> [String]
+tieredSpecMap trl_ixes =
+    let fin_trl_ixes = reverse trl_ixes
+        ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
+        spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
+                   ix_byspec
+    in  map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
+                             (rspecDsk spec) (rspecCpu spec) cnt) spec_map
+
 -- * Formatting functions
 
 -- | Given the original and final nodes, computes the relocation description.
@@ -941,6 +957,8 @@ iMoveToJob nl il idx move =
          ReplaceAndFailover np -> [ opR np, opF ]
          FailoverAndReplace ns -> [ opF, opR ns ]
 
+-- * Node group functions
+
 -- | Computes the group of an instance
 instanceGroup :: Node.List -> Instance.Instance -> Result Gdx
 instanceGroup nl i =