1 {-# LANGUAGE ScopedTypeVariables #-}
3 -- | Handle documents defined by Heartbeat.dtd.
5 module TSN.XML.Heartbeat (
11 import Data.Tuple.Curry ( uncurryN )
12 import Test.Tasty ( TestTree, testGroup )
13 import Test.Tasty.HUnit ( (@?=), testCase )
14 import Text.XML.HXT.Core (
26 import TSN.DbImport ( ImportResult(..) )
27 import Xml ( pickle_unpickle, unpickleable )
30 -- | The data structure that holds the XML representation of a
36 time_stamp :: String }
40 -- | A (un)pickler that turns a Heartbeat XML file into a 'Message'
42 pickle_message :: PU Message
45 xpWrap (from_tuple, to_tuple) $
46 xpTriple (xpElem "XML_File_ID" xpInt)
47 (xpElem "heading" xpText)
48 (xpElem "time_stamp" xpText)
50 from_tuple = uncurryN Message
51 to_tuple m = (xml_file_id m,
56 -- | Verify (and report) the received heartbeat. We return
57 -- 'ImportSkipped' because we want to indicate that we processed the
58 -- file but there was nothing to import.
60 verify :: XmlTree -> IO ImportResult
62 let root_element = unpickleDoc pickle_message xml
63 return $ case root_element of
64 Nothing -> ImportFailed "Could not unpickle document in import_generic."
65 Just _ -> ImportSkipped "Heartbeat received. Thump."
69 heartbeat_tests :: TestTree
73 [ test_pickle_of_unpickle_is_identity,
74 test_unpickle_succeeds ]
77 -- | Warning: succeess of this test does not mean that unpickling
80 test_pickle_of_unpickle_is_identity :: TestTree
81 test_pickle_of_unpickle_is_identity =
82 testCase "pickle composed with unpickle is the identity" $ do
83 let path = "test/xml/Heartbeat.xml"
84 (expected :: [Message], actual) <- pickle_unpickle pickle_message path
88 -- | Make sure we can unpickle the sample file.
90 test_unpickle_succeeds :: TestTree
91 test_unpickle_succeeds =
92 testCase "unpickling succeeds" $ do
93 let path = "test/xml/Heartbeat.xml"
94 actual <- unpickleable path pickle_message