Simplify some tests by passing a pickler instead of relying on a XmlPickler instance.

[dead/htsn-import.git] / src / TSN / XML / Heartbeat.hs

diff --git a/src/TSN/XML/Heartbeat.hs b/src/TSN/XML/Heartbeat.hs
index bcf906955e9d5c19b8d392a7331aa29118f18445..588c75c6a54006f14dc1185bc18ac7f3f7087f7c 100644 (file)
--- a/src/TSN/XML/Heartbeat.hs
+++ b/src/TSN/XML/Heartbeat.hs
@@ -1,10 +1,13 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
+-- | Handle documents defined by Heartbeat.dtd.
+--
 module TSN.XML.Heartbeat (
   heartbeat_tests,
   verify )
 where
 
+-- System imports.
 import Data.Tuple.Curry ( uncurryN )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
@@ -15,13 +18,17 @@ import Text.XML.HXT.Core (
   XmlTree,
   xpTriple,
   xpElem,
-  xpPrim,
+  xpInt,
   xpText,
   xpWrap )
 
+-- Local imports.
 import TSN.DbImport ( ImportResult(..) )
 import Xml ( pickle_unpickle, unpickleable )
 
+
+-- | The data structure that holds the XML representation of a
+--   Heartbeat message.
 data Message =
   Message {
     xml_file_id :: Int,
@@ -29,11 +36,14 @@ data Message =
     time_stamp :: String }
   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" xpPrim)
+    xpTriple (xpElem "XML_File_ID" xpInt)
              (xpElem "heading" xpText)
              (xpElem "time_stamp" xpText)
   where
@@ -42,20 +52,19 @@ pickle_message =
                   heading m,
                   time_stamp m)
 
-instance XmlPickler Message where
-  xpickle = pickle_message
-
 
--- | Verify (and report) the received heartbeat. We always return
---   Nothing to avoid spurious "successfully imported..." notices.
+-- | Verify (and report) the received heartbeat. We return
+--   'ImportSkipped' because we want to indicate that we processed the
+--   file but there was nothing to import.
 --
 verify :: XmlTree -> IO ImportResult
 verify xml = do
-  let root_element = unpickleDoc xpickle xml :: Maybe Message
+  let root_element = unpickleDoc pickle_message xml
   return $ case root_element of
     Nothing -> ImportFailed "Could not unpickle document in import_generic."
     Just _  -> ImportSkipped "Heartbeat received. Thump."
 
+
 -- * Tasty Tests
 heartbeat_tests :: TestTree
 heartbeat_tests =
@@ -65,16 +74,19 @@ heartbeat_tests =
       test_unpickle_succeeds ]
 
 
--- | Warning, succeess of this test does not mean that unpickling
+-- | Warning: succeess of this test does not mean that unpickling
 --   succeeded.
+--
 test_pickle_of_unpickle_is_identity :: TestTree
 test_pickle_of_unpickle_is_identity =
   testCase "pickle composed with unpickle is the identity" $ do
     let path = "test/xml/Heartbeat.xml"
-    (expected :: [Message], actual) <- pickle_unpickle "message" path
+    (expected :: [Message], actual) <- pickle_unpickle pickle_message path
     actual @?= expected
 
 
+-- | Make sure we can unpickle the sample file.
+--
 test_unpickle_succeeds :: TestTree
 test_unpickle_succeeds =
   testCase "unpickling succeeds" $ do