X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=blobdiff_plain;f=src%2FTSN%2FPicklers.hs;h=6f131a75b921f4aac3490a39214a5106db0f6160;hp=3d7215a07744436055a7eff73a8169201d394301;hb=4ad960facfe0b939e71e4afe4502fce3108d90e3;hpb=03a49e2a1db26026c86804a73acee025842282db

diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs
index 3d7215a..6f131a7 100644
--- a/src/TSN/Picklers.hs
+++ b/src/TSN/Picklers.hs
@@ -9,6 +9,7 @@ module TSN.Picklers (
   xp_datetime,
   xp_early_line_date,
   xp_earnings,
+  xp_fracpart_only_double,
   xp_gamedate,
   xp_tba_time,
   xp_time,
@@ -28,6 +29,7 @@ import Data.Tree.NTree.TypeDefs ( NTree(..) )
 import System.Locale ( TimeLocale( wDays, months ), defaultTimeLocale )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
+import Text.Read ( readMaybe )
 import Text.XML.HXT.Arrow.Pickle (
   xpText,
   xpWrap,
@@ -148,6 +150,7 @@ format_commas x =
   reverse (intercalate "," $ chunksOf 3 $ reverse $ show x)
 
 
+
 -- | Parse \<Earnings\> from an 'AutoRaceResultsListing'. These are
 --   essentially 'Int's, but they look like,
 --
@@ -185,6 +188,45 @@ xp_earnings =
 
 
 
+-- | Pickle a 'Double' that can be missing its leading zero (for
+--   values less than one). For example, we've seen,
+--
+--   <TrackLength KPH=".805">0.5</TrackLength>
+--
+--   Which 'xpPrim' can't handle without the leading
+--   zero. Unfortunately there's no way pickle/unpickle can be
+--   inverses of each other here, since \"0.5\" and \".5\" should
+--   unpickle to the same 'Double'.
+--
+--   Examples:
+--
+--   >>> let tn = text_node "0.5"
+--   >>> unpickleDoc xp_fracpart_only_double tn
+--   Just 0.5
+--
+--   >>> let tn = text_node ".5"
+--   >>> unpickleDoc xp_fracpart_only_double tn
+--   Just 0.5
+--
+--   >>> let tn = text_node "foo"
+--   >>> unpickleDoc xp_fracpart_only_double tn
+--   Nothing
+--
+xp_fracpart_only_double :: PU Double
+xp_fracpart_only_double =
+  (to_double, from_double) `xpWrapMaybe` xpText
+  where
+    -- | Convert a 'String' to a 'Double', maybe. We always prepend a
+    -- zero, since it will fix the fraction-only values, and not hurt
+    -- the ones that already have a leading integer.
+    to_double :: String -> Maybe Double
+    to_double s = readMaybe ("0" ++ s)
+
+    from_double :: Double -> String
+    from_double = show
+
+
+
 -- | (Un)pickle an unpadded 'UTCTime'. Used for example on the
 --   \<RaceDate\> elements in an 'AutoRaceResults' message.
 --