{-# 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
  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 =
  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