Commit a87a017b authored by Petr Pudlak's avatar Petr Pudlak

Remove FromString in favor of Error from standard libraries

They have the very same functionality, and using our own FromString only
causes unnecessary code duplication.
Signed-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent 8d61946f
......@@ -27,7 +27,7 @@ module Ganeti.BasicTypes
, Result
, ResultT(..)
, resultT
, FromString(..)
, Error(..) -- re-export from Control.Monad.Error
, isOk
, isBad
, justOk
......@@ -74,35 +74,26 @@ genericResult _ g (Ok b) = g b
-- | 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
instance (Error a) => Monad (GenericResult a) where
(>>=) (Bad x) _ = Bad x
(>>=) (Ok x) fn = fn x
return = Ok
fail = Bad . mkFromString
fail = Bad . strMsg
instance Functor (GenericResult a) where
fmap _ (Bad msg) = Bad msg
fmap fn (Ok val) = Ok (fn val)
instance (FromString a, Monoid a) => MonadPlus (GenericResult a) where
mzero = Bad $ mkFromString "zero Result when used as MonadPlus"
instance (Error a, Monoid a) => MonadPlus (GenericResult a) where
mzero = Bad $ strMsg "zero Result when used as MonadPlus"
-- for mplus, when we 'add' two Bad values, we concatenate their
-- error descriptions
(Bad x) `mplus` (Bad y) = Bad (x `mappend` mkFromString "; " `mappend` y)
(Bad x) `mplus` (Bad y) = Bad (x `mappend` strMsg "; " `mappend` y)
(Bad _) `mplus` x = x
x@(Ok _) `mplus` _ = x
instance (FromString a) => MonadError a (GenericResult a) where
instance (Error a) => MonadError a (GenericResult a) where
throwError = Bad
catchError x h = genericResult h (const x) x
......@@ -112,7 +103,7 @@ instance Applicative (GenericResult a) where
_ <*> (Bad x) = Bad x
(Ok f) <*> (Ok x) = Ok $ f x
instance (FromString a, Monoid a) => Alternative (GenericResult a) where
instance (Error a, Monoid a) => Alternative (GenericResult a) where
empty = mzero
(<|>) = mplus
......@@ -135,33 +126,33 @@ elimResultT l r = ResultT . (runResultT . result <=< runResultT)
instance (Monad f) => Functor (ResultT a f) where
fmap f = ResultT . liftM (fmap f) . runResultT
instance (Monad m, FromString a) => Applicative (ResultT a m) where
instance (Monad m, Error a) => Applicative (ResultT a m) where
pure = return
(<*>) = ap
instance (Monad m, FromString a) => Monad (ResultT a m) where
fail err = ResultT (return . Bad $ mkFromString err)
instance (Monad m, Error a) => Monad (ResultT a m) where
fail err = ResultT (return . Bad $ strMsg err)
return = lift . return
(>>=) = flip (elimResultT throwError)
instance (Monad m, FromString a) => MonadError a (ResultT a m) where
instance (Monad m, Error a) => MonadError a (ResultT a m) where
throwError = resultT . Bad
catchError x h = elimResultT h return x
instance MonadTrans (ResultT a) where
lift = ResultT . liftM Ok
instance (MonadIO m, FromString a) => MonadIO (ResultT a m) where
instance (MonadIO m, Error a) => MonadIO (ResultT a m) where
liftIO = lift . liftIO
instance (Monad m, FromString a, Monoid a) => MonadPlus (ResultT a m) where
instance (Monad m, Error a, Monoid a) => MonadPlus (ResultT a m) where
mzero = ResultT $ return mzero
-- Ensure that 'y' isn't run if 'x' contains a value. This makes it a bit
-- more complicated than 'mplus' of 'GenericResult'.
mplus x y = elimResultT combine return x
where combine x' = ResultT $ liftM (mplus (Bad x')) (runResultT y)
instance (Monad m, FromString a, Monoid a) => Alternative (ResultT a m) where
instance (Monad m, Error a, Monoid a) => Alternative (ResultT a m) where
empty = mzero
(<|>) = mplus
......
......@@ -40,7 +40,6 @@ module Ganeti.Errors
, maybeToError
) where
import Control.Monad.Error (Error(..))
import Text.JSON hiding (Result, Ok)
import System.Exit
......@@ -113,15 +112,12 @@ $(genException "GanetiException"
])
instance Error GanetiException where
strMsg = mkFromString
strMsg = GenericError
instance JSON GanetiException where
showJSON = saveGanetiException
readJSON = loadGanetiException
instance FromString GanetiException where
mkFromString = GenericError
-- | Error monad using 'GanetiException' type alias.
type ErrorResult = GenericResult GanetiException
......
......@@ -367,11 +367,10 @@ type FailStats = [(FailMode, Int)]
-- will instead raise an exception.
type OpResult = GenericResult FailMode
-- | 'FromString' instance for 'FailMode' designed to catch unintended
-- | 'Error' instance for 'FailMode' designed to catch unintended
-- use as a general monad.
instance FromString FailMode where
mkFromString v = error $ "Programming error: OpResult used as generic monad"
++ v
instance Error FailMode where
strMsg v = error $ "Programming error: OpResult used as generic monad" ++ v
-- | Conversion from 'OpResult' to 'Result'.
opToResult :: OpResult 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