Descriptions.hs

module Test.HUnit.Gui.Descriptions (describeError, describeFailure, describePath)
where

import List
import Maybe
import Test.HUnit.Base

describeError :: String -> State -> String
describeError = describeProblem

describeFailure :: String -> State -> String
describeFailure = describeProblem

describeProblem :: String -> State -> String
describeProblem msg state =
    let path' = path state
    in if null path'
       then msg
       else (describePath path') ++ ":\n" ++ msg

describePath :: Path -> String
describePath [] = "?"
describePath p = case labels of [] -> prettyPrint listItems
                                _ -> concat [prettyPrint labels, " (", prettyPrint listItems, ")"]
    where
          prettyPrint = concat . intersperse ":" . reverse
          deListItem (ListItem i) = Just $ show i
          deListItem _ = Nothing
          deLabel (Label str) = Just str
          deLabel _ = Nothing
          escapeChar '\'' = ("\\'" ++)
          escapeChar c = (c:)
          prettyPrintLabel l = if ':' `elem` l
                               then "'" ++ (foldr escapeChar "" l) ++ "'"
                               else l
          labels = map prettyPrintLabel $ catMaybes $ map deLabel p
          listItems = catMaybes $ map deListItem p