X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FHeartbeat.hs;h=8fafba1c6c80d6435793a1345ab733329ebfc9a9;hb=22ef5496c109815e1c97d9350181b4a96145fb94;hp=7c62445d1e81f22d1f7788580ceedfcd7fa2683a;hpb=ef96e8bf0cadf5d602022f8c91914d3cabeb35a0;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/Heartbeat.hs b/src/TSN/XML/Heartbeat.hs index 7c62445..8fafba1 100644 --- a/src/TSN/XML/Heartbeat.hs +++ b/src/TSN/XML/Heartbeat.hs @@ -3,11 +3,14 @@ -- | 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 ) @@ -23,28 +26,36 @@ import Text.XML.HXT.Core ( -- 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, @@ -60,11 +71,15 @@ verify :: XmlTree -> IO ImportResult 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 @@ -73,8 +88,9 @@ heartbeat_tests = 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 =