The logic of request processing is not separated into its own
function, and (beside CLI interaction, e.g. verbosity handling) all
logic is now in IAllocator.hs.
---
htools/Ganeti/HTools/IAlloc.hs | 23 +++++++++++++++++------
htools/hail.hs | 11 +----------
2 files changed, 18 insertions(+), 16 deletions(-)
diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs
index a6ba9b3..20bb515 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 62fe7cc..d283b08 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
--
1.7.5.4
