Revision 9ba5c28f Ganeti/HTools/Utils.hs
b/Ganeti/HTools/Utils.hs | ||
---|---|---|
11 | 11 |
, varianceCoeff |
12 | 12 |
, readData |
13 | 13 |
, commaJoin |
14 |
, combineEithers |
|
15 |
, ensureEitherList |
|
16 |
, eitherListHead |
|
17 |
, readEitherString |
|
18 |
, parseEitherList |
|
19 |
, loadJSArray |
|
20 |
, fromObj |
|
21 |
, getStringElement |
|
22 |
, getIntElement |
|
23 |
, getListElement |
|
24 |
, concatEitherElems |
|
25 |
, applyEither1 |
|
26 |
, applyEither2 |
|
14 | 27 |
) where |
15 | 28 |
|
16 | 29 |
import Data.Either |
... | ... | |
18 | 31 |
import Monad |
19 | 32 |
import System |
20 | 33 |
import System.IO |
34 |
import Text.JSON |
|
35 |
import Text.Printf (printf) |
|
21 | 36 |
|
22 | 37 |
import Debug.Trace |
23 | 38 |
|
... | ... | |
88 | 103 |
putStrLn $ fromLeft nd |
89 | 104 |
exitWith $ ExitFailure 1 |
90 | 105 |
return $ fromRight nd |
106 |
|
|
107 |
{-- Our cheap monad-like stuff. |
|
108 |
|
|
109 |
Thi is needed since Either e a is already a monad instance somewhere |
|
110 |
in the standard libraries (Control.Monad.Error) and we don't need that |
|
111 |
entire thing. |
|
112 |
|
|
113 |
-} |
|
114 |
combineEithers :: (Either String a) |
|
115 |
-> (a -> Either String b) |
|
116 |
-> (Either String b) |
|
117 |
combineEithers (Left s) _ = Left s |
|
118 |
combineEithers (Right s) f = f s |
|
119 |
|
|
120 |
ensureEitherList :: [Either String a] -> Either String [a] |
|
121 |
ensureEitherList lst = |
|
122 |
foldr (\elem accu -> |
|
123 |
case (elem, accu) of |
|
124 |
(Left x, _) -> Left x |
|
125 |
(_, Left x) -> Left x -- should never happen |
|
126 |
(Right e, Right a) -> Right (e:a) |
|
127 |
) |
|
128 |
(Right []) lst |
|
129 |
|
|
130 |
eitherListHead :: Either String [a] -> Either String a |
|
131 |
eitherListHead lst = |
|
132 |
case lst of |
|
133 |
Left x -> Left x |
|
134 |
Right (x:_) -> Right x |
|
135 |
Right [] -> Left "List empty" |
|
136 |
|
|
137 |
readEitherString :: JSValue -> Either String String |
|
138 |
readEitherString v = |
|
139 |
case v of |
|
140 |
JSString s -> Right $ fromJSString s |
|
141 |
_ -> Left "Wrong JSON type" |
|
142 |
|
|
143 |
parseEitherList :: (JSObject JSValue -> Either String String) |
|
144 |
-> [JSObject JSValue] |
|
145 |
-> Either String String |
|
146 |
parseEitherList fn idata = |
|
147 |
let ml = ensureEitherList $ map fn idata |
|
148 |
in ml `combineEithers` (Right . unlines) |
|
149 |
|
|
150 |
loadJSArray :: String -> Either String [JSObject JSValue] |
|
151 |
loadJSArray s = resultToEither $ decodeStrict s |
|
152 |
|
|
153 |
fromObj :: JSON a => String -> JSObject JSValue -> Either String a |
|
154 |
fromObj k o = |
|
155 |
case lookup k (fromJSObject o) of |
|
156 |
Nothing -> Left $ printf "key '%s' not found" k |
|
157 |
Just val -> resultToEither $ readJSON val |
|
158 |
|
|
159 |
getStringElement :: String -> JSObject JSValue -> Either String String |
|
160 |
getStringElement = fromObj |
|
161 |
|
|
162 |
getIntElement :: String -> JSObject JSValue -> Either String Int |
|
163 |
getIntElement = fromObj |
|
164 |
|
|
165 |
getListElement :: String -> JSObject JSValue |
|
166 |
-> Either String [JSValue] |
|
167 |
getListElement = fromObj |
|
168 |
|
|
169 |
concatEitherElems :: Either String String |
|
170 |
-> Either String String |
|
171 |
-> Either String String |
|
172 |
concatEitherElems = applyEither2 (\x y -> x ++ "|" ++ y) |
|
173 |
|
|
174 |
applyEither1 :: (a -> b) -> Either String a -> Either String b |
|
175 |
applyEither1 fn a = |
|
176 |
case a of |
|
177 |
Left x -> Left x |
|
178 |
Right y -> Right $ fn y |
|
179 |
|
|
180 |
applyEither2 :: (a -> b -> c) |
|
181 |
-> Either String a |
|
182 |
-> Either String b |
|
183 |
-> Either String c |
|
184 |
applyEither2 fn a b = |
|
185 |
case (a, b) of |
|
186 |
(Right x, Right y) -> Right $ fn x y |
|
187 |
(Left x, _) -> Left x |
|
188 |
(_, Left y) -> Left y |
Also available in: Unified diff