-- |
-- Module:     Trace.Hpc.Codecov.Discover
-- Copyright:  (c) 2021 8c6794b6
-- License:    BSD3
-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>
--
-- Walk through directories and find hpc data.

module Trace.Hpc.Codecov.Discover
  ( -- * Discover function and types
    discover
  , DiscoverArgs(..)
  , BuildTool(..)

    -- * Auxiliary
  , foldDir
  , defaultIgnored
  , foldDirWithIgnoring
  ) where

-- base
import Control.Exception           (throwIO)
import Control.Monad               (when)
import Data.Maybe                  (isNothing)
import System.IO                   (hPutStrLn, stderr)

-- directory
import System.Directory            (doesDirectoryExist, doesFileExist,
                                    listDirectory)

-- filepath
import System.FilePath             (splitFileName, takeExtension,
                                    takeFileName, (<.>), (</>))

-- Internal
import Trace.Hpc.Codecov.Exception
import Trace.Hpc.Codecov.Report


-- ------------------------------------------------------------------------
--
-- Types
--
-- ------------------------------------------------------------------------

-- | Data type to hold arguments of 'discover' function.
data DiscoverArgs = DiscoverArgs
  { DiscoverArgs -> BuildTool
da_tool      :: BuildTool
    -- ^ Tool used to build Haskell cabal package.
  , DiscoverArgs -> FilePath
da_testsuite :: String
    -- ^ Test suite name to search for @.tix@ file.
  , DiscoverArgs -> FilePath
da_rootdir   :: FilePath
    -- ^ The project root directory.
  , DiscoverArgs -> Maybe FilePath
da_builddir  :: Maybe String
    -- ^ Name of the temporary build directory made by the build tool.
  , DiscoverArgs -> [FilePath]
da_skipdirs  :: [String]
    -- ^ Directories to skip while searching for scanning data.
  , DiscoverArgs -> Bool
da_verbose   :: Bool
    -- ^ Flag for shwoing verbose information.
  }

-- | Tool used for building Haskell package source codes.
data BuildTool
  = Cabal
  -- ^ For <https://www.haskell.org/cabal/index.html cabal-install>.
  | Stack
  -- ^ For <https://docs.haskellstack.org/en/stable/README/ 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"

-- | Walk thorugh directory and search for @.mix@ directories, Haskell
-- source code directories, and @.tix@ file.
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"

-- | Show mssage to 'stdrr'.
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


-- ------------------------------------------------------------------------
--
-- Searching mix and tix for stack
--
-- ------------------------------------------------------------------------

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


-- ------------------------------------------------------------------------
--
-- Searching mix and tix for cabal-install
--
-- ------------------------------------------------------------------------

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


-- ------------------------------------------------------------------------
--
-- Simple directory walker
--
-- ------------------------------------------------------------------------

-- | Variant of 'foldDirWithIgnoring' with 'defaultIgnored'.
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

-- | Default directory base names to ignore.
defaultIgnored :: [String]
defaultIgnored :: [FilePath]
defaultIgnored = [FilePath
".git", FilePath
".github"]

-- | Fold under given directory.
foldDirWithIgnoring
  :: [String]
  -- ^ Directory base names to skip.
  -> (FilePath -> a -> IO a)
  -- ^ Accumulator function.
  -> a
  -- ^ Initial accumulator value.
  -> [FilePath]
  -- ^ Directories to walk through.
  -> 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