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 (
25 import TSN.DbImport ( ImportResult(..) )
26 import Xml ( pickle_unpickle, unpickleable )
29 -- | The data structure that holds the XML representation of a
35 time_stamp :: String }
39 -- | A (un)pickler that turns a Heartbeat XML file into a 'Message'
41 pickle_message :: PU Message
44 xpWrap (from_tuple, to_tuple) $
45 xpTriple (xpElem "XML_File_ID" xpInt)
46 (xpElem "heading" xpText)
47 (xpElem "time_stamp" xpText)
49 from_tuple = uncurryN Message
50 to_tuple m = (xml_file_id m,
55 -- | Verify (and report) the received heartbeat. We return
56 -- 'ImportSkipped' because we want to indicate that we processed the
57 -- file but there was nothing to import.
59 verify :: XmlTree -> IO ImportResult
61 let root_element = unpickleDoc pickle_message xml
62 return $ case root_element of
63 Nothing -> ImportFailed "Could not unpickle document in import_generic."
64 Just _ -> ImportSkipped "Heartbeat received. Thump."
68 heartbeat_tests :: TestTree
72 [ test_pickle_of_unpickle_is_identity,
73 test_unpickle_succeeds ]
76 -- | Warning: succeess of this test does not mean that unpickling
79 test_pickle_of_unpickle_is_identity :: TestTree
80 test_pickle_of_unpickle_is_identity =
81 testCase "pickle composed with unpickle is the identity" $ do
82 let path = "test/xml/Heartbeat.xml"
83 (expected :: [Message], actual) <- pickle_unpickle pickle_message path
87 -- | Make sure we can unpickle the sample file.
89 test_unpickle_succeeds :: TestTree
90 test_unpickle_succeeds =
91 testCase "unpickling succeeds" $ do
92 let path = "test/xml/Heartbeat.xml"
93 actual <- unpickleable path pickle_message