Fix very slow unit-test data generation in some cases
[ganeti-local] / htools / Ganeti / HTools / Simu.hs
1 {-| Parsing data from a simulated description of the cluster.
2
3 This module holds the code for parsing a cluster description.
4
5 -}
6
7 {-
8
9 Copyright (C) 2009, 2010, 2011 Google Inc.
10
11 This program is free software; you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation; either version 2 of the License, or
14 (at your option) any later version.
15
16 This program is distributed in the hope that it will be useful, but
17 WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19 General Public License for more details.
20
21 You should have received a copy of the GNU General Public License
22 along with this program; if not, write to the Free Software
23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
24 02110-1301, USA.
25
26 -}
27
28 module Ganeti.HTools.Simu
29   ( loadData
30   , parseData
31   ) where
32
33 import Control.Monad (mplus)
34 import Text.Printf (printf)
35
36 import Ganeti.HTools.Utils
37 import Ganeti.HTools.Types
38 import Ganeti.HTools.Loader
39 import qualified Ganeti.HTools.Container as Container
40 import qualified Ganeti.HTools.Group as Group
41 import qualified Ganeti.HTools.Node as Node
42
43 -- | Parse a shortened policy string (for command line usage).
44 apolAbbrev :: String -> Result AllocPolicy
45 apolAbbrev c | c == "p"  = return AllocPreferred
46              | c == "a"  = return AllocLastResort
47              | c == "u"  = return AllocUnallocable
48              | otherwise = fail $ "Cannot parse AllocPolicy abbreviation '"
49                            ++ c ++ "'"
50
51 -- | Parse the string description into nodes.
52 parseDesc :: String -> Result (AllocPolicy, Int, Int, Int, Int)
53 parseDesc desc =
54   case sepSplit ',' desc of
55     [a, n, d, m, c] -> do
56       apol <- allocPolicyFromRaw a `mplus` apolAbbrev a
57       ncount <- tryRead "node count" n
58       disk <- annotateResult "disk size" (parseUnit d)
59       mem <- annotateResult "memory size" (parseUnit m)
60       cpu <- tryRead "cpu count" c
61       return (apol, ncount, disk, mem, cpu)
62     es -> fail $ printf
63           "Invalid cluster specification, expected 5 comma-separated\
64           \ sections (allocation policy, node count, disk size,\
65           \ memory size, number of CPUs) but got %d: '%s'" (length es) desc
66
67 -- | Creates a node group with the given specifications.
68 createGroup :: Int    -- ^ The group index
69             -> String -- ^ The group specification
70             -> Result (Group.Group, [Node.Node])
71 createGroup grpIndex spec = do
72   (apol, ncount, disk, mem, cpu) <- parseDesc spec
73   let nodes = map (\idx ->
74                      Node.create (printf "node-%02d-%03d" grpIndex idx)
75                            (fromIntegral mem) 0 mem
76                            (fromIntegral disk) disk
77                            (fromIntegral cpu) False grpIndex
78                   ) [1..ncount]
79       grp = Group.create (printf "group-%02d" grpIndex)
80             (printf "fake-uuid-%02d" grpIndex) apol defIPolicy
81   return (Group.setIdx grp grpIndex, nodes)
82
83 -- | Builds the cluster data from node\/instance files.
84 parseData :: [String] -- ^ Cluster description in text format
85           -> Result ClusterData
86 parseData ndata = do
87   grpNodeData <- mapM (uncurry createGroup) $ zip [1..] ndata
88   let (groups, nodes) = unzip grpNodeData
89       nodes' = concat nodes
90   let ktn = map (\(idx, n) -> (idx, Node.setIdx n idx))
91             $ zip [1..] nodes'
92       ktg = map (\g -> (Group.idx g, g)) groups
93   return (ClusterData (Container.fromList ktg)
94                       (Container.fromList ktn) Container.empty [] defIPolicy)
95
96 -- | Builds the cluster data from node\/instance files.
97 loadData :: [String] -- ^ Cluster description in text format
98          -> IO (Result ClusterData)
99 loadData = -- IO monad, just for consistency with the other loaders
100   return . parseData