{-# LANGUAGE TupleSections #-}
module Bazel.Runfiles
( Runfiles
, create
, rlocation
, env
) where
import Control.Monad (guard)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.IO.Class (liftIO)
import Data.Char (toLower)
import Data.Foldable (asum)
import Data.List (find, isPrefixOf, isSuffixOf)
import Data.Maybe (fromMaybe)
import GHC.Stack
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
import System.Environment (getExecutablePath, lookupEnv)
import qualified System.FilePath
import System.FilePath (FilePath, (</>), (<.>), addTrailingPathSeparator, takeFileName)
import System.Info (os)
data Runfiles
= RunfilesRoot !FilePath
| RunfilesManifest !FilePath ![(FilePath, FilePath)]
deriving Show
rlocation :: Runfiles -> FilePath -> FilePath
rlocation (RunfilesRoot f) g = f </> normalize g
rlocation (RunfilesManifest _ m) g = fromMaybe g' $ asum [lookup g' m, lookupDir g' m]
where
g' = normalize g
lookupDir :: FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
lookupDir p = fmap stripSuffix . find match
where
p' = normalize $ addTrailingPathSeparator p
match (key, value) = p' `isPrefixOf` key && drop (length p') key `isSuffixOf` value
stripSuffix (key, value) = take (length value - (length key - length p')) value
normalize :: FilePath -> FilePath
normalize | os == "mingw32" = normalizeWindows
| otherwise = System.FilePath.normalise
normalizeWindows :: FilePath -> FilePath
normalizeWindows = map (toLower . normalizeSlash) . System.FilePath.normalise
where
normalizeSlash '\\' = '/'
normalizeSlash c = c
env :: Runfiles -> [(String, String)]
env (RunfilesRoot f) = [(runfilesDirEnv, f)]
env (RunfilesManifest f _) = [(manifestFileEnv, f), (manifestOnlyEnv, "1")]
runfilesDirEnv :: String
runfilesDirEnv = "RUNFILES_DIR"
manifestFileEnv :: String
manifestFileEnv = "RUNFILES_MANIFEST_FILE"
manifestOnlyEnv :: String
manifestOnlyEnv = "RUNFILES_MANIFEST_ONLY"
create :: HasCallStack => IO Runfiles
create = do
exePath <- getExecutablePath
mbRunfiles <- runMaybeT $ asum
[ do
manifestOnly <- liftIO $ lookupEnv manifestOnlyEnv
guard (manifestOnly /= Just "1")
runfilesRoot <- asum
[ do
let dir = exePath <.> "runfiles"
exists <- liftIO $ doesDirectoryExist dir
guard exists
pure dir
, do
dir <- MaybeT $ lookupEnv runfilesDirEnv
exists <- liftIO $ doesDirectoryExist dir
guard exists
pure dir
]
containsData <- liftIO $ containsOneDataFile runfilesRoot
guard containsData
pure $! RunfilesRoot runfilesRoot
, do
manifestPath <- asum
[ do
let file = exePath <.> "runfiles_manifest"
exists <- liftIO $ doesFileExist file
guard exists
pure file
, do
file <- MaybeT $ lookupEnv manifestFileEnv
exists <- liftIO $ doesFileExist file
guard exists
pure file
]
content <- liftIO $ readFile manifestPath
let mapping = parseManifest content
pure $! RunfilesManifest manifestPath mapping
]
case mbRunfiles of
Just runfiles -> pure runfiles
Nothing -> error "Unable to locate runfiles directory or manifest"
containsOneDataFile :: FilePath -> IO Bool
containsOneDataFile = loop
where
loop fp = do
isDir <- doesDirectoryExist fp
if isDir
then anyM loop =<< fmap (map (fp </>)) (listDirectory fp)
else pure $! takeFileName fp /= "MANIFEST"
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
anyM predicate = loop
where
loop [] = pure False
loop (x:xs) = do
b <- predicate x
if b
then pure True
else loop xs
parseManifest :: String -> [(FilePath, FilePath)]
parseManifest = map parseLine . lines
where
parseLine l =
let (key, value) = span (/= ' ') l in
(normalize key, normalize $ dropWhile (== ' ') value)