{-# LANGUAGE BangPatterns, ScopedTypeVariables, TupleSections #-} module Language.Haskell.GhcMod.GhcPkg ( ghcPkgDbOpt , ghcPkgDbStackOpts , ghcDbStackOpts , ghcDbOpt , getPackageDbStack , getPackageCachePaths , getGhcPkgProgram ) where import Config (cProjectVersion, cTargetPlatformString, cProjectVersionInt) import Control.Applicative import Data.List.Split (splitOn) import Data.Maybe import Exception (handleIO) import System.Directory (doesDirectoryExist, getAppUserDataDirectory) import System.FilePath ((</>)) import Prelude import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Monad.Types import Language.Haskell.GhcMod.CabalHelper import Language.Haskell.GhcMod.PathsAndFiles import Language.Haskell.GhcMod.CustomPackageDb import Language.Haskell.GhcMod.Stack ghcVersion :: Int ghcVersion = read cProjectVersionInt ---------------------------------------------------------------- -- | Get options needed to add a list of package dbs to ghc-pkg's db stack ghcPkgDbStackOpts :: [GhcPkgDb] -- ^ Package db stack -> [String] ghcPkgDbStackOpts dbs = ghcPkgDbOpt `concatMap` dbs -- | Get options needed to add a list of package dbs to ghc's db stack ghcDbStackOpts :: [GhcPkgDb] -- ^ Package db stack -> [String] ghcDbStackOpts dbs = ghcDbOpt `concatMap` dbs ---------------------------------------------------------------- ghcPkgDbOpt :: GhcPkgDb -> [String] ghcPkgDbOpt GlobalDb = ["--global"] ghcPkgDbOpt UserDb = ["--user"] ghcPkgDbOpt (PackageDb pkgDb) | ghcVersion < 706 = ["--no-user-package-conf", "--package-conf=" ++ pkgDb] | otherwise = ["--no-user-package-db", "--package-db=" ++ pkgDb] ghcDbOpt :: GhcPkgDb -> [String] ghcDbOpt GlobalDb | ghcVersion < 706 = ["-global-package-conf"] | otherwise = ["-global-package-db"] ghcDbOpt UserDb | ghcVersion < 706 = ["-user-package-conf"] | otherwise = ["-user-package-db"] ghcDbOpt (PackageDb pkgDb) | ghcVersion < 706 = ["-no-user-package-conf", "-package-conf", pkgDb] | otherwise = ["-no-user-package-db", "-package-db", pkgDb] ---------------------------------------------------------------- getGhcPkgProgram :: IOish m => GhcModT m FilePath getGhcPkgProgram = do crdl <- cradle progs <- optPrograms <$> options case cradleProject crdl of (StackProject senv) -> do Just ghcPkg <- getStackGhcPkgPath senv return ghcPkg _ -> return $ ghcPkgProgram progs getPackageDbStack :: IOish m => GhcModT m [GhcPkgDb] getPackageDbStack = do crdl <- cradle mCusPkgStack <- getCustomPkgDbStack stack <- case cradleProject crdl of PlainProject -> return [GlobalDb, UserDb] SandboxProject -> do Just db <- liftIO $ getSandboxDb crdl return $ [GlobalDb, db] CabalProject -> getCabalPackageDbStack (StackProject StackEnv {..}) -> return $ map PackageDb [seSnapshotPkgDb, seLocalPkgDb] return $ fromMaybe stack mCusPkgStack getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath] getPackageCachePaths sysPkgCfg = do pkgDbStack <- getPackageDbStack catMaybes <$> (liftIO . resolvePackageConfig sysPkgCfg) `mapM` pkgDbStack -- TODO: use PkgConfRef --- Copied from ghc module `Packages' unfortunately it's not exported :/ resolvePackageConfig :: FilePath -> GhcPkgDb -> IO (Maybe FilePath) resolvePackageConfig sysPkgCfg GlobalDb = return $ Just sysPkgCfg resolvePackageConfig _ UserDb = handleIO (\_ -> return Nothing) $ do appdir <- getAppUserDataDirectory "ghc" let dir = appdir </> (target_arch ++ '-':target_os ++ '-':cProjectVersion) pkgconf = dir </> "package.conf.d" exist <- doesDirectoryExist pkgconf return $ if exist then Just pkgconf else Nothing where [target_arch,_,target_os] = splitOn "-" cTargetPlatformString resolvePackageConfig _ (PackageDb name) = return $ Just name