From 3c5efc1361484f55d9e40b6be4618b2ff8aded26 Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Mon, 15 Oct 2012 16:10:24 +0200
Subject: Make test management scripts more robust

 * They are now independent from the current directory, and hence can be
   called from everywhere

 * On UNIX/Linux they can now be run as scripts
---
 html-test/accept.lhs | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100755 html-test/accept.lhs

(limited to 'html-test/accept.lhs')

diff --git a/html-test/accept.lhs b/html-test/accept.lhs
new file mode 100755
index 00000000..3dfc099b
--- /dev/null
+++ b/html-test/accept.lhs
@@ -0,0 +1,49 @@
+#!/usr/bin/env runhaskell
+\begin{code}
+{-# LANGUAGE CPP #-}
+import System.Cmd
+import System.Environment
+import System.FilePath
+import System.Directory
+import Data.List
+import Control.Applicative
+
+baseDir = takeDirectory __FILE__
+
+main :: IO ()
+main = do
+  contents <- filter (`notElem` ignore) <$> getDirectoryContents (baseDir </> "output")
+  args <- getArgs
+  if not $ null args then
+    mapM_ copy [ baseDir </> "output" </> file | file <- contents, ".html" `isSuffixOf` file, takeBaseName file `elem` args  ]
+  else
+    mapM_ copy [ baseDir </> "output" </> file | file <- contents]
+  where
+    ignore = [
+        "."
+      , ".."
+      , "doc-index.html"
+      , "index-frames.html"
+      , "index.html"
+      ]
+
+copy :: FilePath -> IO ()
+copy file = do
+  let new = baseDir </> "ref" </> takeFileName file
+  if ".html" `isSuffixOf` file then do
+    putStrLn (file ++ " -> " ++ new)
+    stripLinks <$> readFile file >>= writeFile new
+  else do
+    -- copy css, images, etc.
+    copyFile file new
+
+stripLinks :: String -> String
+stripLinks str =
+  let prefix = "<a href=\"" in
+  case stripPrefix prefix str of
+    Just str' -> prefix ++ stripLinks (dropWhile (/= '"') str')
+    Nothing ->
+      case str of
+        [] -> []
+        x : xs -> x : stripLinks xs
+\end{code}
-- 
cgit v1.2.3


From 18fd9f5a0a1debe23bef4ba813143b886d586740 Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Mon, 15 Oct 2012 20:28:26 +0200
Subject: Adapt accept.lhs, so that it ignores more index files

---
 html-test/accept.lhs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

(limited to 'html-test/accept.lhs')

diff --git a/html-test/accept.lhs b/html-test/accept.lhs
index 3dfc099b..ea55c35c 100755
--- a/html-test/accept.lhs
+++ b/html-test/accept.lhs
@@ -12,19 +12,19 @@ baseDir = takeDirectory __FILE__
 
 main :: IO ()
 main = do
-  contents <- filter (`notElem` ignore) <$> getDirectoryContents (baseDir </> "output")
+  contents <- filter (not . ignore) <$> getDirectoryContents (baseDir </> "output")
   args <- getArgs
   if not $ null args then
     mapM_ copy [ baseDir </> "output" </> file | file <- contents, ".html" `isSuffixOf` file, takeBaseName file `elem` args  ]
   else
     mapM_ copy [ baseDir </> "output" </> file | file <- contents]
   where
-    ignore = [
-        "."
-      , ".."
-      , "doc-index.html"
-      , "index-frames.html"
-      , "index.html"
+    ignore =
+      foldr (liftA2 (||)) (const False) [
+        (== ".")
+      , (== "..")
+      , (isPrefixOf "index")
+      , (isPrefixOf "doc-index")
       ]
 
 copy :: FilePath -> IO ()
-- 
cgit v1.2.3


From 410d8a4f7cfe3b45b98719f75bffc9ac06626fbc Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Mon, 15 Oct 2012 20:34:40 +0200
Subject: Adapt output directory for HTML tests

---
 .gitignore           | 2 +-
 html-test/accept.lhs | 6 +++---
 html-test/run.lhs    | 2 +-
 3 files changed, 5 insertions(+), 5 deletions(-)

(limited to 'html-test/accept.lhs')

diff --git a/.gitignore b/.gitignore
index 3d242029..b516bcf8 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,5 @@
 /dist/
-/html-test/output/
+/html-test/out/
 
 /doc/haddock
 /doc/autom4te.cache/
diff --git a/html-test/accept.lhs b/html-test/accept.lhs
index ea55c35c..f6dfc4cd 100755
--- a/html-test/accept.lhs
+++ b/html-test/accept.lhs
@@ -12,12 +12,12 @@ baseDir = takeDirectory __FILE__
 
 main :: IO ()
 main = do
-  contents <- filter (not . ignore) <$> getDirectoryContents (baseDir </> "output")
+  contents <- filter (not . ignore) <$> getDirectoryContents (baseDir </> "out")
   args <- getArgs
   if not $ null args then
-    mapM_ copy [ baseDir </> "output" </> file | file <- contents, ".html" `isSuffixOf` file, takeBaseName file `elem` args  ]
+    mapM_ copy [ baseDir </> "out" </> file | file <- contents, ".html" `isSuffixOf` file, takeBaseName file `elem` args  ]
   else
-    mapM_ copy [ baseDir </> "output" </> file | file <- contents]
+    mapM_ copy [ baseDir </> "out" </> file | file <- contents]
   where
     ignore =
       foldr (liftA2 (||)) (const False) [
diff --git a/html-test/run.lhs b/html-test/run.lhs
index c543e020..7d3b805b 100755
--- a/html-test/run.lhs
+++ b/html-test/run.lhs
@@ -27,7 +27,7 @@ packageRoot, dataDir, haddockPath, baseDir, testDir, outDir :: FilePath
 baseDir = takeDirectory __FILE__
 testDir       = baseDir </> "src"
 refDir        = baseDir </> "ref"
-outDir        = baseDir </> "output"
+outDir        = baseDir </> "out"
 packageRoot   = baseDir </> ".."
 dataDir       = packageRoot </> "resources"
 haddockPath   = packageRoot </> "dist" </> "build" </> "haddock" </> "haddock"
-- 
cgit v1.2.3