module GhcMod.PathsAndFiles (
module GhcMod.PathsAndFiles
, module GhcMod.Caching
) where
import Config (cProjectVersion)
import Control.Arrow (second)
import Control.Applicative
import Control.Exception as E
import Control.Monad
import Control.Monad.Trans.Maybe
import Data.List
import Data.Char
import Data.Maybe
import Data.Traversable hiding (mapM)
import Distribution.Helper (buildPlatform)
import System.Directory
import System.FilePath
import System.Process
import GhcMod.Types
import GhcMod.Caching
import qualified GhcMod.Utils as U
import Utils (mightExist)
import Prelude
type DirPath = FilePath
type FileName = String
findCabalFile :: FilePath -> IO (Maybe FilePath)
findCabalFile dir = findFileInParentsP isCabalFile pick dir
where
pick [] = Nothing
pick [cf] = Just cf
pick cfs = throw $ GMETooManyCabalFiles cfs
findStackConfigFile :: FilePath -> IO (Maybe FilePath)
findStackConfigFile dir =
findFileInParentsP (=="stack.yaml") pick dir
where
pick [] = Nothing
pick (sf:_) = Just sf
findCabalSandboxDir :: FilePath -> IO (Maybe FilePath)
findCabalSandboxDir dir =
fmap takeDirectory <$> findFileInParentsP isSandboxConfig pick dir
where
isSandboxConfig = (==sandboxConfigFileName)
pick [] = Nothing
pick (sc:_) = Just sc
findCustomPackageDbFile :: FilePath -> IO (Maybe FilePath)
findCustomPackageDbFile dir =
mightExist $ dir </> "ghc-mod.package-db-stack"
getSandboxDb :: Cradle -> IO (Maybe GhcPkgDb)
getSandboxDb crdl = do
mConf <- traverse readFile =<< mightExist (sandboxConfigFile crdl)
bp <- buildPlatform readProcess
return $ PackageDb . fixPkgDbVer bp <$> (extractSandboxDbDir =<< mConf)
where
fixPkgDbVer bp dir =
case takeFileName dir == ghcSandboxPkgDbDir bp of
True -> dir
False -> takeDirectory dir </> ghcSandboxPkgDbDir bp
extractSandboxDbDir :: String -> Maybe FilePath
extractSandboxDbDir conf = extractValue <$> parse conf
where
key = "package-db:"
keyLen = length key
parse = listToMaybe . filter (key `isPrefixOf`) . lines
extractValue = U.dropWhileEnd isSpace . dropWhile isSpace . drop keyLen
isCabalFile :: FilePath -> Bool
isCabalFile f = takeExtension' f == ".cabal"
takeExtension' :: FilePath -> String
takeExtension' p =
if takeFileName p == takeExtension p
then ""
else takeExtension p
findFileInParentsP :: (FilePath -> Bool)
-> ([FilePath] -> Maybe a)
-> FilePath
-> IO (Maybe a)
findFileInParentsP p r dir = runMaybeT $
join $ msum <$> map (MaybeT . fmap r) <$> liftIO (findFilesInParentsP p dir)
findFilesInParentsP :: (FilePath -> Bool) -> FilePath
-> IO [IO [FilePath]]
findFilesInParentsP p dir' = U.makeAbsolute' dir' >>= \dir -> return $
map (\d -> (map (d </>)) <$> getFilesP p d) $ parents dir
getFilesP :: (FilePath -> Bool) -> DirPath -> IO [FileName]
getFilesP p dir = filterM p' =<< getDirectoryContentsSafe
where
p' fn = do
(p fn && ) <$> doesFileExist (dir </> fn)
getDirectoryContentsSafe = do
rdable <- readable <$> getPermissions dir
if rdable
then getDirectoryContents dir
else return []
parents :: FilePath -> [FilePath]
parents "" = []
parents dir' =
let (drive, dir) = splitDrive $ normalise $ dropTrailingPathSeparator dir'
in map (joinDrive drive) $ parents' $ filter (/=".") $ splitDirectories dir
where
parents' :: [String] -> [FilePath]
parents' [] | isAbsolute dir' = "":[]
parents' [] = []
parents' dir = [joinPath dir] ++ parents' (init dir)
setupConfigFile :: Cradle -> FilePath
setupConfigFile crdl =
cradleRootDir crdl </> setupConfigPath (cradleDistDir crdl)
sandboxConfigFile :: Cradle -> FilePath
sandboxConfigFile crdl = cradleRootDir crdl </> sandboxConfigFileName
sandboxConfigFileName :: String
sandboxConfigFileName = "cabal.sandbox.config"
setupConfigPath :: FilePath -> FilePath
setupConfigPath dist = dist </> "setup-config"
macrosHeaderPath :: FilePath
macrosHeaderPath = autogenModulesDir </> "cabal_macros.h"
autogenModulePath :: String -> String
autogenModulePath pkg_name =
autogenModulesDir </> ("Paths_" ++ map fixchar pkg_name) <.> ".hs"
where fixchar '-' = '_'
fixchar c = c
autogenModulesDir :: FilePath
autogenModulesDir = "build" </> "autogen"
ghcSandboxPkgDbDir :: String -> String
ghcSandboxPkgDbDir buildPlatf = do
buildPlatf ++ "-ghc-" ++ cProjectVersion ++ "-packages.conf.d"
packageCache :: String
packageCache = "package.cache"
symbolCache :: Cradle -> FilePath
symbolCache crdl = cradleRootDir crdl </> cradleDistDir crdl </> symbolCacheFile
symbolCacheFile :: String
symbolCacheFile = "ghc-mod.symbol-cache"
resolvedComponentsCacheFile :: FilePath -> FilePath
resolvedComponentsCacheFile dist =
setupConfigPath dist <.> "ghc-mod.resolved-components"
cabalHelperCacheFile :: FilePath -> FilePath
cabalHelperCacheFile dist =
setupConfigPath dist <.> "ghc-mod.cabal-components"
mergedPkgOptsCacheFile :: FilePath -> FilePath
mergedPkgOptsCacheFile dist =
setupConfigPath dist <.> "ghc-mod.package-options"
pkgDbStackCacheFile :: FilePath -> FilePath
pkgDbStackCacheFile dist =
setupConfigPath dist <.> "ghc-mod.package-db-stack"