diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs index a6ba9b3aab058365f2e36b437fc87494c1ee12f9..20bb5150997d18e9387b22ce648ff2d3068cdd2c 100644 --- a/htools/Ganeti/HTools/IAlloc.hs +++ b/htools/Ganeti/HTools/IAlloc.hs @@ -24,15 +24,12 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} module Ganeti.HTools.IAlloc - ( parseData - , formatResponse - , readRequest - , processRequest - , processResults + ( readRequest + , runIAllocator ) where import Data.Either () -import Data.Maybe (fromMaybe, isJust, fromJust) +import Data.Maybe (fromMaybe, isJust) import Data.List import Control.Monad import Text.JSON (JSObject, JSValue(JSBool, JSString, JSArray), @@ -293,3 +290,17 @@ readRequest opts args = do let Request rqt _ = r1 return $ Request rqt cdata else return r1) + +-- | Main iallocator pipeline. +runIAllocator :: Request -> String +runIAllocator request = + let Request rq _ = request + sols = processRequest request >>= processResults rq + (ok, info, rn) = + case sols of + Ok as -> (True, "Request successful: " ++ + intercalate ", " (Cluster.asLog as), + Cluster.asSolutions as) + Bad s -> (False, "Request failed: " ++ s, []) + resp = formatResponse ok info rq rn + in resp diff --git a/htools/hail.hs b/htools/hail.hs index 62fe7cc4b0190d3583406f40a3bb1e56411809de..d283b081370148491fdbd6549fbc83c52984ba8f 100644 --- a/htools/hail.hs +++ b/htools/hail.hs @@ -26,7 +26,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA module Main (main) where import Control.Monad -import Data.List import Data.Maybe (isJust, fromJust) import System.IO import qualified System @@ -35,7 +34,6 @@ import qualified Ganeti.HTools.Cluster as Cluster import Ganeti.HTools.CLI import Ganeti.HTools.IAlloc -import Ganeti.HTools.Types import Ganeti.HTools.Loader (Request(..), ClusterData(..)) -- | Options list and functions @@ -73,12 +71,5 @@ main = do hPutStrLn stderr $ Cluster.printNodes (cdNodes cdata) (fromJust shownodes) - let sols = processRequest request >>= processResults rq - let (ok, info, rn) = - case sols of - Ok as -> (True, "Request successful: " ++ - intercalate ", " (Cluster.asLog as), - Cluster.asSolutions as) - Bad s -> (False, "Request failed: " ++ s, []) - resp = formatResponse ok info rq rn + let resp = runIAllocator request putStrLn resp