root / htools / Ganeti / BasicTypes.hs @ 0aff2293
History | View | Annotate | Download (5.7 kB)
1 | 0c37d1e4 | Iustin Pop | {- |
---|---|---|---|
2 | 0c37d1e4 | Iustin Pop | |
3 | 1091021c | Iustin Pop | Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
4 | 0c37d1e4 | Iustin Pop | |
5 | 0c37d1e4 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
6 | 0c37d1e4 | Iustin Pop | it under the terms of the GNU General Public License as published by |
7 | 0c37d1e4 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
8 | 0c37d1e4 | Iustin Pop | (at your option) any later version. |
9 | 0c37d1e4 | Iustin Pop | |
10 | 0c37d1e4 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
11 | 0c37d1e4 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
12 | 0c37d1e4 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | 0c37d1e4 | Iustin Pop | General Public License for more details. |
14 | 0c37d1e4 | Iustin Pop | |
15 | 0c37d1e4 | Iustin Pop | You should have received a copy of the GNU General Public License |
16 | 0c37d1e4 | Iustin Pop | along with this program; if not, write to the Free Software |
17 | 0c37d1e4 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
18 | 0c37d1e4 | Iustin Pop | 02110-1301, USA. |
19 | 0c37d1e4 | Iustin Pop | |
20 | 0c37d1e4 | Iustin Pop | -} |
21 | 0c37d1e4 | Iustin Pop | |
22 | 0c37d1e4 | Iustin Pop | module Ganeti.BasicTypes |
23 | 0c37d1e4 | Iustin Pop | ( Result(..) |
24 | 0c37d1e4 | Iustin Pop | , isOk |
25 | 0c37d1e4 | Iustin Pop | , isBad |
26 | 0c37d1e4 | Iustin Pop | , eitherToResult |
27 | f3f76ccc | Iustin Pop | , annotateResult |
28 | 1091021c | Iustin Pop | , annotateIOError |
29 | 2fc5653f | Iustin Pop | , select |
30 | 2fc5653f | Iustin Pop | , LookupResult(..) |
31 | 2fc5653f | Iustin Pop | , MatchPriority(..) |
32 | 2fc5653f | Iustin Pop | , lookupName |
33 | 2fc5653f | Iustin Pop | , goodLookupResult |
34 | 2fc5653f | Iustin Pop | , goodMatchPriority |
35 | 2fc5653f | Iustin Pop | , prefixMatch |
36 | 2fc5653f | Iustin Pop | , compareNameComponent |
37 | 0c37d1e4 | Iustin Pop | ) where |
38 | 0c37d1e4 | Iustin Pop | |
39 | 0c37d1e4 | Iustin Pop | import Control.Monad |
40 | 2fc5653f | Iustin Pop | import Data.Function |
41 | 2fc5653f | Iustin Pop | import Data.List |
42 | 0c37d1e4 | Iustin Pop | |
43 | 0c37d1e4 | Iustin Pop | -- | This is similar to the JSON library Result type - /very/ similar, |
44 | 0c37d1e4 | Iustin Pop | -- but we want to use it in multiple places, so we abstract it into a |
45 | 0c37d1e4 | Iustin Pop | -- mini-library here. |
46 | 0c37d1e4 | Iustin Pop | -- |
47 | 0c37d1e4 | Iustin Pop | -- The failure value for this monad is simply a string. |
48 | 0c37d1e4 | Iustin Pop | data Result a |
49 | 0c37d1e4 | Iustin Pop | = Bad String |
50 | 0c37d1e4 | Iustin Pop | | Ok a |
51 | 0c37d1e4 | Iustin Pop | deriving (Show, Read, Eq) |
52 | 0c37d1e4 | Iustin Pop | |
53 | 0c37d1e4 | Iustin Pop | instance Monad Result where |
54 | 0c37d1e4 | Iustin Pop | (>>=) (Bad x) _ = Bad x |
55 | 0c37d1e4 | Iustin Pop | (>>=) (Ok x) fn = fn x |
56 | 0c37d1e4 | Iustin Pop | return = Ok |
57 | 0c37d1e4 | Iustin Pop | fail = Bad |
58 | 0c37d1e4 | Iustin Pop | |
59 | 0c37d1e4 | Iustin Pop | instance MonadPlus Result where |
60 | 0c37d1e4 | Iustin Pop | mzero = Bad "zero Result when used as MonadPlus" |
61 | 0c37d1e4 | Iustin Pop | -- for mplus, when we 'add' two Bad values, we concatenate their |
62 | 0c37d1e4 | Iustin Pop | -- error descriptions |
63 | 0c37d1e4 | Iustin Pop | (Bad x) `mplus` (Bad y) = Bad (x ++ "; " ++ y) |
64 | 0c37d1e4 | Iustin Pop | (Bad _) `mplus` x = x |
65 | 0c37d1e4 | Iustin Pop | x@(Ok _) `mplus` _ = x |
66 | 0c37d1e4 | Iustin Pop | |
67 | 0c37d1e4 | Iustin Pop | -- | Simple checker for whether a 'Result' is OK. |
68 | 0c37d1e4 | Iustin Pop | isOk :: Result a -> Bool |
69 | 0c37d1e4 | Iustin Pop | isOk (Ok _) = True |
70 | 0c37d1e4 | Iustin Pop | isOk _ = False |
71 | 0c37d1e4 | Iustin Pop | |
72 | 0c37d1e4 | Iustin Pop | -- | Simple checker for whether a 'Result' is a failure. |
73 | 0c37d1e4 | Iustin Pop | isBad :: Result a -> Bool |
74 | 0c37d1e4 | Iustin Pop | isBad = not . isOk |
75 | 0c37d1e4 | Iustin Pop | |
76 | 0c37d1e4 | Iustin Pop | -- | Converter from Either String to 'Result'. |
77 | 0c37d1e4 | Iustin Pop | eitherToResult :: Either String a -> Result a |
78 | 0c37d1e4 | Iustin Pop | eitherToResult (Left s) = Bad s |
79 | 0c37d1e4 | Iustin Pop | eitherToResult (Right v) = Ok v |
80 | f3f76ccc | Iustin Pop | |
81 | f3f76ccc | Iustin Pop | -- | Annotate a Result with an ownership information. |
82 | f3f76ccc | Iustin Pop | annotateResult :: String -> Result a -> Result a |
83 | f3f76ccc | Iustin Pop | annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s |
84 | f3f76ccc | Iustin Pop | annotateResult _ v = v |
85 | 1091021c | Iustin Pop | |
86 | 1091021c | Iustin Pop | -- | Annotates and transforms IOErrors into a Result type. This can be |
87 | 1091021c | Iustin Pop | -- used in the error handler argument to 'catch', for example. |
88 | 1091021c | Iustin Pop | annotateIOError :: String -> IOError -> IO (Result a) |
89 | 1091021c | Iustin Pop | annotateIOError description exc = |
90 | 1091021c | Iustin Pop | return . Bad $ description ++ ": " ++ show exc |
91 | 2fc5653f | Iustin Pop | |
92 | 2fc5653f | Iustin Pop | -- * Misc functionality |
93 | 2fc5653f | Iustin Pop | |
94 | 2fc5653f | Iustin Pop | -- | Return the first result with a True condition, or the default otherwise. |
95 | 2fc5653f | Iustin Pop | select :: a -- ^ default result |
96 | 2fc5653f | Iustin Pop | -> [(Bool, a)] -- ^ list of \"condition, result\" |
97 | 2fc5653f | Iustin Pop | -> a -- ^ first result which has a True condition, or default |
98 | 2fc5653f | Iustin Pop | select def = maybe def snd . find fst |
99 | 2fc5653f | Iustin Pop | |
100 | 2fc5653f | Iustin Pop | -- * Lookup of partial names functionality |
101 | 2fc5653f | Iustin Pop | |
102 | 2fc5653f | Iustin Pop | -- | The priority of a match in a lookup result. |
103 | 2fc5653f | Iustin Pop | data MatchPriority = ExactMatch |
104 | 2fc5653f | Iustin Pop | | MultipleMatch |
105 | 2fc5653f | Iustin Pop | | PartialMatch |
106 | 2fc5653f | Iustin Pop | | FailMatch |
107 | 2fc5653f | Iustin Pop | deriving (Show, Read, Enum, Eq, Ord) |
108 | 2fc5653f | Iustin Pop | |
109 | 2fc5653f | Iustin Pop | -- | The result of a name lookup in a list. |
110 | 2fc5653f | Iustin Pop | data LookupResult = LookupResult |
111 | 2fc5653f | Iustin Pop | { lrMatchPriority :: MatchPriority -- ^ The result type |
112 | 2fc5653f | Iustin Pop | -- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise |
113 | 2fc5653f | Iustin Pop | , lrContent :: String |
114 | 2fc5653f | Iustin Pop | } deriving (Show, Read) |
115 | 2fc5653f | Iustin Pop | |
116 | 2fc5653f | Iustin Pop | -- | Lookup results have an absolute preference ordering. |
117 | 2fc5653f | Iustin Pop | instance Eq LookupResult where |
118 | 2fc5653f | Iustin Pop | (==) = (==) `on` lrMatchPriority |
119 | 2fc5653f | Iustin Pop | |
120 | 2fc5653f | Iustin Pop | instance Ord LookupResult where |
121 | 2fc5653f | Iustin Pop | compare = compare `on` lrMatchPriority |
122 | 2fc5653f | Iustin Pop | |
123 | 2fc5653f | Iustin Pop | -- | Check for prefix matches in names. |
124 | 2fc5653f | Iustin Pop | -- Implemented in Ganeti core utils.text.MatchNameComponent |
125 | 2fc5653f | Iustin Pop | -- as the regexp r"^%s(\..*)?$" % re.escape(key) |
126 | 2fc5653f | Iustin Pop | prefixMatch :: String -- ^ Lookup |
127 | 2fc5653f | Iustin Pop | -> String -- ^ Full name |
128 | 2fc5653f | Iustin Pop | -> Bool -- ^ Whether there is a prefix match |
129 | 2fc5653f | Iustin Pop | prefixMatch = isPrefixOf . (++ ".") |
130 | 2fc5653f | Iustin Pop | |
131 | 2fc5653f | Iustin Pop | -- | Is the lookup priority a "good" one? |
132 | 2fc5653f | Iustin Pop | goodMatchPriority :: MatchPriority -> Bool |
133 | 2fc5653f | Iustin Pop | goodMatchPriority ExactMatch = True |
134 | 2fc5653f | Iustin Pop | goodMatchPriority PartialMatch = True |
135 | 2fc5653f | Iustin Pop | goodMatchPriority _ = False |
136 | 2fc5653f | Iustin Pop | |
137 | 2fc5653f | Iustin Pop | -- | Is the lookup result an actual match? |
138 | 2fc5653f | Iustin Pop | goodLookupResult :: LookupResult -> Bool |
139 | 2fc5653f | Iustin Pop | goodLookupResult = goodMatchPriority . lrMatchPriority |
140 | 2fc5653f | Iustin Pop | |
141 | 2fc5653f | Iustin Pop | -- | Compares a canonical name and a lookup string. |
142 | 2fc5653f | Iustin Pop | compareNameComponent :: String -- ^ Canonical (target) name |
143 | 2fc5653f | Iustin Pop | -> String -- ^ Partial (lookup) name |
144 | 2fc5653f | Iustin Pop | -> LookupResult -- ^ Result of the lookup |
145 | 2fc5653f | Iustin Pop | compareNameComponent cnl lkp = |
146 | 2fc5653f | Iustin Pop | select (LookupResult FailMatch lkp) |
147 | 2fc5653f | Iustin Pop | [ (cnl == lkp , LookupResult ExactMatch cnl) |
148 | 2fc5653f | Iustin Pop | , (prefixMatch lkp cnl , LookupResult PartialMatch cnl) |
149 | 2fc5653f | Iustin Pop | ] |
150 | 2fc5653f | Iustin Pop | |
151 | 2fc5653f | Iustin Pop | -- | Lookup a string and choose the best result. |
152 | 2fc5653f | Iustin Pop | chooseLookupResult :: String -- ^ Lookup key |
153 | 2fc5653f | Iustin Pop | -> String -- ^ String to compare to the lookup key |
154 | 2fc5653f | Iustin Pop | -> LookupResult -- ^ Previous result |
155 | 2fc5653f | Iustin Pop | -> LookupResult -- ^ New result |
156 | 2fc5653f | Iustin Pop | chooseLookupResult lkp cstr old = |
157 | 2fc5653f | Iustin Pop | -- default: use class order to pick the minimum result |
158 | 2fc5653f | Iustin Pop | select (min new old) |
159 | 2fc5653f | Iustin Pop | -- special cases: |
160 | 2fc5653f | Iustin Pop | -- short circuit if the new result is an exact match |
161 | 2fc5653f | Iustin Pop | [ (lrMatchPriority new == ExactMatch, new) |
162 | 2fc5653f | Iustin Pop | -- if both are partial matches generate a multiple match |
163 | 2fc5653f | Iustin Pop | , (partial2, LookupResult MultipleMatch lkp) |
164 | 2fc5653f | Iustin Pop | ] where new = compareNameComponent cstr lkp |
165 | 2fc5653f | Iustin Pop | partial2 = all ((PartialMatch==) . lrMatchPriority) [old, new] |
166 | 2fc5653f | Iustin Pop | |
167 | 2fc5653f | Iustin Pop | -- | Find the canonical name for a lookup string in a list of names. |
168 | 2fc5653f | Iustin Pop | lookupName :: [String] -- ^ List of keys |
169 | 2fc5653f | Iustin Pop | -> String -- ^ Lookup string |
170 | 2fc5653f | Iustin Pop | -> LookupResult -- ^ Result of the lookup |
171 | 2fc5653f | Iustin Pop | lookupName l s = foldr (chooseLookupResult s) |
172 | 2fc5653f | Iustin Pop | (LookupResult FailMatch s) l |