{-# LANGUAGE LambdaCase #-}

module Skeletest.Internal.Paths (
  setOriginalDirectory,
  readTestFile,
  listTestFiles,
) where

import Control.Monad (forM)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Text (Text)
import Data.Text.IO qualified as Text
import Skeletest.Internal.Error (invariantViolation)
import System.Directory (doesDirectoryExist, getCurrentDirectory, listDirectory)
import System.Environment (lookupEnv)
import System.FilePath ((</>))
import System.IO.Unsafe (unsafePerformIO)

originalDirectoryRef :: IORef FilePath
originalDirectoryRef :: IORef FilePath
originalDirectoryRef = IO (IORef FilePath) -> IORef FilePath
forall a. IO a -> a
unsafePerformIO (IO (IORef FilePath) -> IORef FilePath)
-> IO (IORef FilePath) -> IORef FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (IORef FilePath)
forall a. a -> IO (IORef a)
newIORef (FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
invariantViolation FilePath
"Original directory not set")
{-# NOINLINE originalDirectoryRef #-}

data TestRoot = TestRootBuildDir | TestRootCWD | TestRoot FilePath

setOriginalDirectory :: FilePath -> IO ()
setOriginalDirectory :: FilePath -> IO ()
setOriginalDirectory FilePath
buildDir = do
  TestRoot
testRoot <-
    FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"SKELETEST_TEST_ROOT" IO (Maybe FilePath)
-> (Maybe FilePath -> IO TestRoot) -> IO TestRoot
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FilePath
Nothing -> TestRoot -> IO TestRoot
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRoot
TestRootBuildDir
      Just FilePath
"BUILD_DIR" -> TestRoot -> IO TestRoot
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRoot
TestRootBuildDir
      Just FilePath
"CWD" -> TestRoot -> IO TestRoot
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRoot
TestRootCWD
      Just FilePath
fp -> TestRoot -> IO TestRoot
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestRoot -> IO TestRoot) -> TestRoot -> IO TestRoot
forall a b. (a -> b) -> a -> b
$ FilePath -> TestRoot
TestRoot FilePath
fp
  FilePath
root <-
    case TestRoot
testRoot of
      TestRoot
TestRootBuildDir -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
buildDir
      TestRoot
TestRootCWD -> IO FilePath
getCurrentDirectory
      TestRoot FilePath
fp -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
fp
  IORef FilePath -> FilePath -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef FilePath
originalDirectoryRef FilePath
root

readTestFile :: FilePath -> IO Text
readTestFile :: FilePath -> IO Text
readTestFile FilePath
fp = do
  FilePath
dir <- IORef FilePath -> IO FilePath
forall a. IORef a -> IO a
readIORef IORef FilePath
originalDirectoryRef
  FilePath -> IO Text
Text.readFile (FilePath -> IO Text) -> FilePath -> IO Text
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
fp

listTestFiles :: IO [FilePath]
listTestFiles :: IO [FilePath]
listTestFiles = do
  FilePath
dir <- IORef FilePath -> IO FilePath
forall a. IORef a -> IO a
readIORef IORef FilePath
originalDirectoryRef
  FilePath -> IO [FilePath]
listDirectoryRecursive FilePath
dir
 where
  listDirectoryRecursive :: FilePath -> IO [FilePath]
listDirectoryRecursive FilePath
dir = do
    [FilePath]
entries <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
ignoredDirs) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
dir
    ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[FilePath]] -> IO [FilePath])
-> ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
entries ((FilePath -> IO [FilePath]) -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
entry -> do
      let absEntry :: FilePath
absEntry = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
entry
      Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
absEntry
      if Bool
isDir
        then (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
entry </>) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectoryRecursive FilePath
absEntry
        else [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
entry]

  -- Hardcode some paths to ignore
  ignoredDirs :: [FilePath]
ignoredDirs =
    [ FilePath
".git"
    , FilePath
"dist-newstyle"
    , FilePath
".stack-work"
    ]