cab 0.2.9 → 0.2.10

raw patch · 3 files changed

+52/−31 lines, 3 filesdep +conduit-extradep +resourcetdep −attoparsec-conduitdep −unixdep ~conduitdep ~process-conduit

Dependencies added: conduit-extra, resourcet

Dependencies removed: attoparsec-conduit, unix

Dependency ranges changed: conduit, process-conduit

Files

• Distribution/Cab/Commands.hs +43/−20
• Distribution/Cab/VerDB.hs +1/−0
• cab.cabal +8/−11

@@ -5,10 +5,10 @@   , genpaths, check, initSandbox, add, ghci   ) where -import Control.Applicative hiding (many)-import Control.Monad-import Data.Char-import Data.List (isPrefixOf, isSuffixOf, intercalate)+import Control.Applicative ((<$>))+import Control.Monad (forM_, unless, when, void)+import Data.Char (toLower)+import Data.List (intercalate, isPrefixOf) import qualified Data.Map as M import Distribution.Cab.GenPaths import Distribution.Cab.PkgDB@@ -16,9 +16,11 @@ import Distribution.Cab.Sandbox import Distribution.Cab.VerDB import Distribution.Cab.Version-import System.Exit-import System.IO-import System.Process hiding (env)+import System.Directory (doesDirectoryExist, removeDirectoryRecursive)+import System.Exit (exitFailure)+import System.FilePath (takeDirectory, takeFileName)+import System.IO (hPutStrLn, stderr)+import System.Process (readProcess, system)  ---------------------------------------------------------------- @@ -103,23 +105,44 @@     doit = OptNoharm `notElem` opts  purge :: Bool -> [Option] -> (String,String) -> IO ()-purge doit opts (name,ver) = do---    putStrLn $ "Deleting " ++ name ++ " " ++ ver+purge doit opts nameVer = do     sandboxOpts <- (makeOptList . getSandboxOpts2) <$> getSandbox-    libdirs <- queryGhcPkg sandboxOpts "library-dirs"-    haddoc  <- cutTrailing "html" `fmap` queryGhcPkg sandboxOpts "haddock-html"-    unregister doit opts (name,ver)-    putStrLn $ unwords ["Deleting dirs:", libdirs, haddoc]-    when doit . void . system . unwords $ ["rm -rf ", libdirs, haddoc]+    dirs <- getDirs nameVer sandboxOpts+    unregister doit opts nameVer+    mapM_ (removeDir doit) dirs   where     makeOptList "" = []     makeOptList x  = [x]-    queryGhcPkg sandboxOpts field = do-        let options = ["field"] ++ sandboxOpts ++ [name ++ "-" ++ ver, field]-        (!!1) . words <$> readProcess "ghc-pkg" options ""-    cutTrailing suffix s-      | suffix `isSuffixOf` s = reverse . drop (length suffix) . reverse $ s-      | otherwise             = s++getDirs :: (String,String) -> [String] -> IO [FilePath]+getDirs (name,ver) sandboxOpts = do+    libdirs <- queryGhcPkg "library-dirs"+    haddock <- map docDir <$> queryGhcPkg "haddock-html"+    return $ topDir $ libdirs ++ haddock+  where+    nameVer = name ++ "-" ++ ver+    queryGhcPkg field = do+        let options = ["field"] ++ sandboxOpts ++ [nameVer, field]+        ws <- words <$> readProcess "ghc-pkg" options ""+        return $ case ws of+            []     -> []+            (_:xs) -> xs+    docDir dir+      | takeFileName dir == "html" = takeDirectory dir+      | otherwise                  = dir+    topDir []     = []+    topDir ds@(dir:_)+      | takeFileName top == nameVer = top : ds+      | otherwise                   = ds+      where+        top = takeDirectory dir++removeDir :: Bool -> FilePath -> IO ()+removeDir doit dir = do+    exist <- doesDirectoryExist dir+    when exist $ do+        putStrLn $ "Deleting " ++ dir+        when doit $ removeDirectoryRecursive dir  unregister :: Bool -> [Option] -> (String,String) -> IO () unregister doit _ (name,ver) =

@@ -14,6 +14,7 @@  import Control.Applicative import Control.Arrow (second)+import Control.Monad.Trans.Resource (runResourceT) import Data.Attoparsec.ByteString.Char8 import Data.Conduit import Data.Conduit.Attoparsec

@@ -1,5 +1,5 @@ Name:                   cab-Version:                0.2.9+Version:                0.2.10 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -23,14 +23,15 @@   Build-Depends:        base >= 4.0 && < 5                       , Cabal                       , attoparsec >= 0.10-                      , attoparsec-conduit >= 0.3                       , bytestring-                      , conduit >= 0.3+                      , conduit >= 1.1+                      , conduit-extra                       , containers                       , directory                       , filepath                       , process-                      , process-conduit >= 0.1+                      , process-conduit >= 1.1+                      , resourcet   Exposed-Modules:	Distribution.Cab                         Distribution.Cab.PkgDB                         Distribution.Cab.Printer@@ -50,18 +51,14 @@                       , cab                       , Cabal >= 1.18                       , attoparsec >= 0.10-                      , attoparsec-conduit >= 0.3                       , bytestring-                      , conduit >= 0.3+                      , conduit >= 1.1+                      , conduit-extra                       , containers                       , directory                       , filepath                       , process-                      , process-conduit >= 0.1-  if os(windows)-     Build-Depends:-  else-     Build-Depends:     unix+                      , process-conduit >= 1.1   Other-Modules:	Commands                         Doc                         Help