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