-- @+leo-ver=4-thin
-- @+node:gcross.20091202203048.6990:@thin runtests.hs
-- @@language Haskell

-- @<< Import needed modules >>
-- @+node:gcross.20091202203048.6992:<< Import needed modules >>
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
-- @-node:gcross.20091202203048.6992:<< Import needed modules >>
-- @nl

-- @+others
-- @+node:gcross.20091202203048.7047:Values
-- @+node:gcross.20091202203048.7049:dictionary_mapping_words_to_lengths
dictionary_mapping_words_to_lengths :: [(String,Int)]
dictionary_mapping_words_to_lengths =
    [("foo",3)
    ,("bar",3)
    ]
-- @-node:gcross.20091202203048.7049:dictionary_mapping_words_to_lengths
-- @-node:gcross.20091202203048.7047:Values
-- @+node:gcross.20091202203048.6995:Functions
-- @+node:gcross.20091202203048.7002:sqrtWithError
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)
-- @nonl
-- @-node:gcross.20091202203048.7002:sqrtWithError
-- @+node:gcross.20091202203048.7013:sumWithError
-- @+node:gcross.20091202203048.7001:sumWithError
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)

-- @-node:gcross.20091202203048.7001:sumWithError
-- @+node:gcross.20091202203048.7006:sumWithError_2
sumWithError_2 argument1 argument2 = do
    value1 <- argument1
    value2 <- argument2
    return (value1 + value2)
-- @-node:gcross.20091202203048.7006:sumWithError_2
-- @+node:gcross.20091202203048.7012:sumWithError_3
sumWithError_3 = liftM2 (+)
-- @-node:gcross.20091202203048.7012:sumWithError_3
-- @+node:gcross.20091202203048.7020:sumWithError_4
sumWithError_4 :: Either ErrorMessage Float -> Either ErrorMessage Float -> Either ErrorMessage Float
sumWithError_4 = liftA2 (+)
-- @-node:gcross.20091202203048.7020:sumWithError_4
-- @-node:gcross.20091202203048.7013:sumWithError
-- @+node:gcross.20091202203048.7014:showSumOrErrorOf
-- @+node:gcross.20091202203048.6997:showSumOrErrorOf
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
-- @nonl
-- @-node:gcross.20091202203048.6997:showSumOrErrorOf
-- @+node:gcross.20091202203048.7016:showSumOrErrorOf_2
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
-- @-node:gcross.20091202203048.7016:showSumOrErrorOf_2
-- @+node:gcross.20091202203048.7018:showSumOrErrorOf_3
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
-- @-node:gcross.20091202203048.7018:showSumOrErrorOf_3
-- @+node:gcross.20091202203048.7024:showSumOrErrorOf_4
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
-- @-node:gcross.20091202203048.7024:showSumOrErrorOf_4
-- @-node:gcross.20091202203048.7014:showSumOrErrorOf
-- @-node:gcross.20091202203048.6995:Functions
-- @-others

main = defaultMain $
    -- @    << Tests >>
    -- @+node:gcross.20091202203048.6996:<< Tests >>
    -- @+others
    -- @+node:gcross.20091202203048.6993:Documentation examples
    [testGroup "Documentation examples"
        -- @    @+others
        -- @+node:gcross.20091202203048.6994:showSumOrErrorOf
        [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)
            ]
        -- @-node:gcross.20091202203048.6994:showSumOrErrorOf
        -- @+node:gcross.20091202203048.7008:showSumOrErrorOf_2
        ,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)
            ]
        -- @-node:gcross.20091202203048.7008:showSumOrErrorOf_2
        -- @+node:gcross.20091202203048.7010:showSumOrErrorOf_3
        ,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)
            ]
        -- @-node:gcross.20091202203048.7010:showSumOrErrorOf_3
        -- @+node:gcross.20091202203048.7022:showSumOrErrorOf_4
        ,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)
            ]
        -- @-node:gcross.20091202203048.7022:showSumOrErrorOf_4
        -- @+node:gcross.20091203120301.1651:Multiline strings
        ,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."
            ]
        -- @-node:gcross.20091203120301.1651:Multiline strings
        -- @-others
        ]
    -- @-node:gcross.20091202203048.6993:Documentation examples
    -- @-others
    -- @nonl
    -- @-node:gcross.20091202203048.6996:<< Tests >>
    -- @nl
    ]
-- @-node:gcross.20091202203048.6990:@thin runtests.hs
-- @-leo