Add/rework picklers tests, and use the new picklers in TSN.XML.EarlyLine.

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

diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs
index 232f3579c7a6f257c018b7ad24d6d4c01e40c095..3d7215a07744436055a7eff73a8169201d394301 100644 (file)
--- a/src/TSN/Picklers.hs
+++ b/src/TSN/Picklers.hs
@@ -107,6 +107,10 @@ xp_date =
 --   >>> unpickleDoc xp_date_padded tn
 --   Just 1983-02-15 00:00:00 UTC
 --
+--   >>> let tn = text_node "06/07/2014"
+--   >>> unpickleDoc xp_date_padded tn
+--   Just 2014-06-07 00:00:00 UTC
+--
 xp_date_padded :: PU UTCTime
 xp_date_padded =
   (to_date, from_date) `xpWrapMaybe` xpText
@@ -222,26 +226,16 @@ xp_datetime =
 --
 --   Examples:
 --
+--   >>> import Data.Maybe ( fromJust )
 --   >>> :{
 --         let parse_date :: String -> Maybe UTCTime;
 --         parse_date = parseTime defaultTimeLocale date_format;
 --       :}
 --
---   >>> let (Just d1) = parse_date "1/1/1970"
---   >>> date_suffix d1
---   "st"
---
---   >>> let (Just d2) = parse_date "1/2/1970"
---   >>> date_suffix d2
---   "nd"
---
---   >>> let (Just d3) = parse_date "1/3/1970"
---   >>> date_suffix d3
---   "rd"
---
---   >>> let (Just d4) = parse_date "1/4/1970"
---   >>> date_suffix d4
---   "th"
+--   >>> let dates = [ "1/" ++ (d : "/1970") | d <- ['1'..'9'] ]
+--   >>> let suffixes = map (date_suffix . fromJust . parse_date) dates
+--   >>> suffixes
+--   ["st","nd","rd","th","th","th","th","th","th"]
 --
 date_suffix :: UTCTime -> String
 date_suffix t =
@@ -480,6 +474,13 @@ xp_ambiguous_time =
 --   >>> pickleDoc xp_early_line_date result
 --   NTree (XTag "/" []) [NTree (XText "SUNDAY, MAY 25TH (05/25/2014)") []]
 --
+--   >>> let tn = text_node "SATURDAY, JUNE 7TH (06/07/2014)"
+--   >>> let (Just result) = unpickleDoc xp_early_line_date tn
+--   >>> result
+--   2014-06-07 00:00:00 UTC
+--   >>> pickleDoc xp_early_line_date result
+--   NTree (XTag "/" []) [NTree (XText "SATURDAY, JUNE 7TH (06/07/2014)") []]
+--
 xp_early_line_date :: PU UTCTime
 xp_early_line_date =
   (to_time, from_time) `xpWrapMaybe` xpText
@@ -504,7 +505,7 @@ xp_early_line_date =
 
     wacko_date_formats :: [String]
     wacko_date_formats =
-      ["%A, %B %d" ++ suffix ++ " (" ++ date_format_padded ++ ")" |
+      ["%A, %B %-d" ++ suffix ++ " (" ++ date_format_padded ++ ")" |
          suffix <- ["ST", "ND", "RD","TH"] ]
 
     to_time :: String -> Maybe UTCTime
@@ -519,7 +520,9 @@ xp_early_line_date =
       formatTime caps_time_locale fmt t
       where
         upper_suffix = map toUpper (date_suffix t)
-        fmt = "%A, %B %d" ++ upper_suffix ++ " (" ++ date_format_padded ++ ")"
+        fmt = "%A, %B %-d" ++ upper_suffix ++ " (" ++ date_format_padded ++ ")"
+
+
 
 -- | Create an 'XmlTree' containing only the given text. This is
 --   useful for testing (un)picklers, where we don't want to have to