From 76cf3eee776d35ba2b18dd0d07df7496a083ae3a Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 31 Dec 2013 16:40:47 -0500 Subject: [PATCH] Move the XML modules into the XML subdirectory. Don't save the default fields along with the news. Make the makefile a little more accurate. --- makefile | 10 ++++++---- src/Main.hs | 6 +++--- src/TSN/{ => XML}/Injuries.hs | 2 +- src/TSN/{ => XML}/InjuriesDetail.hs | 2 +- src/TSN/{ => XML}/News.hs | 20 ++++++++------------ test/TestSuite.hs | 6 +++--- 6 files changed, 22 insertions(+), 24 deletions(-) rename src/TSN/{ => XML}/Injuries.hs (99%) rename src/TSN/{ => XML}/InjuriesDetail.hs (99%) rename src/TSN/{ => XML}/News.hs (96%) diff --git a/makefile b/makefile index 1be5000..07530a6 100644 --- a/makefile +++ b/makefile @@ -1,20 +1,22 @@ PN = htsn-import BIN = dist/build/$(PN)/$(PN) TESTSUITE_BIN = dist/build/testsuite/testsuite +SRCS := $(shell find src/ -type f -name '*.hs') +TEST_SRCS := $(shell find test/ -type f -name '*.hs') .PHONY : dist hlint -$(BIN): $(PN).cabal src/*.hs src/TSN/*.hs +$(BIN): $(PN).cabal $(SRCS) runghc Setup.hs clean runghc Setup.hs configure --user --prefix=/ runghc Setup.hs build -profile: $(PN).cabal src/*.hs src/TSN/*.hs +profile: $(PN).cabal $(SRCS) runghc Setup.hs clean runghc Setup.hs configure --user --enable-executable-profiling --prefix=/ runghc Setup.hs build -doc: $(PN).cabal src/*.hs src/TSN/*.hs +doc: $(PN).cabal $(SRCS) runghc Setup.hs configure --user --prefix=/ runghc Setup.hs hscolour --executables runghc Setup.hs haddock --internal \ @@ -27,7 +29,7 @@ clean: rm -f *.xml rm -rf tmp -$(TESTSUITE_BIN): $(PN).cabal src/*.hs test/TestSuite.hs +$(TESTSUITE_BIN): $(PN).cabal $(SRCS) $(TEST_SRCS) runghc Setup.hs configure --user --enable-tests --prefix=/ runghc Setup.hs build diff --git a/src/Main.hs b/src/Main.hs index 568f0fe..3ea2606 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -39,9 +39,9 @@ import Network.Services.TSN.Report ( report_info, report_error ) import TSN.DbImport -import qualified TSN.Injuries as Injuries ( Listing ) -import qualified TSN.InjuriesDetail as InjuriesDetail ( PlayerListing ) -import qualified TSN.News as News ( Message ) +import qualified TSN.XML.Injuries as Injuries ( Listing ) +import qualified TSN.XML.InjuriesDetail as InjuriesDetail ( PlayerListing ) +import qualified TSN.XML.News as News ( Message ) import Xml ( parse_opts ) diff --git a/src/TSN/Injuries.hs b/src/TSN/XML/Injuries.hs similarity index 99% rename from src/TSN/Injuries.hs rename to src/TSN/XML/Injuries.hs index 8c2de14..92bf4e2 100644 --- a/src/TSN/Injuries.hs +++ b/src/TSN/XML/Injuries.hs @@ -13,7 +13,7 @@ -- The listings will be mapped to a database table called "injuries" -- automatically. The root message is not retained. -- -module TSN.Injuries ( +module TSN.XML.Injuries ( Listing, Message( listings ), injuries_tests ) diff --git a/src/TSN/InjuriesDetail.hs b/src/TSN/XML/InjuriesDetail.hs similarity index 99% rename from src/TSN/InjuriesDetail.hs rename to src/TSN/XML/InjuriesDetail.hs index a787ad5..cb3afea 100644 --- a/src/TSN/InjuriesDetail.hs +++ b/src/TSN/XML/InjuriesDetail.hs @@ -17,7 +17,7 @@ -- "injuries_detail" automatically. The root "message" and "listing" -- are not retained. -- -module TSN.InjuriesDetail ( +module TSN.XML.InjuriesDetail ( Listing ( player_listings ), Message ( listings ), PlayerListing, diff --git a/src/TSN/News.hs b/src/TSN/XML/News.hs similarity index 96% rename from src/TSN/News.hs rename to src/TSN/XML/News.hs index 2366819..61da812 100644 --- a/src/TSN/News.hs +++ b/src/TSN/XML/News.hs @@ -11,7 +11,7 @@ -- | Parse TSN XML for the DTD "newsxml.dtd". Each document contains a -- root element \ that contains an entire news item. -- -module TSN.News ( +module TSN.XML.News ( Message, news_tests ) where @@ -152,16 +152,12 @@ data MessageXml = data Message = Message { - db_xml_file_id :: Int, - db_heading :: String, db_mid :: MsgId, - db_category :: String, db_sport :: String, db_url :: String, db_sms :: String, db_text :: String, - db_continue :: String, - db_time_stamp :: String } + db_continue :: String } deriving (Eq, Show) instance ToFromXml Message where @@ -172,10 +168,10 @@ instance ToFromXml Message where -- used our named fields. to_xml (Message {..}) = MessageXml - db_xml_file_id - db_heading + 0 + "" db_mid - db_category + "" db_sport db_url [] @@ -183,12 +179,12 @@ instance ToFromXml Message where db_sms db_text db_continue - db_time_stamp + "" -- We don't need the key argument (from_xml_fk) since the XML type -- contains more information in this case. - from_xml (MessageXml a b c d e f _ _ g h i j) = - Message a b c d e f g h i j + from_xml (MessageXml _ _ c _ e f _ _ g h i _) = + Message c e f g h i mkPersist tsn_codegen_config [groundhog| diff --git a/test/TestSuite.hs b/test/TestSuite.hs index f5f1b4f..4446f8c 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -1,8 +1,8 @@ import Test.Tasty ( TestTree, defaultMain, testGroup ) -import TSN.Injuries ( injuries_tests ) -import TSN.InjuriesDetail ( injuries_detail_tests ) -import TSN.News ( news_tests ) +import TSN.XML.Injuries ( injuries_tests ) +import TSN.XML.InjuriesDetail ( injuries_detail_tests ) +import TSN.XML.News ( news_tests ) tests :: TestTree tests = testGroup -- 2.44.2