ghc-pkg-autofix 0.1.4 → 0.2.0
raw patch · 2 files changed
+59/−25 lines, 2 filesdep +cmdargs
Dependencies added: cmdargs
Files
- Main.hs +49/−21
- ghc-pkg-autofix.cabal +10/−4
Main.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns, RecordWildCards, DeriveDataTypeable #-} {-# OPTIONS_GHC -Wall #-} module Main where import Distribution.InstalledPackageInfo@@ -10,12 +10,29 @@ import System.FilePath import Data.Maybe import Data.List.Split+import Control.Exception+import System.Console.CmdArgs import PkgCheckParser +data Opts = Opts { sandbox :: Maybe FilePath }+ deriving (Show, Eq, Typeable, Data)++defOpts :: Opts+defOpts = Opts { sandbox = Nothing+ &= help "Check cabal-dev's sandbox (default: cabal-dev)"+ &= typ "PATH"+ &= opt "cabal-dev" &= name "s" &= name "cabal-dev"+ } &= program "ghc-pkg-autofix"+ &= summary "ghc-pkg-autofix: An automatic broken dependency fixer for Cabal"+ main :: IO () main = do- (_, _, hErr, _) <- runInteractiveProcess "ghc-pkg" ["check"] Nothing Nothing+ opts <- cmdArgs defOpts+ (_, _, hErr, _) <-+ case sandbox opts of+ Just path -> runInteractiveProcess "cabal-dev" ["-s", path, "ghc-pkg", "check"] Nothing Nothing+ Nothing -> runInteractiveProcess "ghc-pkg" ["check"] Nothing Nothing src <- hGetContents hErr if null src then putStrLn "Nothing to fix. exit."@@ -23,17 +40,20 @@ Left err -> hPrint stderr err Right ps -> do print ps- mapM_ procPackage ps- _ <- readProcess "ghc-pkg" ["recache", "--user"] ""+ mapM_ (procPackage (sandbox opts)) ps+ _ <- case sandbox opts of+ Nothing -> readProcess "ghc-pkg" ["recache", "--user"] ""+ Just dv -> readProcess "cabal-dev" ["-s", dv, "ghc-pkg", "recache", "--user"] "" return () -procPackage :: BrokenPackage -> IO ()-procPackage P{packageID, brokenDeps} = do- Just packID <- getPackageID packageID- newPIDs <- mapM (getPackageID . getPackageName) brokenDeps+procPackage :: Maybe FilePath -> BrokenPackage -> IO ()+procPackage mfp P{packageID, brokenDeps} = do+ Just packID <- getPackageID mfp packageID+ newPIDs <- mapM (getPackageID mfp . getPackageName) brokenDeps let table = catMaybes $ zipWith (fmap.(,)) brokenDeps newPIDs- infoPath <- getPackageInfoPath packID+ infoPath <- getPackageInfoPath mfp packID rslt <- parseInstalledPackageInfo <$> readFile infoPath+ print (infoPath, rslt) case rslt of ParseFailed err -> hPrint stderr err ParseOk _ pack -> do@@ -46,25 +66,33 @@ getPackageName :: String -> String getPackageName pid = intercalate "-" $ init' $ splitOn "-" pid -getPackageID :: String -> IO (Maybe String)-getPackageID pName = do- rsl <- parseInstalledPackageInfo <$> readProcess "ghc-pkg" ["describe", pName] ""+getPackageID :: Maybe FilePath -> String -> IO (Maybe String)+getPackageID mfp pName = handle handler $ do+ rsl <- parseInstalledPackageInfo <$>+ case mfp of+ Nothing -> readProcess "ghc-pkg" ["describe", pName] ""+ Just fp -> readProcess "cabal-dev" ["-s", fp, "ghc-pkg", "describe", pName] "" case rsl of ParseFailed _ -> return Nothing ParseOk _ pack -> do let InstalledPackageId pid = installedPackageId pack return (Just pid)+ where+ handler :: SomeException -> IO (Maybe String)+ handler e = print e >> return Nothing replace :: String -> String -> [InstalledPackageId] -> [InstalledPackageId]-replace old new = intercalate [ InstalledPackageId new ] .- splitOn [InstalledPackageId old]+replace old new = intercalate [ InstalledPackageId new ] . splitOn [InstalledPackageId old] -getPackageInfoPath :: String -> IO FilePath-getPackageInfoPath pid = do- dir <- getConfDir+getPackageInfoPath :: Maybe FilePath -> String -> IO FilePath+getPackageInfoPath mfp pid = do+ dir <- getConfDir mfp return $ dir </> (pid++".conf") -getConfDir :: IO FilePath-getConfDir = do- src <- readProcess "ghc-pkg" ["list", "--user"] ""- return $ init $ head $ filter ((=='/').head) $ lines src+getConfDir :: Maybe FilePath -> IO FilePath+getConfDir mfp = do+ src <- case mfp of+ Nothing -> readProcess "ghc-pkg" ["list", "--user"] ""+ Just fp -> readProcess "cabal-dev" ["-s", fp, "ghc-pkg", "list", "--user"] ""+ let ans = init $ head $ drop 1 $ filter ("/" `isPrefixOf`) $ lines src+ return ans
ghc-pkg-autofix.cabal view
@@ -7,15 +7,17 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.1.4+Version: 0.2.0 -- A short (one-line) description of the package.-Synopsis: Simple utility to fix BROKEN package dependencies.+Synopsis: Simple utility to fix BROKEN package dependencies for cabal-install. -- A longer description of the package. Description: The cabal-install sometimes reinstall existing library and break some package dependencies. This utility fixes such situations by replacing old package id in "broken" package with new id. Please Use at your own risk. + NOTE for v.0.2: Now ghc-pkg-autofix supports cabal-dev!+ -- The license under which the package is released. License: BSD3 @@ -41,7 +43,7 @@ -- Extra-source-files: -- Constraint on the version of Cabal needed to build this package.-Cabal-version: >=1.2+Cabal-version: >=1.6 Executable ghc-pkg-autofix@@ -51,7 +53,7 @@ -- Packages needed in order to build this package. Build-depends: base >= 4 && < 5, parsec >= 3 && < 4, split >= 0.1 && < 0.2, filepath >= 1 && < 2, process >= 1.0 && < 1.1,- Cabal >= 1.8 && <2+ Cabal >= 1.8 && <2, cmdargs == 0.9.* -- Modules not exported by this package. Other-modules: PkgCheckParser@@ -59,3 +61,7 @@ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: +source-repository head+ type: git+ location: git://github.com/konn/ghc-pkg-autofix.git+