module System.TestLoop.Internal.Cabal (parseCabalFile) where
import Control.Applicative ((<$>), (<*>))
import Data.List (isSuffixOf)
import Data.Monoid (First (..), mconcat)
import System.Directory (getCurrentDirectory,
getDirectoryContents,
getHomeDirectory)
import System.Environment (getArgs)
import System.FilePath (joinPath, takeDirectory)
import Distribution.PackageDescription (CondTree (..),
GenericPackageDescription (..),
TestSuite (..),
TestSuiteInterface (..),
condTreeData,
hsSourceDirs,
testBuildInfo)
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Verbosity (normal)
import System.TestLoop.Internal.Types
getTestSuiteToRun :: IO (Maybe String)
getTestSuiteToRun = do
args <- getArgs
case args of
(x:_) -> return (Just x)
_ -> return Nothing
parseTestSuiteInfo :: Maybe String
-> (String, CondTree a b TestSuite)
-> Maybe (String, String, [String])
parseTestSuiteInfo (Just inputName) (name, CondNode { condTreeData=testSuite })
| inputName == name =
case testInterface testSuite of
TestSuiteExeV10 _ file ->
Just (name, file, hsSourceDirs $ testBuildInfo testSuite)
_ -> Nothing
| otherwise = Nothing
parseTestSuiteInfo Nothing input@(name, _) = parseTestSuiteInfo (Just name) input
getCabalFilePathFrom :: FilePath -> IO (Maybe FilePath)
getCabalFilePathFrom originalPath =
getHomeDirectory >>= loop originalPath
where
loop currentPath finalPath = do
if currentPath == finalPath
then return Nothing
else do
contents <- getDirectoryContents currentPath
case dropWhile (not . (".cabal" `isSuffixOf`)) contents of
[] -> loop (takeDirectory currentPath) finalPath
(result:_) -> return $ Just (joinPath [currentPath, result])
getCabalFilePath :: IO (Maybe FilePath)
getCabalFilePath = do
getCurrentDirectory >>= getCabalFilePathFrom
parseCabalFile_ :: Maybe String
-> GenericPackageDescription
-> Maybe (String, String, [String])
parseCabalFile_ testSuiteName genericPackDesc =
getFirst . mconcat $ map (First . parseTestSuiteInfo testSuiteName)
(condTestSuites genericPackDesc)
parseCabalFile :: IO (TestSuiteName, MainModuleName, HsSourcePaths)
parseCabalFile = do
mcabalFilePath <- getCabalFilePath
case mcabalFilePath of
Just cabalFilePath -> do
result <- parseCabalFile_ <$> getTestSuiteToRun
<*> readPackageDescription normal cabalFilePath
maybe (error $ msg ++ cabalFilePath)
return
result
Nothing ->
error "Couldn't find a cabal file in this directory"
where
msg = mconcat [ "You need to have at least one test-suite "
, "with type == exitcode-stdio-1.0 on "]