Fix hlint suggestions.

[dead/htsn-import.git] / src / TSN / XML / News.hs

diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 26ca8c0deb76670e3aeee7ec28ac1567baec2ddd..565c7a52fb038b10e377b651bee1b58c73a49777 100644 (file)
--- 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