module Parser
  ( testResults
  , TestCase
  , TestResult(..)
  , FailureReason
  , testCase
  , testId
  , testResult
  , failureMessage
  , stackTrace
  ) where

import Prelude hiding (lookup)

import Data.Functor   ((<$>))
import Data.Map       (lookup)
import Data.Maybe     (fromMaybe)
import Data.Text      (pack, unpack, Text, append, strip)
import Text.XML       (parseText, def, documentRoot, Element(Element),
                       nameLocalName, Node(NodeContent, NodeElement),
                       Name(Name))

import qualified Data.Text.Lazy as L

-- type to hold why a specific test failed
data FailureReason = FailureReason
                   { failureMessage :: Text
                   , stackTrace :: Text
                   }
                   deriving (Show, Eq)

-- type to hold a general test result
data TestResult = TestSuccess
                | TestFailure FailureReason
                | UnknownResult Text
                deriving (Show, Eq)

-- type to hold data for a general test case
data TestCase = TestCase
              { testCase :: Text
              , testId :: Int
              , testResult :: TestResult
              }
              deriving (Show, Eq)

-- parses the contents of a TestResults file
testResults :: String -> Either String [TestCase]
testResults results =
  case parseText def (L.pack results) of
       Left _    -> Left "could not parse"
       Right doc -> Right $ accumulateResults (documentRoot doc)

-- given an XML root element, find all <test-case> elements and try to extract
-- success/failure
accumulateResults :: Element -> [TestCase]
accumulateResults (Element name a nodes) =
  case nameLocalName name of
       "test-case" -> return $ TestCase name' (read (unpack id)) testresult
       _           -> concatMap accumulateResults children
  where children = elements nodes
        name' = fromMaybe "" (a !? "name")
        id = fromMaybe "?" (a !? "id")
        testresult = case fromMaybe "result not found" (a !? "result") of
                          "Passed" -> TestSuccess
                          "Failed" -> TestFailure reason
                          res      -> UnknownResult res
        reason = case filter (/= Nothing) (findFailure <$> children) of
                      (Just f:_) -> f
                      _          -> FailureReason
                                    "<malformed xml>"
                                    "<malformed xml>"

-- attempts to find a failure reason for a test that failed
findFailure :: Element -> Maybe FailureReason
findFailure (Element name a nodes) =
  case nameLocalName name of
       "failure" -> Just $ FailureReason message stacktrace
       _         -> case filter (/= Nothing) (findFailure <$> children) of
                         (f:_) -> f
                         _     -> Nothing
  where children = elements nodes
        message = strip . fromMaybe "<no message found>" $
          case filter (/= Nothing) (findTag "message" <$> children) of
               (m:_) -> m
               _     -> Nothing
        stacktrace = strip . fromMaybe "<no stack trace found>" $
          case filter (/= Nothing) (findTag "stack-trace" <$> children) of
               (m:_) -> m
               _     -> Nothing

-- attempts to retrieve tag data given an element and tag
findTag :: Text -> Element ->  Maybe Text
findTag tag (Element name a nodes) =
  if nameLocalName name == tag then
    -- nodes should not be empty lists because every xml tag technically has
    -- some text
    fromContent (head nodes)
  else
    case filter (/= Nothing) (findTag tag <$> children) of
         (m:_) -> m
         _     -> Nothing
  where children = elements nodes

-- gets all the xml elements from a list of xml nodes
elements :: [Node] -> [Element]
elements [] = []
elements (NodeElement e:es) = e : elements es
elements (_:es) = elements es

-- extracts content from a node
fromContent :: Node -> Maybe Text
fromContent (NodeContent t) = Just t
fromContent _ = Nothing

-- shorthand for hashmap lookup that returns a Maybe type
(!?) = flip lookup