Some documentation updates for the new parameters

[ganeti-local] / hail.hs

diff --git a/hail.hs b/hail.hs
index d2a6c01..ae8e112 100644 (file)
--- a/hail.hs
+++ b/hail.hs
@@ -2,6 +2,27 @@
 
 -}
 
 
 -}
 

+{-
+
+Copyright (C) 2009 Google Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+-}
+

 module Main (main) where
 
 import Data.List
 module Main (main) where
 
 import Data.List

@@ -15,7 +36,6 @@ import qualified System
 
 import Text.Printf (printf)
 
 
 import Text.Printf (printf)
 

-import qualified Ganeti.HTools.Container as Container

 import qualified Ganeti.HTools.Cluster as Cluster
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 import qualified Ganeti.HTools.Cluster as Cluster
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance

@@ -23,6 +43,7 @@ import qualified Ganeti.HTools.CLI as CLI
 import Ganeti.HTools.IAlloc
 import Ganeti.HTools.Types
 import Ganeti.HTools.Loader (RqType(..), Request(..))
 import Ganeti.HTools.IAlloc
 import Ganeti.HTools.Types
 import Ganeti.HTools.Loader (RqType(..), Request(..))

+import Ganeti.HTools.Utils

 
 -- | Command line options structure.
 data Options = Options
 
 -- | Command line options structure.
 data Options = Options

@@ -53,15 +74,15 @@ options =
     ]
 
 
     ]
 
 

-filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
+filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]

             -> m [(Node.List, [Node.Node])]
 filterFails sols =
     if null sols then fail "No nodes onto which to allocate at all"
             -> m [(Node.List, [Node.Node])]
 filterFails sols =
     if null sols then fail "No nodes onto which to allocate at all"

-    else let sols' = filter (isJust . fst) sols
+    else let sols' = filter (isJust . fst3) sols

          in if null sols' then
                 fail "No valid allocation solutions"
             else
          in if null sols' then
                 fail "No valid allocation solutions"
             else

-                return $ map (\(x, y) -> (fromJust x, y)) sols'
+                return $ map (\(x, _, y) -> (fromJust x, y)) sols'

 
 processResults :: (Monad m) => [(Node.List, [Node.Node])]
                -> m (String, [Node.Node])
 
 processResults :: (Monad m) => [(Node.List, [Node.Node])]
                -> m (String, [Node.Node])

@@ -70,12 +91,22 @@ processResults sols =
         sols'' = sortBy (compare `on` fst) sols'
         (best, w) = head sols''
         (worst, l) = last sols''
         sols'' = sortBy (compare `on` fst) sols'
         (best, w) = head sols''
         (worst, l) = last sols''

-        info = printf "Valid results: %d, best score: %.8f for node(s) %s, \
-                      \worst score: %.8f for node(s) %s" (length sols'')
-                      best (intercalate "/" . map Node.name $ w)
-                      worst (intercalate "/" . map Node.name $ l)
+        info = (printf "Valid results: %d, best score: %.8f for node(s) %s, \
+                       \worst score: %.8f for node(s) %s" (length sols'')
+                       best (intercalate "/" . map Node.name $ w)
+                       worst (intercalate "/" . map Node.name $ l))::String

     in return (info, w)
 
     in return (info, w)
 

+-- | Process a request and return new node lists
+processRequest ::
+                  Request
+               -> Result [(Maybe Node.List, Instance.Instance, [Node.Node])]
+processRequest request =
+  let Request rqtype nl il _ = request
+  in case rqtype of
+       Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
+       Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
+

 -- | Main function.
 main :: IO ()
 main = do
 -- | Main function.
 main :: IO ()
 main = do

@@ -95,12 +126,8 @@ main = do
                  exitWith $ ExitFailure 1
                Ok rq -> return rq
 
                  exitWith $ ExitFailure 1
                Ok rq -> return rq
 

-  let Request rqtype nl il csf = request
-      new_nodes = case rqtype of
-                    Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
-                    Relocate idx reqn exnodes ->
-                        Cluster.tryReloc nl il idx reqn exnodes
-  let sols = new_nodes >>= filterFails >>= processResults
+  let Request _ _ _ csf = request
+      sols = processRequest request >>= filterFails >>= processResults

   let (ok, info, rn) = case sols of
                Ok (info, sn) -> (True, "Request successful: " ++ info,
                                      map ((++ csf) . Node.name) sn)
   let (ok, info, rn) = case sols of
                Ok (info, sn) -> (True, "Request successful: " ++ info,
                                      map ((++ csf) . Node.name) sn)