content: -- |
  -- HUnit - Haskell XML Toolbox examples and tests for arrows
  --
  -- Author: Uwe Schmidt uwe@fh-wedel.de
  --
  
  module Main where
  
  import System
  import Test.HUnit
  import Text.XML.HXT.Core
  import Text.XML.HXT.XPath
  
  
  -- |
  -- auxiliary function to make haskell string constants with quotes more readable
  
  singleToDoubleQuote     :: String -> String
  singleToDoubleQuote
      = map (\ c -> if c == '\'' then '\"' else c)
  
  testLA  :: String -> String -> LA XmlTree XmlTree -> Test
  testLA doc expected f
      = TestCase $ assertEqual "LA XmlTree XmlTree:" [expected] res
        where
        res = runLA (xread >>> xshow f) doc
  
  testLAString    :: String -> String -> LA XmlTree String -> Test
  testLAString doc expected f
      = TestCase $ assertEqual "LA XmlTree String:" [expected] res
        where
        res = runLA (xread >>> f) doc
  
  mkTestSeqLA     :: String -> [(String, LA XmlTree XmlTree)] -> [Test]
  mkTestSeqLA doc
      = map (\ (res, f) -> testLA doc (singleToDoubleQuote res) f)
  
  nodeSetTests    :: Test
  nodeSetTests
      = TestList $
        [ TestLabel "node set and simple XPath tests with getXPathTrees" $
          TestList $
          mkTestSeqLA doc (testGetXPathTrees tests)
  
        , TestLabel "node set and simple XPath tests with getXPathNodeSet" $
          TestList $
          mkTestSeqLA doc (testGetXPathNodes tests)
  
        , TestLabel "node set and simple XPath tests with processFromNodeSet" $
          TestList $
          mkTestSeqLA doc (testProcessXPath processTests)
  
        , TestLabel "node set and simple XPath tests with processXPathTrees" $
          TestList $
          mkTestSeqLA doc (testProcessXPath' processTests)
        ]
      where
      doc = "<x p='.'>.0<x p='.1'>.1.0</x>.2<y p='.3'>.3.0<x p='.3.1'>.3.1.0</x></y>.4</x>"
  
      testGetXPathTrees = map (\ (r, xp) -> (r, getXPathTrees xp))                        -- these arrows are equivalent
      testGetXPathNodes = map (\ (r, xp) -> (r, getFromNodeSet $< getXPathNodeSet xp))    -- except for the ordering of the result set
                                                                                          -- which does not matter for these tests
      testProcessXPath  = map (\ (r, xp, a) -> (r, processFromNodeSet a $< getXPathNodeSet xp))
      testProcessXPath' = map (\ (r, xp, a) -> (r, processXPathTrees a xp))
  
      tests = [ (doc                                              , "/x"  )
              , ("<y p='.3'>.3.0<x p='.3.1'>.3.1.0</x></y>"       , "/x/y"        )
              , ("<x p='.3.1'>.3.1.0</x>"                         , "/x/y/x"      )
              , (".0.2.4"                                         , "/x/text()"   )
              , (".3.0"                                           , "/x/y/text()" )
              , ("<x p='.1'>.1.0</x><x p='.3.1'>.3.1.0</x>"       , "/x//x"       )
              ]
  
      processTests
           = [ ("<x p='.'>x<x p='.1'>x</x>x<y p='.3'>x<x p='.3.1'>x</x></y>x</x>",          "//text()",           changeText (const "x")  )
             , ("<x p='.'>.0<x p='.1'>.1.0</x>.2<y p='.3'>.3.0<x p='.3.1'>x</x></y>.4</x>", "/x/y/x/text()",      changeText (const "x")  )
             , ("<x p='.'>.0<x p='.1'>.1.0</x>.2<y p='.3'>.3.0</y>.4</x>",                  "/x/y/x",             none                    )
             , ("<x p='.'>.0<x p='.1'>.1.0</x>.2<y p='.3'>.3.0zzz</y>.4</x>",               "/x/y/x",             txt "zzz"               )
             , ("<x p='.'>.0<x p='.1'>.1.0</x>.2<y p='.3'>.3.0<x p='.3.1' q='3.2'>.3.1.0</x></y>.4</x>",
                                                                                            "/x/y/x",             addAttr "q" "3.2"       )
             ]
  -- |
  -- the complete set of test cases
  
  allTests        :: Test
  allTests
      = TestList
        [ nodeSetTests
        ]
  
  main    :: IO ()
  main
      = do
        c <- runTestTT allTests
        putStrLn $ show c
        let errs = errors c
            fails = failures c
        System.exitWith (codeGet errs fails)
  
  codeGet :: Int -> Int -> ExitCode
  codeGet errs fails
      | fails > 0       = ExitFailure 2
      | errs > 0        = ExitFailure 1
      | otherwise       = ExitSuccess
  
  -- ----------------------------------------------------------
  