From 86b11d329ffa739f9b3ae83997e6bbb38af19b9b Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Tue, 22 Jul 2014 18:55:38 -0400
Subject: [PATCH] Add tests for existing picklers.

---
 src/TSN/Picklers.hs | 91 ++++++++++++++++++++++++++++++++++++++++++++-
 test/TestSuite.hs   |  2 +
 2 files changed, 92 insertions(+), 1 deletion(-)

diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs
index 3863017..a8b0567 100644
--- a/src/TSN/Picklers.hs
+++ b/src/TSN/Picklers.hs
@@ -2,6 +2,7 @@
 --   feed.
 --
 module TSN.Picklers (
+  pickler_tests,
   xp_ambiguous_time,
   xp_date,
   xp_date_padded,
@@ -20,12 +21,21 @@ import Data.List.Split ( chunksOf )
 import Data.String.Utils ( replace )
 import Data.Time.Clock ( NominalDiffTime, UTCTime, addUTCTime )
 import Data.Time.Format ( formatTime, parseTime )
+import Data.Tree.NTree.TypeDefs ( NTree(..) )
 import System.Locale ( defaultTimeLocale )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Arrow.Pickle (
   xpText,
   xpWrap,
   xpWrapMaybe )
 import Text.XML.HXT.Arrow.Pickle.Xml ( PU )
+import Text.XML.HXT.Core (
+  XmlTree,
+  XNode( XTag, XText ),
+  mkName,
+  pickleDoc,
+  unpickleDoc )
 
 -- Local imports.
 import TSN.Parse (
@@ -250,6 +260,31 @@ xp_time_dots =
 -- | (Un)pickle a UTCTime without the date portion, allowing for a
 --   value of \"TBA\" (which gets translated to 'Nothing').
 --
+--   /Examples/:
+--
+--   A failed parse will return 'Nothing':
+--
+--   >>> let tn = text_node "YO"
+--   >>> unpickleDoc xp_tba_time tn
+--   Just Nothing
+--
+--   And so will parsing a \"TBA\":
+--
+--   >>> let tn = text_node "TBA"
+--   >>> unpickleDoc xp_tba_time tn
+--   Just Nothing
+--
+--   But re-pickling 'Nothing' gives only \"TBA\":
+--
+--   >>> pickleDoc xp_tba_time Nothing
+--   NTree (XTag "/" []) [NTree (XText "TBA") []]
+--
+--   A normal time is also parsed successfully, of course:
+--
+--   >>> let tn = text_node "08:10 PM"
+--   >>> unpickleDoc xp_tba_time tn
+--   Just (Just 1970-01-01 20:10:00 UTC)
+--
 xp_tba_time :: PU (Maybe UTCTime)
 xp_tba_time =
   (to_time, from_time) `xpWrap` xpText
@@ -266,13 +301,20 @@ xp_tba_time =
 
 
 -- | (Un)pickle the \<time_stamp\> element format to/from a 'UTCTime'.
+--   The time_stamp elements look something like,
 --
---   Example:  \<time_stamp\> January 6, 2014, at 10:11 PM ET \</time_stamp\>
+--   \<time_stamp\> January 6, 2014, at 10:11 PM ET \</time_stamp\>
 --
 --   TSN doesn't provide a proper time zone name, so we assume that
 --   it's always Eastern Standard Time. EST is UTC-5, so we
 --   add/subtract 5 hours to convert to/from UTC.
 --
+--   Examples:
+--
+--   >>> let tn = text_node " January 6, 2014, at 10:11 PM ET "
+--   >>> unpickleDoc xp_time_stamp tn
+--   Just 2014-01-07 03:11:00 UTC
+--
 xp_time_stamp :: PU UTCTime
 xp_time_stamp =
   (parse_time_stamp, from_time_stamp) `xpWrapMaybe` xpText
@@ -293,6 +335,10 @@ xp_time_stamp =
 --
 --   Examples:
 --
+--   >>> let tn = text_node "8:00"
+--   >>> unpickleDoc xp_ambiguous_time tn
+--   Just 1970-01-01 08:00:00 UTC
+--
 xp_ambiguous_time :: PU UTCTime
 xp_ambiguous_time =
   (to_time, from_time) `xpWrapMaybe` xpText
@@ -306,3 +352,46 @@ xp_ambiguous_time =
     from_time :: UTCTime -> String
     from_time =
       formatTime defaultTimeLocale ambiguous_time_format
+
+
+-- | Create an 'XmlTree' containing only the given text. This is
+--   useful for testing (un)picklers, where we don't want to have to
+--   bother to create a dummy XML document.
+--
+--   Examples:
+--
+--   >>> text_node "8:00"
+--   NTree (XText "8:00") []
+--
+text_node :: String -> XmlTree
+text_node s = NTree (XText s) []
+
+
+
+--
+-- * Tasty Tests
+--
+
+-- | A list of all tests for this module. This primary exists to
+--   eliminate the unused import/export warnings for 'unpickleDoc' and
+--   'text_node' which are otherwise only used in the doctests.
+--
+pickler_tests :: TestTree
+pickler_tests =
+  testGroup
+    "Pickler tests"
+    [ test_pickle_of_unpickle_is_identity ]
+
+
+-- | If we unpickle something and then pickle it, we should wind up
+--   with the same thing we started with (plus an additional root
+--   element).
+--
+test_pickle_of_unpickle_is_identity :: TestTree
+test_pickle_of_unpickle_is_identity =
+  testCase "pickle composed with unpickle is (almost) the identity" $ do
+    let tn = text_node "8:00"
+    let (Just utctime) = unpickleDoc xp_ambiguous_time tn
+    let actual = pickleDoc xp_ambiguous_time utctime
+    let expected = NTree (XTag (mkName "/") []) [tn]
+    actual @?= expected
diff --git a/test/TestSuite.hs b/test/TestSuite.hs
index e153076..985b53c 100644
--- a/test/TestSuite.hs
+++ b/test/TestSuite.hs
@@ -1,5 +1,6 @@
 import Test.Tasty ( TestTree, defaultMain, testGroup )
 
+import TSN.Picklers ( pickler_tests )
 import TSN.XML.AutoRacingResults ( auto_racing_results_tests )
 import TSN.XML.AutoRacingSchedule ( auto_racing_schedule_tests )
 import TSN.XML.GameInfo ( game_info_tests )
@@ -26,6 +27,7 @@ tests = testGroup
             jfile_tests,
             news_tests,
             odds_tests,
+            pickler_tests,
             schedule_changes_tests,
             scores_tests,
             sport_info_tests,
-- 
2.43.2