Revision cabce2f4 htools/hail.hs

b/htools/hail.hs
28 28
import Control.Monad
29 29
import Data.List
30 30
import Data.Maybe (isJust, fromJust)
31
import System (exitWith, ExitCode(..))
32 31
import System.IO
33 32
import qualified System
34 33

  
......
37 36
import Ganeti.HTools.CLI
38 37
import Ganeti.HTools.IAlloc
39 38
import Ganeti.HTools.Types
40
import Ganeti.HTools.Loader (RqType(..), Request(..), ClusterData(..))
41
import Ganeti.HTools.ExtLoader (loadExternalData)
39
import Ganeti.HTools.Loader (Request(..), ClusterData(..))
42 40

  
43 41
-- | Options list and functions
44 42
options :: [OptType]
......
51 49
    , oShowHelp
52 50
    ]
53 51

  
54
processResults :: (Monad m) =>
55
                  RqType -> Cluster.AllocSolution
56
               -> m Cluster.AllocSolution
57
processResults _ (Cluster.AllocSolution { Cluster.asSolutions = [],
58
                                          Cluster.asLog = msgs }) =
59
  fail $ intercalate ", " msgs
60

  
61
processResults (Evacuate _) as = return as
62

  
63
processResults _ as =
64
    case Cluster.asSolutions as of
65
      _:[] -> return as
66
      _ -> fail "Internal error: multiple allocation solutions"
67

  
68
-- | Process a request and return new node lists
69
processRequest :: Request
70
               -> Result Cluster.AllocSolution
71
processRequest request =
72
  let Request rqtype (ClusterData gl nl il _) = request
73
  in case rqtype of
74
       Allocate xi reqn -> Cluster.tryMGAlloc gl nl il xi reqn
75
       Relocate idx reqn exnodes -> Cluster.tryMGReloc gl nl il
76
                                    idx reqn exnodes
77
       Evacuate exnodes -> Cluster.tryMGEvac gl nl il exnodes
78
       MultiReloc _ _ -> fail "multi-reloc not handled"
79
       NodeEvacuate _ _ -> fail "node-evacuate not handled"
80

  
81
-- | Reads the request from the data file(s)
82
readRequest :: Options -> [String] -> IO Request
83
readRequest opts args = do
84
  when (null args) $ do
85
         hPutStrLn stderr "Error: this program needs an input file."
86
         exitWith $ ExitFailure 1
87

  
88
  input_data <- readFile (head args)
89
  r1 <- case parseData input_data of
90
          Bad err -> do
91
            hPutStrLn stderr $ "Error: " ++ err
92
            exitWith $ ExitFailure 1
93
          Ok rq -> return rq
94
  (if isJust (optDataFile opts) ||  (not . null . optNodeSim) opts
95
   then do
96
     cdata <- loadExternalData opts
97
     let Request rqt _ = r1
98
     return $ Request rqt cdata
99
   else return r1)
100

  
101 52
-- | Main function.
102 53
main :: IO ()
103 54
main = do

Also available in: Unified diff