]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blob - TSN/XML/Weather.hs
Allow "TBA" laps in TSN.XML.AutoRacingSchedule.
[dead/htsn-import.git] / TSN / XML / Weather.hs
1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE RecordWildCards #-}
5 {-# LANGUAGE TemplateHaskell #-}
6 {-# LANGUAGE TypeFamilies #-}
7
8 -- | Parse TSN XML for the DTD \"weatherxml.dtd\". Each document
9 -- contains a bunch of forecasts, which each contain zero or more
10 -- leagues, which in turn (each) contain a bunch of listings.
11 --
12 module TSN.XML.Weather (
13 dtd,
14 is_type1,
15 pickle_message,
16 teams_are_normal,
17 -- * Tests
18 weather_tests,
19 -- * WARNING: these are private but exported to silence warnings
20 WeatherConstructor(..),
21 WeatherDetailedWeatherListingItemConstructor(..),
22 WeatherForecastConstructor(..),
23 WeatherForecastListingConstructor(..) )
24 where
25
26 -- System imports.
27 import Control.Monad ( forM_ )
28 import Data.Time ( UTCTime )
29 import Data.Tuple.Curry ( uncurryN )
30 import Database.Groundhog (
31 countAll,
32 deleteAll,
33 insert_,
34 migrate,
35 runMigration,
36 silentMigrationLogger )
37 import Database.Groundhog.Core ( DefaultKey )
38 import Database.Groundhog.Generic ( runDbConn )
39 import Database.Groundhog.Sqlite ( withSqliteConn )
40 import Database.Groundhog.TH (
41 groundhog,
42 mkPersist )
43 import Test.Tasty ( TestTree, testGroup )
44 import Test.Tasty.HUnit ( (@?=), testCase )
45 import Text.XML.HXT.Core (
46 PU,
47 XmlTree,
48 (/>),
49 (>>>),
50 addNav,
51 descendantAxis,
52 filterAxis,
53 followingSiblingAxis,
54 hasName,
55 readDocument,
56 remNav,
57 runLA,
58 runX,
59 xp8Tuple,
60 xp9Tuple,
61 xpAttr,
62 xpElem,
63 xpInt,
64 xpList,
65 xpOption,
66 xpPair,
67 xpText,
68 xpTriple,
69 xpWrap )
70
71 -- Local imports.
72 import TSN.Codegen (
73 tsn_codegen_config )
74 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
75 import TSN.Picklers ( xp_datetime, xp_gamedate, xp_time_stamp )
76 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
77 import Xml (
78 Child(..),
79 FromXml(..),
80 FromXmlFk(..),
81 ToDb(..),
82 parse_opts,
83 pickle_unpickle,
84 unpickleable,
85 unsafe_unpickle )
86
87
88
89 -- | The DTD to which this module corresponds. Used to invoke dbimport.
90 --
91 dtd :: String
92 dtd = "weatherxml.dtd"
93
94
95 --
96 -- DB/XML Data types
97 --
98
99 -- * WeatherForecastListing/WeatherForecastListingXml
100
101 -- | XML representation of a weather forecast listing.
102 --
103 data WeatherForecastListingXml =
104 WeatherForecastListingXml {
105 xml_teams :: String,
106 xml_weather :: String }
107 deriving (Eq, Show)
108
109
110 -- | Database representation of a weather forecast listing. The
111 -- 'db_league_name' field should come from the containing \<league\>
112 -- element which is not stored in the database.
113 --
114 data WeatherForecastListing =
115 WeatherForecastListing {
116 db_weather_forecasts_id :: DefaultKey WeatherForecast,
117 db_league_name :: Maybe String,
118 db_teams :: String,
119 db_weather :: String }
120
121
122 -- | We don't make 'WeatherForecastListingXml' an instance of
123 -- 'FromXmlFk' because it needs some additional information, namely
124 -- the league name from its containing \<league\> element.
125 --
126 -- When supplied with a forecast id and a league name, this will
127 -- turn an XML listing into a database one.
128 --
129 from_xml_fk_league :: DefaultKey WeatherForecast
130 -> (Maybe String)
131 -> WeatherForecastListingXml
132 -> WeatherForecastListing
133 from_xml_fk_league fk ln WeatherForecastListingXml{..} =
134 WeatherForecastListing {
135 db_weather_forecasts_id = fk,
136 db_league_name = ln,
137 db_teams = xml_teams,
138 db_weather = xml_weather }
139
140
141 -- * WeatherLeague
142
143 -- | XML representation of a league, as they appear in the weather
144 -- documents. There is no associated database representation because
145 -- the league element really adds no information besides its own
146 -- (usually empty) name. The leagues contain listings, so we
147 -- associate the league name with each listing instead.
148 --
149 data WeatherLeague =
150 WeatherLeague {
151 league_name :: Maybe String,
152 listings :: [WeatherForecastListingXml] }
153 deriving (Eq, Show)
154
155
156 -- * WeatherForecast/WeatherForecastXml
157
158 -- | Database representation of a weather forecast.
159 --
160 data WeatherForecast =
161 WeatherForecast {
162 db_weather_id :: DefaultKey Weather,
163 db_game_date :: UTCTime }
164
165
166 -- | XML representation of a weather forecast.
167 --
168 data WeatherForecastXml =
169 WeatherForecastXml {
170 xml_game_date :: UTCTime,
171 xml_leagues :: [WeatherLeague] }
172 deriving (Eq, Show)
173
174
175 instance ToDb WeatherForecastXml where
176 -- | The database representation of a 'WeatherForecastXml' is a
177 -- 'WeatherForecast'.
178 --
179 type Db WeatherForecastXml = WeatherForecast
180
181
182 instance Child WeatherForecastXml where
183 -- | The database type containing a 'WeatherForecastXml' is
184 -- 'Weather'.
185 type Parent WeatherForecastXml = Weather
186
187
188 instance FromXmlFk WeatherForecastXml where
189
190 -- | To convert a 'WeatherForecastXml' into a 'WeatherForecast', we
191 -- add the foreign key to the containing 'Weather', and copy the
192 -- game date.
193 --
194 from_xml_fk fk WeatherForecastXml{..} =
195 WeatherForecast {
196 db_weather_id = fk,
197 db_game_date = xml_game_date }
198
199
200 -- | This allows us to call 'insert_xml' on an 'WeatherForecastXml'
201 -- without first converting it to the database representation.
202 --
203 instance XmlImportFk WeatherForecastXml
204
205 -- * WeatherDetailedWeatherXml
206
207 -- | XML Representation of a \<Detailed_Weather\>, which just contains
208 -- a bunch iof \<DW_Listing\>s. There is no associated database type
209 -- since these don't really contain any information.
210 --
211 data WeatherDetailedWeatherXml =
212 WeatherDetailedWeatherXml {
213 xml_detailed_listings :: [WeatherDetailedWeatherListingXml] }
214 deriving (Eq, Show)
215
216
217 -- * WeatherDetailedWeatherXml
218
219 -- | XML Representation of a \<DW_Listing\>. The sport and sport code
220 -- come as attributes, but then these just contain a bunch of
221 -- \<Item\>s. There is no associated database type since these don't
222 -- contain much information. The sport we already know from the
223 -- \<message\>, while the sport code is ignored since it's already
224 -- present in each \<Item\>s.
225 --
226 data WeatherDetailedWeatherListingXml =
227 WeatherDetailedWeatherListingXml {
228 xml_dtl_listing_sport :: String,
229 xml_dtl_listing_sport_code :: String,
230 xml_items :: [WeatherDetailedWeatherListingItemXml] }
231 deriving (Eq, Show)
232
233 -- * WeatherDetailedWeatherListingItem / WeatherDetailedWeatherListingItemXml
234
235 -- | Database representation of a detailed weather item. The away/home
236 -- teams don't use the representation in "TSN.Team" because all
237 -- we're given is a name, and a team id is required for "TSN.Team".
238 --
239 -- We also drop the sport name, because it's given in the parent
240 -- 'Weather'.
241 --
242 data WeatherDetailedWeatherListingItem =
243 WeatherDetailedWeatherListingItem {
244 db_dtl_weather_id :: DefaultKey Weather, -- ^ Avoid name collision by
245 -- using \"dtl\" prefix.
246 db_sport_code :: String,
247 db_game_id :: Int,
248 db_dtl_game_date :: UTCTime, -- ^ Avoid name clash with \"dtl\" prefix
249 db_away_team :: String,
250 db_home_team :: String,
251 db_weather_type :: Int,
252 db_description :: String,
253 db_temp_adjust :: Maybe String,
254 db_temperature :: Int }
255
256
257 -- | XML representation of a detailed weather item. Same as the
258 -- database representation, only without the foreign key and the
259 -- sport name that comes from the containing listing.
260 data WeatherDetailedWeatherListingItemXml =
261 WeatherDetailedWeatherListingItemXml {
262 xml_sport_code :: String,
263 xml_game_id :: Int,
264 xml_dtl_game_date :: UTCTime,
265 xml_away_team :: String,
266 xml_home_team :: String,
267 xml_weather_type :: Int,
268 xml_description :: String,
269 xml_temp_adjust :: Maybe String,
270 xml_temperature :: Int }
271 deriving (Eq, Show)
272
273
274 instance ToDb WeatherDetailedWeatherListingItemXml where
275 -- | Our database analogue is a 'WeatherDetailedWeatherListingItem'.
276 type Db WeatherDetailedWeatherListingItemXml =
277 WeatherDetailedWeatherListingItem
278
279 instance Child WeatherDetailedWeatherListingItemXml where
280 -- | We skip two levels of containers and say that the items belong
281 -- to the top-level 'Weather'.
282 type Parent WeatherDetailedWeatherListingItemXml = Weather
283
284 instance FromXmlFk WeatherDetailedWeatherListingItemXml where
285 -- | To convert from the XML to database representation, we simply
286 -- add the foreign key (to Weather) and copy the rest of the fields.
287 from_xml_fk fk WeatherDetailedWeatherListingItemXml{..} =
288 WeatherDetailedWeatherListingItem {
289 db_dtl_weather_id = fk,
290 db_sport_code = xml_sport_code,
291 db_game_id = xml_game_id,
292 db_dtl_game_date = xml_dtl_game_date,
293 db_away_team = xml_away_team,
294 db_home_team = xml_home_team,
295 db_weather_type = xml_weather_type,
296 db_description = xml_description,
297 db_temp_adjust = xml_temp_adjust,
298 db_temperature = xml_temperature }
299
300 -- | This allows us to insert the XML representation directly without
301 -- having to do the manual XML -\> DB conversion.
302 --
303 instance XmlImportFk WeatherDetailedWeatherListingItemXml
304
305 -- * Weather/Message
306
307 -- | The database representation of a weather message. We don't
308 -- contain the forecasts or the detailed weather since those are
309 -- foreigned-keyed to us.
310 --
311 data Weather =
312 Weather {
313 db_xml_file_id :: Int,
314 db_sport :: String,
315 db_title :: String,
316 db_time_stamp :: UTCTime }
317
318
319 -- | The XML representation of a weather message.
320 --
321 data Message =
322 Message {
323 xml_xml_file_id :: Int,
324 xml_heading :: String,
325 xml_category :: String,
326 xml_sport :: String,
327 xml_title :: String,
328 xml_forecasts :: [WeatherForecastXml],
329 xml_detailed_weather :: Maybe WeatherDetailedWeatherXml,
330 xml_time_stamp :: UTCTime }
331 deriving (Eq, Show)
332
333 instance ToDb Message where
334 -- | The database representation of 'Message' is 'Weather'.
335 --
336 type Db Message = Weather
337
338 instance FromXml Message where
339 -- | To get a 'Weather' from a 'Message', we drop a bunch of
340 -- unwanted fields.
341 --
342 from_xml Message{..} =
343 Weather {
344 db_xml_file_id = xml_xml_file_id,
345 db_sport = xml_sport,
346 db_title = xml_title,
347 db_time_stamp = xml_time_stamp }
348
349 -- | This allows us to insert the XML representation 'Message'
350 -- directly.
351 --
352 instance XmlImport Message
353
354
355 --
356 -- * Database stuff
357 --
358
359 mkPersist tsn_codegen_config [groundhog|
360 - entity: Weather
361 constructors:
362 - name: Weather
363 uniques:
364 - name: unique_weather
365 type: constraint
366 # Prevent multiple imports of the same message.
367 fields: [db_xml_file_id]
368
369 - entity: WeatherForecast
370 dbName: weather_forecasts
371 constructors:
372 - name: WeatherForecast
373 fields:
374 - name: db_weather_id
375 reference:
376 onDelete: cascade
377
378 - entity: WeatherForecastListing
379 dbName: weather_forecast_listings
380 constructors:
381 - name: WeatherForecastListing
382 fields:
383 - name: db_weather_forecasts_id
384 reference:
385 onDelete: cascade
386
387 # We rename the two fields that needed a "dtl" prefix to avoid a name clash.
388 - entity: WeatherDetailedWeatherListingItem
389 dbName: weather_detailed_items
390 constructors:
391 - name: WeatherDetailedWeatherListingItem
392 fields:
393 - name: db_dtl_weather_id
394 dbName: weather_id
395 reference:
396 onDelete: cascade
397 - name: db_dtl_game_date
398 dbName: game_date
399
400 |]
401
402
403
404 -- | There are two different types of documents that claim to be
405 -- \"weatherxml.dtd\". The first, more common type has listings
406 -- within forecasts. The second type has forecasts within
407 -- listings. Clearly we can't parse both of these using the same
408 -- parser!
409 --
410 -- For now we're simply punting on the issue and refusing to parse
411 -- the second type. This will check the given @xmltree@ to see if
412 -- there are any forecasts contained within listings. If there are,
413 -- then it's the second type that we don't know what to do with.
414 --
415 is_type1 :: XmlTree -> Bool
416 is_type1 xmltree =
417 case elements of
418 [] -> True
419 _ -> False
420 where
421 parse :: XmlTree -> [XmlTree]
422 parse = runLA $ hasName "/"
423 /> hasName "message"
424 /> hasName "listing"
425 /> hasName "forecast"
426
427 elements = parse xmltree
428
429
430 -- | Some weatherxml documents even have the Home/Away teams in the
431 -- wrong order. We can't parse that! This next bit of voodoo detects
432 -- whether or not there are any \<HomeTeam\> elements that are
433 -- directly followed by sibling \<AwayTeam\> elements. This is the
434 -- opposite of the usual order.
435 --
436 teams_are_normal :: XmlTree -> Bool
437 teams_are_normal xmltree =
438 case elements of
439 [] -> True
440 _ -> False
441 where
442 parse :: XmlTree -> [XmlTree]
443 parse = runLA $ hasName "/"
444 /> hasName "message"
445 /> hasName "Detailed_Weather"
446 /> hasName "DW_Listing"
447 /> hasName "Item"
448 >>> addNav
449 >>> descendantAxis
450 >>> filterAxis (hasName "HomeTeam")
451 >>> followingSiblingAxis
452 >>> remNav
453 >>> hasName "AwayTeam"
454
455 elements = parse xmltree
456
457
458 instance DbImport Message where
459 dbmigrate _ =
460 run_dbmigrate $ do
461 migrate (undefined :: Weather)
462 migrate (undefined :: WeatherForecast)
463 migrate (undefined :: WeatherForecastListing)
464 migrate (undefined :: WeatherDetailedWeatherListingItem)
465
466 dbimport m = do
467 -- First we insert the top-level weather record.
468 weather_id <- insert_xml m
469
470 -- Next insert all of the forecasts, one at a time.
471 forM_ (xml_forecasts m) $ \forecast -> do
472 forecast_id <- insert_xml_fk weather_id forecast
473
474 -- With the forecast id in hand, loop through this forecast's
475 -- leagues...
476 forM_ (xml_leagues forecast) $ \league -> do
477 -- Construct the function that converts an XML listing to a
478 -- database one.
479 let todb = from_xml_fk_league forecast_id (league_name league)
480
481 -- Now use it to convert all of the XML listings.
482 let db_listings = map todb (listings league)
483
484 -- And finally, insert those DB listings.
485 mapM_ insert_ db_listings
486
487 -- Now we do the detailed weather items.
488 case (xml_detailed_weather m) of
489 Nothing -> return ()
490 Just dw -> do
491 let detailed_listings = xml_detailed_listings dw
492 let items = concatMap xml_items detailed_listings
493 mapM_ (insert_xml_fk_ weather_id) items
494
495 return ImportSucceeded
496
497
498 --
499 -- * Pickling
500 --
501
502 -- | Pickler to convert a 'WeatherForecastListingXml' to/from XML.
503 --
504 pickle_listing :: PU WeatherForecastListingXml
505 pickle_listing =
506 xpElem "listing" $
507 xpWrap (from_pair, to_pair) $
508 xpPair
509 (xpElem "teams" xpText)
510 (xpElem "weather" xpText)
511 where
512 from_pair = uncurry WeatherForecastListingXml
513 to_pair WeatherForecastListingXml{..} = (xml_teams, xml_weather)
514
515
516 -- | Pickler to convert a 'WeatherLeague' to/from XML.
517 --
518 pickle_league :: PU WeatherLeague
519 pickle_league =
520 xpElem "league" $
521 xpWrap (from_pair, to_pair) $
522 xpPair
523 (xpAttr "name" $ xpOption xpText)
524 (xpList pickle_listing)
525 where
526 from_pair = uncurry WeatherLeague
527 to_pair WeatherLeague{..} = (league_name, listings)
528
529
530 -- | Pickler to convert a 'WeatherForecastXml' to/from XML.
531 --
532 pickle_forecast :: PU WeatherForecastXml
533 pickle_forecast =
534 xpElem "forecast" $
535 xpWrap (from_pair, to_pair) $
536 xpPair
537 (xpAttr "gamedate" xp_gamedate)
538 (xpList pickle_league)
539 where
540 from_pair = uncurry WeatherForecastXml
541 to_pair WeatherForecastXml{..} = (xml_game_date,
542 xml_leagues)
543
544
545
546 -- | (Un)pickle a 'WeatherDetailedWeatherListingItemXml'.
547 --
548 pickle_item :: PU WeatherDetailedWeatherListingItemXml
549 pickle_item =
550 xpElem "Item" $
551 xpWrap (from_tuple, to_tuple) $
552 xp9Tuple (xpElem "Sportcode" xpText)
553 (xpElem "GameID" xpInt)
554 (xpElem "Gamedate" xp_datetime)
555 (xpElem "AwayTeam" xpText)
556 (xpElem "HomeTeam" xpText)
557 (xpElem "WeatherType" xpInt)
558 (xpElem "Description" xpText)
559 (xpElem "TempAdjust" (xpOption xpText))
560 (xpElem "Temperature" xpInt)
561 where
562 from_tuple = uncurryN WeatherDetailedWeatherListingItemXml
563 to_tuple w = (xml_sport_code w,
564 xml_game_id w,
565 xml_dtl_game_date w,
566 xml_away_team w,
567 xml_home_team w,
568 xml_weather_type w,
569 xml_description w,
570 xml_temp_adjust w,
571 xml_temperature w)
572
573
574 -- | (Un)pickle a 'WeatherDetailedWeatherListingXml'.
575 --
576 pickle_dw_listing :: PU WeatherDetailedWeatherListingXml
577 pickle_dw_listing =
578 xpElem "DW_Listing" $
579 xpWrap (from_tuple, to_tuple) $
580 xpTriple (xpAttr "SportCode" xpText)
581 (xpAttr "Sport" xpText)
582 (xpList pickle_item)
583 where
584 from_tuple = uncurryN WeatherDetailedWeatherListingXml
585 to_tuple w = (xml_dtl_listing_sport w,
586 xml_dtl_listing_sport_code w,
587 xml_items w)
588
589
590 -- | (Un)pickle a 'WeatherDetailedWeatherXml'
591 --
592 pickle_detailed_weather :: PU WeatherDetailedWeatherXml
593 pickle_detailed_weather =
594 xpElem "Detailed_Weather" $
595 xpWrap (WeatherDetailedWeatherXml, xml_detailed_listings)
596 (xpList pickle_dw_listing)
597
598
599 -- | Pickler to convert a 'Message' to/from XML.
600 --
601 pickle_message :: PU Message
602 pickle_message =
603 xpElem "message" $
604 xpWrap (from_tuple, to_tuple) $
605 xp8Tuple
606 (xpElem "XML_File_ID" xpInt)
607 (xpElem "heading" xpText)
608 (xpElem "category" xpText)
609 (xpElem "sport" xpText)
610 (xpElem "title" xpText)
611 (xpList pickle_forecast)
612 (xpOption pickle_detailed_weather)
613 (xpElem "time_stamp" xp_time_stamp)
614 where
615 from_tuple = uncurryN Message
616 to_tuple Message{..} = (xml_xml_file_id,
617 xml_heading,
618 xml_category,
619 xml_sport,
620 xml_title,
621 xml_forecasts,
622 xml_detailed_weather,
623 xml_time_stamp)
624
625
626 --
627 -- * Tasty tests
628 --
629 weather_tests :: TestTree
630 weather_tests =
631 testGroup
632 "Weather tests"
633 [ test_on_delete_cascade,
634 test_pickle_of_unpickle_is_identity,
635 test_unpickle_succeeds,
636 test_types_detected_correctly,
637 test_normal_teams_detected_correctly ]
638
639
640 -- | If we unpickle something and then pickle it, we should wind up
641 -- with the same thing we started with. WARNING: success of this
642 -- test does not mean that unpickling succeeded.
643 --
644 test_pickle_of_unpickle_is_identity :: TestTree
645 test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
646 [ check "pickle composed with unpickle is the identity"
647 "test/xml/weatherxml.xml",
648
649 check "pickle composed with unpickle is the identity (detailed)"
650 "test/xml/weatherxml-detailed.xml" ]
651 where
652 check desc path = testCase desc $ do
653 (expected, actual) <- pickle_unpickle pickle_message path
654 actual @?= expected
655
656
657 -- | Make sure we can actually unpickle these things.
658 --
659 test_unpickle_succeeds :: TestTree
660 test_unpickle_succeeds = testGroup "unpickle tests"
661 [ check "unpickling succeeds"
662 "test/xml/weatherxml.xml",
663 check "unpickling succeeds (detailed)"
664 "test/xml/weatherxml-detailed.xml" ]
665 where
666 check desc path = testCase desc $ do
667 actual <- unpickleable path pickle_message
668 let expected = True
669 actual @?= expected
670
671
672 -- | Make sure everything gets deleted when we delete the top-level
673 -- record.
674 --
675 test_on_delete_cascade :: TestTree
676 test_on_delete_cascade = testGroup "cascading delete tests"
677 [ check "deleting weather deletes its children"
678 "test/xml/weatherxml.xml",
679 check "deleting weather deletes its children (detailed)"
680 "test/xml/weatherxml-detailed.xml" ]
681 where
682 check desc path = testCase desc $ do
683 weather <- unsafe_unpickle path pickle_message
684 let a = undefined :: Weather
685 let b = undefined :: WeatherForecast
686 let c = undefined :: WeatherForecastListing
687 let d = undefined :: WeatherDetailedWeatherListingItem
688 actual <- withSqliteConn ":memory:" $ runDbConn $ do
689 runMigration silentMigrationLogger $ do
690 migrate a
691 migrate b
692 migrate c
693 migrate d
694 _ <- dbimport weather
695 deleteAll a
696 count_a <- countAll a
697 count_b <- countAll b
698 count_c <- countAll c
699 count_d <- countAll d
700 return $ count_a + count_b + count_c + count_d
701 let expected = 0
702 actual @?= expected
703
704
705 -- | This is used in a few tests to extract an 'XmlTree' from a path.
706 --
707 unsafe_get_xmltree :: String -> IO XmlTree
708 unsafe_get_xmltree path =
709 fmap head $ runX $ readDocument parse_opts path
710
711
712 -- | We want to make sure type1 documents are detected as type1, and
713 -- type2 documents detected as type2..
714 --
715 test_types_detected_correctly :: TestTree
716 test_types_detected_correctly =
717 testGroup "weatherxml types detected correctly" $
718 [ check "test/xml/weatherxml.xml"
719 "first type detected correctly"
720 True,
721 check "test/xml/weatherxml-detailed.xml"
722 "first type detected correctly (detailed)"
723 True,
724 check "test/xml/weatherxml-type2.xml"
725 "second type detected correctly"
726 False ]
727 where
728 check path desc expected = testCase desc $ do
729 xmltree <- unsafe_get_xmltree path
730 let actual = is_type1 xmltree
731 actual @?= expected
732
733
734 -- | We want to make sure normal teams are detected as normal, and the
735 -- backwards ones are flagged as backwards.
736 --
737 test_normal_teams_detected_correctly :: TestTree
738 test_normal_teams_detected_correctly =
739 testGroup "team order is detected correctly" [
740
741 check "normal teams are detected correctly"
742 "test/xml/weatherxml.xml"
743 True,
744
745 check "backwards teams are detected correctly"
746 "test/xml/weatherxml-backwards-teams.xml"
747 False ]
748 where
749 check desc path expected = testCase desc $ do
750 xmltree <- unsafe_get_xmltree path
751 let actual = teams_are_normal xmltree
752 actual @?= expected