From: Michael Orlitzky Date: Mon, 30 Dec 2013 17:42:03 +0000 (-0500) Subject: Get pickling (but not insertion) working for TSN.News. X-Git-Tag: 0.0.1~142 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=04f468994697d4d983a09a8e612948b23a973848;p=dead%2Fhtsn-import.git Get pickling (but not insertion) working for TSN.News. --- diff --git a/htsn-import.cabal b/htsn-import.cabal index cbec4e6..362beac 100644 --- a/htsn-import.cabal +++ b/htsn-import.cabal @@ -26,6 +26,7 @@ executable htsn-import groundhog-postgresql == 0.4.*, groundhog-sqlite == 0.4.*, groundhog-th == 0.4.*, + MissingH == 1.2.*, old-locale == 1.0.*, tasty == 0.7.*, tasty-hunit == 0.4.*, @@ -79,6 +80,7 @@ test-suite testsuite groundhog-postgresql == 0.4.*, groundhog-sqlite == 0.4.*, groundhog-th == 0.4.*, + MissingH == 1.2.*, old-locale == 1.0.*, tasty == 0.7.*, tasty-hunit == 0.4.*, diff --git a/src/Main.hs b/src/Main.hs index 9730f5e..4485777 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -54,7 +54,7 @@ import qualified TSN.InjuriesDetail as InjuriesDetail ( Listing ( player_listings ), Message ( listings ), PlayerListing ) -import qualified TSN.News as News +import qualified TSN.News as News ( Message ) import Xml ( parse_opts ) @@ -94,7 +94,10 @@ import_generic dummy g cfg xml -- | Import TSN.News from an 'XmlTree'. import_news :: Configuration -> XmlTree -> IO (Maybe Int) -import_news = undefined +import_news = + import_generic + (undefined :: News.Message) + id -- | Import TSN.Injuries from an 'XmlTree'. import_injuries :: Configuration -> XmlTree -> IO (Maybe Int) diff --git a/src/TSN/News.hs b/src/TSN/News.hs index 4e24c3a..74b4846 100644 --- a/src/TSN/News.hs +++ b/src/TSN/News.hs @@ -14,6 +14,7 @@ module TSN.News ( news_tests ) where +import Data.List.Utils ( join, split ) import Data.Tuple.Curry ( uncurryN ) import Database.Groundhog() import Database.Groundhog.TH @@ -37,14 +38,19 @@ import Text.XML.HXT.Core ( import Xml ( pickle_unpickle ) +-- Can't use a newtype with groundhog. +data NewsTeam = + NewsTeam { team_name :: String } + deriving (Eq, Show) + data MsgId = MsgId { - msg_id_text :: Int, + msg_id :: Int, event_id :: String } deriving (Eq, Show) -data Location = - Location { +data NewsLocation = + NewsLocation { city :: String, state :: String, country :: String } @@ -53,13 +59,13 @@ data Location = data Message = Message { xml_file_id :: Int, - msg_id :: MsgId, heading :: String, + mid :: MsgId, category :: String, sport :: String, url :: String, - teams :: [String], - location :: Location, + teams :: [NewsTeam], + locations :: [NewsLocation], sms :: String, text :: String, continue :: String, @@ -67,11 +73,43 @@ data Message = deriving (Eq, Show) --- mkPersist defaultCodegenConfig [groundhog| --- - entity: Message --- dbName: injuries --- |] +mkPersist defaultCodegenConfig [groundhog| +- entity: NewsTeam + dbName: news_teams + +- entity: NewsLocation + dbName: news_locations + +- entity: Message + dbName: news + constructors: + - name: Message + fields: + - name: mid + embeddedType: + - {name: msg_id, dbName: msg_id} + - {name: event_id, dbName: event_id} + +- embedded: MsgId + fields: + - name: msg_id + - name: event_id +|] + +pickle_news_team :: PU NewsTeam +pickle_news_team = + xpElem "team" $ + xpWrap (from_string, to_string) xpText + where + to_string :: NewsTeam -> String + to_string = team_name + + from_string :: String -> NewsTeam + from_string = NewsTeam + +instance XmlPickler NewsTeam where + xpickle = pickle_news_team pickle_msg_id :: PU MsgId pickle_msg_id = @@ -80,23 +118,23 @@ pickle_msg_id = xpPair xpPrim (xpAttr "EventId" xpText0) where from_tuple = uncurryN MsgId - to_tuple m = (msg_id_text m, event_id m) + to_tuple m = (msg_id m, event_id m) instance XmlPickler MsgId where xpickle = pickle_msg_id -pickle_location :: PU Location +pickle_location :: PU NewsLocation pickle_location = - xpElem "listing" $ + xpElem "location" $ xpWrap (from_tuple, to_tuple) $ xpTriple (xpElem "city" xpText) - (xpElem "state" xpPrim) - (xpElem "location" xpText) + (xpElem "state" xpText) + (xpElem "country" xpText) where - from_tuple = uncurryN Location + from_tuple = uncurryN NewsLocation to_tuple l = (city l, state l, country l) -instance XmlPickler Location where +instance XmlPickler NewsLocation where xpickle = pickle_location @@ -105,32 +143,44 @@ pickle_message = xpElem "message" $ xpWrap (from_tuple, to_tuple) $ xp12Tuple (xpElem "XML_File_ID" xpPrim) - pickle_msg_id (xpElem "heading" xpText) + pickle_msg_id (xpElem "category" xpText) (xpElem "sport" xpText) (xpElem "url" xpText) - (xpList $ xpElem "team" xpText) - (pickle_location) - (xpElem "sms" xpText) + (xpList $ pickle_news_team) + (xpList $ pickle_location) + (xpElem "SMS" xpText) (xpElem "text" xpText) - (xpElem "continue" xpText) + pickle_continue (xpElem "time_stamp" xpText) where from_tuple = uncurryN Message to_tuple m = (xml_file_id m, - msg_id m, heading m, + mid m, category m, sport m, url m, teams m, - location m, + locations m, sms m, text m, continue m, time_stamp m) + pickle_continue :: PU String + pickle_continue = + xpWrap (to_string, from_string) $ + xpElem "continue" $ + (xpList $ xpElem "P" xpText) + where + from_string :: String -> [String] + from_string = split "\n" + + to_string :: [String] -> String + to_string = join "\n" + instance XmlPickler Message where xpickle = pickle_message diff --git a/test/TestSuite.hs b/test/TestSuite.hs index 17d9a24..f5f1b4f 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -2,11 +2,14 @@ import Test.Tasty ( TestTree, defaultMain, testGroup ) import TSN.Injuries ( injuries_tests ) import TSN.InjuriesDetail ( injuries_detail_tests ) +import TSN.News ( news_tests ) tests :: TestTree tests = testGroup "All tests" - [ injuries_tests, injuries_detail_tests ] + [ injuries_tests, + injuries_detail_tests, + news_tests ] main :: IO () main = defaultMain tests