X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FWeather.hs;h=c1ec2ef0004ff34cd77faf9563896698433f85ef;hb=16d86e7a3c1eda08b91752f92510a1de0b952a17;hp=0866f6f09ee7a666f54da7cb4ce47e1f60e8c47a;hpb=fe55e0de738d00b94ad1269bafe32beb83860387;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/Weather.hs b/src/TSN/XML/Weather.hs
index 0866f6f..c1ec2ef 100644
--- a/src/TSN/XML/Weather.hs
+++ b/src/TSN/XML/Weather.hs
@@ -52,10 +52,8 @@ import Text.XML.HXT.Core (
   filterAxis,
   followingSiblingAxis,
   hasName,
-  readDocument,
   remNav,
   runLA,
-  runX,
   xp8Tuple,
   xp9Tuple,
   xpAttr,
@@ -79,9 +77,9 @@ import Xml (
   FromXml(..),
   FromXmlFk(..),
   ToDb(..),
-  parse_opts,
   pickle_unpickle,
   unpickleable,
+  unsafe_read_document,
   unsafe_unpickle )
 
 
@@ -384,7 +382,8 @@ mkPersist tsn_codegen_config [groundhog|
           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:
@@ -484,6 +483,14 @@ instance DbImport Message where
         -- 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
 
 
@@ -694,19 +701,12 @@ test_on_delete_cascade = testGroup "cascading delete tests"
       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,
@@ -718,7 +718,7 @@ test_types_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
 
@@ -739,6 +739,6 @@ test_normal_teams_detected_correctly =
           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