CommonUtils.hs

module Test.CommonUtils
  (
    findSrcFiles
  , readFileGhc

  -- * File paths and directories
  , hackageWorkDir
  , workDir
  , configDir
  , failuresDir
  , failuresHtmlDir
  , cppFile
  , parseFailFile
  , processed
  , processedFailFile
  , logFile
  , origFailuresFile
  , badpackagesFile
  , blackListed
  , knownFailuresFile
  , failuresHtmlFile
  ) where

import Control.Monad
import Control.Monad.Extra
import Data.List hiding (find)
import qualified GHC.Data.StringBuffer as GHC
import System.Directory
import System.FilePath

-- ---------------------------------------------------------------------

-- | Round trip working dir holding current hackage contents, can be deleted
hackageWorkDir :: FilePath
hackageWorkDir = "./hackage-roundtrip-work"

-- ---------------------------------------------------------------------

-- | Round trip working dir, can be deleted
workDir :: FilePath
workDir = "./roundtrip-work"

-- | Round trip configuration dir, keept under version control
configDir :: FilePath
configDir = "./roundtrip-config"

-- |Directory where results of failing tests are stored for later analysis
failuresDir :: FilePath
failuresDir = workDir </> "failures"

-- |Directory where results of failing tests are provided in html format
failuresHtmlDir :: FilePath
failuresHtmlDir = workDir </> "html"

-- |Generated:files known to fail due to CPP parse failures, caused by an Exception
cppFile :: FilePath
cppFile = workDir </> "cpp.txt"

-- |Generated:files returning ParseFail status
parseFailFile :: FilePath
parseFailFile = workDir </> "pfail.txt"

-- |Generated:files successfully processed
processed :: FilePath
processed = workDir </> "processed.txt"

-- |Generated:files which failed comparison
processedFailFile :: FilePath
processedFailFile = workDir </> "failed.txt"

-- |log of current file being processed, for knowing what to blacklist
logFile :: FilePath
logFile = workDir </> "roundtrip.log"

-- |list of original failures, when rerunning tests after static processing
origFailuresFile :: FilePath
origFailuresFile = workDir </> "origfailures.txt"

-- |name of index html page
failuresHtmlFile :: FilePath
failuresHtmlFile = "failures.html"

-- -- |location and name of index html page
-- failuresHtmlFile :: FilePath
-- failuresHtmlFile = failuresHtmlDir </> "failures.html"

-- ---------------------------------------------------------------------

-- |Hand edited list of files known to segfault
badpackagesFile :: FilePath
badpackagesFile = configDir </> "badpackages.txt"

-- |Hand edited list of files known to segfault
blackListed :: FilePath
blackListed = configDir </> "blacklist.txt"

-- |Hand edited list of files known to fail, no fix required/possible
knownFailuresFile :: FilePath
knownFailuresFile = configDir </> "knownfailures.txt"

-- ---------------------------------------------------------------------

-- Given base directory finds all haskell source files
findSrcFiles :: FilePath -> IO [FilePath]
findSrcFiles = traverseDir okDirectory accFile []
  where
    okDirectory :: FilePath -> Bool
    okDirectory path
      | "." `isPrefixOf` takeBaseName path = False
      | otherwise = True

    accFile :: [FilePath] -> FilePath -> IO [FilePath]
    accFile acc fileName = do
      return (if (takeExtension fileName == ".hs" && p fileName)
                then fileName:acc
                else acc)
      where
        p x
          | "refactored" `isInfixOf` x = False
          | "Setup.hs" `isInfixOf` x = False
          | "HLint.hs" `isInfixOf` x = False -- HLint config files
          | otherwise                 = True

-- ---------------------------------------------------------------------
-- Based on https://stackoverflow.com/questions/51712083/recursively-search-directories-for-all-files-matching-name-criteria-in-haskell
traverseDir :: (FilePath -> Bool) -> (b -> FilePath -> IO b) -> b -> FilePath -> IO b
traverseDir validDir transition =
    let go state dirPath =
            do names <- listDirectory dirPath
               let paths = map (dirPath </>) names
               (dirPaths, filePaths) <- partitionM doesDirectoryExist paths
               state' <- foldM transition state filePaths -- process current dir
               foldM go state' (filter validDir dirPaths) -- process subdirs
     in go

-- ---------------------------------------------------------------------
readFileGhc :: FilePath -> IO String
readFileGhc file = do
  buf@(GHC.StringBuffer _ len _) <- GHC.hGetStringBuffer file
  return (GHC.lexemeToString buf len)