Revision f59cefcb

b/src/Ganeti/BasicTypes.hs
29 29
  , mkResultT
30 30
  , withError
31 31
  , withErrorT
32
  , resultT
32
  , toError
33 33
  , toErrorStr
34 34
  , Error(..) -- re-export from Control.Monad.Error
35 35
  , isOk
......
186 186
-- | Lift a 'Result' value to any 'MonadError'. Since 'ResultT' is itself its
187 187
-- instance, it's a generalization of
188 188
-- @Monad m => GenericResult a b -> ResultT a m b@.
189
resultT :: (MonadError e m) => GenericResult e a -> m a
190
resultT = genericResult throwError return
191
{-# INLINE resultT #-}
189
toError :: (MonadError e m) => GenericResult e a -> m a
190
toError = genericResult throwError return
191
{-# INLINE toError #-}
192 192

  
193 193
-- | An alias for @withError strMsg@, which is often used to lift a pure error
194 194
-- to a monad stack. See also 'annotateResult'.
b/src/Ganeti/Query/Query.hs
193 193
genericQuery fieldsMap collector nameFn configFn getFn cfg
194 194
             live fields qfilter wanted =
195 195
  runResultT $ do
196
  cfilter <- resultT $ compileFilter fieldsMap qfilter
196
  cfilter <- toError $ compileFilter fieldsMap qfilter
197 197
  let selected = getSelectedFields fieldsMap fields
198 198
      (fdefs, fgetters, _) = unzip3 selected
199 199
      live' = live && needsLiveData fgetters
200
  objects <- resultT $ case wanted of
200
  objects <- toError $ case wanted of
201 201
             [] -> Ok . niceSortKey nameFn .
202 202
                   Map.elems . fromContainer $ configFn cfg
203 203
             _  -> mapM (getFn cfg) wanted
204 204
  -- Run the first pass of the filter, without a runtime context; this will
205 205
  -- limit the objects that we'll contact for exports
206
  fobjects <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
206
  fobjects <- toError $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
207 207
                        objects
208 208
  -- Gather the runtime data
209 209
  runtimes <- case collector of
......
291 291
  let wanted_names = getRequestedJobIDs qfilter
292 292
      want_arch = Query.Job.wantArchived fields
293 293
  rjids <- case wanted_names of
294
             Bad msg -> resultT . Bad $ GenericError msg
294
             Bad msg -> toError . Bad $ GenericError msg
295 295
             Ok [] -> if live
296 296
                        -- we can check the filesystem for actual jobs
297 297
                        then do
......
299 299
                            lift (determineJobDirectories rootdir want_arch
300 300
                              >>= getJobIDs)
301 301
                          case maybeJobIDs of
302
                            Left e -> (resultT . Bad) . BlockDeviceError $
302
                            Left e -> (toError . Bad) . BlockDeviceError $
303 303
                              "Unable to fetch the job list: " ++ show e
304
                            Right jobIDs -> resultT . Ok $ sortJobIDs jobIDs
304
                            Right jobIDs -> toError . Ok $ sortJobIDs jobIDs
305 305
                        -- else we shouldn't look at the filesystem...
306 306
                        else return []
307
             Ok v -> resultT $ Ok v
308
  cfilter <- resultT $ compileFilter Query.Job.fieldsMap qfilter
307
             Ok v -> toError $ Ok v
308
  cfilter <- toError $ compileFilter Query.Job.fieldsMap qfilter
309 309
  let selected = getSelectedFields Query.Job.fieldsMap fields
310 310
      (fdefs, fgetters, _) = unzip3 selected
311 311
      (_, filtergetters, _) = unzip3 . getSelectedFields Query.Job.fieldsMap
......
314 314
      disabled_data = Bad "live data disabled"
315 315
  -- runs first pass of the filter, without a runtime context; this
316 316
  -- will limit the jobs that we'll load from disk
317
  jids <- resultT $
317
  jids <- toError $
318 318
          filterM (\jid -> evaluateFilter cfg Nothing jid cfilter) rjids
319 319
  -- here we run the runtime data gathering, filtering and evaluation,
320 320
  -- all in the same step, so that we don't keep jobs in memory longer
......
327 327
              job <- lift $ if live'
328 328
                              then loadJobFromDisk qdir True jid
329 329
                              else return disabled_data
330
              pass <- resultT $ evaluateFilter cfg (Just job) jid cfilter
330
              pass <- toError $ evaluateFilter cfg (Just job) jid cfilter
331 331
              let nlst = if pass
332 332
                           then let row = map (execGetter cfg job jid) fgetters
333 333
                                in rnf row `seq` row:lst

Also available in: Unified diff