just style.
This commit is contained in:
parent
697ad3722a
commit
cd56e26b25
@ -10,19 +10,16 @@ module Language.Haskell.GhcMod.GhcPkg (
|
|||||||
, getPackageDbPackages
|
, getPackageDbPackages
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Language.Haskell.GhcMod.Types
|
import Config (cProjectVersionInt) -- ghc version
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Exception (SomeException(..))
|
import Control.Exception (SomeException(..))
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
--import Control.Exception.IOChoice ((||>))
|
|
||||||
import Data.Char (isSpace)
|
import Data.Char (isSpace)
|
||||||
import Data.List (isPrefixOf)
|
import Data.List (isPrefixOf)
|
||||||
|
import Language.Haskell.GhcMod.Types
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
import System.Process (readProcess)
|
import System.Process (readProcess)
|
||||||
|
|
||||||
import Config (cProjectVersionInt) -- ghc version
|
|
||||||
|
|
||||||
ghcVersion :: Int
|
ghcVersion :: Int
|
||||||
ghcVersion = read cProjectVersionInt
|
ghcVersion = read cProjectVersionInt
|
||||||
|
|
||||||
@ -30,8 +27,7 @@ ghcVersion = read cProjectVersionInt
|
|||||||
getSandboxDb :: FilePath -- ^ Path to the cabal package root directory
|
getSandboxDb :: FilePath -- ^ Path to the cabal package root directory
|
||||||
-- (containing the @cabal.sandbox.config@ file)
|
-- (containing the @cabal.sandbox.config@ file)
|
||||||
-> IO FilePath
|
-> IO FilePath
|
||||||
getSandboxDb cdir =
|
getSandboxDb cdir = getSandboxDbDir (cdir </> "cabal.sandbox.config")
|
||||||
getSandboxDbDir (cdir </> "cabal.sandbox.config")
|
|
||||||
|
|
||||||
-- | Extract the sandbox package db directory from the cabal.sandbox.config file.
|
-- | Extract the sandbox package db directory from the cabal.sandbox.config file.
|
||||||
-- Exception is thrown if the sandbox config file is broken.
|
-- Exception is thrown if the sandbox config file is broken.
|
||||||
@ -61,8 +57,7 @@ getPackageDbPackages :: FilePath -- ^ Project Directory (where the
|
|||||||
-- cabal.sandbox.config file would be if it
|
-- cabal.sandbox.config file would be if it
|
||||||
-- exists)
|
-- exists)
|
||||||
-> IO [PackageBaseName]
|
-> IO [PackageBaseName]
|
||||||
getPackageDbPackages cdir =
|
getPackageDbPackages cdir = ghcPkgList =<< getPackageDbStack cdir
|
||||||
ghcPkgList =<< getPackageDbStack cdir
|
|
||||||
|
|
||||||
getPackageDbStack :: FilePath -- ^ Project Directory (where the
|
getPackageDbStack :: FilePath -- ^ Project Directory (where the
|
||||||
-- cabal.sandbox.config file would be if it
|
-- cabal.sandbox.config file would be if it
|
||||||
@ -75,12 +70,9 @@ getPackageDbStack cdir =
|
|||||||
|
|
||||||
-- | List packages in one or more ghc package stores
|
-- | List packages in one or more ghc package stores
|
||||||
ghcPkgList :: [GhcPkgDb] -> IO [PackageBaseName]
|
ghcPkgList :: [GhcPkgDb] -> IO [PackageBaseName]
|
||||||
ghcPkgList dbs =
|
ghcPkgList dbs = words <$> readProcess "ghc-pkg" opts ""
|
||||||
words <$> readProcess "ghc-pkg" opts ""
|
|
||||||
where
|
where
|
||||||
opts =
|
opts = ["--simple-output", "--names-only", "list"] ++ ghcPkgDbStackOpts dbs
|
||||||
["--simple-output", "--names-only", "list"]
|
|
||||||
++ ghcPkgDbStackOpts dbs
|
|
||||||
|
|
||||||
-- | Get options needed to add a list of package dbs to ghc-pkg's db stack
|
-- | Get options needed to add a list of package dbs to ghc-pkg's db stack
|
||||||
ghcPkgDbStackOpts :: [GhcPkgDb] -- ^ Package db stack
|
ghcPkgDbStackOpts :: [GhcPkgDb] -- ^ Package db stack
|
||||||
@ -89,60 +81,23 @@ ghcPkgDbStackOpts dbs = (ghcPkgDbOpt `concatMap` dbs)
|
|||||||
|
|
||||||
-- | Get options needed to add a list of package dbs to ghc's db stack
|
-- | Get options needed to add a list of package dbs to ghc's db stack
|
||||||
ghcDbStackOpts :: [GhcPkgDb] -- ^ Package db stack
|
ghcDbStackOpts :: [GhcPkgDb] -- ^ Package db stack
|
||||||
-> [String]
|
-> [String]
|
||||||
ghcDbStackOpts dbs = (ghcDbOpt `concatMap` dbs)
|
ghcDbStackOpts dbs = (ghcDbOpt `concatMap` dbs)
|
||||||
|
|
||||||
ghcPkgDbOpt :: GhcPkgDb -> [String]
|
ghcPkgDbOpt :: GhcPkgDb -> [String]
|
||||||
ghcPkgDbOpt GlobalDb = ["--global"]
|
ghcPkgDbOpt GlobalDb = ["--global"]
|
||||||
ghcPkgDbOpt UserDb = ["--user"]
|
ghcPkgDbOpt UserDb = ["--user"]
|
||||||
ghcPkgDbOpt (PackageDb pkgDb)
|
ghcPkgDbOpt (PackageDb pkgDb)
|
||||||
| ghcVersion < 706 = ["--no-user-package-conf", "--package-conf=" ++ pkgDb]
|
| ghcVersion < 706 = ["--no-user-package-conf", "--package-conf=" ++ pkgDb]
|
||||||
| otherwise = ["--no-user-package-db", "--package-db=" ++ pkgDb]
|
| otherwise = ["--no-user-package-db", "--package-db=" ++ pkgDb]
|
||||||
|
|
||||||
ghcDbOpt :: GhcPkgDb -> [String]
|
ghcDbOpt :: GhcPkgDb -> [String]
|
||||||
ghcDbOpt GlobalDb | ghcVersion < 706 = ["-global-package-conf"]
|
ghcDbOpt GlobalDb
|
||||||
| otherwise = ["-global-package-db"]
|
| ghcVersion < 706 = ["-global-package-conf"]
|
||||||
ghcDbOpt UserDb | ghcVersion < 706 = ["-user-package-conf"]
|
| otherwise = ["-global-package-db"]
|
||||||
| otherwise = ["-user-package-db"]
|
ghcDbOpt UserDb
|
||||||
|
| ghcVersion < 706 = ["-user-package-conf"]
|
||||||
|
| otherwise = ["-user-package-db"]
|
||||||
ghcDbOpt (PackageDb pkgDb)
|
ghcDbOpt (PackageDb pkgDb)
|
||||||
| ghcVersion < 706 = ["-no-user-package-conf", "-package-conf", pkgDb]
|
| ghcVersion < 706 = ["-no-user-package-conf", "-package-conf", pkgDb]
|
||||||
| otherwise = ["-no-user-package-db", "-package-db", pkgDb]
|
| otherwise = ["-no-user-package-db", "-package-db", pkgDb]
|
||||||
|
|
||||||
-- getPackageDbPackages :: FilePath -> IO [Package]
|
|
||||||
-- getPackageDbPackages cdir = (getPkgDb >>= listDbPackages) `E.catch` handler
|
|
||||||
-- where
|
|
||||||
-- getPkgDb = getPackageDbDir (cdir </> configFile)
|
|
||||||
-- handler :: SomeException -> IO [Package]
|
|
||||||
-- handler _ = return []
|
|
||||||
|
|
||||||
-- listDbPackages :: FilePath -> IO [Package]
|
|
||||||
-- listDbPackages pkgdir = do
|
|
||||||
-- files <- filter (".conf" `isSuffixOf`) <$> getDirectoryContents pkgdir
|
|
||||||
-- mapM (extractPackage . (pkgdir </>)) files
|
|
||||||
|
|
||||||
-- extractPackage :: FilePath -> IO Package
|
|
||||||
-- extractPackage pconf = do
|
|
||||||
-- contents <- lines <$> readFile pconf
|
|
||||||
-- -- Be strict to ensure that an error can be caught.
|
|
||||||
-- let !name = extractName $ parseName contents
|
|
||||||
-- !pid = extractId $ parseId contents
|
|
||||||
-- return (name, Just pid)
|
|
||||||
-- where
|
|
||||||
-- parseName = parse nameKey
|
|
||||||
-- extractName = extract nameKeyLength
|
|
||||||
-- parseId = parse idKey
|
|
||||||
-- extractId = extract idKeyLength
|
|
||||||
-- parse key = head . filter (key `isPrefixOf`)
|
|
||||||
-- extract keylen = takeWhile (not . isSpace) . dropWhile isSpace . drop keylen
|
|
||||||
|
|
||||||
-- nameKey :: String
|
|
||||||
-- nameKey = "name:"
|
|
||||||
|
|
||||||
-- idKey :: String
|
|
||||||
-- idKey = "id:"
|
|
||||||
|
|
||||||
-- nameKeyLength :: Int
|
|
||||||
-- nameKeyLength = length nameKey
|
|
||||||
|
|
||||||
-- idKeyLength :: Int
|
|
||||||
-- idKeyLength = length idKey
|
|
||||||
|
Loading…
Reference in New Issue
Block a user