Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / BasicTypes.hs @ 5cefb2b2

History | View | Annotate | Download (2.3 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 0c37d1e4 Iustin Pop
  ) where
30 0c37d1e4 Iustin Pop
31 0c37d1e4 Iustin Pop
import Control.Monad
32 0c37d1e4 Iustin Pop
33 0c37d1e4 Iustin Pop
-- | This is similar to the JSON library Result type - /very/ similar,
34 0c37d1e4 Iustin Pop
-- but we want to use it in multiple places, so we abstract it into a
35 0c37d1e4 Iustin Pop
-- mini-library here.
36 0c37d1e4 Iustin Pop
--
37 0c37d1e4 Iustin Pop
-- The failure value for this monad is simply a string.
38 0c37d1e4 Iustin Pop
data Result a
39 0c37d1e4 Iustin Pop
    = Bad String
40 0c37d1e4 Iustin Pop
    | Ok a
41 0c37d1e4 Iustin Pop
    deriving (Show, Read, Eq)
42 0c37d1e4 Iustin Pop
43 0c37d1e4 Iustin Pop
instance Monad Result where
44 0c37d1e4 Iustin Pop
  (>>=) (Bad x) _ = Bad x
45 0c37d1e4 Iustin Pop
  (>>=) (Ok x) fn = fn x
46 0c37d1e4 Iustin Pop
  return = Ok
47 0c37d1e4 Iustin Pop
  fail = Bad
48 0c37d1e4 Iustin Pop
49 0c37d1e4 Iustin Pop
instance MonadPlus Result where
50 0c37d1e4 Iustin Pop
  mzero = Bad "zero Result when used as MonadPlus"
51 0c37d1e4 Iustin Pop
  -- for mplus, when we 'add' two Bad values, we concatenate their
52 0c37d1e4 Iustin Pop
  -- error descriptions
53 0c37d1e4 Iustin Pop
  (Bad x) `mplus` (Bad y) = Bad (x ++ "; " ++ y)
54 0c37d1e4 Iustin Pop
  (Bad _) `mplus` x = x
55 0c37d1e4 Iustin Pop
  x@(Ok _) `mplus` _ = x
56 0c37d1e4 Iustin Pop
57 0c37d1e4 Iustin Pop
-- | Simple checker for whether a 'Result' is OK.
58 0c37d1e4 Iustin Pop
isOk :: Result a -> Bool
59 0c37d1e4 Iustin Pop
isOk (Ok _) = True
60 0c37d1e4 Iustin Pop
isOk _ = False
61 0c37d1e4 Iustin Pop
62 0c37d1e4 Iustin Pop
-- | Simple checker for whether a 'Result' is a failure.
63 0c37d1e4 Iustin Pop
isBad :: Result a  -> Bool
64 0c37d1e4 Iustin Pop
isBad = not . isOk
65 0c37d1e4 Iustin Pop
66 0c37d1e4 Iustin Pop
-- | Converter from Either String to 'Result'.
67 0c37d1e4 Iustin Pop
eitherToResult :: Either String a -> Result a
68 0c37d1e4 Iustin Pop
eitherToResult (Left s) = Bad s
69 0c37d1e4 Iustin Pop
eitherToResult (Right v) = Ok v
70 f3f76ccc Iustin Pop
71 f3f76ccc Iustin Pop
-- | Annotate a Result with an ownership information.
72 f3f76ccc Iustin Pop
annotateResult :: String -> Result a -> Result a
73 f3f76ccc Iustin Pop
annotateResult owner (Bad s) = Bad $ owner ++ ": " ++ s
74 f3f76ccc Iustin Pop
annotateResult _ v = v
75 1091021c Iustin Pop
76 1091021c Iustin Pop
-- | Annotates and transforms IOErrors into a Result type. This can be
77 1091021c Iustin Pop
-- used in the error handler argument to 'catch', for example.
78 1091021c Iustin Pop
annotateIOError :: String -> IOError -> IO (Result a)
79 1091021c Iustin Pop
annotateIOError description exc =
80 1091021c Iustin Pop
  return . Bad $ description ++ ": " ++ show exc