haskell-updater 1.0.0.0 → 1.1.0.0
raw patch · 4 files changed
+100/−53 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- Distribution/Gentoo/GHC.hs +2/−2
- Distribution/Gentoo/PkgManager.hs +51/−19
- Main.hs +37/−28
- haskell-updater.cabal +10/−4
Distribution/Gentoo/GHC.hs view
@@ -37,8 +37,8 @@ -- Other imports import Data.Char(isDigit)-import Data.Either(Either(..), partitionEithers)-import Data.Maybe(Maybe(..), maybe, fromJust)+import Data.Either(partitionEithers)+import Data.Maybe(fromJust) import qualified Data.Map as Map import Data.Map(Map) import qualified Data.ByteString.Char8 as BS
Distribution/Gentoo/PkgManager.hs view
@@ -1,7 +1,7 @@ {- | Module : Distribution.Gentoo.PkgManager Description : Using package managers in Gentoo.- Copyright : (c) Ivan Lazar Miljenovic 2009+ Copyright : (c) Ivan Lazar Miljenovic, Emil Karlson 2010 License : GPL-2 or later Maintainer : Ivan.Miljenovic@gmail.com @@ -11,8 +11,11 @@ ( PkgManager , definedPMs , choosePM+ , stringToCustomPM+ , isValidPM , defaultPM , defaultPMName+ , nameOfPM , dummy , PMFlag(..) , buildCmd@@ -21,9 +24,11 @@ import Distribution.Gentoo.Packages import Data.Char(toLower)-import Data.Maybe(mapMaybe)+import Data.Maybe(mapMaybe, fromMaybe) import qualified Data.Map as M import Data.Map(Map)+import System.IO.Error(try)+import System.Environment(getEnv) -- ----------------------------------------------------------------------------- @@ -31,6 +36,7 @@ data PkgManager = Portage | PkgCore | Paludis+ | InvalidPM String | CustomPM String deriving (Eq, Ord, Show, Read) @@ -38,9 +44,17 @@ dummy :: PkgManager dummy = CustomPM "echo" --- | The default package manager.-defaultPM :: PkgManager-defaultPM = pmNameMap M.! defaultPMName+-- | The default package manager. If the environment variable+-- @PACKAGE_MANAGER@ exists, use that; otherwise default to+-- "portage". Note that even if that environment variable is+-- defined, if it is unknown then it won't be used.+defaultPM :: IO PkgManager+defaultPM = do eDPM <- try $ getEnv "PACKAGE_MANAGER"+ let dPM = either (const defaultPMName) id eDPM+ mPM = dPM `M.lookup` pmNameMap+ return $ fromMaybe knownDef mPM+ where+ knownDef = pmNameMap M.! defaultPMName defaultPMName :: String defaultPMName = "portage"@@ -49,31 +63,48 @@ definedPMs :: [String] definedPMs = M.keys pmNameMap +isValidPM :: PkgManager -> Either String PkgManager+isValidPM (InvalidPM pmname) = Left pmname+isValidPM pm = Right pm+ pmNameMap :: Map String PkgManager pmNameMap = M.fromList [ ("portage", Portage) , ("pkgcore", PkgCore) , ("paludis", Paludis) ] +pmNameMap' :: Map PkgManager String+pmNameMap' = M.fromList . map (\(nm,pm) -> (pm,nm)) $ M.toList pmNameMap++nameOfPM :: PkgManager -> String+nameOfPM (CustomPM pmname) = "custom package manager command: " ++ pmname+nameOfPM (InvalidPM pmname) = "invalid package manager: " ++ pmname+nameOfPM pm = pmNameMap' M.! pm+ -- | Choose the appropriate PM from the textual representation; throws -- an error if that PM isn't known.-choosePM :: String -> Either String PkgManager-choosePM pm = maybe (Left pm) Right $ pm' `M.lookup` pmNameMap+choosePM :: String -> PkgManager+choosePM pm = maybe (InvalidPM pm) id $ pm' `M.lookup` pmNameMap where pm' = map toLower pm +stringToCustomPM :: String -> PkgManager+stringToCustomPM = CustomPM+ pmCommand :: PkgManager -> String pmCommand Portage = "emerge" pmCommand PkgCore = "pmerge" pmCommand Paludis = "paludis" pmCommand (CustomPM cmd) = cmd+pmCommand (InvalidPM _) = undefined -defaultPMFlags :: PkgManager -> [String]-defaultPMFlags Portage = ["--oneshot", "--keep-going"]-defaultPMFlags PkgCore = ["--deep", "--oneshot", "--ignore-failures"]-defaultPMFlags Paludis = [ "--install", "--preserve-world"- , "--continue-on-failure if-independent"]-defaultPMFlags CustomPM{} = []+defaultPMFlags :: PkgManager -> [String]+defaultPMFlags Portage = ["--oneshot", "--keep-going"]+defaultPMFlags PkgCore = ["--deep", "--oneshot", "--ignore-failures"]+defaultPMFlags Paludis = [ "--install", "--preserve-world"+ , "--continue-on-failure if-independent"]+defaultPMFlags CustomPM{} = []+defaultPMFlags (InvalidPM _) = undefined buildCmd :: PkgManager -> [PMFlag] -> [Package] -> String buildCmd pm fs ps = unwords $ pmCommand pm : fs' ++ ps'@@ -89,11 +120,12 @@ | UpdateAsNeeded deriving (Eq, Ord, Show, Read) -flagRep :: PkgManager -> PMFlag -> Maybe String-flagRep Portage = portagePMFlag-flagRep PkgCore = pkgcorePMFlag-flagRep Paludis = paludisPMFlag-flagRep CustomPM{} = const Nothing -- Can't tell how flags would work.+flagRep :: PkgManager -> PMFlag -> Maybe String+flagRep Portage = portagePMFlag+flagRep PkgCore = pkgcorePMFlag+flagRep Paludis = paludisPMFlag+flagRep CustomPM{} = const Nothing -- Can't tell how flags would work.+flagRep (InvalidPM _) = undefined portagePMFlag :: PMFlag -> Maybe String portagePMFlag PretendBuild = Just "--pretend"@@ -107,4 +139,4 @@ paludisPMFlag :: PMFlag -> Maybe String paludisPMFlag PretendBuild = Just "--pretend" paludisPMFlag UpdateDeep = Just "--dl-upgrade always"-paludisPMFlag UpdateAsNeeded = Just "--dl-upgrade as-needed"+paludisPMFlag UpdateAsNeeded = Just "--dl-upgrade as-needed --dl-new-slots as-needed"
Main.hs view
@@ -1,7 +1,7 @@ {- | Module : Main Description : The haskell-updater executable- Copyright : (c) Ivan Lazar Miljenovic, Stephan Friedrichs 2009+ Copyright : (c) Ivan Lazar Miljenovic, Stephan Friedrichs, Emil Karlson 2010 License : GPL-2 or later Maintainer : Ivan.Miljenovic@gmail.com @@ -63,7 +63,7 @@ runAction :: RunModifier -> Action -> IO a runAction _ Help = help runAction _ Version = version-runAction rm (Build ts) = do systemInfo+runAction rm (Build ts) = do systemInfo rm ps <- allGetPackages ts buildPkgs rm ps @@ -121,6 +121,7 @@ data Flag = HelpFlag | VersionFlag | PM String+ | CustomPMFlag String | Check | Upgrade | Pretend@@ -129,23 +130,24 @@ parseArgs :: IO (RunModifier, Action) parseArgs = do args <- getArgs- argParser $ getOpt Permute options args+ defPM <- defaultPM+ argParser defPM $ getOpt Permute options args -argParser :: ([Flag], [String], [String])- -> IO (RunModifier, Action)-argParser (fls, oth, []) = do unless (null oth)- $ putErrLn- $ unwords $ "Unknown options:" : oth- unless (null bPms)- $ putErrLn- $ unwords $ "Unknown package managers:" : bPms- return (rm, a)+argParser :: PkgManager -> ([Flag], [String], [String])+ -> IO (RunModifier, Action)+argParser dPM (fls, oth, []) = do unless (null oth)+ $ putErrLn+ $ unwords $ "Unknown options:" : oth+ unless (null bPms)+ $ putErrLn+ $ unwords $ "Unknown package managers:" : bPms+ return (rm, a) where (fls', as) = partitionBy flagToAction fls a = combineAllActions as (opts, pms) = partitionBy flagToPM fls'- (bPms, pms') = partitionBy choosePM pms- pm = emptyElse defaultPM last pms'+ (bPms, pms') = partitionBy isValidPM pms+ pm = emptyElse dPM last pms' opts' = Set.fromList opts hasFlag = flip Set.member opts' pmFlags = bool id (PretendBuild:) (hasFlag Pretend)@@ -156,7 +158,7 @@ , withCmd = PrintAndRun } -argParser (_, _, errs) = die $ unwords $ "Errors in arguments:" : errs+argParser _ (_, _, errs) = die $ unwords $ "Errors in arguments:" : errs flagToAction :: Flag -> Either Flag Action flagToAction HelpFlag = Right Help@@ -165,9 +167,10 @@ flagToAction Upgrade = Right . Build $ Set.singleton GhcUpgrade flagToAction f = Left f -flagToPM :: Flag -> Either Flag String-flagToPM (PM pm) = Right pm-flagToPM f = Left f+flagToPM :: Flag -> Either Flag PkgManager+flagToPM (CustomPMFlag pm) = Right $ stringToCustomPM pm+flagToPM (PM pm) = Right $ choosePM pm+flagToPM f = Left f options :: [OptDescr Flag] options =@@ -178,6 +181,9 @@ , Option ['P'] ["package-manager"] (ReqArg PM "PM") $ "Use package manager PM, where PM can be one of:\n" ++ pmList ++ defPM+ , Option ['C'] ["--custom-pm"] (ReqArg CustomPMFlag "command")+ "Use custom command as package manager;\n\+ \ignores the --pretend and --no-deep flags." , Option ['p'] ["pretend"] (NoArg Pretend) "Only pretend to build packages." , Option [] ["no-deep"] (NoArg NoDeep)@@ -190,7 +196,9 @@ where pmList = unlines . map ((++) " * ") $ definedPMs defPM = "The last valid value of PM specified is chosen.\n\- \The default package manager is: " ++ defaultPMName+ \The default package manager is: " ++ defaultPMName ++ ",\n\+ \which can be overriden with the \"PACKAGE_MANAGER\"\n\+ \environment variable." -- ----------------------------------------------------------------------------- -- Printing information.@@ -220,15 +228,16 @@ \\n\ \Options:" -systemInfo :: IO ()-systemInfo = do ver <- ghcVersion- pName <- getProgName- pLoc <- ghcLoc- libDir <- ghcLibDir- putStrLn $ "Running " ++ pName ++ " using GHC " ++ ver- putStrLn $ " * Executable: " ++ pLoc- putStrLn $ " * Library directory: " ++ libDir- putStrLn ""+systemInfo :: RunModifier -> IO ()+systemInfo rm = do ver <- ghcVersion+ pName <- getProgName+ pLoc <- ghcLoc+ libDir <- ghcLibDir+ putStrLn $ "Running " ++ pName ++ " using GHC " ++ ver+ putStrLn $ " * Executable: " ++ pLoc+ putStrLn $ " * Library directory: " ++ libDir+ putStrLn $ " * Package manager: " ++ nameOfPM (pkgmgr rm)+ putStrLn "" -- ----------------------------------------------------------------------------- -- Utility functions
haskell-updater.cabal view
@@ -1,6 +1,6 @@ Name: haskell-updater Homepage: http://haskell.org/haskellwiki/Gentoo#haskell-updater-Version: 1.0.0.0+Version: 1.1.0.0 Synopsis: Rebuild Haskell dependencies in Gentoo Description: haskell-updater rebuilds Haskell packages on Gentoo after a GHC upgrade or a dependency upgrade.@@ -16,14 +16,20 @@ Copyright: (c) Ivan Lazar Miljenovic, Lennart Kolmodin, Stephan Friedrichs+ Emil Karlson Author: Ivan Lazar Miljenovic, Lennart Kolmodin, Stephan Friedrichs+ Emil Karlson Maintainer: Ivan.Miljenovic@gmail.com-Cabal-Version: >= 1.2+Cabal-Version: >= 1.6 Build-Type: Simple Extra-Source-Files: TODO +Source-Repository head+ Type: darcs+ Location: http://code.haskell.org/gentoo/haskell-updater/+ Executable haskell-updater { Main-Is: Main.hs@@ -35,8 +41,8 @@ Ghc-Options: -Wall Ghc-Prof-Options: -auto-all - Build-Depends: base >= 3 && < 5,- Cabal >= 1.8 && < 1.9,+ Build-Depends: base == 4.*,+ Cabal == 1.8.*, containers < 0.4, filepath < 1.2, directory < 1.1,