Commit 93be1ced authored by Iustin Pop's avatar Iustin Pop
Browse files

Generalise the Result type



Currently, our error monad—Result—has a plain string error type. This
is not good, as we don't have structured errors, we can't pass back
proper error information to Python code, etc.

To solve this, we generalise this type as 'GenericResult a', and make
Result an alias to 'GenericResult String' for compatibility with the
old code. New error hierarchies will be introduced as different
types. Furthermore, we generalise our helper functions too, so that
they can work on any 'GeneralInstance a' type, not only Result.

There are two small drawbacks to this generalisation. First, a Monad
instance requires (at least for the way we use it) a 'fail :: String
-> m a' instance, so we need to be able to build an 'a' value from a
string; therefore, we can implement the Monad instance only for a
newly-introduced typeclass, 'FromString', which requires the needed
conversion function. Second, due to the fact that 'String' is a type
alias (for [Char]) instead of an actual type, we need to enable the
FlexibleInstances language pragma; as far as I know, this has no
significant drawbacks.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichael Hanselmann <hansmi@google.com>
parent 659d769d
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
......
......@@ -49,7 +49,7 @@ prop_toArrayFail :: Int -> String -> Bool -> Property
prop_toArrayFail i s b =
-- poor man's instance Arbitrary JSValue
forAll (elements [J.showJSON i, J.showJSON s, J.showJSON b]) $ \item ->
case JSON.toArray item of
case JSON.toArray item::BasicTypes.Result [J.JSValue] of
BasicTypes.Bad _ -> passTest
BasicTypes.Ok result -> failTest $ "Unexpected parse, got " ++ show result
......
......@@ -204,6 +204,6 @@ testSerialisation a =
J.Ok a' -> a ==? a'
-- | Result to PropertyM IO.
resultProp :: BasicTypes.Result a -> PropertyM IO a
resultProp (BasicTypes.Bad msg) = stop $ failTest msg
resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
resultProp (BasicTypes.Bad err) = stop . failTest $ show err
resultProp (BasicTypes.Ok val) = return val
{-# LANGUAGE FlexibleInstances #-}
{-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
......@@ -20,9 +22,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.BasicTypes
( Result(..)
( GenericResult(..)
, Result
, ResultT(..)
, resultT
, FromString(..)
, isOk
, isBad
, eitherToResult
......@@ -44,27 +48,36 @@ import Control.Monad.Trans
import Data.Function
import Data.List
-- | This is similar to the JSON library Result type - /very/ similar,
-- but we want to use it in multiple places, so we abstract it into a
-- mini-library here.
--
-- The failure value for this monad is simply a string.
data Result a
= Bad String
| Ok a
-- | Generic monad for our error handling mechanisms.
data GenericResult a b
= Bad a
| Ok b
deriving (Show, Read, Eq)
instance Monad Result where
-- | Type alias for a string Result.
type Result = GenericResult String
-- | Type class for things that can be built from strings.
class FromString a where
mkFromString :: String -> a
-- | Trivial 'String' instance; requires FlexibleInstances extension
-- though.
instance FromString [Char] where
mkFromString = id
-- | 'Monad' instance for 'GenericResult'.
instance (FromString a) => Monad (GenericResult a) where
(>>=) (Bad x) _ = Bad x
(>>=) (Ok x) fn = fn x
return = Ok
fail = Bad
fail = Bad . mkFromString
instance Functor Result where
instance Functor (GenericResult a) where
fmap _ (Bad msg) = Bad msg
fmap fn (Ok val) = Ok (fn val)
instance MonadPlus Result where
instance MonadPlus (GenericResult String) where
mzero = Bad "zero Result when used as MonadPlus"
-- for mplus, when we 'add' two Bad values, we concatenate their
-- error descriptions
......@@ -72,7 +85,7 @@ instance MonadPlus Result where
(Bad _) `mplus` x = x
x@(Ok _) `mplus` _ = x
instance Applicative Result where
instance Applicative (GenericResult a) where
pure = Ok
(Bad f) <*> _ = Bad f
_ <*> (Bad x) = Bad x
......@@ -80,10 +93,10 @@ instance Applicative Result where
-- | This is a monad transformation for Result. It's implementation is
-- based on the implementations of MaybeT and ErrorT.
newtype ResultT m a = ResultT {runResultT :: m (Result a)}
newtype ResultT a m b = ResultT {runResultT :: m (GenericResult a b)}
instance (Monad m) => Monad (ResultT m) where
fail err = ResultT (return $ Bad err)
instance (Monad m, FromString a) => Monad (ResultT a m) where
fail err = ResultT (return . Bad $ mkFromString err)
return = lift . return
x >>= f = ResultT $ do
a <- runResultT x
......@@ -91,29 +104,29 @@ instance (Monad m) => Monad (ResultT m) where
Ok val -> runResultT $ f val
Bad err -> return $ Bad err
instance MonadTrans ResultT where
instance MonadTrans (ResultT a) where
lift x = ResultT (liftM Ok x)
instance (MonadIO m) => MonadIO (ResultT m) where
instance (MonadIO m, FromString a) => MonadIO (ResultT a m) where
liftIO = lift . liftIO
-- | Lift a `Result` value to a `ResultT`.
resultT :: Monad m => Result a -> ResultT m a
resultT :: Monad m => GenericResult a b -> ResultT a m b
resultT = ResultT . return
-- | Simple checker for whether a 'Result' is OK.
isOk :: Result a -> Bool
-- | Simple checker for whether a 'GenericResult' is OK.
isOk :: GenericResult a b -> Bool
isOk (Ok _) = True
isOk _ = False
isOk _ = False
-- | Simple checker for whether a 'Result' is a failure.
isBad :: Result a -> Bool
-- | Simple checker for whether a 'GenericResult' is a failure.
isBad :: GenericResult a b -> Bool
isBad = not . isOk
-- | Converter from Either String to 'Result'.
eitherToResult :: Either String a -> Result a
eitherToResult (Left s) = Bad s
eitherToResult (Right v) = Ok v
-- | Converter from Either String to 'GeneicResult'.
eitherToResult :: Either a b -> GenericResult a b
eitherToResult (Left s) = Bad s
eitherToResult (Right v) = Ok v
-- | Annotate a Result with an ownership information.
annotateResult :: String -> Result a -> Result a
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment