------------------------------------------------------------------------------ -- | -- Module : Data.ErrorMessage -- Copyright : (c) Gregory Crosswhite -- License : BSD-style -- Maintainer : gcross@phys.washington.edu -- Stability : provisional -- Portability : portable -- -- This philosophy behind this package is that it is often better to find out -- all of the errors that have occured in a computation and report them -- simultaneously, rather than aborting as soon as the first error is -- encountered. Towards this end, this module supplies a type of -- /combinable error messages/ so that all of the errors from subcomputations -- can be gathered and presented together. -- -- The following provides an example of how these can be used: -- -- > sqrtWithError :: Float -> Either ErrorMessage Float -- > sqrtWithError x -- > | x < 0 -- > = leftErrorMessageText -- > ("Error computing the square root of " ++ (show x) ++ ":") -- > "Square roots cannot be taken of negative numbers." -- > | otherwise -- > = Right (sqrt x) -- > -- > sumWithError :: Either ErrorMessage Float -> Either ErrorMessage Float -> Either ErrorMessage Float -- > sumWithError (Left error1) (Left error2) = Left (error1 `mappend` error2) -- > sumWithError (Left error) _ = Left error -- > sumWithError _ (Left error) = Left error -- > sumWithError (Right value1) (Right value2) = Right (value1 + value2) -- > -- > showSumOrErrorOf :: Float -> Float -> String -- > showSumOrErrorOf x y = -- > case sumWithError (sqrtWithError x) (sqrtWithError y) of -- > Right value -> "The value is " ++ show value -- > Left error -> show . formatErrorMessage $ error -- -- The result of @showSumOrErrorOf (-1) (-2)@ is the string, -- -- > Error computing the square root of -1: -- > Square roots cannot be taken of negative numbers. -- > Error computing the square root of -2: -- > Square roots cannot be taken of negative numbers. -- -- whereas the result of @showSumOrErrorOf (-1) (-1)@ is the string, -- -- > Error computing the square root of -1: -- > Square roots cannot be taken of negative numbers. -- -- Note how the error message only appears once; this is because the process -- of combining the error messages automatically eliminates all identical -- headings under the assumption that they came from the same original -- computation, as was the case here. -- -- Currently, the definition of @sumWithError@ is largely boilerplate. -- Happily, the Haskell community has done a lot of work to identify patterns -- such as these and to write libraries that allow us to express them -- concisely. In particular, a standard trick when working with errors like -- this is to express the calculation as a 'Monad', such as by using the -- following definition: -- -- > sumWithError_2 argument1 argument2 = do -- > value1 <- argument1 -- > value2 <- argument2 -- > return (value1 + value2) -- -- Or, even more concisely: -- -- > sumWithError_3 = liftM2 (+) -- -- Unfortunately though, neither of these definitions have the same semantics -- as the original @sumWithError@, as using both we get the following error -- message for @showSumOrErrorOf (-1) (-2)@: -- -- > Error computing the square root of -1: -- > Square roots cannot be taken of negative numbers. -- -- That is, we have lost the second of the two error messages. The reason -- for this is that 'Monad'-style error processing expresses the computation -- as a sequence, and gives up as soon as it sees any error. In this case of -- @sumWithError@, however, the evaluation of the second argument can proceed -- even if there was an error in the first argument. Thus, rather than using -- a 'Monad' pattern, we use an 'Applicative' pattern: -- -- > sumWithError_4 = liftA2 (+) -- -- Now both error messages are displayed. -- ------------------------------------------------------------------------------ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.ErrorMessage ( -- * The ErrorMessage Type ErrorMessage(..) -- $error_message_type -- ** Instances for ErrorMessage -- $error_message_instances -- ** Instances for Doc -- $doc_instances -- ** Applicative Instances -- $applicative_instances -- * Creation of Error Messages -- $error_message_creation ,errorMessage ,errorMessageText ,errorMessageTextFromMultilineString ,leftErrorMessage ,leftErrorMessageText ,leftErrorMessageTextFromMultilineString -- * Formatting of Error Messages -- $error_message_formatting ,formatErrorMessage ,formatMessageWithHeading -- * Gathering Results with Errors -- $gathering_results_with_errors ,gatherResultsOrErrors ,gatherResultsOrError ) where import Control.Arrow import Control.Applicative hiding (empty) import Control.Applicative.Infix import Control.Monad import Control.Monad.Error import Data.Either import Data.Either.Unwrap import Data.Function import Data.Monoid import Data.Map (Map) import qualified Data.Map as Map import Text.PrettyPrint.ANSI.Leijen newtype ErrorMessage = ErrorMessage { unwrapErrorMessage :: Map String Doc } instance (Monoid e) => Applicative (Either e) where pure = Right (<*>) (Left error2) (Left error1) = Left (error1 `mappend` error2) (<*>) (Left error) _ = Left error (<*>) _ (Left error) = Left error (<*>) (Right function) (Right argument) = Right (function argument) instance (Monoid e, Error e, Monad m) => Applicative (ErrorT e m) where pure = return e_fn <*> e_arg = ErrorT $ liftM2 (<*>) (runErrorT e_fn) (runErrorT e_arg) instance Error ErrorMessage where noMsg = strMsg "(and he did not even bother to include an error message! :-/)" strMsg = errorMessage "Error caused by the programmer:" . text instance Monoid ErrorMessage where mempty = ErrorMessage Map.empty mappend (ErrorMessage a) (ErrorMessage b) = ErrorMessage (mappend a b) mconcat = ErrorMessage . mconcat . map unwrapErrorMessage instance Error Doc where noMsg = empty strMsg = text instance Monoid Doc where mempty = empty mappend = (<$$>) mconcat = vcat -- | -- The function 'errorMessage' takes a heading and a body and produce an -- ErrorMessage object from them; this can be considered to be a thin -- wrapper around 'Data.Map.singleton'. errorMessage :: String -> Doc -> ErrorMessage errorMessage heading = ErrorMessage . Map.singleton heading -- | -- Since one usually wants to return not just an ErrorMessage, but a value of -- the form @Left error_message@, the function 'leftErrorMessage' is provided -- as a convenience; it creates the error message, and then wraps it inside -- of 'Left'. leftErrorMessage :: String -> Doc -> Either ErrorMessage a leftErrorMessage heading = Left . errorMessage heading -- | -- The function 'errorMessageText' is similar to the function 'errorMessage', -- but for the body it takes a 'String' instead of a 'Doc'. It is provided -- for convenience. errorMessageText :: String -> String -> ErrorMessage errorMessageText heading = errorMessage heading . text -- | -- The function 'leftErrorMessageText' is 'errorMessageText' composed with -- the 'Left' constructor for convenience. leftErrorMessageText :: String -> String -> Either ErrorMessage a leftErrorMessageText heading = Left . errorMessageText heading -- | -- Use this function when you want to create an error message from a -- multi-line string. -- -- Although one could alternatively use 'errorMessageText', if one were to do -- this then one would only see only the first line of be indented when the -- error message is formatted for output. For example, -- -- > errorMessageText "A poem:" "Roses are red.\nViolets are blue." -- -- produces the following (formatted) error message: -- -- > A poem: -- > Roses are red. -- > Violets are blue. -- -- The reason for this is because the line breaks are not known to the 'Doc' -- combinators, and so the indentation is not handled properly. The function -- 'errorMessageTextFromMultilineString' takes care of this for you. For -- example, -- -- > errorMessageTextFromMultilineString "A poem:" "Roses are red.\nViolets are blue." -- -- produces the following (formatted) error message: -- -- > A poem: -- > Roses are red. -- > Violets are blue. -- errorMessageTextFromMultilineString :: String -> String -> ErrorMessage errorMessageTextFromMultilineString heading = errorMessage heading . vcat . map text . lines -- | -- The function 'leftErrorMessageTextFromMultilineString' is -- 'errorMessageTextFromMultilineString' composed with the 'Left' constructor -- for convenience. leftErrorMessageTextFromMultilineString :: String -> String -> Either ErrorMessage a leftErrorMessageTextFromMultilineString heading = Left . errorMessageTextFromMultilineString heading -- | -- This function takes an 'ErrorMessage' and formats it into a 'Doc'. It -- does this by converting the headings into 'text' objects, merging them -- with their respective bodies (the latter having been indented by four -- spaces), and then concatenating the result. formatErrorMessage :: ErrorMessage -> Doc formatErrorMessage = vcat . map (uncurry formatMessageWithHeading) . Map.assocs . unwrapErrorMessage -- | -- This is the utility function used by 'formatErrorMessage' to format a -- 'Doc' given a heading and a body; it indents the body by four spaces and -- then appends it after the heading. formatMessageWithHeading :: String -> Doc -> Doc formatMessageWithHeading heading body = text heading <$$> indent 4 body -- | -- This function takes a list of values which might contain errors and -- returns either a list of the errors found in the values or the full list -- of results. Note that there is no restriction on the type of the errors. gatherResultsOrErrors :: [Either e a] -> Either [e] [a] gatherResultsOrErrors eithers = case partitionEithers (eithers) of ([],results) -> Right results (errors,_) -> Left errors -- | -- This function is similar to 'gatherResultsOrErrors', but instead of -- returning a list of errors it combines them into a single error. Note -- that only restriction on the type of the error is that it be an instance -- of 'Monoid', so this operation is not limited to 'ErrorMessage's but could -- also be used for, say, 'Doc's, as in the following example: -- -- > dictionary_mapping_words_to_lengths :: [(String,Int)] -- > dictionary_mapping_words_to_lengths = -- > [("foo",3) -- > ,("bar",3) -- > ] -- > -- > getWordLengthsOrError :: [String] -> Either ErrorMessage [Int] -- > getWordLengthsOrError = -- > mapLeft -- > (errorMessage -- > "Error looking up the following words in the dictionary:" -- > ) -- > . -- > gatherResultsOrError -- > . -- > map lookupAndReturnResultOrError -- -- The function call -- -- > getWordLengthsOrError ["foo","apple","cat","bar"] -- -- results in the following error message: -- -- > Error looking up the following words in the dictionary: -- > apple -- > cat -- gatherResultsOrError :: Monoid e => [Either e a] -> Either e [a] gatherResultsOrError = mapLeft mconcat . gatherResultsOrErrors -- $error_message_type -- The 'ErrorMessage' type is simply a map from 'String' to 'Doc'; the reason -- why the values are 'Doc' is because this allows us to compose them using -- the combinators in Leijen's pretty-printing library. -- -- The reason why the internal type is a 'Map' rather than a List is because -- we /assume/ that error message headings are unique, and so if we see the -- same heading it must have come from the same error. If we did not make -- such an assumption, then we would have no way of preventing the same error -- from appearing several times in the message in the case that many -- sub-computations all depended on the same erroneous result. -- $error_message_instances -- In some respects, the most important part of the 'ErrorMessage' type are -- its instances: -- -- * The 'Monoid' instance says that we can take any two error messages and -- combine them using 'mappend' and/or 'mconcat'; the implementation for -- this is just that of the underlying Map type. -- -- * The 'Error' instance allows us to work inside the 'ErrorT' monad using -- 'ErrorMessage' as the error type. Although it was mentioned earlier that -- using 'Applicative' is generally preferable since it finds as many errors -- as possible before halting, there are times when a later computation -- really does need the result of an earlier computation, and in this case -- the sequential structure of 'Monad's exactly fits the bill. -- -- Note that in order for 'ErrorMessage' to be an instance of 'Error', I -- needed to define how to create an 'ErrorMessage' without a heading -- ('strMsg') and possibly without even a body ('noMsg'); however, if this -- ever happens, it means that the error was not handled properly --- e.g., -- when there is a pattern match failure. Thus, the heading of errors -- created by 'noMsg' and 'strMsg' is -- /Error caused by the programmer:/ -- $doc_instances -- Unfortunately, it does not show up in the API documentation that this -- module also defines the following two instances for 'Doc': -- -- * The 'Monoid' instance says that we can combine any two 'Doc's by -- concatenating them vertically. -- -- * The 'Error' instance defines a 'noMsg' error to be the 'empty' 'Doc' and -- the 'strMsg' error to be a 'text' 'Doc'. -- -- $applicative_instances -- Unfortunately, it does not show up in the API documentation that this -- module also defines the following two 'Applicative' instances: -- -- > instance (Monoid e) => Applicative (Either e) where ... -- -- This instance declaration allows you to lift pure functions into functions -- that work with values that might have errors, since both 'Doc' and -- 'ErrorMessage' are instances of 'Monoid'. For example, we can use -- @liftA2 (+)@ to lift the @(+)@ function into a function that checks both -- of its arguments for errors before computing the sum. As was described -- earlier, the advantage of @liftA2 (+)@ over @liftM2 (+)@ is that the -- former checks for errors in both arguments and will combine them if -- present, whereas the latter will ignore errors in the second argument if -- there is an error in the first argument. -- -- > instance (Monoid e, Error e, Monad m) => Applicative (ErrorT e m) where -- > pure = return -- > e_fn <*> e_arg = ErrorT $ liftM2 (<*>) (runErrorT e_fn) (runErrorT e_arg) -- -- This instance definition lifts the @Applicative (Either e)@ so that it -- works for values obtained from monadic computations. Note that the -- definition first executes the monad @e_fn@ and then the monad @e_arg@, and -- only after both monads have been executed in this sequence does it apply -- the operator @(\<*\>)@ to the values in order to possibly combine their -- error messages. -- -- These instances allow you to write code like the following: -- -- > data Point = Point { x :: Int, y :: Int, z :: Int } -- > -- > pOrError = Point <$> xOrError <*> yOrError <*> zOrError -- -- The value @pOrError@ is either a @Point@, or a combination of the error -- messages in @xOrError@, @yOrError@, and @zOrError@. -- -- $error_message_creation -- Up to now we have spent a lot time discussing how to combine -- 'ErrorMessage's, but little time discussing how to produce them. The -- provided functions for doing this are as follows: -- $error_message_formatting -- The end purpose of 'ErrorMessage' \'s existence is to be displayed to the -- user. Towards this end, the following functions format an 'ErrorMessage' -- into a 'Doc'. -- $gathering_results_with_errors -- Although there are many combinators available (such as 'liftA' and \<$\>) -- for lifting pure functions to functions that handle errors, there are -- times when one wants to gather together a list of results which might -- possibly contain some errors. The following functions assist in doing -- this.