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

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 26ca8c0..565c7a5 100644
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -270,8 +270,8 @@ pickle_message =
               (xpElem "category" xpText)
               (xpElem "sport" xpText)
               (xpElem "url" xpText)
-              (xpList $ pickle_news_team)
-              (xpList $ pickle_location)
+              (xpList pickle_news_team)
+              (xpList pickle_location)
               (xpElem "SMS" xpText)
               (xpOption (xpElem "Editor" xpText))
               (xpElem "text" xpText)
@@ -297,7 +297,7 @@ pickle_message =
     pickle_continue =
       xpWrap (to_string, from_string) $
         xpElem "continue" $
-          (xpList $ xpElem "P" xpText)
+          xpList (xpElem "P" xpText)
       where
         from_string :: String -> [String]
         from_string = split "\n"
@@ -339,15 +339,13 @@ news_tests =
   testGroup
     "News tests"
     [ test_news_fields_have_correct_names,
-      test_pickle_of_unpickle_is_identity1,
-      test_pickle_of_unpickle_is_identity2,
-      test_unpickle_succeeds1,
-      test_unpickle_succeeds2 ]
+      test_pickle_of_unpickle_is_identity,
+      test_unpickle_succeeds ]
 
 
 test_news_fields_have_correct_names :: TestTree
 test_news_fields_have_correct_names =
-  testCase "news fields get correct database names" $ do
+  testCase "news fields get correct database names" $
     mapM_ check (zip actual expected)
   where
     -- This is cool, it uses the (derived) Data instance of
@@ -368,34 +366,28 @@ test_news_fields_have_correct_names =
 
 -- | Warning, succeess of this test does not mean that unpickling
 --   succeeded.
-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_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
+test_pickle_of_unpickle_is_identity :: TestTree
+test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
+  [ check "pickle composed with unpickle is the identity"
+          "test/xml/newsxml.xml",
+
+    check "pickle composed with unpickle is the identity (with Editor)"
+          "test/xml/newsxml-with-editor.xml" ]
+  where
+    check desc path = testCase desc $ do
+      (expected :: [MessageXml], actual) <- pickle_unpickle "message" path
+      actual @?= expected
+
+
+test_unpickle_succeeds :: TestTree
+test_unpickle_succeeds = testGroup "unpickle tests"
+  [ check "unpickling succeeds"
+          "test/xml/newsxml.xml",
+
+    check "unpickling succeeds (with Editor)"
+          "test/xml/newsxml-with-editor.xml" ]
+  where
+    check desc path = testCase desc $ do
+      actual <- unpickleable path pickle_message
+      let expected = True
+      actual @?= expected