Add some tests for the article URL construction.

diff --git a/makefile b/makefile
index 15a218731a0df652788f2621855f3f9532eb7ced..ec658b07233d557c7bc4e2297927025376f6c5c0 100644 (file)
--- a/makefile
+++ b/makefile
@@ -1,6 +1,11 @@
 .PHONY : test publish_doc doc src_html hlint
 
-lwn-epub: src/*.hs
+# There's onlt one '$' in the awk script, but we have to double-money
+# it for make.
+PN  := $(shell grep 'name:' *.cabal | awk '{ print $$2 }')
+BIN := dist/build/$(PN)/$(PN)
+
+$(BIN): src/*.hs
        runghc Setup.hs clean
        runghc Setup.hs configure --user --flags=${FLAGS}
        runghc Setup.hs build
@@ -19,5 +24,8 @@ doc: src_html
                                --executables \
                                --hyperlink-source
 
-test:
-       runghc -i"src" test/TestSuite.hs
+dist/build/autogen: $(BIN)
+
+
+test: dist/build/autogen
+       runghc -i"src" -i"dist/build/autogen" test/TestSuite.hs

diff --git a/src/LWN/URI.hs b/src/LWN/URI.hs
index 1cf88263f5a627ecb5851bc6531858fe1b257f3f..7aa4240cf146eee312801881100ce43be087b6e5 100644 (file)
--- a/src/LWN/URI.hs
+++ b/src/LWN/URI.hs
@@ -40,6 +40,19 @@ http_port uri =
     parse_result = uriAuthority uri
 
 
+make_https :: URL -> URL
+make_https url =
+  case parse_result of
+    Nothing -> url -- Shrug?
+    Just uri ->
+      if http uri then
+        show $ uri { uriScheme = "https:" }
+      else
+        url -- Leave non-http URLs alone.
+  where
+    parse_result = parseURIReference url
+
+
 -- | Does this URI use an HTTPS-compatible port?
 https_port :: URI -> Bool
 https_port uri =

diff --git a/src/Main.hs b/src/Main.hs
index 47c69fa1cba9ade063d2b63bea22fe800b33a4e9..924b9a558dd59df682d9cbdb3713fceaad0b27f1 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -11,13 +11,16 @@ import System.IO (
   stdout
   )
 import System.IO.UTF8 (readFile)
+import Test.HUnit (Assertion, assertEqual)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
 import Text.Regex.Posix ((=~))
 import Text.XML.HXT.Core
 
 import CommandLine (show_help)
 import Configuration (Cfg(..), get_cfg)
 import LWN.Page
-import LWN.URI (is_lwn_url, make_absolute_url)
+import LWN.URI (is_lwn_url, make_absolute_url, make_https)
 import Misc (contains)
 
 
@@ -70,16 +73,16 @@ real_article_path s = do
       case make_absolute_url "current" of
         Nothing -> s
         Just ac -> ac
-    abs_s =
-      case make_absolute_url s of
+    abs_article =
+      case make_absolute_url ("Articles/" ++ s) of
         Nothing -> s
         Just as -> as
 
     check_cases :: String
     check_cases
-      | is_lwn_url s = s
+      | is_lwn_url s = make_https s
       | s `contains` "current" = abs_current
-      | s =~ "^[0-9]+$" = abs_s
+      | s =~ "^[0-9]+$" = abs_article
       | otherwise = s -- Give up
 
 main :: IO ()
@@ -101,3 +104,39 @@ main = do
     Nothing -> do
       _ <- show_help
       return ()
+
+
+
+test_current_article_path :: Assertion
+test_current_article_path = do
+  let expected = "https://lwn.net/current"
+  actual <- real_article_path "current"
+  assertEqual "Current article path constructed" expected actual
+
+test_numbered_article_path :: Assertion
+test_numbered_article_path = do
+  let expected = "https://lwn.net/Articles/69"
+  actual <- real_article_path "69" -- I'm twelve
+  assertEqual "Numbered article path constructed" expected actual
+
+
+test_full_article_path :: Assertion
+test_full_article_path = do
+  let expected = "https://lwn.net/Articles/502979/"
+  actual <- real_article_path "https://lwn.net/Articles/502979/"
+  assertEqual "Full article path left alone" expected actual
+
+test_non_https_article_path :: Assertion
+test_non_https_article_path = do
+  let expected = "https://lwn.net/Articles/502979/"
+  actual <- real_article_path "http://lwn.net/Articles/502979/"
+  assertEqual "Non-https URL made https" expected actual
+
+main_tests :: Test
+main_tests =
+  testGroup "Main Tests" [
+    testCase "Current article path constructed" test_current_article_path,
+    testCase "Numbered article path constructed" test_numbered_article_path,
+    testCase "Full article path left alone" test_full_article_path,
+    testCase "Non-https URL made https" test_non_https_article_path ]
+     
\ No newline at end of file

diff --git a/test/TestSuite.hs b/test/TestSuite.hs
index 791408ed7c8a6f3003898669f9380cf9116734b6..ce648dcd6ae6ee19c9eba6e5fbb681d4083df733 100644 (file)
--- a/test/TestSuite.hs
+++ b/test/TestSuite.hs
@@ -15,6 +15,7 @@ import Test.Framework.Runners.Options
 import Test.Framework.Providers.API (TestName)
 import Test.HUnit
 
+import Main (main_tests)
 import LWN.Page (page_tests)
 import LWN.URI (uri_tests)
 
@@ -22,5 +23,6 @@ main :: IO ()
 main = defaultMain tests
 
 tests :: [Test.Framework.Test]
-tests = [ page_tests,
+tests = [ main_tests,
+          page_tests,
           uri_tests ]