-- | Main executable module. module Main where import Control.Monad (when) import Data.Maybe (fromMaybe) import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) import System.FilePath (takeDirectory) import System.IO (IOMode(ReadMode), hGetContents, hPutStrLn, withFile, stderr) import Test.Tasty.Discover.Internal.Config (Config (..), parseConfig) import Test.Tasty.Discover.Internal.Driver (findTests, generateTestDriver) -- | Main function. main :: IO () main = do args <- getArgs name <- getProgName case args of src:_:dst:opts -> case parseConfig (takeDirectory src) name opts of Left err -> do hPutStrLn stderr err exitFailure Right config -> do tests <- findTests config let ingredients = tastyIngredients config moduleName = fromMaybe "Main" (generatedModuleName config) header <- readHeader src let output = generateTestDriver config moduleName ingredients src tests when (debug config) $ hPutStrLn stderr output -- Write in-place only when content differs (no temp file) when (inPlace config) $ do let newContent = unlines $ header ++ [marker, output] -- Strictly read the existing file so the handle is closed before we write (important on Windows) oldContent <- withFile src ReadMode $ \h -> do s <- hGetContents h length s `seq` return s when (oldContent /= newContent) $ writeFile src newContent writeFile dst $ "{-# LINE " ++ show (length header + 2) ++ " " ++ show src ++ " #-}\n" ++ output _ -> do hPutStrLn stderr "Usage: tasty-discover src _ dst [OPTION...]" exitFailure where marker = "-- GENERATED BY tasty-discover" readHeader src = withFile src ReadMode $ \h -> do header <- takeWhile (marker /=) . lines <$> hGetContents h seq (length header) (return header)