Skip to content
Snippets Groups Projects
Commit 8472a321 authored by Iustin Pop's avatar Iustin Pop
Browse files

Remove the ktn/kti from second half of loading

This removes the return of ktn/kti from Loader.mergeData and associated
functions.
parent db1bcfe8
No related branches found
No related tags found
No related merge requests found
...@@ -98,7 +98,7 @@ shTemplate = ...@@ -98,7 +98,7 @@ shTemplate =
-- | External tool data loader from a variety of sources -- | External tool data loader from a variety of sources
loadExternalData :: (EToolOptions a) => loadExternalData :: (EToolOptions a) =>
a a
-> IO (NodeList, InstanceList, String, NameList, NameList) -> IO (NodeList, InstanceList, String)
loadExternalData opts = do loadExternalData opts = do
(env_node, env_inst) <- parseEnv () (env_node, env_inst) <- parseEnv ()
let nodef = if nodeSet opts then nodeFile opts let nodef = if nodeSet opts then nodeFile opts
...@@ -111,7 +111,7 @@ loadExternalData opts = do ...@@ -111,7 +111,7 @@ loadExternalData opts = do
host -> Rapi.loadData host host -> Rapi.loadData host
let ldresult = input_data >>= Loader.mergeData let ldresult = input_data >>= Loader.mergeData
(loaded_nl, il, csf, ktn, kti) <- (loaded_nl, il, csf) <-
(case ldresult of (case ldresult of
Ok x -> return x Ok x -> return x
Bad s -> do Bad s -> do
...@@ -124,4 +124,4 @@ loadExternalData opts = do ...@@ -124,4 +124,4 @@ loadExternalData opts = do
putStrLn "Warning: cluster has inconsistent data:" putStrLn "Warning: cluster has inconsistent data:"
putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs
return (fixed_nl, il, csf, ktn, kti) return (fixed_nl, il, csf)
...@@ -26,7 +26,7 @@ data RqType ...@@ -26,7 +26,7 @@ data RqType
| Relocate Int | Relocate Int
deriving (Show) deriving (Show)
data Request = Request RqType NodeList InstanceList String NameList NameList data Request = Request RqType NodeList InstanceList String
deriving (Show) deriving (Show)
parseBaseInstance :: String parseBaseInstance :: String
...@@ -101,8 +101,8 @@ parseData body = do ...@@ -101,8 +101,8 @@ parseData body = do
ridx <- lookupNode kti rname rname ridx <- lookupNode kti rname rname
return $ Relocate ridx return $ Relocate ridx
other -> fail $ ("Invalid request type '" ++ other ++ "'") other -> fail $ ("Invalid request type '" ++ other ++ "'")
(map_n, map_i, csf, xtn, xti) <- mergeData (ktn, nl, kti, il) (map_n, map_i, csf) <- mergeData (ktn, nl, kti, il)
return $ Request rqtype map_n map_i csf xtn xti return $ Request rqtype map_n map_i csf
formatResponse :: Bool -> String -> [String] -> String formatResponse :: Bool -> String -> [String] -> String
formatResponse success info nodes = formatResponse success info nodes =
......
...@@ -68,13 +68,10 @@ fixNodes nl il = ...@@ -68,13 +68,10 @@ fixNodes nl il =
-- | Compute the longest common suffix of a NameList list that -- | Compute the longest common suffix of a NameList list that
-- | starts with a dot -- | starts with a dot
longestDomain :: NameList -> String longestDomain :: [String] -> String
longestDomain [] = "" longestDomain [] = ""
longestDomain ((_,x):xs) = longestDomain (x:xs) =
let foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
onlyStrings = snd $ unzip xs
in
foldr (\ suffix accu -> if all (isSuffixOf suffix) onlyStrings
then suffix then suffix
else accu) else accu)
"" $ filter (isPrefixOf ".") (tails x) "" $ filter (isPrefixOf ".") (tails x)
...@@ -89,22 +86,20 @@ mergeData :: ([(String, Int)], Node.AssocList, ...@@ -89,22 +86,20 @@ mergeData :: ([(String, Int)], Node.AssocList,
[(String, Int)], Instance.AssocList) -- ^ Data from either [(String, Int)], Instance.AssocList) -- ^ Data from either
-- Text.loadData -- Text.loadData
-- or Rapi.loadData -- or Rapi.loadData
-> Result (NodeList, InstanceList, String, NameList, NameList) -> Result (NodeList, InstanceList, String)
mergeData (ktn, nl, kti, il) = do mergeData (ktn, nl, kti, il) = do
let let
nl2 = fixNodes nl il nl2 = fixNodes nl il
il3 = Container.fromAssocList il il3 = Container.fromAssocList il
nl3 = Container.fromAssocList nl3 = Container.fromAssocList
(map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2) (map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2)
xtn = swapPairs ktn node_names = map Node.name $ Container.elems nl3
xti = swapPairs kti inst_names = map Instance.name $ Container.elems il3
common_suffix = longestDomain (xti ++ xtn) common_suffix = longestDomain (node_names ++ inst_names)
csl = length common_suffix 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 snl = Container.map (\n -> setName n (stripSuffix csl $ name n)) nl3
sil = Container.map (\i -> setName i (stripSuffix csl $ name i)) il3 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 -- | Check cluster data for consistency
checkData :: NodeList -> InstanceList checkData :: NodeList -> InstanceList
......
...@@ -181,7 +181,7 @@ main = do ...@@ -181,7 +181,7 @@ main = do
let oneline = optOneline opts let oneline = optOneline opts
verbose = optVerbose opts verbose = optVerbose opts
(fixed_nl, il, csf, _, _) <- CLI.loadExternalData opts (fixed_nl, il, csf) <- CLI.loadExternalData opts
let offline_names = optOffline opts let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl all_nodes = Container.elems fixed_nl
......
...@@ -145,7 +145,7 @@ main = do ...@@ -145,7 +145,7 @@ main = do
hPutStrLn stderr "Error: this program doesn't take any arguments." hPutStrLn stderr "Error: this program doesn't take any arguments."
exitWith $ ExitFailure 1 exitWith $ ExitFailure 1
(nl, il, csf, _, _) <- CLI.loadExternalData opts (nl, il, csf) <- CLI.loadExternalData opts
printf "Loaded %d nodes, %d instances\n" printf "Loaded %d nodes, %d instances\n"
(Container.size nl) (Container.size nl)
......
...@@ -6,7 +6,6 @@ module Main (main) where ...@@ -6,7 +6,6 @@ module Main (main) where
import Data.List import Data.List
import Data.Function import Data.Function
import Data.Maybe(fromJust)
import Monad import Monad
import System import System
import System.IO import System.IO
...@@ -162,7 +161,7 @@ main = do ...@@ -162,7 +161,7 @@ main = do
Bad err -> printf "\nError: failed to load data. \ Bad err -> printf "\nError: failed to load data. \
\Details:\n%s\n" err \Details:\n%s\n" err
Ok x -> do Ok x -> do
let (nl, il, csf, _, _) = x let (nl, il, csf) = x
(_, fix_nl) = Loader.checkData nl il (_, fix_nl) = Loader.checkData nl il
putStrLn $ printCluster fix_nl il putStrLn $ printCluster fix_nl il
when (optShowNodes opts) $ do when (optShowNodes opts) $ do
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment