src/TSN/XML/Heartbeat.hs

   1 {-# LANGUAGE ScopedTypeVariables #-}
   2
   3 -- | Handle documents defined by Heartbeat.dtd.
   4 --
   5 module TSN.XML.Heartbeat (
   6   dtd,
   7   verify,
   8   -- * Tests
   9   heartbeat_tests )
  10 where
  11
  12 -- System imports.
  13 import Data.Tuple.Curry ( uncurryN )
  14 import Test.Tasty ( TestTree, testGroup )
  15 import Test.Tasty.HUnit ( (@?=), testCase )
  16 import Text.XML.HXT.Core (
  17   PU,
  18   unpickleDoc,
  19   XmlTree,
  20   xpTriple,
  21   xpElem,
  22   xpInt,
  23   xpText,
  24   xpWrap )
  25
  26 -- Local imports.
  27 import TSN.DbImport ( ImportResult(..) )
  28 import Xml ( pickle_unpickle, unpickleable )
  29
  30
  31 -- | The DTD to which this module corresponds.
  32 --
  33 dtd :: String
  34 dtd = "Heartbeat.dtd"
  35
  36 -- | The data structure that holds the XML representation of a
  37 --   Heartbeat message.
  38 --
  39 data Message =
  40   Message {
  41     xml_file_id :: Int,
  42     heading :: String,
  43     time_stamp :: String }
  44   deriving (Eq, Show)
  45
  46
  47 -- | A (un)pickler that turns a Heartbeat XML file into a 'Message'
  48 --   and vice-versa.
  49 --
  50 pickle_message :: PU Message
  51 pickle_message =
  52   xpElem "message" $
  53     xpWrap (from_tuple, to_tuple) $
  54     xpTriple (xpElem "XML_File_ID" xpInt)
  55              (xpElem "heading" xpText)
  56              (xpElem "time_stamp" xpText)
  57   where
  58     from_tuple = uncurryN Message
  59     to_tuple m = (xml_file_id m,
  60                   heading m,
  61                   time_stamp m)
  62
  63
  64 -- | Verify (and report) the received heartbeat. We return
  65 --   'ImportSkipped' because we want to indicate that we processed the
  66 --   file but there was nothing to import.
  67 --
  68 verify :: XmlTree -> IO ImportResult
  69 verify xml = do
  70   let root_element = unpickleDoc pickle_message xml
  71   return $ case root_element of
  72     Nothing -> ImportFailed "Could not unpickle document to be verified."
  73     Just _  -> ImportSkipped "Heartbeat received. Thump."
  74
  75 --
  76 -- Tasty Tests
  77 --
  78
  79 -- | A list of all tests for this module.
  80 --
  81 heartbeat_tests :: TestTree
  82 heartbeat_tests =
  83   testGroup
  84     "Heartbeat tests"
  85     [ test_pickle_of_unpickle_is_identity,
  86       test_unpickle_succeeds ]
  87
  88
  89 -- | If we unpickle something and then pickle it, we should wind up
  90 --   with the same thing we started with. WARNING: success of this
  91 --   test does not mean that unpickling succeeded.
  92 --
  93 test_pickle_of_unpickle_is_identity :: TestTree
  94 test_pickle_of_unpickle_is_identity =
  95   testCase "pickle composed with unpickle is the identity" $ do
  96     let path = "test/xml/Heartbeat.xml"
  97     (expected :: [Message], actual) <- pickle_unpickle pickle_message path
  98     actual @?= expected
  99
 100
 101 -- | Make sure we can unpickle the sample file.
 102 --
 103 test_unpickle_succeeds :: TestTree
 104 test_unpickle_succeeds =
 105   testCase "unpickling succeeds" $ do
 106   let path = "test/xml/Heartbeat.xml"
 107   actual <- unpickleable path pickle_message
 108   let expected = True
 109   actual @?= expected