root / htools / Ganeti / BasicTypes.hs @ 1091021c
History | View | Annotate | Download (2.7 kB)
1 |
{- |
---|---|
2 |
|
3 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
4 |
|
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. |
9 |
|
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. |
14 |
|
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 |
18 |
02110-1301, USA. |
19 |
|
20 |
-} |
21 |
|
22 |
module Ganeti.BasicTypes |
23 |
( Result(..) |
24 |
, isOk |
25 |
, isBad |
26 |
, eitherToResult |
27 |
, annotateResult |
28 |
, annotateIOError |
29 |
, exitIfBad |
30 |
) where |
31 |
|
32 |
import Control.Monad |
33 |
import System.IO (hPutStrLn, stderr) |
34 |
import System.Exit |
35 |
|
36 |
-- | This is similar to the JSON library Result type - /very/ similar, |
37 |
-- but we want to use it in multiple places, so we abstract it into a |
38 |
-- mini-library here. |
39 |
-- |
40 |
-- The failure value for this monad is simply a string. |
41 |
data Result a |
42 |
= Bad String |
43 |
| Ok a |
44 |
deriving (Show, Read, Eq) |
45 |
|
46 |
instance Monad Result where |
47 |
(>>=) (Bad x) _ = Bad x |
48 |
(>>=) (Ok x) fn = fn x |
49 |
return = Ok |
50 |
fail = Bad |
51 |
|
52 |
instance MonadPlus Result where |
53 |
mzero = Bad "zero Result when used as MonadPlus" |
54 |
-- for mplus, when we 'add' two Bad values, we concatenate their |
55 |
-- error descriptions |
56 |
(Bad x) `mplus` (Bad y) = Bad (x ++ "; " ++ y) |
57 |
(Bad _) `mplus` x = x |
58 |
x@(Ok _) `mplus` _ = x |
59 |
|
60 |
-- | Simple checker for whether a 'Result' is OK. |
61 |
isOk :: Result a -> Bool |
62 |
isOk (Ok _) = True |
63 |
isOk _ = False |
64 |
|
65 |
-- | Simple checker for whether a 'Result' is a failure. |
66 |
isBad :: Result a -> Bool |
67 |
isBad = not . isOk |
68 |
|
69 |
-- | Converter from Either String to 'Result'. |
70 |
eitherToResult :: Either String a -> Result a |
71 |
eitherToResult (Left s) = Bad s |
72 |
eitherToResult (Right v) = Ok v |
73 |
|
74 |
-- | Annotate a Result with an ownership information. |
75 |
annotateResult :: String -> Result a -> Result a |
76 |
annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s |
77 |
annotateResult _ v = v |
78 |
|
79 |
-- | Annotates and transforms IOErrors into a Result type. This can be |
80 |
-- used in the error handler argument to 'catch', for example. |
81 |
annotateIOError :: String -> IOError -> IO (Result a) |
82 |
annotateIOError description exc = |
83 |
return . Bad $ description ++ ": " ++ show exc |
84 |
|
85 |
-- | Unwraps a 'Result', exiting the program if it is a 'Bad' value, |
86 |
-- otherwise returning the actual contained value. |
87 |
exitIfBad :: Result a -> IO a |
88 |
exitIfBad (Bad s) = do |
89 |
hPutStrLn stderr $ "Failure: " ++ s |
90 |
exitWith (ExitFailure 1) |
91 |
exitIfBad (Ok v) = return v |