src/TSN/Xml.hs

   1 -- | Minimal XML functionality needed to parse each document's
   2 --   XML_File_ID.
   3 --
   4 module TSN.Xml (
   5   parse_xmlfid,
   6   xml_prologue,
   7   xml_tests )
   8 where
   9
  10 import Data.Maybe ( listToMaybe, mapMaybe )
  11 import Test.Tasty ( TestTree, testGroup )
  12 import Test.Tasty.HUnit ( (@?=), Assertion, testCase )
  13 import Text.Read ( readMaybe )
  14 import Text.XML.HXT.Core (
  15   (>>>),
  16   (/>),
  17   getChildren,
  18   getText,
  19   hasName,
  20   runLA,
  21   xreadDoc )
  22
  23 -- | A tiny parser written in HXT to extract the "XML_File_ID" element
  24 --   from a document.
  25 parse_xmlfid :: String -> Maybe Integer
  26 parse_xmlfid =
  27   listToMaybe . mapMaybe readMaybe . parse
  28   where
  29     parse :: String -> [String]
  30     parse =
  31       runLA (xreadDoc
  32                >>> hasName "message"
  33                />  hasName "XML_File_ID"
  34                >>> getChildren
  35                >>> getText)
  36
  37
  38 -- | The opening "tag" for the XML prologue.
  39 xml_prologue :: String
  40 xml_prologue = "<?xml "
  41
  42
  43 -- * Tasty Tests
  44 xml_tests :: TestTree
  45 xml_tests =
  46   testGroup
  47     "XML tests"
  48     [ xml_file_id_tests ]
  49
  50
  51 xml_file_id_tests :: TestTree
  52 xml_file_id_tests =
  53   testCase "XML_File_ID is parsed correctly" $ do
  54     let xmlfids = ["19908216", "19908216", "19908245", "19908246", "19908247"]
  55     mapM_ check xmlfids
  56   where
  57     check :: String -> Assertion
  58     check xmlfid = do
  59       xml <- readFile ("test/xml/" ++ xmlfid ++ ".xml")
  60       let actual = parse_xmlfid xml
  61       let expected = readMaybe xmlfid
  62       actual @?= expected