diff options
Diffstat (limited to 'html-test')
-rwxr-xr-x | html-test/run.hs | 69 |
1 files changed, 62 insertions, 7 deletions
diff --git a/html-test/run.hs b/html-test/run.hs index 99ca1ec1..be31aeea 100755 --- a/html-test/run.hs +++ b/html-test/run.hs @@ -1,9 +1,16 @@ #!/usr/bin/env runhaskell {-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} +import Control.Monad + +import Data.Maybe + +import System.Console.GetOpt import System.Directory import System.Environment +import System.Exit import System.FilePath @@ -17,22 +24,70 @@ refDir = baseDir </> "ref" outDir = baseDir </> "out" +data Config = Config + { cfgHaddockPath :: FilePath + , cfgFiles :: [FilePath] + } + + main :: IO () main = do - files <- processArgs =<< getArgs - putStrLn $ "Files to test: " ++ show files + Config { .. } <- parseArgs =<< getArgs + putStrLn $ "Files to test: " ++ show cfgFiles + + +parseArgs :: [String] -> IO Config +parseArgs args = do + let (flags, files, errors) = getOpt Permute options args + + when (not $ null errors) $ do + mapM_ putStrLn errors + exitFailure + + when (FlagHelp `elem` flags) $ do + putStrLn $ usageInfo "" options + exitSuccess + + cfgFiles <- processFileArgs files + let cfgHaddockPath = haddockPath flags + return $ Config { .. } -processArgs :: [String] -> IO [FilePath] -processArgs [] = filter isSourceFile <$> getDirectoryContents srcDir -processArgs args = pure $ map processArg args +processFileArgs :: [String] -> IO [FilePath] +processFileArgs [] = filter isSourceFile <$> getDirectoryContents srcDir +processFileArgs args = pure $ map processFileArg args -processArg :: String -> FilePath -processArg arg +processFileArg :: String -> FilePath +processFileArg arg | isSourceFile arg = arg | otherwise = srcDir </> arg <.> "hs" isSourceFile :: FilePath -> Bool isSourceFile path = takeExtension path `elem` [".hs", ".lhs"] + + +data Flag + = FlagHaddockPath FilePath + | FlagHelp + deriving Eq + + +options :: [OptDescr Flag] +options = + [ Option [] ["haddock-path"] (ReqArg FlagHaddockPath "FILE") + "path to Haddock executable to exectue tests with" + , Option ['h'] ["help"] (NoArg FlagHelp) + "display this help end exit" + ] + + +haddockPath :: [Flag] -> FilePath +haddockPath flags = case mlast [ path | FlagHaddockPath path <- flags ] of + Just path -> path + Nothing -> rootDir </> "dist" </> "build" </> "haddock" </> "haddock" + + +mlast :: [a] -> Maybe a +mlast = listToMaybe . reverse |