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 MonadPlus Result where
60 mzero = Bad "zero Result when used as MonadPlus"
61 -- for mplus, when we 'add' two Bad values, we concatenate their
63 (Bad x) `mplus` (Bad y) = Bad (x ++ "; " ++ y)
65 x@(Ok _) `mplus` _ = x
67 -- | Simple checker for whether a 'Result' is OK.
68 isOk :: Result a -> Bool
72 -- | Simple checker for whether a 'Result' is a failure.
73 isBad :: Result a -> Bool
76 -- | Converter from Either String to 'Result'.
77 eitherToResult :: Either String a -> Result a
78 eitherToResult (Left s) = Bad s
79 eitherToResult (Right v) = Ok v
81 -- | Annotate a Result with an ownership information.
82 annotateResult :: String -> Result a -> Result a
83 annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s
84 annotateResult _ v = v
86 -- | Annotates and transforms IOErrors into a Result type. This can be
87 -- used in the error handler argument to 'catch', for example.
88 annotateIOError :: String -> IOError -> IO (Result a)
89 annotateIOError description exc =
90 return . Bad $ description ++ ": " ++ show exc
92 -- * Misc functionality
94 -- | Return the first result with a True condition, or the default otherwise.
95 select :: a -- ^ default result
96 -> [(Bool, a)] -- ^ list of \"condition, result\"
97 -> a -- ^ first result which has a True condition, or default
98 select def = maybe def snd . find fst
100 -- * Lookup of partial names functionality
102 -- | The priority of a match in a lookup result.
103 data MatchPriority = ExactMatch
107 deriving (Show, Read, Enum, Eq, Ord)
109 -- | The result of a name lookup in a list.
110 data LookupResult = LookupResult
111 { lrMatchPriority :: MatchPriority -- ^ The result type
112 -- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise
113 , lrContent :: String
114 } deriving (Show, Read)
116 -- | Lookup results have an absolute preference ordering.
117 instance Eq LookupResult where
118 (==) = (==) `on` lrMatchPriority
120 instance Ord LookupResult where
121 compare = compare `on` lrMatchPriority
123 -- | Check for prefix matches in names.
124 -- Implemented in Ganeti core utils.text.MatchNameComponent
125 -- as the regexp r"^%s(\..*)?$" % re.escape(key)
126 prefixMatch :: String -- ^ Lookup
127 -> String -- ^ Full name
128 -> Bool -- ^ Whether there is a prefix match
129 prefixMatch = isPrefixOf . (++ ".")
131 -- | Is the lookup priority a "good" one?
132 goodMatchPriority :: MatchPriority -> Bool
133 goodMatchPriority ExactMatch = True
134 goodMatchPriority PartialMatch = True
135 goodMatchPriority _ = False
137 -- | Is the lookup result an actual match?
138 goodLookupResult :: LookupResult -> Bool
139 goodLookupResult = goodMatchPriority . lrMatchPriority
141 -- | Compares a canonical name and a lookup string.
142 compareNameComponent :: String -- ^ Canonical (target) name
143 -> String -- ^ Partial (lookup) name
144 -> LookupResult -- ^ Result of the lookup
145 compareNameComponent cnl lkp =
146 select (LookupResult FailMatch lkp)
147 [ (cnl == lkp , LookupResult ExactMatch cnl)
148 , (prefixMatch lkp cnl , LookupResult PartialMatch cnl)
151 -- | Lookup a string and choose the best result.
152 chooseLookupResult :: String -- ^ Lookup key
153 -> String -- ^ String to compare to the lookup key
154 -> LookupResult -- ^ Previous result
155 -> LookupResult -- ^ New result
156 chooseLookupResult lkp cstr old =
157 -- default: use class order to pick the minimum result
160 -- short circuit if the new result is an exact match
161 [ (lrMatchPriority new == ExactMatch, new)
162 -- if both are partial matches generate a multiple match
163 , (partial2, LookupResult MultipleMatch lkp)
164 ] where new = compareNameComponent cstr lkp
165 partial2 = all ((PartialMatch==) . lrMatchPriority) [old, new]
167 -- | Find the canonical name for a lookup string in a list of names.
168 lookupName :: [String] -- ^ List of keys
169 -> String -- ^ Lookup string
170 -> LookupResult -- ^ Result of the lookup
171 lookupName l s = foldr (chooseLookupResult s)
172 (LookupResult FailMatch s) l