root / htools / Ganeti / HTools / Types.hs @ 2c9336a4
History | View | Annotate | Download (11.7 kB)
1 | e4c5beaf | Iustin Pop | {-| Some common types. |
---|---|---|---|
2 | e4c5beaf | Iustin Pop | |
3 | e4c5beaf | Iustin Pop | -} |
4 | e4c5beaf | Iustin Pop | |
5 | e2fa2baf | Iustin Pop | {- |
6 | e2fa2baf | Iustin Pop | |
7 | 2e5eb96a | Iustin Pop | Copyright (C) 2009, 2010, 2011 Google Inc. |
8 | e2fa2baf | Iustin Pop | |
9 | e2fa2baf | Iustin Pop | This program is free software; you can redistribute it and/or modify |
10 | e2fa2baf | Iustin Pop | it under the terms of the GNU General Public License as published by |
11 | e2fa2baf | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
12 | e2fa2baf | Iustin Pop | (at your option) any later version. |
13 | e2fa2baf | Iustin Pop | |
14 | e2fa2baf | Iustin Pop | This program is distributed in the hope that it will be useful, but |
15 | e2fa2baf | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | e2fa2baf | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | e2fa2baf | Iustin Pop | General Public License for more details. |
18 | e2fa2baf | Iustin Pop | |
19 | e2fa2baf | Iustin Pop | You should have received a copy of the GNU General Public License |
20 | e2fa2baf | Iustin Pop | along with this program; if not, write to the Free Software |
21 | e2fa2baf | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | e2fa2baf | Iustin Pop | 02110-1301, USA. |
23 | e2fa2baf | Iustin Pop | |
24 | e2fa2baf | Iustin Pop | -} |
25 | e2fa2baf | Iustin Pop | |
26 | e4c5beaf | Iustin Pop | module Ganeti.HTools.Types |
27 | 19f38ee8 | Iustin Pop | ( Idx |
28 | 19f38ee8 | Iustin Pop | , Ndx |
29 | 0dc1bf87 | Iustin Pop | , Gdx |
30 | 19f38ee8 | Iustin Pop | , NameAssoc |
31 | 92e32d76 | Iustin Pop | , Score |
32 | 2180829f | Iustin Pop | , Weight |
33 | c4d98278 | Iustin Pop | , GroupID |
34 | 0dc1bf87 | Iustin Pop | , AllocPolicy(..) |
35 | 2c9336a4 | Iustin Pop | , allocPolicyFromString |
36 | 2c9336a4 | Iustin Pop | , allocPolicyToString |
37 | 1f9066c0 | Iustin Pop | , RSpec(..) |
38 | 2180829f | Iustin Pop | , DynUtil(..) |
39 | 2180829f | Iustin Pop | , zeroUtil |
40 | ee9724b9 | Iustin Pop | , baseUtil |
41 | 2180829f | Iustin Pop | , addUtil |
42 | 2180829f | Iustin Pop | , subUtil |
43 | f4c0b8c5 | Iustin Pop | , defVcpuRatio |
44 | f4c0b8c5 | Iustin Pop | , defReservedDiskRatio |
45 | 1e3dccc8 | Iustin Pop | , unitMem |
46 | 1e3dccc8 | Iustin Pop | , unitCpu |
47 | 1e3dccc8 | Iustin Pop | , unitDsk |
48 | 82ea2874 | Iustin Pop | , unknownField |
49 | 92e32d76 | Iustin Pop | , Placement |
50 | 92e32d76 | Iustin Pop | , IMove(..) |
51 | cc25e437 | Iustin Pop | , DiskTemplate(..) |
52 | 2c9336a4 | Iustin Pop | , diskTemplateToString |
53 | 2c9336a4 | Iustin Pop | , diskTemplateFromString |
54 | 0e8ae201 | Iustin Pop | , MoveJob |
55 | 0e8ae201 | Iustin Pop | , JobSet |
56 | 19f38ee8 | Iustin Pop | , Result(..) |
57 | 06fb841e | Iustin Pop | , isOk |
58 | 06fb841e | Iustin Pop | , isBad |
59 | a30b473c | Iustin Pop | , eitherToResult |
60 | 19f38ee8 | Iustin Pop | , Element(..) |
61 | f2280553 | Iustin Pop | , FailMode(..) |
62 | 478df686 | Iustin Pop | , FailStats |
63 | f2280553 | Iustin Pop | , OpResult(..) |
64 | a30b473c | Iustin Pop | , opToResult |
65 | 135a6c6a | Iustin Pop | , connTimeout |
66 | 135a6c6a | Iustin Pop | , queryTimeout |
67 | 1fe412bb | Iustin Pop | , EvacMode(..) |
68 | 19f38ee8 | Iustin Pop | ) where |
69 | e4c5beaf | Iustin Pop | |
70 | 1c7c4578 | Iustin Pop | import Control.Monad |
71 | 2d0ca2c5 | Iustin Pop | import qualified Data.Map as M |
72 | b2ba4669 | Iustin Pop | import qualified Text.JSON as JSON |
73 | 2d0ca2c5 | Iustin Pop | |
74 | 2e5eb96a | Iustin Pop | import qualified Ganeti.Constants as C |
75 | 2e5eb96a | Iustin Pop | |
76 | 9188aeef | Iustin Pop | -- | The instance index type. |
77 | 608efcce | Iustin Pop | type Idx = Int |
78 | 608efcce | Iustin Pop | |
79 | 9188aeef | Iustin Pop | -- | The node index type. |
80 | 608efcce | Iustin Pop | type Ndx = Int |
81 | 608efcce | Iustin Pop | |
82 | 0dc1bf87 | Iustin Pop | -- | The group index type. |
83 | 0dc1bf87 | Iustin Pop | type Gdx = Int |
84 | 0dc1bf87 | Iustin Pop | |
85 | 9188aeef | Iustin Pop | -- | The type used to hold name-to-idx mappings. |
86 | 2d0ca2c5 | Iustin Pop | type NameAssoc = M.Map String Int |
87 | e4c5beaf | Iustin Pop | |
88 | 92e32d76 | Iustin Pop | -- | A separate name for the cluster score type. |
89 | 92e32d76 | Iustin Pop | type Score = Double |
90 | 92e32d76 | Iustin Pop | |
91 | 2180829f | Iustin Pop | -- | A separate name for a weight metric. |
92 | 2180829f | Iustin Pop | type Weight = Double |
93 | 2180829f | Iustin Pop | |
94 | 0dc1bf87 | Iustin Pop | -- | The Group UUID type. |
95 | c4d98278 | Iustin Pop | type GroupID = String |
96 | c4d98278 | Iustin Pop | |
97 | 0dc1bf87 | Iustin Pop | -- | The Group allocation policy type. |
98 | 73206d0a | Iustin Pop | -- |
99 | 73206d0a | Iustin Pop | -- Note that the order of constructors is important as the automatic |
100 | 73206d0a | Iustin Pop | -- Ord instance will order them in the order they are defined, so when |
101 | 73206d0a | Iustin Pop | -- changing this data type be careful about the interaction with the |
102 | 73206d0a | Iustin Pop | -- desired sorting order. |
103 | 73206d0a | Iustin Pop | data AllocPolicy |
104 | 73206d0a | Iustin Pop | = AllocPreferred -- ^ This is the normal status, the group |
105 | 73206d0a | Iustin Pop | -- should be used normally during allocations |
106 | 73206d0a | Iustin Pop | | AllocLastResort -- ^ This group should be used only as |
107 | 73206d0a | Iustin Pop | -- last-resort, after the preferred groups |
108 | 73206d0a | Iustin Pop | | AllocUnallocable -- ^ This group must not be used for new |
109 | 73206d0a | Iustin Pop | -- allocations |
110 | 3c002a13 | Iustin Pop | deriving (Show, Read, Eq, Ord, Enum, Bounded) |
111 | 0dc1bf87 | Iustin Pop | |
112 | 525bfb36 | Iustin Pop | -- | Convert a string to an alloc policy. |
113 | 2c9336a4 | Iustin Pop | allocPolicyFromString :: (Monad m) => String -> m AllocPolicy |
114 | 2c9336a4 | Iustin Pop | allocPolicyFromString s = |
115 | 2e5eb96a | Iustin Pop | case () of |
116 | 2e5eb96a | Iustin Pop | _ | s == C.allocPolicyPreferred -> return AllocPreferred |
117 | 2e5eb96a | Iustin Pop | | s == C.allocPolicyLastResort -> return AllocLastResort |
118 | 2e5eb96a | Iustin Pop | | s == C.allocPolicyUnallocable -> return AllocUnallocable |
119 | 2e5eb96a | Iustin Pop | | otherwise -> fail $ "Invalid alloc policy mode: " ++ s |
120 | b2ba4669 | Iustin Pop | |
121 | 525bfb36 | Iustin Pop | -- | Convert an alloc policy to the Ganeti string equivalent. |
122 | 2c9336a4 | Iustin Pop | allocPolicyToString :: AllocPolicy -> String |
123 | 2c9336a4 | Iustin Pop | allocPolicyToString AllocPreferred = C.allocPolicyPreferred |
124 | 2c9336a4 | Iustin Pop | allocPolicyToString AllocLastResort = C.allocPolicyLastResort |
125 | 2c9336a4 | Iustin Pop | allocPolicyToString AllocUnallocable = C.allocPolicyUnallocable |
126 | b2ba4669 | Iustin Pop | |
127 | b2ba4669 | Iustin Pop | instance JSON.JSON AllocPolicy where |
128 | 2c9336a4 | Iustin Pop | showJSON = JSON.showJSON . allocPolicyToString |
129 | b2ba4669 | Iustin Pop | readJSON s = case JSON.readJSON s of |
130 | 2c9336a4 | Iustin Pop | JSON.Ok s' -> allocPolicyFromString s' |
131 | b2ba4669 | Iustin Pop | JSON.Error e -> JSON.Error $ |
132 | b2ba4669 | Iustin Pop | "Can't parse alloc_policy: " ++ e |
133 | b2ba4669 | Iustin Pop | |
134 | 1f9066c0 | Iustin Pop | -- | The resource spec type. |
135 | 1f9066c0 | Iustin Pop | data RSpec = RSpec |
136 | 1f9066c0 | Iustin Pop | { rspecCpu :: Int -- ^ Requested VCPUs |
137 | 1f9066c0 | Iustin Pop | , rspecMem :: Int -- ^ Requested memory |
138 | 1f9066c0 | Iustin Pop | , rspecDsk :: Int -- ^ Requested disk |
139 | 6bc39970 | Iustin Pop | } deriving (Show, Read, Eq) |
140 | 1f9066c0 | Iustin Pop | |
141 | 2180829f | Iustin Pop | -- | The dynamic resource specs of a machine (i.e. load or load |
142 | 2180829f | Iustin Pop | -- capacity, as opposed to size). |
143 | 2180829f | Iustin Pop | data DynUtil = DynUtil |
144 | 2180829f | Iustin Pop | { cpuWeight :: Weight -- ^ Standardised CPU usage |
145 | 2180829f | Iustin Pop | , memWeight :: Weight -- ^ Standardised memory load |
146 | c4ef235b | Iustin Pop | , dskWeight :: Weight -- ^ Standardised disk I\/O usage |
147 | 2180829f | Iustin Pop | , netWeight :: Weight -- ^ Standardised network usage |
148 | 6bc39970 | Iustin Pop | } deriving (Show, Read, Eq) |
149 | 2180829f | Iustin Pop | |
150 | 525bfb36 | Iustin Pop | -- | Initial empty utilisation. |
151 | 2180829f | Iustin Pop | zeroUtil :: DynUtil |
152 | 2180829f | Iustin Pop | zeroUtil = DynUtil { cpuWeight = 0, memWeight = 0 |
153 | 2180829f | Iustin Pop | , dskWeight = 0, netWeight = 0 } |
154 | 2180829f | Iustin Pop | |
155 | 525bfb36 | Iustin Pop | -- | Base utilisation (used when no actual utilisation data is |
156 | 525bfb36 | Iustin Pop | -- supplied). |
157 | ee9724b9 | Iustin Pop | baseUtil :: DynUtil |
158 | ee9724b9 | Iustin Pop | baseUtil = DynUtil { cpuWeight = 1, memWeight = 1 |
159 | ee9724b9 | Iustin Pop | , dskWeight = 1, netWeight = 1 } |
160 | ee9724b9 | Iustin Pop | |
161 | 525bfb36 | Iustin Pop | -- | Sum two utilisation records. |
162 | 2180829f | Iustin Pop | addUtil :: DynUtil -> DynUtil -> DynUtil |
163 | 2180829f | Iustin Pop | addUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) = |
164 | 2180829f | Iustin Pop | DynUtil (a1+b1) (a2+b2) (a3+b3) (a4+b4) |
165 | 2180829f | Iustin Pop | |
166 | 525bfb36 | Iustin Pop | -- | Substracts one utilisation record from another. |
167 | 2180829f | Iustin Pop | subUtil :: DynUtil -> DynUtil -> DynUtil |
168 | 2180829f | Iustin Pop | subUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) = |
169 | 2180829f | Iustin Pop | DynUtil (a1-b1) (a2-b2) (a3-b3) (a4-b4) |
170 | 2180829f | Iustin Pop | |
171 | 66dac8e0 | Iustin Pop | -- | The description of an instance placement. It contains the |
172 | 66dac8e0 | Iustin Pop | -- instance index, the new primary and secondary node, the move being |
173 | 66dac8e0 | Iustin Pop | -- performed and the score of the cluster after the move. |
174 | 66dac8e0 | Iustin Pop | type Placement = (Idx, Ndx, Ndx, IMove, Score) |
175 | 92e32d76 | Iustin Pop | |
176 | 525bfb36 | Iustin Pop | -- | An instance move definition. |
177 | 92e32d76 | Iustin Pop | data IMove = Failover -- ^ Failover the instance (f) |
178 | 92e32d76 | Iustin Pop | | ReplacePrimary Ndx -- ^ Replace primary (f, r:np, f) |
179 | 92e32d76 | Iustin Pop | | ReplaceSecondary Ndx -- ^ Replace secondary (r:ns) |
180 | 92e32d76 | Iustin Pop | | ReplaceAndFailover Ndx -- ^ Replace secondary, failover (r:np, f) |
181 | 92e32d76 | Iustin Pop | | FailoverAndReplace Ndx -- ^ Failover, replace secondary (f, r:ns) |
182 | 6bc39970 | Iustin Pop | deriving (Show, Read) |
183 | 92e32d76 | Iustin Pop | |
184 | 179c0828 | Iustin Pop | -- | Instance disk template type. |
185 | cc25e437 | Iustin Pop | data DiskTemplate = DTDiskless |
186 | cc25e437 | Iustin Pop | | DTFile |
187 | cc25e437 | Iustin Pop | | DTSharedFile |
188 | cc25e437 | Iustin Pop | | DTPlain |
189 | cc25e437 | Iustin Pop | | DTBlock |
190 | cc25e437 | Iustin Pop | | DTDrbd8 |
191 | 3c002a13 | Iustin Pop | deriving (Show, Read, Eq, Enum, Bounded) |
192 | cc25e437 | Iustin Pop | |
193 | 179c0828 | Iustin Pop | -- | Converts a DiskTemplate to String. |
194 | 2c9336a4 | Iustin Pop | diskTemplateToString :: DiskTemplate -> String |
195 | 2c9336a4 | Iustin Pop | diskTemplateToString DTDiskless = C.dtDiskless |
196 | 2c9336a4 | Iustin Pop | diskTemplateToString DTFile = C.dtFile |
197 | 2c9336a4 | Iustin Pop | diskTemplateToString DTSharedFile = C.dtSharedFile |
198 | 2c9336a4 | Iustin Pop | diskTemplateToString DTPlain = C.dtPlain |
199 | 2c9336a4 | Iustin Pop | diskTemplateToString DTBlock = C.dtBlock |
200 | 2c9336a4 | Iustin Pop | diskTemplateToString DTDrbd8 = C.dtDrbd8 |
201 | cc25e437 | Iustin Pop | |
202 | 179c0828 | Iustin Pop | -- | Converts a DiskTemplate from String. |
203 | 2c9336a4 | Iustin Pop | diskTemplateFromString :: (Monad m) => String -> m DiskTemplate |
204 | 2c9336a4 | Iustin Pop | diskTemplateFromString s = |
205 | cc25e437 | Iustin Pop | case () of |
206 | cc25e437 | Iustin Pop | _ | s == C.dtDiskless -> return DTDiskless |
207 | cc25e437 | Iustin Pop | | s == C.dtFile -> return DTFile |
208 | cc25e437 | Iustin Pop | | s == C.dtSharedFile -> return DTSharedFile |
209 | cc25e437 | Iustin Pop | | s == C.dtPlain -> return DTPlain |
210 | cc25e437 | Iustin Pop | | s == C.dtBlock -> return DTBlock |
211 | cc25e437 | Iustin Pop | | s == C.dtDrbd8 -> return DTDrbd8 |
212 | cc25e437 | Iustin Pop | | otherwise -> fail $ "Invalid disk template: " ++ s |
213 | cc25e437 | Iustin Pop | |
214 | cc25e437 | Iustin Pop | instance JSON.JSON DiskTemplate where |
215 | 2c9336a4 | Iustin Pop | showJSON = JSON.showJSON . diskTemplateToString |
216 | cc25e437 | Iustin Pop | readJSON s = case JSON.readJSON s of |
217 | 2c9336a4 | Iustin Pop | JSON.Ok s' -> diskTemplateFromString s' |
218 | cc25e437 | Iustin Pop | JSON.Error e -> JSON.Error $ |
219 | cc25e437 | Iustin Pop | "Can't parse disk_template as string: " ++ e |
220 | cc25e437 | Iustin Pop | |
221 | 0e8ae201 | Iustin Pop | -- | Formatted solution output for one move (involved nodes and |
222 | 525bfb36 | Iustin Pop | -- commands. |
223 | 924f9c16 | Iustin Pop | type MoveJob = ([Ndx], Idx, IMove, [String]) |
224 | 0e8ae201 | Iustin Pop | |
225 | 525bfb36 | Iustin Pop | -- | Unknown field in table output. |
226 | 82ea2874 | Iustin Pop | unknownField :: String |
227 | 82ea2874 | Iustin Pop | unknownField = "<unknown field>" |
228 | 82ea2874 | Iustin Pop | |
229 | 525bfb36 | Iustin Pop | -- | A list of command elements. |
230 | 0e8ae201 | Iustin Pop | type JobSet = [MoveJob] |
231 | 0e8ae201 | Iustin Pop | |
232 | 135a6c6a | Iustin Pop | -- | Connection timeout (when using non-file methods). |
233 | 135a6c6a | Iustin Pop | connTimeout :: Int |
234 | 135a6c6a | Iustin Pop | connTimeout = 15 |
235 | 135a6c6a | Iustin Pop | |
236 | 135a6c6a | Iustin Pop | -- | The default timeout for queries (when using non-file methods). |
237 | 135a6c6a | Iustin Pop | queryTimeout :: Int |
238 | 135a6c6a | Iustin Pop | queryTimeout = 60 |
239 | 135a6c6a | Iustin Pop | |
240 | f4c0b8c5 | Iustin Pop | -- | Default vcpu-to-pcpu ratio (randomly chosen value). |
241 | f4c0b8c5 | Iustin Pop | defVcpuRatio :: Double |
242 | f4c0b8c5 | Iustin Pop | defVcpuRatio = 64 |
243 | f4c0b8c5 | Iustin Pop | |
244 | f4c0b8c5 | Iustin Pop | -- | Default max disk usage ratio. |
245 | f4c0b8c5 | Iustin Pop | defReservedDiskRatio :: Double |
246 | f4c0b8c5 | Iustin Pop | defReservedDiskRatio = 0 |
247 | f4c0b8c5 | Iustin Pop | |
248 | 1e3dccc8 | Iustin Pop | -- | Base memory unit. |
249 | 1e3dccc8 | Iustin Pop | unitMem :: Int |
250 | 1e3dccc8 | Iustin Pop | unitMem = 64 |
251 | 1e3dccc8 | Iustin Pop | |
252 | 1e3dccc8 | Iustin Pop | -- | Base disk unit. |
253 | 1e3dccc8 | Iustin Pop | unitDsk :: Int |
254 | 1e3dccc8 | Iustin Pop | unitDsk = 256 |
255 | 1e3dccc8 | Iustin Pop | |
256 | 1e3dccc8 | Iustin Pop | -- | Base vcpus unit. |
257 | 1e3dccc8 | Iustin Pop | unitCpu :: Int |
258 | 1e3dccc8 | Iustin Pop | unitCpu = 1 |
259 | 1e3dccc8 | Iustin Pop | |
260 | a30b473c | Iustin Pop | -- | This is similar to the JSON library Result type - /very/ similar, |
261 | a30b473c | Iustin Pop | -- but we want to use it in multiple places, so we abstract it into a |
262 | a30b473c | Iustin Pop | -- mini-library here. |
263 | a30b473c | Iustin Pop | -- |
264 | a30b473c | Iustin Pop | -- The failure value for this monad is simply a string. |
265 | e4c5beaf | Iustin Pop | data Result a |
266 | e4c5beaf | Iustin Pop | = Bad String |
267 | e4c5beaf | Iustin Pop | | Ok a |
268 | 1cb92fac | Iustin Pop | deriving (Show, Read, Eq) |
269 | e4c5beaf | Iustin Pop | |
270 | e4c5beaf | Iustin Pop | instance Monad Result where |
271 | e4c5beaf | Iustin Pop | (>>=) (Bad x) _ = Bad x |
272 | e4c5beaf | Iustin Pop | (>>=) (Ok x) fn = fn x |
273 | e4c5beaf | Iustin Pop | return = Ok |
274 | e4c5beaf | Iustin Pop | fail = Bad |
275 | 497e30a1 | Iustin Pop | |
276 | 1c7c4578 | Iustin Pop | instance MonadPlus Result where |
277 | 1c7c4578 | Iustin Pop | mzero = Bad "zero Result when used as MonadPlus" |
278 | 1c7c4578 | Iustin Pop | -- for mplus, when we 'add' two Bad values, we concatenate their |
279 | 1c7c4578 | Iustin Pop | -- error descriptions |
280 | 1c7c4578 | Iustin Pop | (Bad x) `mplus` (Bad y) = Bad (x ++ "; " ++ y) |
281 | 1c7c4578 | Iustin Pop | (Bad _) `mplus` x = x |
282 | 1c7c4578 | Iustin Pop | x@(Ok _) `mplus` _ = x |
283 | 1c7c4578 | Iustin Pop | |
284 | 525bfb36 | Iustin Pop | -- | Simple checker for whether a 'Result' is OK. |
285 | 06fb841e | Iustin Pop | isOk :: Result a -> Bool |
286 | 06fb841e | Iustin Pop | isOk (Ok _) = True |
287 | 06fb841e | Iustin Pop | isOk _ = False |
288 | 06fb841e | Iustin Pop | |
289 | 525bfb36 | Iustin Pop | -- | Simple checker for whether a 'Result' is a failure. |
290 | 06fb841e | Iustin Pop | isBad :: Result a -> Bool |
291 | 06fb841e | Iustin Pop | isBad = not . isOk |
292 | 06fb841e | Iustin Pop | |
293 | 179c0828 | Iustin Pop | -- | Converter from Either String to 'Result'. |
294 | a30b473c | Iustin Pop | eitherToResult :: Either String a -> Result a |
295 | a30b473c | Iustin Pop | eitherToResult (Left s) = Bad s |
296 | a30b473c | Iustin Pop | eitherToResult (Right v) = Ok v |
297 | a30b473c | Iustin Pop | |
298 | 525bfb36 | Iustin Pop | -- | Reason for an operation's falure. |
299 | f2280553 | Iustin Pop | data FailMode = FailMem -- ^ Failed due to not enough RAM |
300 | f2280553 | Iustin Pop | | FailDisk -- ^ Failed due to not enough disk |
301 | f2280553 | Iustin Pop | | FailCPU -- ^ Failed due to not enough CPU capacity |
302 | f2280553 | Iustin Pop | | FailN1 -- ^ Failed due to not passing N1 checks |
303 | 5f0b9579 | Iustin Pop | | FailTags -- ^ Failed due to tag exclusion |
304 | 6bc39970 | Iustin Pop | deriving (Eq, Enum, Bounded, Show, Read) |
305 | f2280553 | Iustin Pop | |
306 | 525bfb36 | Iustin Pop | -- | List with failure statistics. |
307 | 478df686 | Iustin Pop | type FailStats = [(FailMode, Int)] |
308 | 478df686 | Iustin Pop | |
309 | 525bfb36 | Iustin Pop | -- | Either-like data-type customized for our failure modes. |
310 | a30b473c | Iustin Pop | -- |
311 | a30b473c | Iustin Pop | -- The failure values for this monad track the specific allocation |
312 | a30b473c | Iustin Pop | -- failures, so this is not a general error-monad (compare with the |
313 | a30b473c | Iustin Pop | -- 'Result' data type). One downside is that this type cannot encode a |
314 | a30b473c | Iustin Pop | -- generic failure mode, hence 'fail' for this monad is not defined |
315 | a30b473c | Iustin Pop | -- and will cause an exception. |
316 | f2280553 | Iustin Pop | data OpResult a = OpFail FailMode -- ^ Failed operation |
317 | f2280553 | Iustin Pop | | OpGood a -- ^ Success operation |
318 | 6bc39970 | Iustin Pop | deriving (Show, Read) |
319 | f2280553 | Iustin Pop | |
320 | f2280553 | Iustin Pop | instance Monad OpResult where |
321 | f2280553 | Iustin Pop | (OpGood x) >>= fn = fn x |
322 | f2280553 | Iustin Pop | (OpFail y) >>= _ = OpFail y |
323 | f2280553 | Iustin Pop | return = OpGood |
324 | f2280553 | Iustin Pop | |
325 | a30b473c | Iustin Pop | -- | Conversion from 'OpResult' to 'Result'. |
326 | a30b473c | Iustin Pop | opToResult :: OpResult a -> Result a |
327 | a30b473c | Iustin Pop | opToResult (OpFail f) = Bad $ show f |
328 | a30b473c | Iustin Pop | opToResult (OpGood v) = Ok v |
329 | a30b473c | Iustin Pop | |
330 | 9188aeef | Iustin Pop | -- | A generic class for items that have updateable names and indices. |
331 | 497e30a1 | Iustin Pop | class Element a where |
332 | 9188aeef | Iustin Pop | -- | Returns the name of the element |
333 | 262a08a2 | Iustin Pop | nameOf :: a -> String |
334 | c854092b | Iustin Pop | -- | Returns all the known names of the element |
335 | c854092b | Iustin Pop | allNames :: a -> [String] |
336 | 9188aeef | Iustin Pop | -- | Returns the index of the element |
337 | 262a08a2 | Iustin Pop | idxOf :: a -> Int |
338 | 3e4480e0 | Iustin Pop | -- | Updates the alias of the element |
339 | 3e4480e0 | Iustin Pop | setAlias :: a -> String -> a |
340 | 3e4480e0 | Iustin Pop | -- | Compute the alias by stripping a given suffix (domain) from |
341 | 525bfb36 | Iustin Pop | -- the name |
342 | 3e4480e0 | Iustin Pop | computeAlias :: String -> a -> a |
343 | 3e4480e0 | Iustin Pop | computeAlias dom e = setAlias e alias |
344 | 3e4480e0 | Iustin Pop | where alias = take (length name - length dom) name |
345 | 3e4480e0 | Iustin Pop | name = nameOf e |
346 | 9188aeef | Iustin Pop | -- | Updates the index of the element |
347 | 497e30a1 | Iustin Pop | setIdx :: a -> Int -> a |
348 | 1fe412bb | Iustin Pop | |
349 | 1fe412bb | Iustin Pop | -- | The iallocator node-evacuate evac_mode type. |
350 | 1fe412bb | Iustin Pop | data EvacMode = ChangePrimary |
351 | 1fe412bb | Iustin Pop | | ChangeSecondary |
352 | 1fe412bb | Iustin Pop | | ChangeAll |
353 | 1fe412bb | Iustin Pop | deriving (Show, Read) |
354 | 9f8b97ce | Iustin Pop | |
355 | 9f8b97ce | Iustin Pop | instance JSON.JSON EvacMode where |
356 | 9f8b97ce | Iustin Pop | showJSON mode = case mode of |
357 | 9f8b97ce | Iustin Pop | ChangeAll -> JSON.showJSON C.iallocatorNevacAll |
358 | 9f8b97ce | Iustin Pop | ChangePrimary -> JSON.showJSON C.iallocatorNevacPri |
359 | 9f8b97ce | Iustin Pop | ChangeSecondary -> JSON.showJSON C.iallocatorNevacSec |
360 | 9f8b97ce | Iustin Pop | readJSON v = |
361 | 9f8b97ce | Iustin Pop | case JSON.readJSON v of |
362 | 9f8b97ce | Iustin Pop | JSON.Ok s | s == C.iallocatorNevacAll -> return ChangeAll |
363 | 9f8b97ce | Iustin Pop | | s == C.iallocatorNevacPri -> return ChangePrimary |
364 | 9f8b97ce | Iustin Pop | | s == C.iallocatorNevacSec -> return ChangeSecondary |
365 | 9f8b97ce | Iustin Pop | | otherwise -> fail $ "Invalid evacuate mode " ++ s |
366 | 9f8b97ce | Iustin Pop | JSON.Error e -> JSON.Error $ |
367 | 9f8b97ce | Iustin Pop | "Can't parse evacuate mode as string: " ++ e |