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