-- | Handle documents defined by Heartbeat.dtd.
--
module TSN.XML.Heartbeat (
- heartbeat_tests,
- verify )
+ dtd,
+ verify,
+ -- * Tests
+ heartbeat_tests )
where
-- System imports.
+import Data.Time.Clock ( UTCTime )
import Data.Tuple.Curry ( uncurryN )
import Test.Tasty ( TestTree, testGroup )
import Test.Tasty.HUnit ( (@?=), testCase )
import Text.XML.HXT.Core (
PU,
unpickleDoc,
- XmlPickler(..),
XmlTree,
xpTriple,
xpElem,
-- Local imports.
import TSN.DbImport ( ImportResult(..) )
+import TSN.Picklers ( xp_time_stamp )
import Xml ( pickle_unpickle, unpickleable )
+-- | The DTD to which this module corresponds.
+--
+dtd :: String
+dtd = "Heartbeat.dtd"
+
-- | The data structure that holds the XML representation of a
-- Heartbeat message.
+--
data Message =
Message {
xml_file_id :: Int,
heading :: String,
- time_stamp :: String }
+ time_stamp :: UTCTime }
deriving (Eq, Show)
-- | A (un)pickler that turns a Heartbeat XML file into a 'Message'
-- and vice-versa.
+--
pickle_message :: PU Message
pickle_message =
xpElem "message" $
xpWrap (from_tuple, to_tuple) $
xpTriple (xpElem "XML_File_ID" xpInt)
(xpElem "heading" xpText)
- (xpElem "time_stamp" xpText)
+ (xpElem "time_stamp" xp_time_stamp)
where
from_tuple = uncurryN Message
to_tuple m = (xml_file_id m,
verify xml = do
let root_element = unpickleDoc pickle_message xml
return $ case root_element of
- Nothing -> ImportFailed "Could not unpickle document in import_generic."
+ Nothing -> ImportFailed "Could not unpickle document to be verified."
Just _ -> ImportSkipped "Heartbeat received. Thump."
+--
+-- Tasty Tests
+--
--- * Tasty Tests
+-- | A list of all tests for this module.
+--
heartbeat_tests :: TestTree
heartbeat_tests =
testGroup
test_unpickle_succeeds ]
--- | Warning: succeess of this test does not mean that unpickling
--- succeeded.
+-- | If we unpickle something and then pickle it, we should wind up
+-- with the same thing we started with. WARNING: success of this
+-- test does not mean that unpickling succeeded.
--
test_pickle_of_unpickle_is_identity :: TestTree
test_pickle_of_unpickle_is_identity =