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: Iustin Pop <iustin@google.com>
Reviewed-by: Michael Hanselmann <hansmi@google.com>

diff --git a/htest/Test/Ganeti/BasicTypes.hs b/htest/Test/Ganeti/BasicTypes.hs
index d3ae51f..af90b0e 100644 (file)
--- a/htest/Test/Ganeti/BasicTypes.hs
+++ b/htest/Test/Ganeti/BasicTypes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-| Unittests for ganeti-htools.

diff --git a/htest/Test/Ganeti/JSON.hs b/htest/Test/Ganeti/JSON.hs
index 6279520..a5477a5 100644 (file)
--- a/htest/Test/Ganeti/JSON.hs
+++ b/htest/Test/Ganeti/JSON.hs
@@ -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
 

diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs
index 27796fc..d61cfb8 100644 (file)
--- a/htest/Test/Ganeti/TestCommon.hs
+++ b/htest/Test/Ganeti/TestCommon.hs
@@ -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

diff --git a/htools/Ganeti/BasicTypes.hs b/htools/Ganeti/BasicTypes.hs
index d688a9c..8f29f33 100644 (file)
--- a/htools/Ganeti/BasicTypes.hs
+++ b/htools/Ganeti/BasicTypes.hs
@@ -1,3 +1,5 @@
+{-# 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