aboutsummaryrefslogtreecommitdiff
path: root/hypsrc-test
diff options
context:
space:
mode:
Diffstat (limited to 'hypsrc-test')
-rw-r--r--hypsrc-test/Utils.hs47
-rwxr-xr-xhypsrc-test/accept.hs27
-rwxr-xr-xhypsrc-test/run.hs122
3 files changed, 0 insertions, 196 deletions
diff --git a/hypsrc-test/Utils.hs b/hypsrc-test/Utils.hs
deleted file mode 100644
index e15fabee..00000000
--- a/hypsrc-test/Utils.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-
-module Utils
- ( baseDir, rootDir
- , srcDir, refDir, outDir, refDir', outDir'
- , haddockPath
- , stripLocalAnchors, stripLocalLinks, stripLocalReferences
- ) where
-
-
-import Data.List
-
-import System.FilePath
-
-
-baseDir, rootDir :: FilePath
-baseDir = takeDirectory __FILE__
-rootDir = baseDir </> ".."
-
-srcDir, refDir, outDir, refDir', outDir' :: FilePath
-srcDir = baseDir </> "src"
-refDir = baseDir </> "ref"
-outDir = baseDir </> "out"
-refDir' = refDir </> "src"
-outDir' = outDir </> "src"
-
-haddockPath :: FilePath
-haddockPath = rootDir </> "dist" </> "build" </> "haddock" </> "haddock"
-
-
-replaceBetween :: Eq a => [a] -> a -> [a] -> [a] -> [a]
-replaceBetween _ _ _ [] = []
-replaceBetween pref end val html@(x:xs') = case stripPrefix pref html of
- Just strip -> pref ++ val ++ (replaceBetween' . dropWhile (/= end)) strip
- Nothing -> x:(replaceBetween' xs')
- where
- replaceBetween' = replaceBetween pref end val
-
-stripLocalAnchors :: String -> String
-stripLocalAnchors = replaceBetween "<a name=\"local-" '\"' "0"
-
-stripLocalLinks :: String -> String
-stripLocalLinks = replaceBetween "<a href=\"#local-" '\"' "0"
-
-stripLocalReferences :: String -> String
-stripLocalReferences = stripLocalLinks . stripLocalAnchors
diff --git a/hypsrc-test/accept.hs b/hypsrc-test/accept.hs
deleted file mode 100755
index 4606b2df..00000000
--- a/hypsrc-test/accept.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/usr/bin/env runhaskell
-{-# LANGUAGE CPP #-}
-
-
-import System.Directory
-import System.FilePath
-import System.Environment
-
-import Utils
-
-
-main :: IO ()
-main = do
- args <- getArgs
- files <- filter isHtmlFile <$> getDirectoryContents outDir'
- let files' = if args == ["--all"] || args == ["-a"]
- then files
- else filter ((`elem` args) . takeBaseName) files
- mapM_ copy files'
- where
- isHtmlFile = (== ".html") . takeExtension
-
-
-copy :: FilePath -> IO ()
-copy file = do
- content <- stripLocalReferences <$> readFile (outDir' </> file)
- writeFile (refDir' </> file) content
diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
deleted file mode 100755
index 853c4f09..00000000
--- a/hypsrc-test/run.hs
+++ /dev/null
@@ -1,122 +0,0 @@
-#!/usr/bin/env runhaskell
-{-# LANGUAGE CPP #-}
-
-
-import Control.Monad
-
-import Data.List
-import Data.Maybe
-
-import System.Directory
-import System.Environment
-import System.Exit
-import System.FilePath
-import System.Process
-
-import Distribution.Verbosity
-import Distribution.Simple.Utils hiding (die)
-
-import Utils
-
-
-main :: IO ()
-main = do
- haddockAvailable <- doesFileExist haddockPath
- unless haddockAvailable $ die "Haddock exectuable not available"
-
- (args, mods) <- partition ("-" `isPrefixOf`) <$> getArgs
- let args' = filter (\arg -> not $ arg == "--all" || arg == "-a") args
- mods' <- map (srcDir </>) <$> case args of
- [] -> getAllSrcModules
- _ -> return $ map (++ ".hs") mods
-
- putHaddockVersion
- putGhcVersion
-
- putStrLn "Running tests..."
- runHaddock $
- [ "--odir=" ++ outDir
- , "--no-warnings"
- , "--hyperlinked-source"
- , "--pretty-html"
- ] ++ args' ++ mods'
-
- forM_ mods' $ check True
-
-
-check :: Bool -> FilePath -> IO ()
-check strict mdl = do
- hasReference <- doesFileExist refFile
- if hasReference
- then do
- ref <- readFile refFile
- out <- readFile outFile
- compareOutput strict mdl ref out
- else do
- putStrLn $ "Pass: " ++ mdl ++ " (no reference file)"
- where
- refFile = refDir' </> takeBaseName mdl ++ ".html"
- outFile = outDir' </> takeBaseName mdl ++ ".html"
-
-
-compareOutput :: Bool -> FilePath -> String -> String -> IO ()
-compareOutput strict mdl ref out = do
- if ref' == out'
- then putStrLn $ "Pass: " ++ mdl
- else do
- putStrLn $ "Fail: " ++ mdl
- diff mdl ref' out'
- when strict $ die "Aborting further tests."
- where
- ref' = stripLocalReferences ref
- out' = stripLocalReferences out
-
-
-diff :: FilePath -> String -> String -> IO ()
-diff mdl ref out = do
- colorDiffPath <- findProgramLocation silent "colordiff"
- let cmd = fromMaybe "diff" colorDiffPath
-
- writeFile refFile ref
- writeFile outFile out
-
- result <- system $ cmd ++ " " ++ refFile ++ " " ++ outFile
- unless (result == ExitSuccess) $ die "Failed to run `diff` command."
- where
- refFile = outDir </> takeBaseName mdl ++ ".ref.nolinks"
- outFile = outDir </> takeBaseName mdl ++ ".nolinks"
-
-
-
-getAllSrcModules :: IO [FilePath]
-getAllSrcModules =
- filter isHaskellFile <$> getDirectoryContents srcDir
- where
- isHaskellFile = (== ".hs") . takeExtension
-
-
-putHaddockVersion :: IO ()
-putHaddockVersion = do
- putStrLn "Haddock version:"
- runHaddock ["--version"]
- putStrLn ""
-
-
-putGhcVersion :: IO ()
-putGhcVersion = do
- putStrLn "GHC version:"
- runHaddock ["--ghc-version"]
- putStrLn ""
-
-
-runHaddock :: [String] -> IO ()
-runHaddock args = do
- menv <- Just <$> getEnvironment
- handle <- runProcess haddockPath args Nothing menv Nothing Nothing Nothing
- waitForSuccess handle $ "Failed to invoke haddock with " ++ show args
-
-
-waitForSuccess :: ProcessHandle -> String -> IO ()
-waitForSuccess handle msg = do
- result <- waitForProcess handle
- unless (result == ExitSuccess) $ die msg