Add a new pickler for Double values that have no leading integer.

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

diff --git a/src/TSN/XML/AutoRacingResults.hs b/src/TSN/XML/AutoRacingResults.hs
index cd5ebec36010eeefc7f9132d02bc1d3f7ae58892..0e80b11b4702a18756328f2021d0d123a174e5ac 100644 (file)
--- a/src/TSN/XML/AutoRacingResults.hs
+++ b/src/TSN/XML/AutoRacingResults.hs
@@ -59,7 +59,11 @@ import Text.XML.HXT.Core (
 -- Local imports.
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
-import TSN.Picklers ( xp_earnings, xp_datetime, xp_time_stamp )
+import TSN.Picklers (
+  xp_earnings,
+  xp_fracpart_only_double,
+  xp_datetime,
+  xp_time_stamp )
 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
 import Xml (
   Child(..),
@@ -528,7 +532,9 @@ pickle_race_information =
     xp11Tuple (-- I can't think of another way to get both the
                -- TrackLength and its KPH attribute. So we shove them
                -- both in a 2-tuple. This should probably be an embedded type!
-                 xpElem "TrackLength" $ xpPair xpText (xpAttr "KPH" xpPrim) )
+                 xpElem "TrackLength" $
+                   xpPair xpText
+                          (xpAttr "KPH" xp_fracpart_only_double) )
               (xpElem "Laps" xpInt)
               (xpOption $ xpElem "AverageSpeedMPH" xpPrim)
               (xpOption $ xpElem "AverageSpeedKPH" xpPrim)
@@ -578,24 +584,33 @@ auto_racing_results_tests =
 --   test does not mean that unpickling succeeded.
 --
 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/AutoRacingResultsXML.xml"
-    (expected, actual) <- pickle_unpickle pickle_message path
-    actual @?= expected
+test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" $
+  [ check "pickle composed with unpickle is the identity"
+          "test/xml/AutoRacingResultsXML.xml",
+
+    check "pickle composed with unpickle is the identity (fractional KPH)"
+          "test/xml/AutoRacingResultsXML-fractional-kph.xml" ]
+  where
+    check desc path = testCase desc $ do
+      (expected, actual) <- pickle_unpickle pickle_message path
+      actual @?= expected
 
 
 
 -- | Make sure we can actually unpickle these things.
 --
 test_unpickle_succeeds :: TestTree
-test_unpickle_succeeds =
-  testCase "unpickling succeeds" $ do
-    let path = "test/xml/AutoRacingResultsXML.xml"
-    actual <- unpickleable path pickle_message
+test_unpickle_succeeds = testGroup "unpickle tests" $
+  [ check "unpickling succeeds"
+          "test/xml/AutoRacingResultsXML.xml",
 
-    let expected = True
-    actual @?= expected
+    check "unpickling succeeds (fractional KPH)"
+          "test/xml/AutoRacingResultsXML-fractional-kph.xml" ]
+  where
+    check desc path = testCase desc $ do
+      actual <- unpickleable path pickle_message
+      let expected = True
+      actual @?= expected
 
 
 
@@ -603,24 +618,29 @@ test_unpickle_succeeds =
 --   record.
 --
 test_on_delete_cascade :: TestTree
-test_on_delete_cascade =
-  testCase "deleting auto_racing_results deletes its children" $ do
-    let path = "test/xml/AutoRacingResultsXML.xml"
-    results <- unsafe_unpickle path pickle_message
-    let a = undefined :: AutoRacingResults
-    let b = undefined :: AutoRacingResultsListing
-    let c = undefined :: AutoRacingResultsRaceInformation
-
-    actual <- withSqliteConn ":memory:" $ runDbConn $ do
-                runMigration silentMigrationLogger $ do
-                  migrate a
-                  migrate b
-                  migrate c
-                _ <- dbimport results
-                deleteAll a
-                count_a <- countAll a
-                count_b <- countAll b
-                count_c <- countAll c
-                return $ sum [count_a, count_b, count_c]
-    let expected = 0
-    actual @?= expected
+test_on_delete_cascade = testGroup "cascading delete tests" $
+  [ check "deleting auto_racing_results deletes its children"
+          "test/xml/AutoRacingResultsXML.xml",
+
+    check "deleting auto_racing_results deletes its children (fractional KPH)"
+          "test/xml/AutoRacingResultsXML-fractional-kph.xml" ]
+  where
+    check desc path = testCase desc $ do
+      results <- unsafe_unpickle path pickle_message
+      let a = undefined :: AutoRacingResults
+      let b = undefined :: AutoRacingResultsListing
+      let c = undefined :: AutoRacingResultsRaceInformation
+
+      actual <- withSqliteConn ":memory:" $ runDbConn $ do
+                  runMigration silentMigrationLogger $ do
+                    migrate a
+                    migrate b
+                    migrate c
+                  _ <- dbimport results
+                  deleteAll a
+                  count_a <- countAll a
+                  count_b <- countAll b
+                  count_c <- countAll c
+                  return $ sum [count_a, count_b, count_c]
+      let expected = 0
+      actual @?= expected