packages feed

error-message (empty) → 1.0

raw patch · 5 files changed

+693/−0 lines, 5 filesdep +InfixApplicativedep +ansi-wl-pprintdep +basesetup-changed

Dependencies added: InfixApplicative, ansi-wl-pprint, base, containers, either-unwrap, mtl

Files

+ Data/ErrorMessage.hs view
@@ -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.+
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -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 ()
+ error-message.cabal view
@@ -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.*
+ tests/runtests.hs view
@@ -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."+            ]+        ]+    ]