Revision 78694255 hail.hs

b/hail.hs
92 92 
        sols'' = sortBy (compare `on` fst) sols'
93 93 
        (best, w) = head sols''
94 94 
        (worst, l) = last sols''
95 
        info = printf "Valid results: %d, best score: %.8f for node(s) %s, \
96 
                      \worst score: %.8f for node(s) %s" (length sols'')
97 
                      best (intercalate "/" . map Node.name $ w)
98 
                      worst (intercalate "/" . map Node.name $ l)
95 
        info = (printf "Valid results: %d, best score: %.8f for node(s) %s, \
96 
                       \worst score: %.8f for node(s) %s" (length sols'')
97 
                       best (intercalate "/" . map Node.name $ w)
98 
                       worst (intercalate "/" . map Node.name $ l))::String
99 99 
    in return (info, w)
100 100 

  		





  
  101
  
    
-- | Process a request and return new node lists


  		





  
  102
  
    
processRequest ::


  		





  
  103
  
    
                  Request


  		





  
  104
  
    
               -> Result [(Maybe Node.List, Instance.Instance, [Node.Node])]


  		





  
  105
  
    
processRequest request =


  		





  
  106
  
    
  let Request rqtype nl il _ = request


  		





  
  107
  
    
  in case rqtype of


  		





  
  108
  
    
       Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn


  		





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


  		





  
  110
  
    

  		





  101
  111
  
    
-- | Main function.


  		





  102
  112
  
    
main :: IO ()


  		





  103
  113
  
    
main = do


  		





  ......




  117
  127
  
    
                 exitWith $ ExitFailure 1


  		





  118
  128
  
    
               Ok rq -> return rq


  		





  119
  129
  
    

  		





  120
  
  
    
  let Request rqtype nl il csf = request


  		





  121
  
  
    
      new_nodes = case rqtype of


  		





  122
  
  
    
                    Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn


  		





  123
  
  
    
                    Relocate idx reqn exnodes ->


  		





  124
  
  
    
                        Cluster.tryReloc nl il idx reqn exnodes


  		





  125
  
  
    
  let sols = new_nodes >>= filterFails >>= processResults


  		





  
  130
  
    
  let Request _ _ _ csf = request


  		





  
  131
  
    
      sols = processRequest request >>= filterFails >>= processResults


  		





  126
  132
  
    
  let (ok, info, rn) = case sols of


  		





  127
  133
  
    
               Ok (info, sn) -> (True, "Request successful: " ++ info,


  		





  128
  134
  
    
                                     map ((++ csf) . Node.name) sn)


  		












Also available in:
  Unified diff