1 {-# LANGUAGE ScopedTypeVariables #-}
3 -- | Handle documents defined by Heartbeat.dtd.
5 module TSN.XML.Heartbeat (
13 import Data.Tuple.Curry ( uncurryN )
14 import Test.Tasty ( TestTree, testGroup )
15 import Test.Tasty.HUnit ( (@?=), testCase )
16 import Text.XML.HXT.Core (
27 import TSN.DbImport ( ImportResult(..) )
28 import Xml ( pickle_unpickle, unpickleable )
31 -- | The DTD to which this module corresponds.
36 -- | The data structure that holds the XML representation of a
43 time_stamp :: String }
47 -- | A (un)pickler that turns a Heartbeat XML file into a 'Message'
50 pickle_message :: PU Message
53 xpWrap (from_tuple, to_tuple) $
54 xpTriple (xpElem "XML_File_ID" xpInt)
55 (xpElem "heading" xpText)
56 (xpElem "time_stamp" xpText)
58 from_tuple = uncurryN Message
59 to_tuple m = (xml_file_id m,
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.
68 verify :: XmlTree -> IO ImportResult
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."
79 -- | A list of all tests for this module.
81 heartbeat_tests :: TestTree
85 [ test_pickle_of_unpickle_is_identity,
86 test_unpickle_succeeds ]
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.
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
101 -- | Make sure we can unpickle the sample file.
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