Create an ImportResult type and refactor things around it.

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

diff --git a/src/TSN/XML/Heartbeat.hs b/src/TSN/XML/Heartbeat.hs
new file mode 100644 (file)
index 0000000..c408483
--- /dev/null
+++ b/src/TSN/XML/Heartbeat.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module TSN.XML.Heartbeat (
+  heartbeat_tests,
+  verify )
+where
+
+import Data.Tuple.Curry ( uncurryN )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+import Text.XML.HXT.Core (
+  PU,
+  unpickleDoc,
+  XmlPickler(..),
+  XmlTree,
+  xpTriple,
+  xpElem,
+  xpPrim,
+  xpText,
+  xpWrap )
+
+import TSN.DbImport ( ImportResult(..) )
+import Xml ( pickle_unpickle )
+
+data Message =
+  Message {
+    xml_file_id :: Int,
+    heading :: String,
+    time_stamp :: String }
+  deriving (Eq, Show)
+
+pickle_message :: PU Message
+pickle_message =
+  xpElem "message" $
+    xpWrap (from_tuple, to_tuple) $
+    xpTriple (xpElem "XML_File_ID" xpPrim)
+             (xpElem "heading" xpText)
+             (xpElem "time_stamp" xpText)
+  where
+    from_tuple = uncurryN Message
+    to_tuple m = (xml_file_id m,
+                  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 :: XmlTree -> IO ImportResult
+verify xml = do
+  let root_element = unpickleDoc xpickle xml :: Maybe Message
+  case root_element of
+    Nothing -> return $ Err "Could not unpickle document in import_generic."
+    Just _  -> return $ Info "Heartbeat received."
+
+-- * Tasty Tests
+heartbeat_tests :: TestTree
+heartbeat_tests =
+  testGroup
+    "Heartbeat tests"
+    [ test_pickle_of_unpickle_is_identity ]
+
+
+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
+    actual @?= expected