Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
itminedu
snf-ganeti
Commits
5182e970
Commit
5182e970
authored
Feb 25, 2010
by
Iustin Pop
Browse files
A number of small fixes from hlint
parent
edb198a0
Changes
10
Hide whitespace changes
Inline
Side-by-side
Ganeti/HTools/Cluster.hs
View file @
5182e970
...
...
@@ -60,8 +60,8 @@ module Ganeti.HTools.Cluster
)
where
import
Data.List
import
Data.Ord
(
comparing
)
import
Text.Printf
(
printf
)
import
Data.Function
import
Control.Monad
import
qualified
Ganeti.HTools.Container
as
Container
...
...
@@ -117,7 +117,7 @@ computeBadItems :: Node.List -> Instance.List ->
([
Node
.
Node
],
[
Instance
.
Instance
])
computeBadItems
nl
il
=
let
bad_nodes
=
verifyN1
$
getOnline
nl
bad_instances
=
map
(
\
idx
->
Container
.
find
idx
il
)
.
bad_instances
=
map
(
`
Container
.
find
`
il
)
.
sort
.
nub
$
concatMap
(
\
n
->
Node
.
sList
n
++
Node
.
pList
n
)
bad_nodes
in
...
...
@@ -485,7 +485,7 @@ tryBalance ini_tbl disk_moves evac_mode =
-- | Build failure stats out of a list of failures
collapseFailures
::
[
FailMode
]
->
FailStats
collapseFailures
flst
=
map
(
\
k
->
(
k
,
length
$
filter
(
(
==
)
k
)
flst
))
[
minBound
..
maxBound
]
map
(
\
k
->
(
k
,
length
$
filter
(
k
==
)
flst
))
[
minBound
..
maxBound
]
-- | Update current Allocation solution and failure stats with new
-- elements
...
...
@@ -574,8 +574,8 @@ tryEvac :: (Monad m) =>
->
[
Ndx
]
-- ^ Nodes to be evacuated
->
m
AllocSolution
-- ^ Solution list
tryEvac
nl
il
ex_ndx
=
let
ex_nodes
=
map
(
flip
Container
.
find
nl
)
ex_ndx
all_insts
=
nub
.
concat
.
m
ap
Node
.
sList
$
ex_nodes
let
ex_nodes
=
map
(
`
Container
.
find
`
nl
)
ex_ndx
all_insts
=
nub
.
concat
M
ap
Node
.
sList
$
ex_nodes
in
do
(
_
,
sol
)
<-
foldM
(
\
(
nl'
,
(
_
,
_
,
rsols
))
idx
->
do
-- FIXME: hardcoded one node here
...
...
@@ -701,7 +701,7 @@ printNodes nl fs =
let
fields
=
if
null
fs
then
Node
.
defaultFields
else
fs
snl
=
sortBy
(
compar
e
`
on
`
Node
.
idx
)
(
Container
.
elems
nl
)
snl
=
sortBy
(
compar
ing
Node
.
idx
)
(
Container
.
elems
nl
)
(
header
,
isnum
)
=
unzip
$
map
Node
.
showHeader
fields
in
unlines
.
map
((
:
)
' '
.
intercalate
" "
)
$
formatTable
(
header
:
map
(
Node
.
list
fields
)
snl
)
isnum
...
...
@@ -709,14 +709,14 @@ printNodes nl fs =
-- | Print the instance list.
printInsts
::
Node
.
List
->
Instance
.
List
->
String
printInsts
nl
il
=
let
sil
=
sortBy
(
compar
e
`
on
`
Instance
.
idx
)
(
Container
.
elems
il
)
let
sil
=
sortBy
(
compar
ing
Instance
.
idx
)
(
Container
.
elems
il
)
helper
inst
=
[
if
Instance
.
running
inst
then
"R"
else
" "
,
Instance
.
name
inst
,
Container
.
nameOf
nl
(
Instance
.
pNode
inst
)
,
(
let
sdx
=
Instance
.
sNode
inst
in
if
sdx
==
Node
.
noSecondary
then
""
else
Container
.
nameOf
nl
sdx
)
,
let
sdx
=
Instance
.
sNode
inst
in
if
sdx
==
Node
.
noSecondary
then
""
else
Container
.
nameOf
nl
sdx
,
printf
"%3d"
$
Instance
.
vcpus
inst
,
printf
"%5d"
$
Instance
.
mem
inst
,
printf
"%5d"
$
Instance
.
dsk
inst
`
div
`
1024
...
...
Ganeti/HTools/Loader.hs
View file @
5182e970
...
...
@@ -125,7 +125,7 @@ fixNodes accu inst =
filterExTags
::
[
String
]
->
Instance
.
Instance
->
Instance
.
Instance
filterExTags
tl
inst
=
let
old_tags
=
Instance
.
tags
inst
new_tags
=
filter
(
\
tag
->
any
(
\
extag
->
isPrefixOf
extag
tag
)
tl
)
new_tags
=
filter
(
\
tag
->
any
(
`
isPrefixOf
`
tag
)
tl
)
old_tags
in
inst
{
Instance
.
tags
=
new_tags
}
...
...
@@ -198,7 +198,7 @@ checkData nl il =
Container
.
mapAccum
(
\
msgs
node
->
let
nname
=
Node
.
name
node
nilst
=
map
(
flip
Container
.
find
il
)
(
Node
.
pList
node
)
nilst
=
map
(
`
Container
.
find
`
il
)
(
Node
.
pList
node
)
dilst
=
filter
(
not
.
Instance
.
running
)
nilst
adj_mem
=
sum
.
map
Instance
.
mem
$
dilst
delta_mem
=
truncate
(
Node
.
tMem
node
)
...
...
Ganeti/HTools/Luxi.hs
View file @
5182e970
...
...
@@ -151,8 +151,7 @@ getClusterTags :: JSValue -> Result [String]
getClusterTags
v
=
do
let
errmsg
=
"Parsing cluster info"
obj
<-
annotateResult
errmsg
$
asJSObject
v
tags
<-
tryFromObj
errmsg
(
fromJSObject
obj
)
"tags"
return
tags
tryFromObj
errmsg
(
fromJSObject
obj
)
"tags"
-- * Main loader functionality
...
...
Ganeti/HTools/Node.hs
View file @
5182e970
...
...
@@ -163,7 +163,7 @@ delTags = foldl' delTag
-- | Check if we can add a list of tags to a tagmap
rejectAddTags
::
TagMap
->
[
String
]
->
Bool
rejectAddTags
t
=
any
(
flip
Map
.
member
t
)
rejectAddTags
t
=
any
(
`
Map
.
member
`
t
)
-- | Check how many primary instances have conflicting tags. The
-- algorithm to compute this is to sum the count of all tags, then
...
...
Ganeti/HTools/PeerMap.hs
View file @
5182e970
...
...
@@ -42,7 +42,7 @@ module Ganeti.HTools.PeerMap
import
Data.Maybe
(
fromMaybe
)
import
Data.List
import
Data.
Function
import
Data.
Ord
(
comparing
)
import
Ganeti.HTools.Types
...
...
@@ -58,7 +58,7 @@ empty = []
-- | Our reverse-compare function.
pmCompare
::
(
Key
,
Elem
)
->
(
Key
,
Elem
)
->
Ordering
pmCompare
a
b
=
(
compar
e
`
on
`
snd
)
b
a
pmCompare
a
b
=
compar
ing
snd
b
a
-- | Add or update (via a custom function) an element.
addWith
::
(
Elem
->
Elem
->
Elem
)
->
Key
->
Elem
->
PeerMap
->
PeerMap
...
...
Ganeti/HTools/Rapi.hs
View file @
5182e970
...
...
@@ -57,7 +57,7 @@ getUrl url = do
-- | Append the default port if not passed in.
formatHost
::
String
->
String
formatHost
master
=
if
elem
':'
master
then
master
if
':'
`
elem
`
master
then
master
else
"https://"
++
master
++
":5080"
-- | Parse a instance list in JSON format.
...
...
Ganeti/Luxi.hs
View file @
5182e970
...
...
@@ -124,7 +124,7 @@ recvMsg s = do
let
_recv
obuf
=
do
nbuf
<-
withTimeout
queryTimeout
"reading luxi response"
$
S
.
recv
(
socket
s
)
4096
let
(
msg
,
remaining
)
=
break
(
(
==
)
eOM
)
(
obuf
++
nbuf
)
let
(
msg
,
remaining
)
=
break
(
eOM
==
)
(
obuf
++
nbuf
)
(
if
null
remaining
then
_recv
msg
else
return
(
msg
,
tail
remaining
))
...
...
hbal.hs
View file @
5182e970
...
...
@@ -197,9 +197,9 @@ main = do
let
offline_names
=
optOffline
opts
all_nodes
=
Container
.
elems
fixed_nl
all_names
=
map
Node
.
name
all_nodes
offline_wrong
=
filter
(
flip
notElem
all_names
)
offline_names
offline_wrong
=
filter
(
`
notElem
`
all_names
)
offline_names
offline_indices
=
map
Node
.
idx
$
filter
(
\
n
->
elem
(
Node
.
name
n
)
offline_names
)
filter
(
\
n
->
Node
.
name
n
`
elem
`
offline_names
)
all_nodes
m_cpu
=
optMcpu
opts
m_dsk
=
optMdsk
opts
...
...
@@ -209,7 +209,7 @@ main = do
(
commaJoin
offline_wrong
)
::
IO
()
exitWith
$
ExitFailure
1
let
nm
=
Container
.
map
(
\
n
->
if
elem
(
Node
.
idx
n
)
offline_indices
let
nm
=
Container
.
map
(
\
n
->
if
Node
.
idx
n
`
elem
`
offline_indices
then
Node
.
setOffline
n
True
else
n
)
fixed_nl
nl
=
Container
.
map
(
flip
Node
.
setMdsk
m_dsk
.
flip
Node
.
setMcpu
m_cpu
)
...
...
hscan.hs
View file @
5182e970
...
...
@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module
Main
(
main
)
where
import
Data.List
import
Data.Maybe
(
isJust
,
fromJust
)
import
Data.Maybe
(
isJust
,
fromJust
,
fromMaybe
)
import
Monad
#
ifdef
NO_CURL
import
System
(
exitWith
,
ExitCode
(
..
))
...
...
@@ -174,9 +174,7 @@ main = do
"t_disk"
"f_disk"
"Score"
when
(
null
clusters
)
$
do
let
lsock
=
case
optLuxi
opts
of
Just
s
->
s
Nothing
->
defaultLuxiSocket
let
lsock
=
fromMaybe
defaultLuxiSocket
(
optLuxi
opts
)
let
name
=
local
input_data
<-
Luxi
.
loadData
lsock
writeData
nlen
name
opts
(
processData
input_data
)
...
...
hspace.hs
View file @
5182e970
...
...
@@ -29,6 +29,7 @@ import Data.Char (toUpper, isAlphaNum)
import
Data.List
import
Data.Function
import
Data.Maybe
(
isJust
,
fromJust
)
import
Data.Ord
(
comparing
)
import
Monad
import
System
(
exitWith
,
ExitCode
(
..
))
import
System.IO
...
...
@@ -148,7 +149,7 @@ tieredAlloc nl il newinst nreq ixes =
Bad
s
->
Bad
s
Ok
(
errs
,
nl'
,
ixes'
)
->
case
Instance
.
shrinkByType
newinst
.
fst
.
last
$
sortBy
(
compar
e
`
on
`
snd
)
errs
of
sortBy
(
compar
ing
snd
)
errs
of
Bad
_
->
Ok
(
errs
,
nl'
,
ixes'
)
Ok
newinst'
->
tieredAlloc
nl'
il
newinst'
nreq
ixes'
...
...
@@ -201,10 +202,10 @@ printKeys = mapM_ (\(k, v) ->
printInstance
::
Node
.
List
->
Instance
.
Instance
->
[
String
]
printInstance
nl
i
=
[
Instance
.
name
i
,
(
Container
.
nameOf
nl
$
Instance
.
pNode
i
)
,
(
let
sdx
=
Instance
.
sNode
i
in
if
sdx
==
Node
.
noSecondary
then
""
else
Container
.
nameOf
nl
sdx
)
,
Container
.
nameOf
nl
$
Instance
.
pNode
i
,
let
sdx
=
Instance
.
sNode
i
in
if
sdx
==
Node
.
noSecondary
then
""
else
Container
.
nameOf
nl
sdx
,
show
(
Instance
.
mem
i
)
,
show
(
Instance
.
dsk
i
)
,
show
(
Instance
.
vcpus
i
)
...
...
@@ -234,9 +235,9 @@ main = do
let
offline_names
=
optOffline
opts
all_nodes
=
Container
.
elems
fixed_nl
all_names
=
map
Node
.
name
all_nodes
offline_wrong
=
filter
(
flip
notElem
all_names
)
offline_names
offline_wrong
=
filter
(
`
notElem
`
all_names
)
offline_names
offline_indices
=
map
Node
.
idx
$
filter
(
\
n
->
elem
(
Node
.
name
n
)
offline_names
)
filter
(
\
n
->
Node
.
name
n
`
elem
`
offline_names
)
all_nodes
req_nodes
=
optINodes
opts
m_cpu
=
optMcpu
opts
...
...
@@ -252,7 +253,7 @@ main = do
req_nodes
::
IO
()
exitWith
$
ExitFailure
1
let
nm
=
Container
.
map
(
\
n
->
if
elem
(
Node
.
idx
n
)
offline_indices
let
nm
=
Container
.
map
(
\
n
->
if
Node
.
idx
n
`
elem
`
offline_indices
then
Node
.
setOffline
n
True
else
n
)
fixed_nl
nl
=
Container
.
map
(
flip
Node
.
setMdsk
m_dsk
.
flip
Node
.
setMcpu
m_cpu
)
...
...
@@ -333,7 +334,7 @@ main = do
let
allocs
=
length
ixes
fin_ixes
=
reverse
ixes
sreason
=
reverse
$
sortBy
(
compar
e
`
on
`
snd
)
ereason
sreason
=
reverse
$
sortBy
(
compar
ing
snd
)
ereason
when
(
verbose
>
1
)
$
do
hPutStrLn
stderr
"Instance map"
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment