-- |
-- 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 -> String
da_testsuite :: String
    -- ^ Test suite name to search for @.tix@ file.
  , DiscoverArgs -> String
da_rootdir      :: FilePath
    -- ^ The project root directory.
  , DiscoverArgs -> Maybe String
da_builddir  :: Maybe String
    -- ^ Name of the temporary build directory made by the build tool.
  , DiscoverArgs -> [String]
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
(BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> Bool) -> Eq BuildTool
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 -> String
show BuildTool
tool = case BuildTool
tool of
    BuildTool
Cabal -> String
"cabal"
    BuildTool
Stack -> String
"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 :: String
build_dir = case DiscoverArgs -> Maybe String
da_builddir DiscoverArgs
da of
        Maybe String
Nothing  -> BuildTool -> String
defaultBuildDirName (DiscoverArgs -> BuildTool
da_tool DiscoverArgs
da)
        Just String
dir -> String
dir
      list_msg :: [String] -> String
list_msg = ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
p -> String
"    - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
      skipped_dirs_msg :: String
skipped_dirs_msg =
        if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DiscoverArgs -> [String]
da_skipdirs DiscoverArgs
da)
           then String
"No directory specified to skip during discover"
           else String
"Skipping directories: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (DiscoverArgs -> [String]
da_skipdirs DiscoverArgs
da)

  DiscoverArgs -> String -> IO ()
say DiscoverArgs
da (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
    String
"Starting discover for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ BuildTool -> String
forall a. Show a => a -> String
show (DiscoverArgs -> BuildTool
da_tool DiscoverArgs
da) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"Scanning under \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DiscoverArgs -> String
da_rootdir DiscoverArgs
da String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" for .cabal files and \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
build_dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
skipped_dirs_msg

  ([String]
src_dirs, [String]
build_dirs) <- DiscoverArgs -> String -> IO ([String], [String])
findSrcDirsAndBuildDirs DiscoverArgs
da String
build_dir
  DiscoverArgs -> String -> IO ()
say DiscoverArgs
da (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
    String
"Scanned:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"  Directories containing .cabal files:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
list_msg [String]
src_dirs String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"  Build dirs:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
list_msg [String]
build_dirs

  TixPath
tix_path <- String -> IO TixPath
parseTixish (DiscoverArgs -> String
da_testsuite DiscoverArgs
da)
  (Maybe String
mb_tix, [String]
mixs) <- DiscoverArgs -> TixPath -> [String] -> IO (Maybe String, [String])
findTixAndMix DiscoverArgs
da TixPath
tix_path [String]
build_dirs

  String
found_tix_path <- case Maybe String
mb_tix of
    Just String
tix -> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
tix
    Maybe String
Nothing  -> HpcCodecovError -> IO String
forall e a. Exception e => e -> IO a
throwIO (HpcCodecovError -> IO String) -> HpcCodecovError -> IO String
forall a b. (a -> b) -> a -> b
$ String -> HpcCodecovError
TestSuiteNotFound (DiscoverArgs -> String
da_testsuite DiscoverArgs
da)

  DiscoverArgs -> String -> IO ()
say DiscoverArgs
da (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
    String
"Discovered:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"  Tix file: \n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
list_msg [String
found_tix_path] String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"  Mix dirs: \n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
list_msg [String]
mixs

  Report -> IO Report
forall (m :: * -> *) a. Monad m => a -> m a
return (Report -> IO Report) -> Report -> IO Report
forall a b. (a -> b) -> a -> b
$ Report
forall a. Monoid a => a
mempty
    { reportTix :: String
reportTix = String
found_tix_path
    , reportMixDirs :: [String]
reportMixDirs = [String]
mixs
    , reportSrcDirs :: [String]
reportSrcDirs = [String]
src_dirs
    }

data TixPath
  = UnresolvedTixPath FilePath
  | ResolvedTixPath FilePath

parseTixish :: String -> IO TixPath
parseTixish :: String -> IO TixPath
parseTixish String
str = do
  let tix1 :: String
tix1 = if ShowS
takeExtension String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".tix"
                then String
str
                else String
str String -> ShowS
<.> String
"tix"
  Bool
tix1_found <- String -> IO Bool
doesFileExist String
tix1
  if Bool
tix1_found
     then TixPath -> IO TixPath
forall (m :: * -> *) a. Monad m => a -> m a
return (TixPath -> IO TixPath) -> TixPath -> IO TixPath
forall a b. (a -> b) -> a -> b
$ String -> TixPath
ResolvedTixPath String
tix1
     else TixPath -> IO TixPath
forall (m :: * -> *) a. Monad m => a -> m a
return (TixPath -> IO TixPath) -> TixPath -> IO TixPath
forall a b. (a -> b) -> a -> b
$ String -> TixPath
UnresolvedTixPath String
tix1

defaultBuildDirName :: BuildTool -> String
defaultBuildDirName :: BuildTool -> String
defaultBuildDirName BuildTool
tool = case BuildTool
tool of
  BuildTool
Cabal -> String
"dist-newstyle"
  BuildTool
Stack -> String
".stack-work"

-- | Show mssage to 'stdrr'.
say :: DiscoverArgs -> String -> IO ()
say :: DiscoverArgs -> String -> IO ()
say DiscoverArgs
da String
msg = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoverArgs -> Bool
da_verbose DiscoverArgs
da) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg

findSrcDirsAndBuildDirs
  :: DiscoverArgs -> String -> IO ([FilePath], [FilePath])
findSrcDirsAndBuildDirs :: DiscoverArgs -> String -> IO ([String], [String])
findSrcDirsAndBuildDirs DiscoverArgs
da String
build_dir = do
    [String]
ds <- if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ DiscoverArgs -> String
da_rootdir DiscoverArgs
da
        then String -> IO [String]
listDirectory String
"."
        else [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [DiscoverArgs -> String
da_rootdir DiscoverArgs
da]
    [String]
-> (String -> ([String], [String]) -> IO ([String], [String]))
-> ([String], [String])
-> [String]
-> IO ([String], [String])
forall a.
[String] -> (String -> a -> IO a) -> a -> [String] -> IO a
foldDirWithIgnoring [String]
ignored String -> ([String], [String]) -> IO ([String], [String])
forall (f :: * -> *).
Applicative f =>
String -> ([String], [String]) -> f ([String], [String])
f ([String], [String])
forall a a. ([a], [a])
z [String]
ds
  where
    z :: ([a], [a])
z = ([], [])
    f :: String -> ([String], [String]) -> f ([String], [String])
f String
p acc :: ([String], [String])
acc@([String]
src_dirs, [String]
dirs)
      | ShowS
takeExtension String
p_file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".cabal" = ([String], [String]) -> f ([String], [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
p_dirString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
src_dirs, [String]
dirs)
      | String
p_file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
build_dir  = ([String], [String]) -> f ([String], [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String]
src_dirs, String
pString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
dirs)
      | Bool
otherwise = ([String], [String]) -> f ([String], [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String], [String])
acc
      where
        (String
p_dir, String
p_file) = String -> (String, String)
splitFileName String
p
    ignored :: [String]
ignored = String
build_dir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ([String]
defaultIgnored [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ DiscoverArgs -> [String]
da_skipdirs DiscoverArgs
da)

findTixAndMix
  :: DiscoverArgs -> TixPath -> [FilePath]
  -> IO (Maybe FilePath, [FilePath])
findTixAndMix :: DiscoverArgs -> TixPath -> [String] -> IO (Maybe String, [String])
findTixAndMix DiscoverArgs
da TixPath
tixish [String]
build_dirs = case DiscoverArgs -> BuildTool
da_tool DiscoverArgs
da of
  BuildTool
Stack -> [String] -> TixPath -> [String] -> IO (Maybe String, [String])
findForStack [String]
excludes TixPath
tixish [String]
build_dirs
  BuildTool
Cabal -> [String] -> TixPath -> [String] -> IO (Maybe String, [String])
findForCabal [String]
excludes TixPath
tixish [String]
build_dirs
  where
    excludes :: [String]
excludes = [String]
defaultIgnored [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ DiscoverArgs -> [String]
da_skipdirs DiscoverArgs
da


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

findForStack
  :: [String] -> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findForStack :: [String] -> TixPath -> [String] -> IO (Maybe String, [String])
findForStack [String]
excludes TixPath
tx [String]
dirs = do
  Maybe String
mb_tix <- case TixPath
tx of
    ResolvedTixPath String
path   -> Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
path
    UnresolvedTixPath String
name -> [String] -> String -> [String] -> IO (Maybe String)
findStackTix [String]
excludes String
name [String]
dirs
  [String]
mixs <- [String] -> [String] -> IO [String]
findStackMix [String]
excludes [String]
dirs
  (Maybe String, [String]) -> IO (Maybe String, [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String
mb_tix, [String]
mixs)

findStackMix :: [String] -> [FilePath] -> IO [FilePath]
findStackMix :: [String] -> [String] -> IO [String]
findStackMix [String]
ignored [String]
dirs = [String]
-> (String -> [String] -> IO [String])
-> [String]
-> [String]
-> IO [String]
forall a.
[String] -> (String -> a -> IO a) -> a -> [String] -> IO a
foldDirWithIgnoring [String]
ignored String -> [String] -> IO [String]
forall (f :: * -> *).
Applicative f =>
String -> [String] -> f [String]
f [] [String]
dist_dirs
  where
    dist_dirs :: [String]
dist_dirs = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
</> String
"dist") [String]
dirs
    f :: String -> [String] -> f [String]
f String
p [String]
acc =
        [String] -> f [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> f [String]) -> [String] -> f [String]
forall a b. (a -> b) -> a -> b
$ if ShowS
takeFileName String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hpc"
                 then String
p String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc
                 else [String]
acc

findStackTix :: [String] -> String -> [FilePath] -> IO (Maybe FilePath)
findStackTix :: [String] -> String -> [String] -> IO (Maybe String)
findStackTix [String]
ignored String
tix_name [String]
dirs = (String -> Maybe String -> IO (Maybe String))
-> Maybe String -> [String] -> IO (Maybe String)
forall a. (String -> a -> IO a) -> a -> [String] -> IO a
go String -> Maybe String -> IO (Maybe String)
forall (m :: * -> *).
Monad m =>
String -> Maybe String -> m (Maybe String)
f Maybe String
forall a. Maybe a
Nothing [String]
install_dirs
  where
    go :: (String -> a -> IO a) -> a -> [String] -> IO a
go = [String] -> (String -> a -> IO a) -> a -> [String] -> IO a
forall a.
[String] -> (String -> a -> IO a) -> a -> [String] -> IO a
foldDirWithIgnoring [String]
ignored
    install_dirs :: [String]
install_dirs = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
</> String
"install") [String]
dirs
    f :: String -> Maybe String -> m (Maybe String)
f String
_ (Just String
tix) = Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
tix)
    f String
p Maybe String
Nothing = if ShowS
takeFileName String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
tix_name
        then Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
p)
        else Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing


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

findForCabal
  :: [String] -> TixPath -> [FilePath] -> IO (Maybe FilePath, [FilePath])
findForCabal :: [String] -> TixPath -> [String] -> IO (Maybe String, [String])
findForCabal [String]
ignored TixPath
tx = [String]
-> (String
    -> (Maybe String, [String]) -> IO (Maybe String, [String]))
-> (Maybe String, [String])
-> [String]
-> IO (Maybe String, [String])
forall a.
[String] -> (String -> a -> IO a) -> a -> [String] -> IO a
foldDirWithIgnoring [String]
ignored String -> (Maybe String, [String]) -> IO (Maybe String, [String])
f (Maybe String, [String])
forall a. (Maybe String, [a])
z
  where
    f :: String -> (Maybe String, [String]) -> IO (Maybe String, [String])
f = case TixPath
tx of
      ResolvedTixPath String
_ -> [String]
-> String
-> (Maybe String, [String])
-> IO (Maybe String, [String])
findVanilla [String]
ignored
      UnresolvedTixPath String
tix_name -> \String
p acc :: (Maybe String, [String])
acc@(Maybe String
mb_tix, [String]
dirs) -> do
        if Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
mb_tix Bool -> Bool -> Bool
&& ShowS
takeFileName String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
tix_name
          then (Maybe String, [String]) -> IO (Maybe String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
p, [String]
dirs)
          else [String]
-> String
-> (Maybe String, [String])
-> IO (Maybe String, [String])
findVanilla [String]
ignored String
p (Maybe String, [String])
acc

    z :: (Maybe String, [a])
z = case TixPath
tx of
      ResolvedTixPath String
path -> (String -> Maybe String
forall a. a -> Maybe a
Just String
path, [])
      TixPath
_                    -> (Maybe String
forall a. Maybe a
Nothing, [])

findVanilla
  :: [String] -> FilePath -> (Maybe FilePath, [FilePath])
  -> IO (Maybe FilePath, [FilePath])
findVanilla :: [String]
-> String
-> (Maybe String, [String])
-> IO (Maybe String, [String])
findVanilla [String]
ignored String
p acc :: (Maybe String, [String])
acc@(Maybe String
mb_tix, [String]
dirs) = do
  if ShowS
takeFileName String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"vanilla"
    then do
      let mix :: String
mix = String
p String -> ShowS
</> String
"mix"
      Bool
mix_exist <- String -> IO Bool
doesDirectoryExist String
mix
      if Bool
mix_exist
         then do
           let f :: [String] -> [String]
f [String]
xs = [String
mix String -> ShowS
</> String
x| String
x <- [String]
xs, String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
ignored]
           [String]
contents <- [String] -> [String]
f ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
mix
           (Maybe String, [String]) -> IO (Maybe String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
mb_tix, [String]
contents [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
dirs)
         else (Maybe String, [String]) -> IO (Maybe String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
mb_tix, [String]
dirs)
    else (Maybe String, [String]) -> IO (Maybe String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String, [String])
acc


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

-- | Variant of 'foldDirWithIgnoring' with 'defaultIgnored'.
foldDir :: (FilePath -> a -> IO a) -> a -> [FilePath] -> IO a
foldDir :: (String -> a -> IO a) -> a -> [String] -> IO a
foldDir = [String] -> (String -> a -> IO a) -> a -> [String] -> IO a
forall a.
[String] -> (String -> a -> IO a) -> a -> [String] -> IO a
foldDirWithIgnoring [String]
defaultIgnored

-- | Default directory base names to ignore.
defaultIgnored :: [String]
defaultIgnored :: [String]
defaultIgnored = [String
".git", String
".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 :: [String] -> (String -> a -> IO a) -> a -> [String] -> IO a
foldDirWithIgnoring [String]
ignored String -> a -> IO a
f = a -> [String] -> IO a
go
  where
    go :: a -> [String] -> IO a
go a
acc0 [] = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
acc0
    go a
acc0 (String
dir:[String]
dirs) = do
      a
acc1 <- String -> a -> IO a
f String
dir a
acc0
      if ShowS
takeFileName String
dir String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ignored
         then a -> [String] -> IO a
go a
acc1 [String]
dirs
         else do
           Bool
is_dir <- String -> IO Bool
doesDirectoryExist String
dir
           if Bool -> Bool
not Bool
is_dir
             then a -> [String] -> IO a
go a
acc1 [String]
dirs
             else do
               [String]
contents <- ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dir String -> ShowS
</>) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
dir
               a
acc2 <- a -> [String] -> IO a
go a
acc1 [String]
contents
               a -> [String] -> IO a
go a
acc2 [String]
dirs