]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blobdiff - src/TSN/XML/Heartbeat.hs
Migrate TSN.XML.Heartbeat to fixed-vector-hetero.
[dead/htsn-import.git] / src / TSN / XML / Heartbeat.hs
index 89b91adb4605a35a1b6203c0ec2d578f0488b154..39a2bc469d8739f2ef7bb96ff0be80286dad9140 100644 (file)
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Handle documents defined by Heartbeat.dtd.
@@ -10,7 +11,10 @@ module TSN.XML.Heartbeat (
 where
 
 -- System imports.
+import Data.Time.Clock ( UTCTime )
 import Data.Tuple.Curry ( uncurryN )
+import qualified Data.Vector.HFixed as H ( HVector, convert )
+import qualified GHC.Generics as GHC ( Generic )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
@@ -25,6 +29,7 @@ import Text.XML.HXT.Core (
 
 -- Local imports.
 import TSN.DbImport ( ImportResult(..) )
+import TSN.Picklers ( xp_time_stamp )
 import Xml ( pickle_unpickle, unpickleable )
 
 
@@ -37,11 +42,15 @@ dtd = "Heartbeat.dtd"
 --   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 'H.convert'.
+--
+instance H.HVector Message
 
 
 -- | A (un)pickler that turns a Heartbeat XML file into a 'Message'
@@ -50,15 +59,12 @@ data Message =
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     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