-- | External tool data loader from a variety of sources
loadExternalData :: (EToolOptions a) =>
a
- -> IO (NodeList, InstanceList, String, NameList, NameList)
+ -> IO (NodeList, InstanceList, String)
loadExternalData opts = do
(env_node, env_inst) <- parseEnv ()
let nodef = if nodeSet opts then nodeFile opts
host -> Rapi.loadData host
let ldresult = input_data >>= Loader.mergeData
- (loaded_nl, il, csf, ktn, kti) <-
+ (loaded_nl, il, csf) <-
(case ldresult of
Ok x -> return x
Bad s -> do
putStrLn "Warning: cluster has inconsistent data:"
putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs
- return (fixed_nl, il, csf, ktn, kti)
+ return (fixed_nl, il, csf)
| Relocate Int
deriving (Show)
-data Request = Request RqType NodeList InstanceList String NameList NameList
+data Request = Request RqType NodeList InstanceList String
deriving (Show)
parseBaseInstance :: String
ridx <- lookupNode kti rname rname
return $ Relocate ridx
other -> fail $ ("Invalid request type '" ++ other ++ "'")
- (map_n, map_i, csf, xtn, xti) <- mergeData (ktn, nl, kti, il)
- return $ Request rqtype map_n map_i csf xtn xti
+ (map_n, map_i, csf) <- mergeData (ktn, nl, kti, il)
+ return $ Request rqtype map_n map_i csf
formatResponse :: Bool -> String -> [String] -> String
formatResponse success info nodes =
-- | Compute the longest common suffix of a NameList list that
-- | starts with a dot
-longestDomain :: NameList -> String
+longestDomain :: [String] -> String
longestDomain [] = ""
-longestDomain ((_,x):xs) =
- let
- onlyStrings = snd $ unzip xs
- in
- foldr (\ suffix accu -> if all (isSuffixOf suffix) onlyStrings
+longestDomain (x:xs) =
+ foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
then suffix
else accu)
"" $ filter (isPrefixOf ".") (tails x)
[(String, Int)], Instance.AssocList) -- ^ Data from either
-- Text.loadData
-- or Rapi.loadData
- -> Result (NodeList, InstanceList, String, NameList, NameList)
+ -> Result (NodeList, InstanceList, String)
mergeData (ktn, nl, kti, il) = do
let
nl2 = fixNodes nl il
il3 = Container.fromAssocList il
nl3 = Container.fromAssocList
(map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2)
- xtn = swapPairs ktn
- xti = swapPairs kti
- common_suffix = longestDomain (xti ++ xtn)
+ node_names = map Node.name $ Container.elems nl3
+ inst_names = map Instance.name $ Container.elems il3
+ common_suffix = longestDomain (node_names ++ inst_names)
csl = length common_suffix
- stn = map (\(x, y) -> (x, stripSuffix csl y)) xtn
- sti = map (\(x, y) -> (x, stripSuffix csl y)) xti
snl = Container.map (\n -> setName n (stripSuffix csl $ name n)) nl3
sil = Container.map (\i -> setName i (stripSuffix csl $ name i)) il3
- return (snl, sil, common_suffix, stn, sti)
+ return (snl, sil, common_suffix)
-- | Check cluster data for consistency
checkData :: NodeList -> InstanceList
let oneline = optOneline opts
verbose = optVerbose opts
- (fixed_nl, il, csf, _, _) <- CLI.loadExternalData opts
+ (fixed_nl, il, csf) <- CLI.loadExternalData opts
let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl
hPutStrLn stderr "Error: this program doesn't take any arguments."
exitWith $ ExitFailure 1
- (nl, il, csf, _, _) <- CLI.loadExternalData opts
+ (nl, il, csf) <- CLI.loadExternalData opts
printf "Loaded %d nodes, %d instances\n"
(Container.size nl)
import Data.List
import Data.Function
-import Data.Maybe(fromJust)
import Monad
import System
import System.IO
Bad err -> printf "\nError: failed to load data. \
\Details:\n%s\n" err
Ok x -> do
- let (nl, il, csf, _, _) = x
+ let (nl, il, csf) = x
(_, fix_nl) = Loader.checkData nl il
putStrLn $ printCluster fix_nl il
when (optShowNodes opts) $ do