X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FHeartbeat.hs;h=b44f9309379cf9e8fb8d6e51d9d8367c0084c36a;hb=071f8f23b010afab6ab916c480035753c82fc962;hp=588c75c6a54006f14dc1185bc18ac7f3f7087f7c;hpb=4cdcdbe593c30f6434a25896951a1a4dfcc2b1ca;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/Heartbeat.hs b/src/TSN/XML/Heartbeat.hs
index 588c75c..b44f930 100644
--- a/src/TSN/XML/Heartbeat.hs
+++ b/src/TSN/XML/Heartbeat.hs
@@ -1,20 +1,24 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 -- | 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 qualified GHC.Generics as GHC ( Generic )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
   PU,
   unpickleDoc,
-  XmlPickler(..),
   XmlTree,
   xpTriple,
   xpElem,
@@ -23,34 +27,44 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
+import Generics ( Generic(..), to_tuple )
 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 }
-  deriving (Eq, Show)
+  Message
+    Int     -- xml_file_id
+    String  -- heading
+    UTCTime -- time_stamp
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
 
 
 -- | 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,
-                  heading m,
-                  time_stamp m)
 
 
 -- | Verify (and report) the received heartbeat. We return
@@ -61,11 +75,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
@@ -74,8 +92,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 =