module Trace.Hpc.Codecov.Discover
(
discover
, DiscoverArgs(..)
, BuildTool(..)
, foldDir
, defaultIgnored
, foldDirWithIgnoring
) where
import Control.Exception (throwIO)
import Control.Monad (when)
import Data.Maybe (isNothing)
import System.IO (hPutStrLn, stderr)
import System.Directory (doesDirectoryExist, doesFileExist,
listDirectory)
import System.FilePath (splitFileName, takeExtension,
takeFileName, (<.>), (</>))
import Trace.Hpc.Codecov.Exception
import Trace.Hpc.Codecov.Report
data DiscoverArgs = DiscoverArgs
{ DiscoverArgs -> BuildTool
da_tool :: BuildTool
, DiscoverArgs -> FilePath
da_testsuite :: String
, DiscoverArgs -> FilePath
da_rootdir :: FilePath
, DiscoverArgs -> Maybe FilePath
da_builddir :: Maybe String
, DiscoverArgs -> [FilePath]
da_skipdirs :: [String]
, DiscoverArgs -> Bool
da_verbose :: Bool
}
data BuildTool
= Cabal
| Stack
deriving (BuildTool -> BuildTool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildTool -> BuildTool -> Bool
$c/= :: BuildTool -> BuildTool -> Bool
== :: BuildTool -> BuildTool -> Bool
$c== :: BuildTool -> BuildTool -> Bool
Eq)
instance Show BuildTool where
show :: BuildTool -> FilePath
show BuildTool
tool = case BuildTool
tool of
BuildTool
Cabal -> FilePath
"cabal"
BuildTool
Stack -> FilePath
"stack"
discover :: DiscoverArgs -> IO Report
discover :: DiscoverArgs -> IO Report
discover DiscoverArgs
da = do
let build_dir :: FilePath
build_dir = case DiscoverArgs -> Maybe FilePath
da_builddir DiscoverArgs
da of
Maybe FilePath
Nothing -> BuildTool -> FilePath
defaultBuildDirName (DiscoverArgs -> BuildTool
da_tool DiscoverArgs
da)
Just FilePath
dir -> FilePath
dir
list_msg :: [FilePath] -> FilePath
list_msg = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\FilePath
p -> FilePath
" - " forall a. [a] -> [a] -> [a]
++ FilePath
p forall a. [a] -> [a] -> [a]
++ FilePath
"\n")
skipped_dirs_msg :: FilePath
skipped_dirs_msg =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DiscoverArgs -> [FilePath]
da_skipdirs DiscoverArgs
da)
then FilePath
"No directory specified to skip during discover"
else FilePath
"Skipping directories: " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (DiscoverArgs -> [FilePath]
da_skipdirs DiscoverArgs
da)
DiscoverArgs -> FilePath -> IO ()
say DiscoverArgs
da forall a b. (a -> b) -> a -> b
$
FilePath
"Starting discover for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (DiscoverArgs -> BuildTool
da_tool DiscoverArgs
da) forall a. [a] -> [a] -> [a]
++ FilePath
"\n" forall a. [a] -> [a] -> [a]
++
FilePath
"Scanning under \"" forall a. [a] -> [a] -> [a]
++ DiscoverArgs -> FilePath
da_rootdir DiscoverArgs
da forall a. [a] -> [a] -> [a]
++ FilePath
"\"" forall a. [a] -> [a] -> [a]
++
FilePath
" for .cabal files and \"" forall a. [a] -> [a] -> [a]
++ FilePath
build_dir forall a. [a] -> [a] -> [a]
++ FilePath
"\"\n" forall a. [a] -> [a] -> [a]
++
FilePath
skipped_dirs_msg
([FilePath]
src_dirs, [FilePath]
build_dirs) <- DiscoverArgs -> FilePath -> IO ([FilePath], [FilePath])
findSrcDirsAndBuildDirs DiscoverArgs
da FilePath
build_dir
DiscoverArgs -> FilePath -> IO ()
say DiscoverArgs
da forall a b. (a -> b) -> a -> b
$
FilePath
"Scanned:\n" forall a. [a] -> [a] -> [a]
++
FilePath
" Directories containing .cabal files:\n" forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
list_msg [FilePath]
src_dirs forall a. [a] -> [a] -> [a]
++
FilePath
" Build dirs:\n" forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
list_msg [FilePath]
build_dirs
TixPath
tix_path <- FilePath -> IO TixPath
parseTixish (DiscoverArgs -> FilePath
da_testsuite DiscoverArgs
da)
(Maybe FilePath
mb_tix, [FilePath]
mixs) <- DiscoverArgs
-> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findTixAndMix DiscoverArgs
da TixPath
tix_path [FilePath]
build_dirs
FilePath
found_tix_path <- case Maybe FilePath
mb_tix of
Just FilePath
tix -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tix
Maybe FilePath
Nothing -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> HpcCodecovError
TestSuiteNotFound (DiscoverArgs -> FilePath
da_testsuite DiscoverArgs
da)
DiscoverArgs -> FilePath -> IO ()
say DiscoverArgs
da forall a b. (a -> b) -> a -> b
$
FilePath
"Discovered:\n" forall a. [a] -> [a] -> [a]
++
FilePath
" Tix file: \n" forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
list_msg [FilePath
found_tix_path] forall a. [a] -> [a] -> [a]
++
FilePath
" Mix dirs: \n" forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
list_msg [FilePath]
mixs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
{ reportTix :: FilePath
reportTix = FilePath
found_tix_path
, reportMixDirs :: [FilePath]
reportMixDirs = [FilePath]
mixs
, reportSrcDirs :: [FilePath]
reportSrcDirs = [FilePath]
src_dirs
}
data TixPath
= UnresolvedTixPath FilePath
| ResolvedTixPath FilePath
parseTixish :: String -> IO TixPath
parseTixish :: FilePath -> IO TixPath
parseTixish FilePath
str = do
let tix1 :: FilePath
tix1 = if ShowS
takeExtension FilePath
str forall a. Eq a => a -> a -> Bool
== FilePath
".tix"
then FilePath
str
else FilePath
str FilePath -> ShowS
<.> FilePath
"tix"
Bool
tix1_found <- FilePath -> IO Bool
doesFileExist FilePath
tix1
if Bool
tix1_found
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> TixPath
ResolvedTixPath FilePath
tix1
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> TixPath
UnresolvedTixPath FilePath
tix1
defaultBuildDirName :: BuildTool -> String
defaultBuildDirName :: BuildTool -> FilePath
defaultBuildDirName BuildTool
tool = case BuildTool
tool of
BuildTool
Cabal -> FilePath
"dist-newstyle"
BuildTool
Stack -> FilePath
".stack-work"
say :: DiscoverArgs -> String -> IO ()
say :: DiscoverArgs -> FilePath -> IO ()
say DiscoverArgs
da FilePath
msg = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoverArgs -> Bool
da_verbose DiscoverArgs
da) forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
msg
findSrcDirsAndBuildDirs
:: DiscoverArgs -> String -> IO ([FilePath], [FilePath])
findSrcDirsAndBuildDirs :: DiscoverArgs -> FilePath -> IO ([FilePath], [FilePath])
findSrcDirsAndBuildDirs DiscoverArgs
da FilePath
build_dir = do
[FilePath]
ds <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ DiscoverArgs -> FilePath
da_rootdir DiscoverArgs
da
then FilePath -> IO [FilePath]
listDirectory FilePath
"."
else forall (f :: * -> *) a. Applicative f => a -> f a
pure [DiscoverArgs -> FilePath
da_rootdir DiscoverArgs
da]
forall a.
[FilePath] -> (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
foldDirWithIgnoring [FilePath]
ignored forall {f :: * -> *}.
Applicative f =>
FilePath -> ([FilePath], [FilePath]) -> f ([FilePath], [FilePath])
f forall {a} {a}. ([a], [a])
z [FilePath]
ds
where
z :: ([a], [a])
z = ([], [])
f :: FilePath -> ([FilePath], [FilePath]) -> f ([FilePath], [FilePath])
f FilePath
p acc :: ([FilePath], [FilePath])
acc@([FilePath]
src_dirs, [FilePath]
dirs)
| ShowS
takeExtension FilePath
p_file forall a. Eq a => a -> a -> Bool
== FilePath
".cabal" = forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
p_dirforall a. a -> [a] -> [a]
:[FilePath]
src_dirs, [FilePath]
dirs)
| FilePath
p_file forall a. Eq a => a -> a -> Bool
== FilePath
build_dir = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath]
src_dirs, FilePath
pforall a. a -> [a] -> [a]
:[FilePath]
dirs)
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath], [FilePath])
acc
where
(FilePath
p_dir, FilePath
p_file) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
p
ignored :: [FilePath]
ignored = FilePath
build_dir forall a. a -> [a] -> [a]
: ([FilePath]
defaultIgnored forall a. [a] -> [a] -> [a]
++ DiscoverArgs -> [FilePath]
da_skipdirs DiscoverArgs
da)
findTixAndMix
:: DiscoverArgs -> TixPath -> [FilePath]
-> IO (Maybe FilePath, [FilePath])
findTixAndMix :: DiscoverArgs
-> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findTixAndMix DiscoverArgs
da TixPath
tixish [FilePath]
build_dirs = case DiscoverArgs -> BuildTool
da_tool DiscoverArgs
da of
BuildTool
Stack -> [FilePath]
-> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findForStack [FilePath]
excludes TixPath
tixish [FilePath]
build_dirs
BuildTool
Cabal -> [FilePath]
-> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findForCabal [FilePath]
excludes TixPath
tixish [FilePath]
build_dirs
where
excludes :: [FilePath]
excludes = [FilePath]
defaultIgnored forall a. [a] -> [a] -> [a]
++ DiscoverArgs -> [FilePath]
da_skipdirs DiscoverArgs
da
findForStack
:: [String] -> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findForStack :: [FilePath]
-> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findForStack [FilePath]
excludes TixPath
tx [FilePath]
dirs = do
Maybe FilePath
mb_tix <- case TixPath
tx of
ResolvedTixPath FilePath
path -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just FilePath
path
UnresolvedTixPath FilePath
name -> [FilePath] -> FilePath -> [FilePath] -> IO (Maybe FilePath)
findStackTix [FilePath]
excludes FilePath
name [FilePath]
dirs
[FilePath]
mixs <- [FilePath] -> [FilePath] -> IO [FilePath]
findStackMix [FilePath]
excludes [FilePath]
dirs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath
mb_tix, [FilePath]
mixs)
findStackMix :: [String] -> [FilePath] -> IO [FilePath]
findStackMix :: [FilePath] -> [FilePath] -> IO [FilePath]
findStackMix [FilePath]
ignored [FilePath]
dirs = forall a.
[FilePath] -> (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
foldDirWithIgnoring [FilePath]
ignored forall {f :: * -> *}.
Applicative f =>
FilePath -> [FilePath] -> f [FilePath]
f [] [FilePath]
dist_dirs
where
dist_dirs :: [FilePath]
dist_dirs = forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ShowS
</> FilePath
"dist") [FilePath]
dirs
f :: FilePath -> [FilePath] -> f [FilePath]
f FilePath
p [FilePath]
acc =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if ShowS
takeFileName FilePath
p forall a. Eq a => a -> a -> Bool
== FilePath
"hpc"
then FilePath
p forall a. a -> [a] -> [a]
: [FilePath]
acc
else [FilePath]
acc
findStackTix :: [String] -> String -> [FilePath] -> IO (Maybe FilePath)
findStackTix :: [FilePath] -> FilePath -> [FilePath] -> IO (Maybe FilePath)
findStackTix [FilePath]
ignored FilePath
tix_name [FilePath]
dirs = forall {a}. (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
go forall {m :: * -> *}.
Monad m =>
FilePath -> Maybe FilePath -> m (Maybe FilePath)
f forall a. Maybe a
Nothing [FilePath]
install_dirs
where
go :: (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
go = forall a.
[FilePath] -> (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
foldDirWithIgnoring [FilePath]
ignored
install_dirs :: [FilePath]
install_dirs = forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ShowS
</> FilePath
"install") [FilePath]
dirs
f :: FilePath -> Maybe FilePath -> m (Maybe FilePath)
f FilePath
_ (Just FilePath
tix) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FilePath
tix)
f FilePath
p Maybe FilePath
Nothing = if ShowS
takeFileName FilePath
p forall a. Eq a => a -> a -> Bool
== FilePath
tix_name
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FilePath
p)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
findForCabal
:: [String] -> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findForCabal :: [FilePath]
-> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findForCabal [FilePath]
ignored TixPath
tx = forall a.
[FilePath] -> (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
foldDirWithIgnoring [FilePath]
ignored FilePath
-> (Maybe FilePath, [FilePath]) -> IO (Maybe FilePath, [FilePath])
f forall {a}. (Maybe FilePath, [a])
z
where
f :: FilePath
-> (Maybe FilePath, [FilePath]) -> IO (Maybe FilePath, [FilePath])
f = case TixPath
tx of
ResolvedTixPath FilePath
_ -> [FilePath]
-> FilePath
-> (Maybe FilePath, [FilePath])
-> IO (Maybe FilePath, [FilePath])
findVanilla [FilePath]
ignored
UnresolvedTixPath FilePath
tix_name -> \FilePath
p acc :: (Maybe FilePath, [FilePath])
acc@(Maybe FilePath
mb_tix, [FilePath]
dirs) -> do
if forall a. Maybe a -> Bool
isNothing Maybe FilePath
mb_tix Bool -> Bool -> Bool
&& ShowS
takeFileName FilePath
p forall a. Eq a => a -> a -> Bool
== FilePath
tix_name
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FilePath
p, [FilePath]
dirs)
else [FilePath]
-> FilePath
-> (Maybe FilePath, [FilePath])
-> IO (Maybe FilePath, [FilePath])
findVanilla [FilePath]
ignored FilePath
p (Maybe FilePath, [FilePath])
acc
z :: (Maybe FilePath, [a])
z = case TixPath
tx of
ResolvedTixPath FilePath
path -> (forall a. a -> Maybe a
Just FilePath
path, [])
TixPath
_ -> (forall a. Maybe a
Nothing, [])
findVanilla
:: [String] -> FilePath -> (Maybe FilePath, [FilePath])
-> IO (Maybe FilePath, [FilePath])
findVanilla :: [FilePath]
-> FilePath
-> (Maybe FilePath, [FilePath])
-> IO (Maybe FilePath, [FilePath])
findVanilla [FilePath]
ignored FilePath
p acc :: (Maybe FilePath, [FilePath])
acc@(Maybe FilePath
mb_tix, [FilePath]
dirs) = do
if ShowS
takeFileName FilePath
p forall a. Eq a => a -> a -> Bool
== FilePath
"vanilla"
then do
let mix :: FilePath
mix = FilePath
p FilePath -> ShowS
</> FilePath
"mix"
Bool
mix_exist <- FilePath -> IO Bool
doesDirectoryExist FilePath
mix
if Bool
mix_exist
then do
let f :: [FilePath] -> [FilePath]
f [FilePath]
xs = [FilePath
mix FilePath -> ShowS
</> FilePath
x| FilePath
x <- [FilePath]
xs, FilePath
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
ignored]
[FilePath]
contents <- [FilePath] -> [FilePath]
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
mix
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
mb_tix, [FilePath]
contents forall a. [a] -> [a] -> [a]
++ [FilePath]
dirs)
else forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
mb_tix, [FilePath]
dirs)
else forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath, [FilePath])
acc
foldDir :: (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
foldDir :: forall {a}. (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
foldDir = forall a.
[FilePath] -> (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
foldDirWithIgnoring [FilePath]
defaultIgnored
defaultIgnored :: [String]
defaultIgnored :: [FilePath]
defaultIgnored = [FilePath
".git", FilePath
".github"]
foldDirWithIgnoring
:: [String]
-> (FilePath -> a -> IO a)
-> a
-> [FilePath]
-> IO a
foldDirWithIgnoring :: forall a.
[FilePath] -> (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
foldDirWithIgnoring [FilePath]
ignored FilePath -> a -> IO a
f = a -> [FilePath] -> IO a
go
where
go :: a -> [FilePath] -> IO a
go a
acc0 [] = forall (m :: * -> *) a. Monad m => a -> m a
return a
acc0
go a
acc0 (FilePath
dir:[FilePath]
dirs) = do
a
acc1 <- FilePath -> a -> IO a
f FilePath
dir a
acc0
if ShowS
takeFileName FilePath
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
ignored
then a -> [FilePath] -> IO a
go a
acc1 [FilePath]
dirs
else do
Bool
is_dir <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
if Bool -> Bool
not Bool
is_dir
then a -> [FilePath] -> IO a
go a
acc1 [FilePath]
dirs
else do
[FilePath]
contents <- forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> ShowS
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
dir
a
acc2 <- a -> [FilePath] -> IO a
go a
acc1 [FilePath]
contents
a -> [FilePath] -> IO a
go a
acc2 [FilePath]
dirs