+
+-- * NewsTeamXml
+
+-- | The XML type for teams as they show up in the news. We can't
+-- reuse the representation from "TSN.Team" because our name doesn't
+-- appear optional and we have no abbreviation.
+--
+data NewsTeamXml =
+ NewsTeamXml { xml_team_id :: String,
+ xml_team_name :: String }
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic NewsTeamXml
+
+
+instance ToDb NewsTeamXml where
+ -- | The database representation of 'NewsTeamXml' is 'Team'.
+ type Db NewsTeamXml = Team
+
+-- | Convert the XML representation 'NewsTeamXml' to the database
+-- representation 'Team'.
+--
+instance FromXml NewsTeamXml where
+ from_xml NewsTeamXml{..} =
+ Team { team_id = xml_team_id,
+ abbreviation = Nothing,
+ name = Just xml_team_name }
+
+-- | Allow us to import 'NewsTeamXml' directly.
+--
+instance XmlImport NewsTeamXml
+
+
+-- * News_Team
+
+-- | Mapping between News records and Team records in the database. We
+-- don't name the fields because we don't use the names explicitly;
+-- that means we have to give them nice database names via
+-- groundhog.
+--
+data News_Team = News_Team (DefaultKey News) (DefaultKey Team)
+
+
+-- * News_Location
+
+-- | Mapping between 'News' records and 'Location' records in the
+-- database. We don't name the fields because we don't use the names
+-- explicitly; that means we have to give them nice database names
+-- via groundhog.
+--
+data News_Location = News_Location
+ (DefaultKey News)
+ (DefaultKey Location)
+
+
+
+
+-- | Some newsxml documents contain two \<SMS\> elements in a row,
+-- violating the DTD. The second one has always been empty, but it's
+-- irrelevant: we can't parse these, and would like to detect them
+-- in order to report the fact that the busted document is
+-- unsupported.
+--
+-- This function detects whether two \<SMS\> elements appear in a
+-- row, as siblings.
+--
+has_only_single_sms :: XmlTree -> Bool
+has_only_single_sms xmltree =
+ case elements of
+ [] -> True
+ _ -> False
+ where
+ parse :: XmlTree -> [XmlTree]
+ parse = runLA $ hasName "/"
+ /> hasName "message"
+ >>> addNav
+ >>> descendantAxis
+ >>> filterAxis (hasName "SMS")
+ >>> followingSiblingAxis
+ >>> remNav
+ >>> hasName "SMS"
+
+ elements = parse xmltree
+
+
+--
+-- * Database code
+--
+