cblrepo 0.15.1 → 0.16.0
raw patch · 13 files changed
+225/−137 lines, 13 filesdep +stringsearchdep +transformersdep ~Unixutils
Dependencies added: stringsearch, transformers
Dependency ranges changed: Unixutils
Files
- cblrepo.cabal +4/−4
- src/Add.hs +4/−5
- src/ConvertDB.hs +1/−1
- src/Extract.hs +4/−4
- src/ListPkgs.hs +3/−1
- src/OldPkgDB.hs +66/−15
- src/PkgBuild.hs +14/−12
- src/PkgDB.hs +45/−34
- src/Remove.hs +3/−2
- src/Util/Cabal.hs +20/−16
- src/Util/HackageIndex.hs +5/−1
- src/Util/Misc.hs +13/−13
- src/Util/Translation.hs +43/−29
cblrepo.cabal view
@@ -1,5 +1,5 @@ name: cblrepo-version: 0.15.1+version: 0.16.0 cabal-version: >= 1.6 license: OtherLicense license-file: LICENSE-2.0@@ -26,10 +26,10 @@ other-modules: PkgDB Add BumpPkgs BuildPkgs Sync Versions Updates ListPkgs PkgBuild OldPkgDB ConvertDB Remove Extract Util.Translation Util.Cabal Util.HackageIndex Util.Misc Util.Dist build-depends: base ==4.8.*, filepath ==1.4.*,- directory ==1.2.*, Cabal ==1.22.*,+ directory ==1.2.*, Cabal ==1.22.*, transformers ==0.4.*, bytestring ==0.10.*, tar ==0.4.*, zlib ==0.5.*, mtl ==2.2.*,- process ==1.2.*, Unixutils ==1.52.*, unix ==2.7.*,- ansi-wl-pprint ==0.6.*, aeson ==0.8.*,+ process ==1.2.*, Unixutils ==1.53.*, unix ==2.7.*,+ ansi-wl-pprint ==0.6.*, aeson ==0.8.*, stringsearch ==0.3.*, optparse-applicative ==0.11.*, safe ==0.3.*, containers ==0.5.*, utf8-string ==1
src/Add.hs view
@@ -25,7 +25,6 @@ -- {{{2 system import Control.Monad.Reader--- import Control.Monad.Error import Data.List import Data.Maybe import Distribution.PackageDescription@@ -39,7 +38,7 @@ -- {{{1 types data PkgType = GhcType String Version- | DistroType String Version String+ | DistroType String Version Int | RepoType GenericPackageDescription deriving (Eq, Show) @@ -55,9 +54,9 @@ -- ghcPkgs <- asks $ map (uncurry GhcType) . cmdAddGhcPkgs . optsCmd distroPkgs <- asks $ map (\ (n, v, r) -> DistroType n v r) . cmdAddDistroPkgs . optsCmd- genFilePkgs <- mapM (runCabalParseWithTempDir . Cbl.readFromFile . fst) filePkgs- genIdxPkgs <- mapM ((runCabalParseWithTempDir . Cbl.readFromIdx) . (\ (a, b, _) -> (a, b))) idxPkgs- genPkgs <- liftM (map RepoType) $ exitOnErrors (genFilePkgs ++ genIdxPkgs)+ genFilePkgs <- mapM (runCabalParseWithTempDir . fmap snd . Cbl.readFromFile . fst) filePkgs+ genIdxPkgs <- mapM ((runCabalParseWithTempDir . fmap snd . Cbl.readFromIdx) . (\ (a, b, _) -> (a, b))) idxPkgs+ genPkgs <- liftM (map RepoType) $ exitOnAnyLefts (genFilePkgs ++ genIdxPkgs) -- let pkgs = ghcPkgs ++ distroPkgs ++ genPkgs pkgNames = map getName pkgs
src/ConvertDB.hs view
@@ -46,4 +46,4 @@ x = 0 d = ODB.pkgDeps o f = ODB.pkgFlags o- r = ODB.pkgRelease o+ r = read $ ODB.pkgRelease o
src/Extract.hs view
@@ -5,7 +5,7 @@ import Util.HackageIndex import Util.Misc -import Control.Monad.Error+import Control.Monad.Trans.Except import Control.Monad.Reader import qualified Data.ByteString.Lazy as BSL import Data.Version@@ -18,11 +18,11 @@ pkgsNVersions <- asks $ cmdExtractPkgs . optsCmd -- idx <- liftIO $ readIndexFile aD- _ <- mapM (runErrorT . extractAndSave idx) pkgsNVersions >>= exitOnErrors+ _ <- mapM (runExceptT . extractAndSave idx) pkgsNVersions >>= exitOnAnyLefts return () -extractAndSave :: (MonadError String m, MonadIO m) => BSL.ByteString -> (String, Version) -> m ()-extractAndSave idx (pkg, ver) = maybe (throwError errorMsg) (liftIO . BSL.writeFile destFn) (extractCabal idx pkg ver)+extractAndSave :: MonadIO m => BSL.ByteString -> (String, Version) -> ExceptT String m ()+extractAndSave idx (pkg, ver) = maybe (throwE errorMsg) (liftIO . BSL.writeFile destFn) (extractCabal idx pkg ver) where destFn = pkg <.> "cabal" errorMsg = "Failed to extract Cabal for " ++ pkg ++ " " ++ display ver
src/ListPkgs.hs view
@@ -46,8 +46,10 @@ printCblPkgShort :: CblPkg -> IO () printCblPkgShort p =- putStrLn $ pkgName p ++ " " ++ display (pkgVersion p) ++ "-" ++ pkgRelease p ++ showFlagsIfPresent p+ putStrLn $ pkgName p ++ " " ++ v ++ "-" ++ r ++ showFlagsIfPresent p where+ v = display (pkgVersion p) ++ if isRepoPkg p then ("_" ++ show (pkgXRev p)) else ""+ r = if isGhcPkg p then "xx" else show (pkgRelease p) showFlagsIfPresent _p | [] <- pkgFlags _p = "" | fa <- pkgFlags _p = " (" ++ unwords (map showSingleFlag fa) ++ ")"
src/OldPkgDB.hs view
@@ -1,5 +1,5 @@ {-- - Copyright 2011-2013 Per Magnus Therning+ - Copyright 2011-2014 Per Magnus Therning - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License.@@ -16,7 +16,38 @@ {-# LANGUAGE TemplateHaskell #-} -module OldPkgDB where+module OldPkgDB+ ( CblPkg+ , pkgName+ , pkgPkg+ , pkgVersion+ , pkgXRev+ , pkgDeps+ , pkgFlags+ , pkgRelease+ --+ , isGhcPkg+ , isDistroPkg+ , isRepoPkg+ , isBasePkg+ --+ , createGhcPkg+ , createDistroPkg+ , createRepoPkg+ , createCblPkg+ --+ , CblDB+ , addPkg+ , addPkg2+ , delPkg+ , bumpRelease+ , lookupPkg+ , transitiveDependants+ , checkDependants+ , checkAgainstDb+ , saveDb+ , readDb+ ) where -- {{{1 imports import Control.Arrow@@ -33,15 +64,13 @@ import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..), SumEncoding(..)) import qualified Data.ByteString.Lazy.Char8 as C --- {{{ temporary-_depName (P.Dependency (P.PackageName n) _) = n-_depVersionRange (P.Dependency _ vr) = vr+import qualified Util.Dist -- {{{1 types data Pkg = GhcPkg { version :: V.Version } | DistroPkg { version :: V.Version, release :: String }- | RepoPkg { version :: V.Version, deps :: [P.Dependency], flags :: FlagAssignment, release :: String }+ | RepoPkg { version :: V.Version, xrev :: Int, deps :: [P.Dependency], flags :: FlagAssignment, release :: String } deriving (Eq, Show) data CblPkg = CP String Pkg@@ -79,6 +108,10 @@ pkgVersion :: CblPkg -> V.Version pkgVersion (CP _ p) = version p +pkgXRev :: CblPkg -> Int+pkgXRev (CP _ RepoPkg { xrev = x }) = x+pkgXRev _ = 0+ pkgDeps :: CblPkg -> [P.Dependency] pkgDeps (CP _ RepoPkg { deps = d}) = d pkgDeps _ = []@@ -92,26 +125,35 @@ pkgRelease (CP _ DistroPkg { release = r }) = r pkgRelease (CP _ RepoPkg { release = r }) = r +createGhcPkg :: String -> V.Version -> CblPkg createGhcPkg n v = CP n (GhcPkg v)++createDistroPkg :: String -> V.Version -> String -> CblPkg createDistroPkg n v r = CP n (DistroPkg v r)-createRepoPkg n v d fa r = CP n (RepoPkg v d fa r) +createRepoPkg :: String -> V.Version -> Int -> [P.Dependency] -> FlagAssignment -> String -> CblPkg+createRepoPkg n v x d fa r = CP n (RepoPkg v x d fa r)+ createCblPkg :: PackageDescription -> FlagAssignment -> CblPkg-createCblPkg pd fa = createRepoPkg name version deps fa "1"+createCblPkg pd fa = createRepoPkg name version xrev deps fa "1" where- name = (\ (P.PackageName n) -> n) (P.pkgName $ package pd)+ name = Util.Dist.pkgNameStr pd version = P.pkgVersion $ package pd+ xrev = Util.Dist.pkgXRev pd deps = buildDepends pd getDependencyOn :: String -> CblPkg -> Maybe P.Dependency-getDependencyOn n p = find (\ d -> _depName d == n) (pkgDeps p)+getDependencyOn n p = find (\ d -> Util.Dist.depName d == n) (pkgDeps p) +isGhcPkg :: CblPkg -> Bool isGhcPkg (CP _ GhcPkg {}) = True isGhcPkg _ = False +isDistroPkg :: CblPkg -> Bool isDistroPkg (CP _ DistroPkg {}) = True isDistroPkg _ = False +isRepoPkg :: CblPkg -> Bool isRepoPkg (CP _ RepoPkg {}) = True isRepoPkg _ = False @@ -141,12 +183,12 @@ delPkg db n = filter (\ p -> n /= pkgName p) db bumpRelease :: CblDB -> String -> CblDB-bumpRelease db n = let+bumpRelease db n = maybe db (addPkg2 db . doBump) (lookupPkg db n)+ where doBump (CP n' p@RepoPkg { release = r }) = CP n' (p { release = nr }) where nr = show $ read r + (1 :: Int) doBump p = p- in maybe db (addPkg2 db . doBump) (lookupPkg db n) lookupPkg :: CblDB -> String -> Maybe CblPkg lookupPkg [] _ = Nothing@@ -154,9 +196,10 @@ | n == pkgName p = Just p | otherwise = lookupPkg db n +lookupDependants :: [CblPkg] -> String -> [String] lookupDependants db n = filter (/= n) $ map pkgName $ filter (`doesDependOn` n) db where- doesDependOn p n = n `elem` map _depName (pkgDeps p)+ doesDependOn p n = n `elem` map Util.Dist.depName (pkgDeps p) transitiveDependants :: CblDB -> [String] -> [String] transitiveDependants db names = keepLast $ concatMap transUsersOfOne names@@ -164,14 +207,22 @@ transUsersOfOne n = n : transitiveDependants db (lookupDependants db n) keepLast = reverse . nub . reverse --- Todo: test checkDependants :: CblDB -> String -> V.Version -> [(String, Maybe P.Dependency)] checkDependants db n v = let d1 = mapMaybe (lookupPkg db) (lookupDependants db n) -- d2 = map (\ p -> (pkgName p, getDependencyOn n p)) d1 d2 = map (pkgName &&& getDependencyOn n ) d1- fails = filter (not . V.withinRange v . _depVersionRange . fromJust . snd) d2+ fails = filter (not . V.withinRange v . Util.Dist.depVersionRange . fromJust . snd) d2 in fails++checkAgainstDb :: CblDB -> String -> P.Dependency -> Bool+checkAgainstDb db name dep = let+ dN = Util.Dist.depName dep+ dVR = Util.Dist.depVersionRange dep+ in (dN == name) ||+ (case lookupPkg db dN of+ Nothing -> False+ Just (CP _ p) -> V.withinRange (version p) dVR) readDb :: FilePath -> IO CblDB readDb fp = handle
src/PkgBuild.hs view
@@ -23,7 +23,8 @@ import Control.Arrow import Control.Monad.Reader-import Control.Monad.Error+import Control.Monad.Trans.Except+import qualified Data.ByteString.Lazy as BSL (writeFile) import System.Directory import System.FilePath import System.IO@@ -33,43 +34,44 @@ pkgBuild :: Command () pkgBuild = do pkgs <- asks $ pkgs . optsCmd- void $ mapM (runErrorT . generatePkgBuild) pkgs >>= exitOnErrors+ void $ mapM (runExceptT . generatePkgBuild) pkgs >>= exitOnAnyLefts -generatePkgBuild :: String -> ErrorT String Command ()+generatePkgBuild :: String -> ExceptT String Command () generatePkgBuild pkg = do db <- asks dbFile >>= liftIO . readDb patchDir <- asks $ patchDir . optsCmd ghcVer <- asks $ ghcVer . optsCmd ghcRel <- asks $ ghcRel . optsCmd- (ver, fa) <- maybe (throwError $ "Unknown package: " ++ pkg) (return . (pkgVersion &&& pkgFlags)) $ lookupPkg db pkg- --- genericPkgDesc <- runCabalParseWithTempDir $ Cbl.readFromIdx (pkg, ver)- pkgDescAndFlags <- either (const $ throwError ("Failed to finalize package: " ++ pkg)) return+ (ver, fa) <- maybe (throwE $ "Unknown package: " ++ pkg) (return . (pkgVersion &&& pkgFlags)) $ lookupPkg db pkg+ ---+ (cblFile, genericPkgDesc) <- runCabalParseWithTempDir $ Cbl.readFromIdx (pkg, ver)+ pkgDescAndFlags <- either (const $ throwE ("Failed to finalize package: " ++ pkg)) return (finalizePkg ghcVer db fa genericPkgDesc) let archPkg = translate ghcVer ghcRel db (snd pkgDescAndFlags) (fst pkgDescAndFlags) archPkgWPatches <- liftIO $ addPatches patchDir archPkg- archPkgWHash <- withTempDirErrT "/tmp/cblrepo." (addHashes archPkgWPatches)+ archPkgWHash <- withTempDirExceptT "/tmp/cblrepo." (addHashes archPkgWPatches cblFile) liftIO $ createDirectoryIfMissing False (apPkgName archPkgWHash) liftIO $ withWorkingDirectory (apPkgName archPkgWHash) $ do copyPatches "." archPkgWHash hPKGBUILD <- openFile "PKGBUILD" WriteMode hPutDoc hPKGBUILD $ pretty archPkgWHash hClose hPKGBUILD- maybe (return ()) (void . runErrorT . applyPatch "PKGBUILD")+ maybe (return ()) (void . runExceptT . applyPatch "PKGBUILD") (apPkgbuildPatch archPkgWHash) when (apHasLibrary archPkgWHash) $ do hInstall <- openFile (apPkgName archPkgWHash <.> "install") WriteMode let archInstall = aiFromAP archPkgWHash hPutDoc hInstall $ pretty archInstall hClose hInstall- maybe (return ()) (void . runErrorT . applyPatch (apPkgName archPkgWHash <.> "install"))+ maybe (return ()) (void . runExceptT . applyPatch (apPkgName archPkgWHash <.> "install")) (apInstallPatch archPkgWHash)+ BSL.writeFile ("original.cabal") cblFile -runCabalParseWithTempDir :: Cbl.CabalParse a -> ErrorT String Command a+runCabalParseWithTempDir :: Cbl.CabalParse a -> ExceptT String Command a runCabalParseWithTempDir f = do aD <- asks appDir pD <- asks $ patchDir . optsCmd r <- liftIO $ withTemporaryDirectory "/tmp/cblrepo." $ \ destDir -> do let cpe = Cbl.CabalParseEnv aD pD destDir Cbl.runCabalParse cpe f- reThrowError r+ reThrowE r
src/PkgDB.hs view
@@ -55,6 +55,7 @@ import Control.Monad import Data.List import Data.Maybe+import Data.Monoid import Distribution.PackageDescription import System.IO.Error import qualified Distribution.Package as P@@ -68,35 +69,42 @@ -- {{{1 types data Pkg- = GhcPkg { version :: V.Version }- | DistroPkg { version :: V.Version, release :: String }- | RepoPkg { version :: V.Version, xrev :: Int, deps :: [P.Dependency], flags :: FlagAssignment, release :: String }+ = GhcPkg GhcPkgD+ | DistroPkg DistroPkgD+ | RepoPkg RepoPkgD deriving (Eq, Show) +data GhcPkgD = GhcPkgD { gpVersion :: V.Version }+ deriving (Eq, Show)++data DistroPkgD = DistroPkgD { dpVersion :: V.Version , dpRelease :: Int }+ deriving (Eq, Show)++data RepoPkgD = RepoPkgD+ { rpVersion :: V.Version+ , rpXrev :: Int+ , rpDeps :: [P.Dependency]+ , rpFlags :: FlagAssignment, rpRelease :: Int+ } deriving (Eq, Show)+ data CblPkg = CP String Pkg deriving (Eq, Show) type CblDB = [CblPkg] instance Ord CblPkg where- compare- (CP n1 GhcPkg { version = v1 })- (CP n2 GhcPkg { version = v2 }) =- compare (n1, v1) (n2, v2)+ compare (CP n1 (GhcPkg d1)) (CP n2 (GhcPkg d2)) =+ compare (n1, gpVersion d1) (n2, gpVersion d2) compare (CP _ GhcPkg {}) _ = LT compare _ (CP _ GhcPkg {}) = GT - compare- (CP n1 DistroPkg { version = v1, release = r1 })- (CP n2 DistroPkg { version = v2, release = r2 }) =- compare (n1, v1, r1) (n2, v2, r2)+ compare (CP n1 (DistroPkg d1)) (CP n2 (DistroPkg d2)) =+ compare (n1, dpVersion d1, dpRelease d1) (n2, dpVersion d2, dpRelease d2) compare (CP _ DistroPkg {}) _ = LT compare _ (CP _ DistroPkg {}) = GT - compare- (CP n1 RepoPkg { version = v1, release = r1 })- (CP n2 RepoPkg { version = v2, release = r2 }) =- compare (n1, v1, r1) (n2, v2, r2)+ compare (CP n1 (RepoPkg d1)) (CP n2 (RepoPkg d2)) =+ compare (n1, rpVersion d1, rpRelease d1) (n2, rpVersion d2, rpRelease d2) -- {{{1 packages pkgName :: CblPkg -> String@@ -106,36 +114,38 @@ pkgPkg (CP _ p) = p pkgVersion :: CblPkg -> V.Version-pkgVersion (CP _ p) = version p+pkgVersion (CP _ (GhcPkg d)) = gpVersion d+pkgVersion (CP _ (DistroPkg d)) = dpVersion d+pkgVersion (CP _ (RepoPkg d)) = rpVersion d pkgXRev :: CblPkg -> Int-pkgXRev (CP _ RepoPkg { xrev = x }) = x+pkgXRev (CP _ (RepoPkg d)) = rpXrev d pkgXRev _ = 0 pkgDeps :: CblPkg -> [P.Dependency]-pkgDeps (CP _ RepoPkg { deps = d}) = d+pkgDeps (CP _ (RepoPkg d)) = rpDeps d pkgDeps _ = [] pkgFlags :: CblPkg -> FlagAssignment-pkgFlags (CP _ RepoPkg { flags = fa}) = fa+pkgFlags (CP _ (RepoPkg d)) = rpFlags d pkgFlags _ = [] -pkgRelease :: CblPkg -> String-pkgRelease (CP _ GhcPkg {}) = "xx"-pkgRelease (CP _ DistroPkg { release = r }) = r-pkgRelease (CP _ RepoPkg { release = r }) = r+pkgRelease :: CblPkg -> Int+pkgRelease (CP _ (GhcPkg _)) = (-1)+pkgRelease (CP _ (DistroPkg d)) = dpRelease d+pkgRelease (CP _ (RepoPkg d)) = rpRelease d createGhcPkg :: String -> V.Version -> CblPkg-createGhcPkg n v = CP n (GhcPkg v)+createGhcPkg n v = CP n (GhcPkg $ GhcPkgD v) -createDistroPkg :: String -> V.Version -> String -> CblPkg-createDistroPkg n v r = CP n (DistroPkg v r)+createDistroPkg :: String -> V.Version -> Int -> CblPkg+createDistroPkg n v r = CP n (DistroPkg (DistroPkgD v r)) -createRepoPkg :: String -> V.Version -> Int -> [P.Dependency] -> FlagAssignment -> String -> CblPkg-createRepoPkg n v x d fa r = CP n (RepoPkg v x d fa r)+createRepoPkg :: String -> V.Version -> Int -> [P.Dependency] -> FlagAssignment -> Int -> CblPkg+createRepoPkg n v x d fa r = CP n (RepoPkg $ RepoPkgD v x d fa r) createCblPkg :: PackageDescription -> FlagAssignment -> CblPkg-createCblPkg pd fa = createRepoPkg name version xrev deps fa "1"+createCblPkg pd fa = createRepoPkg name version xrev deps fa 1 where name = Util.Dist.pkgNameStr pd version = P.pkgVersion $ package pd@@ -176,7 +186,7 @@ addGhcPkg :: CblDB -> String -> V.Version -> CblDB addGhcPkg db n v = addPkg2 db (createGhcPkg n v) -addDistroPkg :: CblDB -> String -> V.Version -> String -> CblDB+addDistroPkg :: CblDB -> String -> V.Version -> Int -> CblDB addDistroPkg db n v r = addPkg2 db (createDistroPkg n v r) delPkg :: CblDB -> String -> CblDB@@ -185,9 +195,7 @@ bumpRelease :: CblDB -> String -> CblDB bumpRelease db n = maybe db (addPkg2 db . doBump) (lookupPkg db n) where- doBump (CP n' p@RepoPkg { release = r }) = CP n' (p { release = nr })- where- nr = show $ read r + (1 :: Int)+ doBump (CP n' (RepoPkg d)) = CP n' (RepoPkg d { rpRelease = (rpRelease d + 1) }) doBump p = p lookupPkg :: CblDB -> String -> Maybe CblPkg@@ -222,7 +230,7 @@ in (dN == name) || (case lookupPkg db dN of Nothing -> False- Just (CP _ p) -> V.withinRange (version p) dVR)+ Just p -> V.withinRange (pkgVersion p) dVR) readDb :: FilePath -> IO CblDB readDb fp = handle@@ -245,6 +253,9 @@ $(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''V.VersionRange) $(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''FlagName) $(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''Pkg)+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''GhcPkgD)+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''DistroPkgD)+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''RepoPkgD) $(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''CblPkg) instance ToJSON P.Dependency where
src/Remove.hs view
@@ -22,7 +22,8 @@ import Util.Misc -- {{{1 system-import Control.Monad.Error+import Control.Monad+import Control.Monad.Trans import Control.Monad.Reader (asks) import System.Exit @@ -44,4 +45,4 @@ depsString = foldr (\ s t -> " " ++ s ++ "\n" ++ t) "" deps in if null deps then return (delPkg db pkg)- else throwError ("Can't delete package " ++ pkg ++ ", dependants:\n" ++ depsString)+ else fail ("Can't delete package " ++ pkg ++ ", dependants:\n" ++ depsString)
src/Util/Cabal.hs view
@@ -20,9 +20,8 @@ import Util.HackageIndex -import Control.Monad.Error+import Control.Monad.Trans.Except import Control.Monad.Reader-import qualified Data.ByteString.Lazy as BSL import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Parse@@ -35,6 +34,8 @@ import System.Posix import System.Process +import qualified Data.ByteString.Lazy as BSL+ data CabalParseEnv = CabalParseEnv { cpeAppDir :: FilePath , cpePatchDir :: FilePath@@ -42,38 +43,40 @@ } deriving (Eq, Show) -- | Type used for reading Cabal files-type CabalParse a = ReaderT CabalParseEnv (ErrorT String IO) a+type CabalParse a = ReaderT CabalParseEnv (ExceptT String IO) a -- | Run a Cabal parse action in the provided environment. runCabalParse :: CabalParseEnv -> CabalParse a -> IO (Either String a)-runCabalParse cpe f = runErrorT $ runReaderT f cpe+runCabalParse cpe f = runExceptT $ runReaderT f cpe -runCabalParseE :: CabalParseEnv -> CabalParse a -> (ErrorT String IO) a+runCabalParseE :: CabalParseEnv -> CabalParse a -> (ExceptT String IO) a runCabalParseE cpe f = runReaderT f cpe readFromFile :: FilePath -- ^ file name- -> CabalParse GenericPackageDescription+ -> CabalParse (BSL.ByteString, GenericPackageDescription) readFromFile fn = do destDir <- asks cpeDestDir let destFn = destDir </> takeFileName fn liftIO $ copyFile fn destFn- patch destFn- liftIO $ readPackageDescription silent destFn+ cblFile <- patch destFn+ gpd <- liftIO $ readPackageDescription silent destFn+ return (cblFile, gpd) readFromIdx :: (String, Version) -- ^ package name and version- -> CabalParse GenericPackageDescription+ -> CabalParse (BSL.ByteString, GenericPackageDescription) readFromIdx (pN, pV) = do destDir <- asks cpeDestDir appDir <- asks cpeAppDir let destFn = destDir </> pN <.> ".cabal"- copyCabal appDir destFn- patch destFn- liftIO $ readPackageDescription silent destFn+ lift $ copyCabal appDir destFn+ cblFile <- patch destFn+ gpd <- liftIO $ readPackageDescription silent destFn+ return (cblFile, gpd) where copyCabal appDir destFn = do idx <- liftIO $ readIndexFile appDir- cbl <- maybe (throwError $ "Failed to extract contents for " ++ pN ++ " " ++ display pV) return+ cbl <- maybe (throwE $ "Failed to extract contents for " ++ pN ++ " " ++ display pV) return (extractCabal idx pN pV) liftIO $ BSL.writeFile destFn cbl @@ -83,12 +86,13 @@ -- pkg name>.patch@. The file is patched only if a patch with the correct name -- is found in the patch directory (provided via 'CabalParseEnv'). patch :: FilePath -- ^ file to patch- -> CabalParse ()+ -> CabalParse BSL.ByteString patch fn = do pkgName <- liftIO $ extractName fn patchDir <- asks cpePatchDir let patchFn = patchDir </> pkgName <.> "cabal"- applyPatchIfExist fn patchFn+ lift $ applyPatchIfExist fn patchFn+ liftIO $ BSL.readFile fn where extractName fn = liftM name $ readPackageDescription silent fn@@ -102,4 +106,4 @@ case ec of ExitSuccess -> return () ExitFailure _ ->- throwError ("Failed patching " ++ origFn ++ " with " ++ patchFn)+ throwE ("Failed patching " ++ origFn ++ " with " ++ patchFn)
src/Util/HackageIndex.hs view
@@ -23,7 +23,9 @@ import qualified Codec.Archive.Tar as Tar import qualified Codec.Compression.GZip as GZip import Control.Applicative+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Search as BSLS import qualified Data.ByteString.Lazy.UTF8 as BSLU import Data.List import qualified Data.Map as M@@ -72,10 +74,12 @@ -> String -- ^ package name -> Version -- ^ package version -> Maybe BSL.ByteString-extractCabal idx pkg ver = getContent entries+extractCabal idx pkg ver = fmap dosToUnix $ getContent entries where entries = Tar.read $ GZip.decompress idx pkgPath = pkg </> display ver </> pkg <.> "cabal"++ dosToUnix bs = BSLS.replace (BS.pack [0xd, 0xa]) (BSL.pack [0xa]) bs getContent (Tar.Next e es) | pkgPath == Tar.entryPath e =
src/Util/Misc.hs view
@@ -23,7 +23,7 @@ import Control.Exception (onException) import Control.Monad-import Control.Monad.Error+import Control.Monad.Trans.Except import Control.Monad.Reader import Data.Either import Data.Version@@ -100,13 +100,13 @@ ghcPkgArgReader :: ReadM (String, Version) ghcPkgArgReader = pkgNVersionArgReader -distroPkgArgReader :: ReadM (String, Version, String)+distroPkgArgReader :: ReadM (String, Version, Int) distroPkgArgReader = let readDistroPkg = do (n, v) <- readPkgNVersion char ',' r <- many (satisfy (/= ','))- return (n, v, r)+ return (n, v, read r) in do s <- readerAsk@@ -154,7 +154,7 @@ data Cmds = CmdAdd { patchDir :: FilePath, ghcVer :: Version, cmdAddGhcPkgs :: [(String, Version)]- , cmdAddDistroPkgs :: [(String, Version, String)], cmdAddFileCbls :: [(FilePath, FlagAssignment)]+ , cmdAddDistroPkgs :: [(String, Version, Int)], cmdAddFileCbls :: [(FilePath, FlagAssignment)] , cmdAddCbls :: [(String, Version, FlagAssignment)] } | CmdBuildPkgs { pkgs :: [String] } | CmdBumpPkgs { inclusive :: Bool, pkgs :: [String] }@@ -193,7 +193,7 @@ case ec of ExitSuccess -> return () ExitFailure _ ->- throwError ("Failed patching " ++ origFilename ++ " with " ++ patchFilename)+ throwE ("Failed patching " ++ origFilename ++ " with " ++ patchFilename) applyPatchIfExist origFilename patchFilename = liftIO (fileExist patchFilename) >>= flip when (applyPatch origFilename patchFilename)@@ -214,16 +214,16 @@ runCommand cmds func = runReaderT func cmds --- {{{1 ErrorT-reThrowError :: MonadError a m => Either a b -> m b-reThrowError = either throwError return+-- {{{1 ExceptT+reThrowE :: Monad m => Either a b -> ExceptT a m b+reThrowE = either throwE return -withTempDirErrT :: (MonadError e m, MonadIO m) => FilePath -> (FilePath -> ErrorT e IO b) -> m b-withTempDirErrT fp func = do- r <- liftIO $ withTemporaryDirectory fp (runErrorT . func)- reThrowError r+withTempDirExceptT :: MonadIO m => FilePath -> (FilePath -> ExceptT e IO b) -> ExceptT e m b+withTempDirExceptT fp func = do+ r <- liftIO $ withTemporaryDirectory fp (runExceptT . func)+ reThrowE r -exitOnErrors vs = let+exitOnAnyLefts vs = let es = lefts vs in if not $ null $ lefts vs
src/Util/Translation.hs view
@@ -23,7 +23,8 @@ import Prelude hiding ( (<$>) ) import Control.Monad-import Control.Monad.Error+import Control.Monad.Trans+import Control.Monad.Trans.Except import Data.Char import Data.List import Data.Maybe@@ -39,6 +40,8 @@ import System.Unix.Directory import Text.PrettyPrint.ANSI.Leijen hiding((</>)) +import qualified Data.ByteString.Lazy as BSL (writeFile)+ -- {{{1 ShQuotedString newtype ShQuotedString = ShQuotedString String deriving (Eq, Show)@@ -65,6 +68,8 @@ shVarNewValue (ShVar n _) v = ShVar n v shVarAppendValue (ShVar n v1) v2 = ShVar n (v1 `mappend` v2) shVarValue (ShVar _ v) = v+shVarName (ShVar n _) = n+shVarRefName (ShVar n _) = "${" ++ n ++ "}" instance Pretty a => Pretty (ShVar a) where pretty (ShVar n v) = text n <> char '=' <> pretty v@@ -83,7 +88,8 @@ , apShHkgName :: ShVar String , apShPkgName :: ShVar String , apShPkgVer :: ShVar Version- , apShPkgRel :: ShVar String+ , apShPkgRel :: ShVar Int+ , apShXRev :: ShVar String , apShPkgDesc :: ShVar ShQuotedString , apShUrl :: ShVar ShQuotedString , apShLicence :: ShVar ShArray@@ -107,14 +113,15 @@ , apBuildPatch = Nothing , apShHkgName = ShVar "_hkgname" "" , apShPkgName = ShVar "pkgname" ""- , apShPkgVer = ShVar "pkgver" (Version [] [])- , apShPkgRel = ShVar "pkgrel" "0"+ , apShPkgVer = ShVar "_ver" (Version [] [])+ , apShPkgRel = ShVar "pkgrel" 0+ , apShXRev = ShVar "_xrev" "0" , apShPkgDesc = ShVar "pkgdesc" (ShQuotedString "") , apShUrl = ShVar "url" (ShQuotedString "http://hackage.haskell.org/package/${_hkgname}") , apShLicence = ShVar "license" (ShArray []) , apShMakeDepends = ShVar "makedepends" (ShArray []) , apShDepends = ShVar "depends" (ShArray [])- , apShSource = ShVar "source" (ShArray ["http://hackage.haskell.org/packages/archive/${_hkgname}/${pkgver}/${_hkgname}-${pkgver}.tar.gz"])+ , apShSource = ShVar "source" (ShArray ["http://hackage.haskell.org/packages/archive/${_hkgname}/${_ver}/${_hkgname}-${_ver}.tar.gz", "original.cabal"]) , apShInstall = Just $ ShVar "install" (ShQuotedString "${pkgname}.install") -- this is a trick to make sure that the user's setting for integrity -- checking in makepkg.conf isn't used, as long as this array contains@@ -134,6 +141,7 @@ , apShPkgName = pkgName , apShPkgVer = pkgVer , apShPkgRel = pkgRel+ , apShXRev = xrev , apShPkgDesc = pkgDesc , apShUrl = url , apShLicence = pkgLicense@@ -147,9 +155,11 @@ [ text "# custom variables" , pretty hkgName , maybe empty (pretty . ShVar "_licensefile") licenseFile+ , pretty pkgVer+ , pretty xrev , empty, text "# PKGBUILD options/directives" , pretty pkgName- , pretty pkgVer+ , text "pkgver=${_ver}_${_xrev}" , pretty pkgRel , pretty pkgDesc , pretty url@@ -173,11 +183,9 @@ where prepareFunction = text "prepare() {" <> nest 4 (empty <$>- text "cd \"${srcdir}/${_hkgname}-${pkgver}\"" <$>+ text "cd \"${srcdir}/${_hkgname}-${_ver}\"" <$>+ text "cp \"${srcdir}/original.cabal\" \"${srcdir}/${_hkgname}-${_ver}/${_hkgname}.cabal\"" <$> empty <$>- maybe (text "# no cabal patch") (\ _ ->- text $ "patch " ++ shVarValue hkgName ++ ".cabal \"${srcdir}/cabal.patch\" ")- cabalPatchFile <$> maybe (text "# no source patch") (\ _ -> text "patch -p4 < \"${srcdir}/source.patch\"") buildPatchFile@@ -185,7 +193,7 @@ char '}' libBuildFunction = text "build() {" <> nest 4 (empty <$>- text "cd \"${srcdir}/${_hkgname}-${pkgver}\"" <$>+ text "cd \"${srcdir}/${_hkgname}-${_ver}\"" <$> empty <$> nest 4 (text "runhaskell Setup configure -O --enable-library-profiling --enable-shared \\" <$> text "--prefix=/usr --docdir=\"/usr/share/doc/${pkgname}\" \\" <$>@@ -199,7 +207,7 @@ char '}' exeBuildFunction = text "build() {" <>- nest 4 (empty <$> text "cd \"${srcdir}/${_hkgname}-${pkgver}\"" <$>+ nest 4 (empty <$> text "cd \"${srcdir}/${_hkgname}-${_ver}\"" <$> empty <$> text "runhaskell Setup configure -O --prefix=/usr --docdir=\"/usr/share/doc/${pkgname}\"" <> confFlags <$> text "runhaskell Setup build"@@ -213,7 +221,7 @@ libPackageFunction = text "package() {" <> nest 4 (empty <$>- text "cd \"${srcdir}/${_hkgname}-${pkgver}\"" <$>+ text "cd \"${srcdir}/${_hkgname}-${_ver}\"" <$> empty <$> text "install -D -m744 register.sh \"${pkgdir}/usr/share/haskell/${pkgname}/register.sh\"" <$> text "install -m744 unregister.sh \"${pkgdir}/usr/share/haskell/${pkgname}/unregister.sh\"" <$>@@ -226,7 +234,7 @@ char '}' exePackageFunction = text "package() {" <>- nest 4 (empty <$> text "cd \"${srcdir}/${_hkgname}-${pkgver}\"" <$>+ nest 4 (empty <$> text "cd \"${srcdir}/${_hkgname}-${_ver}\"" <$> text "runhaskell Setup copy --destdir=\"${pkgdir}\"" ) <$> char '}'@@ -263,18 +271,18 @@ ] where postInstallFunction = text "post_install() {" <>- nest 4 (empty <$> text "${HS_DIR}/register.sh" <$>+ nest 4 (empty <$> text "${HS_DIR}/register.sh --verbose=0" <$> text "/usr/share/doc/ghc/html/libraries/arch-gen-contents-index") <$> char '}' preUpgradeFunction = text "pre_upgrade() {" <>- nest 4 (empty <$> text "${HS_DIR}/unregister.sh") <$>+ nest 4 (empty <$> text "${HS_DIR}/unregister.sh --verbose=0") <$> char '}' postUpgradeFunction = text "post_upgrade() {" <>- nest 4 (empty <$> text "${HS_DIR}/register.sh" <$>+ nest 4 (empty <$> text "${HS_DIR}/register.sh --verbose=0" <$> text "/usr/share/doc/ghc/html/libraries/arch-gen-contents-index") <$> char '}' preRemoveFunction = text "pre_remove() {" <>- nest 4 (empty <$> text "${HS_DIR}/unregister.sh") <$>+ nest 4 (empty <$> text "${HS_DIR}/unregister.sh --verbose=0") <$> char '}' postRemoveFunction = text "post_remove() {" <> nest 4 (empty <$> text "/usr/share/doc/ghc/html/libraries/arch-gen-contents-index") <$>@@ -290,11 +298,13 @@ -- {{{1 translate -- TODO: -- • translation of extraLibDepends-libs to Arch packages+translate :: Version -> Int -> CblDB -> FlagAssignment -> PackageDescription -> ArchPkg translate ghcVer ghcRel db fa pd = let ap = baseArchPkg (PackageName hkgName) = packageName pd pkgVer = packageVersion pd- pkgRel = maybe "1" pkgRelease (lookupPkg db hkgName)+ pkgRel = maybe 1 pkgRelease (lookupPkg db hkgName)+ xrev = show $ Util.Dist.pkgXRev pd hasLib = isJust (library pd) licFn = let l = licenseFiles pd in if null l then Nothing else Just (head l) archName = (if hasLib then "haskell-" else "") ++ map toLower hkgName@@ -314,6 +324,7 @@ , apShPkgName = shVarNewValue (apShPkgName ap) archName , apShPkgVer = shVarNewValue (apShPkgVer ap) pkgVer , apShPkgRel = shVarNewValue (apShPkgRel ap) pkgRel+ , apShXRev = shVarNewValue (apShXRev ap) xrev , apShPkgDesc = shVarNewValue (apShPkgDesc ap) (ShQuotedString pkgDesc) , apShUrl = shVarNewValue (apShUrl ap) (ShQuotedString url) , apShLicence = shVarNewValue (apShLicence ap) (ShArray [lic])@@ -329,17 +340,18 @@ -- TODO: -- • this is most likely too simplistic to create the Arch package names -- correctly for all possible dependencies-calcExactDeps db pd = let- n = pkgNameStr pd- remPkgs = map DB.pkgName (filter isGhcPkg db) ++ [n]+calcExactDeps db pd = map depString deps+ where+ remPkgs = map DB.pkgName (filter isGhcPkg db) ++ [pkgNameStr pd] deps = filter (not . (`elem` remPkgs)) (map depName (buildDepends pd))- depString n = let++ depString n = "haskell-" ++ name ++ "=" ++ ver ++ "_" ++ xrev ++ "-" ++ rel+ where pkg = fromJust $ lookupPkg db n name = map toLower $ DB.pkgName pkg ver = display $ DB.pkgVersion pkg- rel = pkgRelease pkg- in "haskell-" ++ name ++ "=" ++ ver ++ "-" ++ rel- in map depString deps+ xrev = show $ DB.pkgXRev pkg+ rel = show $ pkgRelease pkg -- {{{1 stuff with patches -- {{{2 addPatches@@ -357,7 +369,7 @@ installPatch <- doesFileExist installPatchFn >>= fi (liftM Just $ canonicalizePath installPatchFn) (return Nothing) buildPatch <- doesFileExist buildPatchFn >>= fi (liftM Just $ canonicalizePath buildPatchFn) (return Nothing) let sources' = shVarAppendValue sources- (ShArray $ catMaybes [maybe Nothing (const $ Just "cabal.patch") cabalPatch, maybe Nothing (const $ Just "source.patch") buildPatch])+ (ShArray $ catMaybes [maybe Nothing (const $ Just "source.patch") buildPatch]) return ap { apCabalPatch = cabalPatch , apPkgbuildPatch = pkgBuildPatch@@ -375,18 +387,20 @@ maybe (return ()) (\ fn -> copyFile fn (destDir </> "source.patch")) buildPatch -- {{{1 addHashes-addHashes ap tmpDir = let+addHashes ap cbl tmpDir = let hashes = map (filter (`elem` "1234567890abcdef")) . lines . drop 11 pkgbuildFn = tmpDir </> "PKGBUILD"+ cblFn = tmpDir </> "original.cabal" pkgbuildPatch = apPkgbuildPatch ap in do liftIO $ copyPatches tmpDir ap liftIO $ writeFile pkgbuildFn (show $ pretty ap) maybe (return ()) (void . applyPatch pkgbuildFn) pkgbuildPatch+ liftIO $ BSL.writeFile cblFn cbl (ec, out, _) <- liftIO $ withWorkingDirectory tmpDir (readProcessWithExitCode "makepkg" ["-g"] "") case ec of ExitFailure _ ->- throwError $ "makepkg: error while calculating the source hashes for " ++ apHkgName ap+ throwE $ "makepkg: error while calculating the source hashes for " ++ apHkgName ap ExitSuccess -> return (if "sha256sums=(" `isPrefixOf` out then replaced else ap) where