Revision 34c00528

b/Ganeti/HTools/IAlloc.hs
156 156 
              let ex_ndx = map Node.idx ex_nodes
157 157 
              return $ Evacuate ex_ndx
158 158 
        other -> fail ("Invalid request type '" ++ other ++ "'")
159 
  return $ Request rqtype map_g map_n map_i ptags
159 
  return $ Request rqtype (ClusterData map_g map_n map_i ptags)
160 160 

  		





  161
  161
  
    
-- | Format the result


  		





  162
  162
  
    
formatRVal :: RqType -> [Node.AllocElement] -> JSValue


  		












  

    
      b/Ganeti/HTools/Loader.hs
    
  






  73
  73
  
    
    deriving (Show)


  		





  74
  74
  
    

  		





  75
  75
  
    
-- | A complete request, as received from Ganeti.


  		





  76
  
  
    
data Request = Request RqType Group.List Node.List Instance.List [String]


  		





  
  76
  
    
data Request = Request RqType ClusterData


  		





  77
  77
  
    
    deriving (Show)


  		





  78
  78
  
    

  		





  79
  79
  
    
-- | The cluster state.


  		












  

    
      b/hail.hs
    
  






  37
  37
  
    
import Ganeti.HTools.CLI


  		





  38
  38
  
    
import Ganeti.HTools.IAlloc


  		





  39
  39
  
    
import Ganeti.HTools.Types


  		





  40
  
  
    
import Ganeti.HTools.Loader (RqType(..), Request(..))


  		





  
  40
  
    
import Ganeti.HTools.Loader (RqType(..), Request(..), ClusterData(..))


  		





  41
  41
  
    
import Ganeti.HTools.ExtLoader (loadExternalData)


  		





  42
  42
  
    

  		





  43
  43
  
    
-- | Options list and functions


  		





  ......




  68
  68
  
    
processRequest :: Request


  		





  69
  69
  
    
               -> Result Cluster.AllocSolution


  		





  70
  70
  
    
processRequest request =


  		





  71
  
  
    
  let Request rqtype gl nl il _ = request


  		





  
  71
  
    
  let Request rqtype (ClusterData gl nl il _) = request


  		





  72
  72
  
    
  in case rqtype of


  		





  73
  73
  
    
       Allocate xi reqn -> Cluster.tryMGAlloc gl nl il xi reqn


  		





  74
  74
  
    
       Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes


  		





  ......




  90
  90
  
    
  r2 <- if isJust (optDataFile opts) ||  (not . null . optNodeSim) opts


  		





  91
  91
  
    
        then  do


  		





  92
  92
  
    
          (gl, nl, il, ctags) <- loadExternalData opts


  		





  93
  
  
    
          let Request rqt _ _ _ _ = r1


  		





  94
  
  
    
          return $ Request rqt gl nl il ctags


  		





  
  93
  
    
          let Request rqt _ = r1


  		





  
  94
  
    
          return $ Request rqt (ClusterData gl nl il ctags)


  		





  95
  95
  
    
        else return r1


  		





  96
  96
  
    
  return r2


  		





  97
  97
  
    

  		





  ......




  105
  105
  
    

  		





  106
  106
  
    
  request <- readRequest opts args


  		





  107
  107
  
    

  		





  108
  
  
    
  let Request rq _ nl _ _ = request


  		





  
  108
  
    
  let Request rq cdata = request


  		





  109
  109
  
    

  		





  110
  110
  
    
  when (isJust shownodes) $ do


  		





  111
  111
  
    
         hPutStrLn stderr "Initial cluster status:"


  		





  112
  
  
    
         hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)


  		





  
  112
  
    
         hPutStrLn stderr $ Cluster.printNodes (cdNodes cdata)


  		





  
  113
  
    
                       (fromJust shownodes)


  		





  113
  114
  
    

  		





  114
  115
  
    
  let sols = processRequest request >>= processResults rq


  		





  115
  116
  
    
  let (ok, info, rn) =


  		












Also available in:
  Unified diff