X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FNews.hs;h=26ca8c0deb76670e3aeee7ec28ac1567baec2ddd;hb=4fd6088bc7b1dcde64728c9edcff577c13dc4e78;hp=661279272e5f1056221fdcb1e06cbfc1ccfe5157;hpb=a1edb885c755aac52e805255382dda50f6664b60;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 6612792..26ca8c0 100644
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -37,7 +37,7 @@ import Text.XML.HXT.Core (
   PU,
   XmlPickler(..),
   unpickleDoc,
-  xp12Tuple,
+  xp13Tuple,
   xpAttr,
   xpElem,
   xpInt,
@@ -149,6 +149,7 @@ data MessageXml =
     xml_teams :: [NewsTeamXml],
     xml_locations :: [NewsLocationXml],
     xml_sms :: String,
+    xml_editor :: Maybe String,
     xml_text :: String,
     xml_continue :: String,
     xml_time_stamp :: String }
@@ -160,6 +161,7 @@ data Message =
     db_sport :: String,
     db_url :: String,
     db_sms :: String,
+    db_editor :: Maybe String,
     db_text :: String,
     db_continue :: String }
   deriving (Data, Eq, Show, Typeable)
@@ -181,14 +183,15 @@ instance ToFromXml Message where
       def
       def
       db_sms
+      db_editor
       db_text
       db_continue
       def
 
   -- We don't need the key argument (from_xml_fk) since the XML type
   -- contains more information in this case.
-  from_xml (MessageXml _ _ c _ e f _ _ i j k _) =
-    Message c e f i j k
+  from_xml (MessageXml _ _ c _ e f _ _ i j k l _) =
+    Message c e f i j k l
 
 
 mkPersist tsn_codegen_config [groundhog|
@@ -261,7 +264,7 @@ pickle_message :: PU MessageXml
 pickle_message =
   xpElem "message" $
     xpWrap (from_tuple, to_tuple) $
-    xp12Tuple (xpElem "XML_File_ID" xpInt)
+    xp13Tuple (xpElem "XML_File_ID" xpInt)
               (xpElem "heading" xpText)
               pickle_msg_id
               (xpElem "category" xpText)
@@ -270,6 +273,7 @@ pickle_message =
               (xpList $ pickle_news_team)
               (xpList $ pickle_location)
               (xpElem "SMS" xpText)
+              (xpOption (xpElem "Editor" xpText))
               (xpElem "text" xpText)
               pickle_continue
               (xpElem "time_stamp" xpText)
@@ -284,6 +288,7 @@ pickle_message =
                   xml_teams m,
                   xml_locations m,
                   xml_sms m,
+                  xml_editor m,
                   xml_text m,
                   xml_continue m,
                   xml_time_stamp m)
@@ -334,8 +339,10 @@ news_tests =
   testGroup
     "News tests"
     [ test_news_fields_have_correct_names,
-      test_pickle_of_unpickle_is_identity,
-      test_unpickle_succeeds ]
+      test_pickle_of_unpickle_is_identity1,
+      test_pickle_of_unpickle_is_identity2,
+      test_unpickle_succeeds1,
+      test_unpickle_succeeds2 ]
 
 
 test_news_fields_have_correct_names :: TestTree
@@ -354,25 +361,41 @@ test_news_fields_have_correct_names =
       map (\x -> tsn_db_field_namer "herp" "derp" 8675309 x 90210) field_names
 
     actual :: [String]
-    actual = ["mid", "sport", "url", "sms", "text", "continue"]
+    actual = ["mid", "sport", "url", "sms", "editor", "text", "continue"]
 
     check (x,y) = (x @?= y)
 
 
 -- | Warning, succeess of this test does not mean that unpickling
 --   succeeded.
-test_pickle_of_unpickle_is_identity :: TestTree
-test_pickle_of_unpickle_is_identity =
+test_pickle_of_unpickle_is_identity1 :: TestTree
+test_pickle_of_unpickle_is_identity1 =
   testCase "pickle composed with unpickle is the identity" $ do
     let path = "test/xml/newsxml.xml"
     (expected :: [MessageXml], actual) <- pickle_unpickle "message" path
     actual @?= expected
 
+-- | Repeat of 'test_pickle_of_unpickle_is_identity1' with a different
+--   XML file.
+test_pickle_of_unpickle_is_identity2 :: TestTree
+test_pickle_of_unpickle_is_identity2 =
+  testCase "pickle composed with unpickle is the identity (with Editor)" $ do
+    let path = "test/xml/newsxml-with-editor.xml"
+    (expected :: [MessageXml], actual) <- pickle_unpickle "message" path
+    actual @?= expected
 
-test_unpickle_succeeds :: TestTree
-test_unpickle_succeeds =
+test_unpickle_succeeds1 :: TestTree
+test_unpickle_succeeds1 =
   testCase "unpickling succeeds" $ do
   let path = "test/xml/newsxml.xml"
   actual <- unpickleable path pickle_message
   let expected = True
   actual @?= expected
+
+test_unpickle_succeeds2 :: TestTree
+test_unpickle_succeeds2 =
+  testCase "unpickling succeeds (with Editor)" $ do
+  let path = "test/xml/newsxml-with-editor.xml"
+  actual <- unpickleable path pickle_message
+  let expected = True
+  actual @?= expected