filterAxis,
followingSiblingAxis,
hasName,
- readDocument,
remNav,
runLA,
- runX,
xp8Tuple,
xp9Tuple,
xpAttr,
FromXml(..),
FromXmlFk(..),
ToDb(..),
- parse_opts,
pickle_unpickle,
unpickleable,
+ unsafe_read_document,
unsafe_unpickle )
data WeatherForecastListingXml =
WeatherForecastListingXml {
xml_teams :: String,
- xml_weather :: String }
+ xml_weather :: Maybe String }
deriving (Eq, Show)
db_weather_forecasts_id :: DefaultKey WeatherForecast,
db_league_name :: Maybe String,
db_teams :: String,
- db_weather :: String }
+ db_weather :: Maybe String }
-- | We don't make 'WeatherForecastListingXml' an instance of
db_away_team :: String,
db_home_team :: String,
db_weather_type :: Int,
- db_description :: String,
+ db_description :: Maybe String,
db_temp_adjust :: Maybe String,
db_temperature :: Int }
xml_away_team :: String,
xml_home_team :: String,
xml_weather_type :: Int,
- xml_description :: String,
+ xml_description :: Maybe String,
xml_temp_adjust :: Maybe String,
xml_temperature :: Int }
deriving (Eq, Show)
reference:
onDelete: cascade
-# We rename the two fields that needed a "dtl" prefix to avoid a name clash.
+ # We rename the two fields that needed a "dtl" prefix to avoid a name
+ # clash.
- entity: WeatherDetailedWeatherListingItem
dbName: weather_detailed_items
constructors:
-- And finally, insert those DB listings.
mapM_ insert_ db_listings
+ -- Now we do the detailed weather items.
+ case (xml_detailed_weather m) of
+ Nothing -> return ()
+ Just dw -> do
+ let detailed_listings = xml_detailed_listings dw
+ let items = concatMap xml_items detailed_listings
+ mapM_ (insert_xml_fk_ weather_id) items
+
return ImportSucceeded
xpWrap (from_pair, to_pair) $
xpPair
(xpElem "teams" xpText)
- (xpElem "weather" xpText)
+ (xpElem "weather" (xpOption xpText))
where
+-- from_pair (ts, Nothing) = WeatherForecastListingXml ts (Just "")
from_pair = uncurry WeatherForecastListingXml
to_pair WeatherForecastListingXml{..} = (xml_teams, xml_weather)
(xpElem "AwayTeam" xpText)
(xpElem "HomeTeam" xpText)
(xpElem "WeatherType" xpInt)
- (xpElem "Description" xpText)
+ (xpElem "Description" (xpOption xpText))
(xpElem "TempAdjust" (xpOption xpText))
(xpElem "Temperature" xpInt)
where
[ check "unpickling succeeds"
"test/xml/weatherxml.xml",
check "unpickling succeeds (detailed)"
- "test/xml/weatherxml-detailed.xml" ]
+ "test/xml/weatherxml-detailed.xml",
+ check "unpickling succeeds (empty weather)"
+ "test/xml/weatherxml-empty-weather.xml"]
where
check desc path = testCase desc $ do
actual <- unpickleable path pickle_message
[ check "deleting weather deletes its children"
"test/xml/weatherxml.xml",
check "deleting weather deletes its children (detailed)"
- "test/xml/weatherxml-detailed.xml" ]
+ "test/xml/weatherxml-detailed.xml",
+ check "deleting weather deletes its children (empty weather)"
+ "test/xml/weatherxml-empty-weather.xml"]
where
check desc path = testCase desc $ do
weather <- unsafe_unpickle path pickle_message
actual @?= expected
--- | This is used in a few tests to extract an 'XmlTree' from a path.
---
-unsafe_get_xmltree :: String -> IO XmlTree
-unsafe_get_xmltree path =
- fmap head $ runX $ readDocument parse_opts path
-
-
-- | We want to make sure type1 documents are detected as type1, and
-- type2 documents detected as type2..
--
test_types_detected_correctly :: TestTree
test_types_detected_correctly =
- testGroup "weatherxml types detected correctly" $
+ testGroup "weatherxml types detected correctly"
[ check "test/xml/weatherxml.xml"
"first type detected correctly"
True,
check "test/xml/weatherxml-detailed.xml"
"first type detected correctly (detailed)"
True,
+ check "test/xml/weatherxml-empty-weather.xml"
+ "first type detected correctly (empty weather)"
+ True,
check "test/xml/weatherxml-type2.xml"
"second type detected correctly"
False ]
where
check path desc expected = testCase desc $ do
- xmltree <- unsafe_get_xmltree path
+ xmltree <- unsafe_read_document path
let actual = is_type1 xmltree
actual @?= expected
False ]
where
check desc path expected = testCase desc $ do
- xmltree <- unsafe_get_xmltree path
+ xmltree <- unsafe_read_document path
let actual = teams_are_normal xmltree
actual @?= expected