From: Michael Orlitzky Date: Wed, 24 Sep 2014 01:57:51 +0000 (-0400) Subject: Make the MostLapsLeading embedded fields of AutoRacingResults optional. X-Git-Tag: 0.1.1~3 X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=commitdiff_plain;h=6d0766209118bd725438d24620d3ac2ffa374fd8 Make the MostLapsLeading embedded fields of AutoRacingResults optional. Add a test case for the newly-optional fields and fix a shelltest. Update the AutoRacingResultsXML dbschema diagram. --- diff --git a/doc/dbschema/AutoRacingResultsXML.png b/doc/dbschema/AutoRacingResultsXML.png index 9ea9386..7f71ddc 100644 Binary files a/doc/dbschema/AutoRacingResultsXML.png and b/doc/dbschema/AutoRacingResultsXML.png differ diff --git a/src/TSN/XML/AutoRacingResults.hs b/src/TSN/XML/AutoRacingResults.hs index 539c438..e7ab014 100644 --- a/src/TSN/XML/AutoRacingResults.hs +++ b/src/TSN/XML/AutoRacingResults.hs @@ -46,6 +46,7 @@ import Text.XML.HXT.Core ( xp11Tuple, xp13Tuple, xpAttr, + xpDefault, xpElem, xpInt, xpList, @@ -259,17 +260,27 @@ instance XmlImportFk AutoRacingResultsListingXml -- the \"db_\" prefix since our field namer is going to strip of -- everything before the first underscore. -- +-- We make the three fields optional because the entire +-- \ is apparently optional (although it is +-- usually present). A 'Nothing' in the XML should get turned into +-- three 'Nothing's in the DB. +-- data MostLapsLeading = MostLapsLeading { - db_most_laps_leading_driver_id :: Int, - db_most_laps_leading_driver :: String, - db_most_laps_leading_number_of_laps :: Int } + db_most_laps_leading_driver_id :: Maybe Int, + db_most_laps_leading_driver :: Maybe String, + db_most_laps_leading_number_of_laps :: Maybe Int } deriving (Data, Eq, Show, Typeable) -- | Database representation of a \ contained -- within a \. -- +-- The 'db_most_laps_leading' field is not optional because when we +-- convert from our XML representation, a missing 'MostLapsLeading' +-- will be replaced with a 'MostLapsLeading' with three missing +-- fields. +-- data AutoRacingResultsRaceInformation = AutoRacingResultsRaceInformation { -- Note the apostrophe to disambiguate it from the @@ -306,7 +317,7 @@ data AutoRacingResultsRaceInformationXml = xml_cautions :: Maybe String, xml_lead_changes :: Maybe String, xml_lap_leaders :: Maybe String, - xml_most_laps_leading :: MostLapsLeading } + xml_most_laps_leading :: Maybe MostLapsLeading } deriving (Eq,Show) @@ -345,8 +356,15 @@ instance FromXmlFk AutoRacingResultsRaceInformationXml where db_cautions = xml_cautions, db_lead_changes = xml_lead_changes, db_lap_leaders = xml_lap_leaders, - db_most_laps_leading = xml_most_laps_leading } - + db_most_laps_leading = most_laps_leading } + where + -- If we didn't get a \, indicate that in + -- the database with an (embedded) 'MostLapsLeading' with three + -- missing fields. + most_laps_leading = + case xml_most_laps_leading of + Just mll -> mll + Nothing -> MostLapsLeading Nothing Nothing Nothing -- | This allows us to insert the XML representation -- 'AutoRacingResultsRaceInformationXml' directly. @@ -507,24 +525,52 @@ pickle_message = -- | Pickler for the \ child of a --- \. +-- \. This is complicated by the fact that the +-- three fields we're trying to parse are not actually optional; +-- only the entire \ is. So we always wrap what +-- we parse in a 'Just', and when converting from the DB to XML, +-- we'll drop the entire element if any of its fields are missing +-- (which they never should be). -- -pickle_most_laps_leading :: PU MostLapsLeading +pickle_most_laps_leading :: PU (Maybe MostLapsLeading) pickle_most_laps_leading = xpElem "Most_Laps_Leading" $ xpWrap (from_tuple, to_tuple) $ - xpTriple (xpElem "DriverID" xpInt) - (xpElem "Driver" xpText) - (xpElem "NumberOfLaps" xpInt) + xpTriple (xpOption $ xpElem "DriverID" xpInt) + (xpOption $ xpElem "Driver" xpText) + (xpOption $ xpElem "NumberOfLaps" xpInt) where - from_tuple = uncurryN MostLapsLeading - to_tuple m = (db_most_laps_leading_driver_id m, - db_most_laps_leading_driver m, - db_most_laps_leading_number_of_laps m) + from_tuple :: (Maybe Int, Maybe String, Maybe Int) -> Maybe MostLapsLeading + from_tuple (Just x, Just y, Just z) = + Just $ MostLapsLeading (Just x) (Just y) (Just z) + from_tuple _ = Nothing + + -- Sure had to go out of my way to avoid the warnings about unused + -- db_most_laps_foo fields here. + to_tuple :: Maybe MostLapsLeading -> (Maybe Int, Maybe String, Maybe Int) + to_tuple Nothing = (Nothing, Nothing, Nothing) + to_tuple (Just (MostLapsLeading Nothing _ _)) = (Nothing, Nothing, Nothing) + to_tuple (Just (MostLapsLeading _ Nothing _)) = (Nothing, Nothing, Nothing) + to_tuple (Just (MostLapsLeading _ _ Nothing)) = (Nothing, Nothing, Nothing) + to_tuple (Just m) = (db_most_laps_leading_driver_id m, + db_most_laps_leading_driver m, + db_most_laps_leading_number_of_laps m) -- | Pickler for the \ child of \. -- +-- There's so much voodoo going on here. We have a double-layered +-- Maybe on top of the MostLapsLeading. When unpickling, we return a +-- Nothing (i.e. a Maybe MostLapsLeading) if any of its fields are +-- missing. But if the entire element is missing, unpickling +-- fails. 'xpOption' doesn't fix this because it would give us a +-- Maybe (Maybe MostLapsLeading). But we can use 'xpDefault' with a +-- default of (Nothing :: Maybe MostLapsLeading) to stick one in +-- there if unpicking a (Maybe MostLapsLeading) fails because +-- \ is missing. +-- +-- Clear as mud, I know. +-- pickle_race_information :: PU AutoRacingResultsRaceInformationXml pickle_race_information = xpElem "Race_Information" $ @@ -544,7 +590,7 @@ pickle_race_information = (xpOption $ xpElem "Cautions" xpText) (xpOption $ xpElem "LeadChanges" xpText) (xpOption $ xpElem "LapLeaders" xpText) - pickle_most_laps_leading + (xpDefault Nothing pickle_most_laps_leading) where -- Derp. Since the first two are paired, we have to -- manually unpack the bazillion arguments. @@ -589,7 +635,10 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" "test/xml/AutoRacingResultsXML.xml", check "pickle composed with unpickle is the identity (fractional KPH)" - "test/xml/AutoRacingResultsXML-fractional-kph.xml" ] + "test/xml/AutoRacingResultsXML-fractional-kph.xml", + + check "pickle composed with unpickle is the identity (No Most_Laps_Leading)" + "test/xml/AutoRacingResultsXML-no-most-laps-leading.xml"] where check desc path = testCase desc $ do (expected, actual) <- pickle_unpickle pickle_message path @@ -605,7 +654,10 @@ test_unpickle_succeeds = testGroup "unpickle tests" "test/xml/AutoRacingResultsXML.xml", check "unpickling succeeds (fractional KPH)" - "test/xml/AutoRacingResultsXML-fractional-kph.xml" ] + "test/xml/AutoRacingResultsXML-fractional-kph.xml", + + check "unpickling succeeds (no Most_Laps_Leading)" + "test/xml/AutoRacingResultsXML-no-most-laps-leading.xml" ] where check desc path = testCase desc $ do actual <- unpickleable path pickle_message @@ -623,7 +675,11 @@ test_on_delete_cascade = testGroup "cascading delete tests" "test/xml/AutoRacingResultsXML.xml", check "deleting auto_racing_results deletes its children (fractional KPH)" - "test/xml/AutoRacingResultsXML-fractional-kph.xml" ] + "test/xml/AutoRacingResultsXML-fractional-kph.xml", + + check ("deleting auto_racing_results deletes its children " ++ + "(No Most_Laps_Leading)") + "test/xml/AutoRacingResultsXML-no-most-laps-leading.xml" ] where check desc path = testCase desc $ do results <- unsafe_unpickle path pickle_message diff --git a/test/shell/import-duplicates.test b/test/shell/import-duplicates.test index 33b1e78..53ab0bd 100644 --- a/test/shell/import-duplicates.test +++ b/test/shell/import-duplicates.test @@ -16,15 +16,15 @@ rm -f shelltest.sqlite3 # and a newsxml that aren't really supposed to import. find ./test/xml -maxdepth 1 -name '*.xml' | wc -l >>> -30 +31 >>>= 0 # Run the imports again; we should get complaints about the duplicate -# xml_file_ids. There are 2 errors for each violation, so we expect 2*26 +# xml_file_ids. There are 2 errors for each violation, so we expect 2*27 # occurrences of the string 'ERROR'. ./dist/build/htsn-import/htsn-import -c 'shelltest.sqlite3' test/xml/*.xml 2>&1 | grep ERROR | wc -l >>> -52 +54 >>>= 0 # Finally, clean up after ourselves.