3 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful, but
11 WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 module Ganeti.BasicTypes
36 , compareNameComponent
43 -- | This is similar to the JSON library Result type - /very/ similar,
44 -- but we want to use it in multiple places, so we abstract it into a
47 -- The failure value for this monad is simply a string.
51 deriving (Show, Read, Eq)
53 instance Monad Result where
54 (>>=) (Bad x) _ = Bad x
55 (>>=) (Ok x) fn = fn x
59 instance Functor Result where
60 fmap _ (Bad msg) = Bad msg
61 fmap fn (Ok val) = Ok (fn val)
63 instance MonadPlus Result where
64 mzero = Bad "zero Result when used as MonadPlus"
65 -- for mplus, when we 'add' two Bad values, we concatenate their
67 (Bad x) `mplus` (Bad y) = Bad (x ++ "; " ++ y)
69 x@(Ok _) `mplus` _ = x
71 -- | Simple checker for whether a 'Result' is OK.
72 isOk :: Result a -> Bool
76 -- | Simple checker for whether a 'Result' is a failure.
77 isBad :: Result a -> Bool
80 -- | Converter from Either String to 'Result'.
81 eitherToResult :: Either String a -> Result a
82 eitherToResult (Left s) = Bad s
83 eitherToResult (Right v) = Ok v
85 -- | Annotate a Result with an ownership information.
86 annotateResult :: String -> Result a -> Result a
87 annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s
88 annotateResult _ v = v
90 -- | Annotates and transforms IOErrors into a Result type. This can be
91 -- used in the error handler argument to 'catch', for example.
92 annotateIOError :: String -> IOError -> IO (Result a)
93 annotateIOError description exc =
94 return . Bad $ description ++ ": " ++ show exc
96 -- * Misc functionality
98 -- | Return the first result with a True condition, or the default otherwise.
99 select :: a -- ^ default result
100 -> [(Bool, a)] -- ^ list of \"condition, result\"
101 -> a -- ^ first result which has a True condition, or default
102 select def = maybe def snd . find fst
104 -- * Lookup of partial names functionality
106 -- | The priority of a match in a lookup result.
107 data MatchPriority = ExactMatch
111 deriving (Show, Read, Enum, Eq, Ord)
113 -- | The result of a name lookup in a list.
114 data LookupResult = LookupResult
115 { lrMatchPriority :: MatchPriority -- ^ The result type
116 -- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise
117 , lrContent :: String
118 } deriving (Show, Read)
120 -- | Lookup results have an absolute preference ordering.
121 instance Eq LookupResult where
122 (==) = (==) `on` lrMatchPriority
124 instance Ord LookupResult where
125 compare = compare `on` lrMatchPriority
127 -- | Check for prefix matches in names.
128 -- Implemented in Ganeti core utils.text.MatchNameComponent
129 -- as the regexp r"^%s(\..*)?$" % re.escape(key)
130 prefixMatch :: String -- ^ Lookup
131 -> String -- ^ Full name
132 -> Bool -- ^ Whether there is a prefix match
133 prefixMatch = isPrefixOf . (++ ".")
135 -- | Is the lookup priority a "good" one?
136 goodMatchPriority :: MatchPriority -> Bool
137 goodMatchPriority ExactMatch = True
138 goodMatchPriority PartialMatch = True
139 goodMatchPriority _ = False
141 -- | Is the lookup result an actual match?
142 goodLookupResult :: LookupResult -> Bool
143 goodLookupResult = goodMatchPriority . lrMatchPriority
145 -- | Compares a canonical name and a lookup string.
146 compareNameComponent :: String -- ^ Canonical (target) name
147 -> String -- ^ Partial (lookup) name
148 -> LookupResult -- ^ Result of the lookup
149 compareNameComponent cnl lkp =
150 select (LookupResult FailMatch lkp)
151 [ (cnl == lkp , LookupResult ExactMatch cnl)
152 , (prefixMatch lkp cnl , LookupResult PartialMatch cnl)
155 -- | Lookup a string and choose the best result.
156 chooseLookupResult :: String -- ^ Lookup key
157 -> String -- ^ String to compare to the lookup key
158 -> LookupResult -- ^ Previous result
159 -> LookupResult -- ^ New result
160 chooseLookupResult lkp cstr old =
161 -- default: use class order to pick the minimum result
164 -- short circuit if the new result is an exact match
165 [ (lrMatchPriority new == ExactMatch, new)
166 -- if both are partial matches generate a multiple match
167 , (partial2, LookupResult MultipleMatch lkp)
168 ] where new = compareNameComponent cstr lkp
169 partial2 = all ((PartialMatch==) . lrMatchPriority) [old, new]
171 -- | Find the canonical name for a lookup string in a list of names.
172 lookupName :: [String] -- ^ List of keys
173 -> String -- ^ Lookup string
174 -> LookupResult -- ^ Result of the lookup
175 lookupName l s = foldr (chooseLookupResult s)
176 (LookupResult FailMatch s) l