## Revision 9dcec001 hspace.hs

b/hspace.hs
132 132
"show help"
133 133
]
134 134

135
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
136
-> m [(Node.List, [Node.Node])]
135
filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
136
-> m [(Node.List, Instance.Instance, [Node.Node])]
137 137
filterFails sols =
138 138
if null sols then fail "No nodes onto which to allocate at all"
139
else let sols' = filter (isJust . fst) sols
139
else let sols' = filter (isJust . fst3) sols
140 140
in if null sols' then
141 141
fail "No valid allocation solutions"
142 142
else
143
return \$ map (\(x, y) -> (fromJust x, y)) sols'
143
return \$ map (\(x, y, z) -> (fromJust x, y, z)) sols'
144 144

145
processResults :: (Monad m) => [(Node.List, [Node.Node])]
146
-> m (Node.List, [Node.Node])
145
processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
146
-> m (Node.List, Instance.Instance, [Node.Node])
147 147
processResults sols =
148
let sols' = map (\(nl', ns) -> (Cluster.compCV  nl', (nl', ns))) sols
148
let sols' = map (\e@(nl', _, _) -> (Cluster.compCV  nl', e)) sols
149 149
sols'' = sortBy (compare `on` fst) sols'
150 150
in return \$ snd \$ head sols''
151 151

......
153 153
-> Instance.List
154 154
-> Instance.Instance
155 155
-> Int
156
-> Int
157
-> (Node.List, Int)
158
iterateDepth nl il newinst nreq depth =
159
let newname = printf "new-%d" depth
156
-> [Instance.Instance]
157
-> (Node.List, [Instance.Instance])
158
iterateDepth nl il newinst nreq ixes =
159
let depth = length ixes
160
newname = printf "new-%d" depth
160 161
newidx = (length \$ Container.elems il) + depth
161 162
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
162 163
sols = Cluster.tryAlloc nl il newi2 nreq
163
orig = (nl, depth)
164
orig = (nl, ixes)
164 165
in
165 166
if isNothing sols then orig
166 167
else let sols' = fromJust sols
167 168
sols'' = filterFails sols'
168 169
in if isNothing sols'' then orig
169
else let (xnl, _) = fromJust \$ processResults \$ fromJust sols''
170
in iterateDepth xnl il newinst nreq (depth+1)
170
else let (xnl, xi, _) = fromJust \$ processResults \$
171
fromJust sols''
172
in iterateDepth xnl il newinst nreq (xi:ixes)
171 173

172 174

173 175
-- | Main function.
......
183 185
let verbose = optVerbose opts
184 186

185 187
(fixed_nl, il, csf) <- CLI.loadExternalData opts
188
let num_instances = length \$ Container.elems il
186 189

187 190
let offline_names = optOffline opts
188 191
all_nodes = Container.elems fixed_nl
......
193 196
all_nodes
194 197

195 198
when (length offline_wrong > 0) \$ do
196
printf "Wrong node name(s) set as offline: %s\n"
199
printf "Error: Wrong node name(s) set as offline: %s\n"
197 200
(commaJoin offline_wrong)
198 201
exitWith \$ ExitFailure 1
199 202

......
206 209

207 210
208 211
when (length bad_nodes > 0) \$ do
209
putStrLn "Cluster not N+1, no space to allocate."
212
putStrLn "Error: Cluster not N+1, no space to allocate."
210 213
exitWith \$ ExitFailure 1
211 214

212 215
when (optShowNodes opts) \$
......
215 218
putStrLn \$ Cluster.printNodes nl
216 219

217 220
let ini_cv = Cluster.compCV nl
221
(orig_mem, orig_disk) = Cluster.totalResources nl
218 222

219 223
(if verbose > 2 then
220 224
printf "Initial coefficients: overall %.8f, %s\n"
221 225
ini_cv (Cluster.printStats nl)
222 226
else
223 227
printf "Initial score: %.8f\n" ini_cv)
228
printf "Initial instances: %d\n" num_instances
229
printf "Initial free RAM: %d\n" orig_mem
230
printf "Initial free disk: %d\n" orig_disk
224 231

225
let imlen = Container.maxNameLen il
226
nmlen = Container.maxNameLen nl
232
let nmlen = Container.maxNameLen nl
227 233
newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
228 234
229 235

230
let (fin_nl, fin_depth) = iterateDepth nl il newinst (optINodes opts) 0
231

232
unless (verbose == 0) \$
233
printf "Solution length=%d\n" fin_depth
236
let (fin_nl, ixes) =
237
iterateDepth nl il newinst (optINodes opts) []
238
allocs = length ixes
239
fin_instances = num_instances + allocs
240
fin_ixes = reverse ixes
241
ix_namelen = maximum . map (length . Instance.name) \$ fin_ixes
242
(final_mem, final_disk) = Cluster.totalResources fin_nl
243

244
printf "Final score: %.8f\n" (Cluster.compCV fin_nl)
245
printf "Final instances: %d\n" (num_instances + allocs)
246
printf "Final free RAM: %d\n" final_mem
247
printf "Final free disk: %d\n" final_disk
248
printf "Usage: %.2f\n" (((fromIntegral num_instances)::Double) /
249
(fromIntegral fin_instances))
250
printf "Allocations: %d\n" allocs
251
when (verbose > 1) \$ do
252
putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s"
253
ix_namelen (Instance.name i)
254
nmlen (Container.nameOf fin_nl \$ Instance.pnode i)
255
nmlen (Container.nameOf fin_nl \$ Instance.snode i))
256
\$ fin_ixes
234 257

235 258
when (optShowNodes opts) \$
236 259
do

Also available in: Unified diff