From b18c060e5cb708901eb29f1f27b25c467875a143 Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Thu, 28 Jun 2012 15:38:52 -0400
Subject: [PATCH 1/1] Add some tests for the article URL construction.

---
 makefile          | 14 +++++++++++---
 src/LWN/URI.hs    | 13 +++++++++++++
 src/Main.hs       | 49 ++++++++++++++++++++++++++++++++++++++++++-----
 test/TestSuite.hs |  4 +++-
 4 files changed, 71 insertions(+), 9 deletions(-)

diff --git a/makefile b/makefile
index 15a2187..ec658b0 100644
--- 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 1cf8826..7aa4240 100644
--- 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 47c69fa..924b9a5 100644
--- 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 791408e..ce648dc 100644
--- 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 ]
-- 
2.43.2