diff --git a/Data/ErrorMessage.hs b/Data/ErrorMessage.hs new file mode 100644 --- /dev/null +++ b/Data/ErrorMessage.hs @@ -0,0 +1,424 @@ +------------------------------------------------------------------------------ +-- | +-- 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. + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2009 Gregory M. Crosswhite +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,24 @@ +import Control.Monad +import Distribution.Simple +import System.Exit +import System.IO +import System.Process +import Text.Printf + +main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests}) + +runzeTests _ _ _ _= do + putStrLn "Checking for required modules..." + found <- forM ["test-framework","test-framework-hunit"] $ \package_name -> do + putStr $ printf "Checking for package %s... " package_name + hFlush stdout + error_code <- system $ printf "ghc-pkg field %s version" package_name + return (error_code == ExitSuccess) + when ((not.and) found) $ do + putStrLn "One or more packages needed for testing was not found." + exitWith $ ExitFailure 1 + putStrLn "" + putStrLn "Running tests..." + putStrLn "" + system "runhaskell -i. -i./tests tests/runtests.hs" + return () diff --git a/error-message.cabal b/error-message.cabal new file mode 100644 --- /dev/null +++ b/error-message.cabal @@ -0,0 +1,31 @@ +Name: error-message +Version: 1.0 +Cabal-Version: >= 1.6 +License: BSD3 +License-File: LICENSE +Author: Gregory Crosswhite +Copyright: (c) 2009 Gregory Crosswhite +Maintainer: gcross@phys.washington.edu +Stability: stable +Homepage: http://github.com/gcross/error-message +Category: Distribution +Synopsis: Composable error messages. +Build-Type: Simple +Description: + 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. +Extra-Source-Files: tests/runtests.hs + +Library + Exposed: True + Exposed-Modules: Data.ErrorMessage + Build-Depends: base == 4.*, + mtl == 1.*, + containers == 0.2.*, + either-unwrap >= 1.1 && < 2, + InfixApplicative == 1.*, + ansi-wl-pprint == 0.5.* diff --git a/tests/runtests.hs b/tests/runtests.hs new file mode 100644 --- /dev/null +++ b/tests/runtests.hs @@ -0,0 +1,188 @@ +import Control.Applicative +import Control.Monad + +import Data.Either.Unwrap +import Data.ErrorMessage +import Data.Monoid + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit + +import Text.PrettyPrint.ANSI.Leijen + +dictionary_mapping_words_to_lengths :: [(String,Int)] +dictionary_mapping_words_to_lengths = + [("foo",3) + ,("bar",3) + ] +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) + +sumWithError_2 argument1 argument2 = do + value1 <- argument1 + value2 <- argument2 + return (value1 + value2) +sumWithError_3 = liftM2 (+) +sumWithError_4 :: Either ErrorMessage Float -> Either ErrorMessage Float -> Either ErrorMessage Float +sumWithError_4 = liftA2 (+) +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 +showSumOrErrorOf_2 :: Float -> Float -> String +showSumOrErrorOf_2 x y = + case sumWithError_2 (sqrtWithError x) (sqrtWithError y) of + Right value -> "The value is " ++ show value + Left error -> show . formatErrorMessage $ error +showSumOrErrorOf_3 :: Float -> Float -> String +showSumOrErrorOf_3 x y = + case sumWithError_3 (sqrtWithError x) (sqrtWithError y) of + Right value -> "The value is " ++ show value + Left error -> show . formatErrorMessage $ error +showSumOrErrorOf_4 :: Float -> Float -> String +showSumOrErrorOf_4 x y = + case sumWithError_4 (sqrtWithError x) (sqrtWithError y) of + Right value -> "The value is " ++ show value + Left error -> show . formatErrorMessage $ error +lookupAndReturnResultOrError :: String -> Either Doc Int +lookupAndReturnResultOrError word = + case lookup word dictionary_mapping_words_to_lengths of + Nothing -> Left (text word) + Just word_length -> Right word_length +getWordLengthsOrError :: [String] -> Either ErrorMessage [Int] +getWordLengthsOrError = + mapLeft + (errorMessage + "Error looking up the following words in the dictionary:" + ) + . + gatherResultsOrError + . + map lookupAndReturnResultOrError + + +main = defaultMain $ + [testGroup "Documentation examples" + [testGroup "showSumOrErrorOf" $ + [testCase "(-1) (-2)" $ + assertEqual + "Was the expected message produced?" + (show . vcat . map text $ + ["Error computing the square root of -1.0:" + ," Square roots cannot be taken of negative numbers." + ,"Error computing the square root of -2.0:" + ," Square roots cannot be taken of negative numbers." + ] + ) + $ + showSumOrErrorOf (-1) (-2) + ,testCase "(-1) (-1)" $ + assertEqual + "Was the expected message produced?" + (show . vcat . map text $ + ["Error computing the square root of -1.0:" + ," Square roots cannot be taken of negative numbers." + ] + ) + $ + showSumOrErrorOf (-1) (-1) + ] + ,testGroup "showSumOrErrorOf_2" $ + [testCase "(-1) (-2)" $ + assertEqual + "Was the expected message produced?" + (show . vcat . map text $ + ["Error computing the square root of -1.0:" + ," Square roots cannot be taken of negative numbers." + ] + ) + $ + showSumOrErrorOf_2 (-1) (-2) + ] + ,testGroup "showSumOrErrorOf_3" $ + [testCase "(-1) (-2)" $ + assertEqual + "Was the expected message produced?" + (show . vcat . map text $ + ["Error computing the square root of -1.0:" + ," Square roots cannot be taken of negative numbers." + ] + ) + $ + showSumOrErrorOf_3 (-1) (-2) + ] + ,testGroup "showSumOrErrorOf_3" $ + [testCase "(-1) (-2)" $ + assertEqual + "Was the expected message produced?" + (show . vcat . map text $ + ["Error computing the square root of -1.0:" + ," Square roots cannot be taken of negative numbers." + ,"Error computing the square root of -2.0:" + ," Square roots cannot be taken of negative numbers." + ] + ) + $ + showSumOrErrorOf_4 (-1) (-2) + ] + ,testCase "getWordLengthsOrError" $ + assertEqual + "Was the expected message produced?" + (Left . show . vcat . map text $ + ["Error looking up the following words in the dictionary:" + ," apple" + ," cat" + ] + ) + . + mapLeft (show . formatErrorMessage) + $ + getWordLengthsOrError ["foo","apple","cat","bar"] + + ,testGroup "Multiline strings" $ + [testCase "errorMessageText" $ + assertEqual + "Was the expected message produced?" + (show . vcat . map text $ + ["A poem:" + ," Roses are red." + ,"Violets are blue." + ] + ) + . + show + . + formatErrorMessage + $ + errorMessageText "A poem:" "Roses are red.\nViolets are blue." + ,testCase "errorMessageTextFromMultilineString" $ + assertEqual + "Was the expected message produced?" + (show . vcat . map text $ + ["A poem:" + ," Roses are red." + ," Violets are blue." + ] + ) + . + show + . + formatErrorMessage + $ + errorMessageTextFromMultilineString "A poem:" "Roses are red.\nViolets are blue." + ] + ] + ]