cblrepo 0.7.3 → 0.8.0
raw patch · 10 files changed
+220/−92 lines, 10 files
Files
- cblrepo.cabal +1/−1
- src/Add.hs +1/−1
- src/ConvertDB.hs +6/−26
- src/ListPkgs.hs +20/−2
- src/Main.hs +1/−0
- src/OldPkgDB.hs +150/−44
- src/PkgBuild.hs +2/−3
- src/PkgDB.hs +20/−8
- src/Util/Misc.hs +2/−2
- src/Util/Translation.hs +17/−5
cblrepo.cabal view
@@ -1,5 +1,5 @@ name: cblrepo-version: 0.7.3+version: 0.8.0 cabal-version: >= 1.6 license: OtherLicense license-file: LICENSE-2.0
src/Add.hs view
@@ -101,7 +101,7 @@ pkgTypeToCblPkg _ (GhcType n v) = createGhcPkg n v pkgTypeToCblPkg _ (DistroType n v r) = createDistroPkg n v r pkgTypeToCblPkg db (RepoType gpd) = fromJust $ case finalizePkg db gpd of- Right (pd, _) -> Just $ createCblPkg pd+ Right (pd, fa) -> Just $ createCblPkg pd fa Left _ -> Nothing finalizeToUnsatisfiableDeps db (RepoType gpd) = case finalizePkg db gpd of
src/ConvertDB.hs view
@@ -24,35 +24,15 @@ -- {{{2 system import Control.Monad.Reader-import Data.Version-import System.IO convertDb :: Command () convertDb = do- inDb <- cfgGet inDbFile >>= \ fn -> liftIO $ ODB.readDb fn+ inDbFn <- cfgGet inDbFile outDbFn <- cfgGet outDbFile- newDb <- liftIO $ mapM doConvert inDb+ newDb <- liftIO $ liftM (map doConvert) (ODB.readDb inDbFn) liftIO $ NDB.saveDb newDb outDbFn -doConvert :: ODB.CblPkg -> IO NDB.CblPkg-doConvert opkg@(n, (v, d, r))- | ODB.isBasePkg opkg = let- withNoStdBuffering f = do- old <- hGetBuffering stdin- hSetBuffering stdin NoBuffering- result <- f- hSetBuffering stdin old- return result- getValidChar = do- putStr " (g)hc or (d)istro? " >> hFlush stdout- getChar >>= (\ c -> putStrLn "" >> return c) >>= (\ c -> if c `elem` "gd" then return c else getValidChar)- createPkg c- | c == 'g' = return $ NDB.createGhcPkg n v- | c == 'd' = do- putStr " release? " >> hFlush stdout- rel <- getLine- return $ NDB.createDistroPkg n v rel- in do- putStr n- withNoStdBuffering $ getValidChar >>= createPkg- | otherwise = return $ NDB.createRepoPkg n v d (show r)+doConvert :: ODB.CblPkg -> NDB.CblPkg+doConvert (ODB.CP n (ODB.GhcPkg v)) = NDB.CP n (NDB.GhcPkg v)+doConvert (ODB.CP n (ODB.DistroPkg v r)) = NDB.CP n (NDB.DistroPkg v r)+doConvert (ODB.CP n (ODB.RepoPkg v d r)) = NDB.CP n (NDB.RepoPkg v d [] r)
src/ListPkgs.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE PatternGuards #-} {- - Copyright 2011 Per Magnus Therning -@@ -21,20 +22,37 @@ import Control.Monad import Control.Monad.Reader+import Data.List import Data.Maybe import Distribution.Text import System.FilePath+import Distribution.PackageDescription listPkgs :: Command () listPkgs = do lG <- cfgGet listGhc lD <- cfgGet listDistro lR <- cfgGet noListRepo+ lH <- cfgGet hackageFmt db <- cfgGet dbFile >>= liftIO . readDb let pkgs = filter (pkgFilter lG lD lR) db- liftIO $ mapM_ printCblPkgShort pkgs+ let printer = if lH+ then printCblPkgHackage+ else printCblPkgShort+ liftIO $ mapM_ printer pkgs pkgFilter g d r p = (g && isGhcPkg p) || (d && isDistroPkg p) || (not r && isRepoPkg p) +printCblPkgShort :: CblPkg -> IO () printCblPkgShort p =- putStrLn $ pkgName p ++ " " ++ (display $ pkgVersion p) ++ "-" ++ pkgRelease p+ putStrLn $ pkgName p ++ " " ++ (display $ pkgVersion p) ++ "-" ++ pkgRelease p ++ showFlagsIfPresent p+ where+ showFlagsIfPresent p+ | [] <- pkgFlags p = ""+ | fa <- pkgFlags p = " (" ++ (intercalate " " $ map showSingleFlag fa) ++ ")"+ showSingleFlag (FlagName n, True) = n+ showSingleFlag (FlagName n, False) = '-' : n++printCblPkgHackage :: CblPkg -> IO ()+printCblPkgHackage p =+ print (pkgName p, (display $ pkgVersion p), Nothing :: Maybe String)
src/Main.hs view
@@ -83,6 +83,7 @@ , listGhc := False += explicit += name "g" += name "ghc" += help "list ghc packages" , listDistro := False += explicit += name "d" += name "distro" += help "list distro packages" , noListRepo := False += explicit += name "no-repo" += help "do not list repo packages"+ , hackageFmt := False += explicit += name "hackage" += help "list in hackage format" ] += name "list" += help "list packages in repo" cmdUrls = record defUrls
src/OldPkgDB.hs view
@@ -16,98 +16,155 @@ module OldPkgDB where -import Util.Misc--import Control.Applicative+-- {{{1 imports import Control.Exception as CE+import Control.Monad+import Data.Data import Data.List import Data.Maybe-import Data.Maybe+import Data.Typeable import Distribution.PackageDescription import Distribution.Text-import Distribution.Version import System.IO.Error import Text.JSON import qualified Distribution.Package as P import qualified Distribution.Version as V -type CblPkg = (String, (V.Version, [P.Dependency], Int))+-- {{{ temporary+_depName (P.Dependency (P.PackageName n) _) = n+_depVersionRange (P.Dependency _ vr) = vr++-- {{{1 types+data Pkg+ = GhcPkg { version :: V.Version }+ | DistroPkg { version :: V.Version, release :: String }+ | RepoPkg { version :: V.Version, deps :: [P.Dependency], release :: String }+ 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 _ 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 _ 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)++-- {{{1 packages pkgName :: CblPkg -> String-pkgName (n, _) = n+pkgName (CP n _) = n +pkgPkg :: CblPkg -> Pkg+pkgPkg (CP _ p) = p+ pkgVersion :: CblPkg -> V.Version-pkgVersion (_, (v, _, _)) = v+pkgVersion (CP _ p) = version p pkgDeps :: CblPkg -> [P.Dependency]-pkgDeps (_, (_, ds, _)) = ds+pkgDeps (CP _ RepoPkg { deps = d}) = d+pkgDeps _ = [] -pkgRelease :: CblPkg -> Int-pkgRelease (_, (_, _, i)) = i+pkgRelease :: CblPkg -> String+pkgRelease (CP _ GhcPkg {}) = "xx"+pkgRelease (CP _ DistroPkg { release = r }) = r+pkgRelease (CP _ RepoPkg { release = r }) = r +createGhcPkg n v = CP n (GhcPkg v)+createDistroPkg n v r = CP n (DistroPkg v r)+createRepoPkg n v d r = CP n (RepoPkg v d r)+ createCblPkg :: PackageDescription -> CblPkg-createCblPkg pd = (name, (version, deps, 1))+createCblPkg pd = createRepoPkg name version deps "1" where name = (\ (P.PackageName n) -> n) (P.pkgName $ package pd) version = P.pkgVersion $ package 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 -> _depName d == n) (pkgDeps p) +isGhcPkg (CP _ GhcPkg {}) = True+isGhcPkg _ = False++isDistroPkg (CP _ DistroPkg {}) = True+isDistroPkg _ = False++isRepoPkg (CP _ RepoPkg {}) = True+isRepoPkg _ = False+ isBasePkg :: CblPkg -> Bool-isBasePkg (_, (_, ds, _)) = null ds+isBasePkg = not . isRepoPkg +-- {{{1 database emptyPkgDB :: CblDB emptyPkgDB = [] -addPkg :: CblDB -> String -> V.Version -> [P.Dependency] -> Int -> CblDB-addPkg db n v ds r = nubBy cmp newdb+addPkg :: CblDB -> String -> Pkg -> CblDB+addPkg db n p = nubBy cmp newdb where- cmp (n1, _) (n2, _) = n1 == n2- newdb = (n, (v, ds, r)) : db+ cmp (CP n1 _) (CP n2 _) = n1 == n2+ newdb = (CP n p):db -addPkg2 db (n, (v, ds, r)) = addPkg db n v ds r+addPkg2 :: CblDB -> CblPkg -> CblDB+addPkg2 db (CP n p) = addPkg db n p -addBasePkg db n v = addPkg db n v [] 0+addGhcPkg :: CblDB -> String -> V.Version -> CblDB+addGhcPkg db n v = addPkg2 db (createGhcPkg n v) +addDistroPkg :: CblDB -> String -> V.Version -> String -> CblDB+addDistroPkg db n v r = addPkg2 db (createDistroPkg n v r)+ delPkg :: CblDB -> String -> CblDB delPkg db n = filter (\ p -> n /= pkgName p) db +bumpRelease :: CblDB -> String -> CblDB+bumpRelease db n = let+ doBump (CP n' p@RepoPkg { release = r }) = CP n' (p { release = nr })+ where+ nr = show $ (read r) + 1+ doBump p = p+ in maybe db (addPkg2 db . doBump) (lookupPkg db n)+ lookupPkg :: CblDB -> String -> Maybe CblPkg-lookupPkg db n = maybe Nothing (\ s -> Just (n, s)) (lookup n db)+lookupPkg [] _ = Nothing+lookupPkg (p:db) n+ | n == pkgName p = Just p+ | otherwise = lookupPkg db n -lookupDependencies :: CblDB -> String -> Maybe [String]-lookupDependencies db n =- case lookupPkg db n of- Nothing -> Nothing- Just p -> let- ds = pkgDeps p- in Just $ map depName ds+lookupDependants db n = filter (/= n) $ map pkgName $ filter (\ p -> doesDependOn p n) db+ where+ doesDependOn p n = n `elem` (map _depName $ pkgDeps p) -lookupDependants :: CblDB -> String -> [String]-lookupDependants db n = map pkgName $ filter (\ p -> doesDependOn p n) db+transitiveDependants :: CblDB -> [String] -> [String]+transitiveDependants db names = keepLast $ concat $ map transUsersOfOne names where- doesDependOn p n = n `elem` (map depName $ pkgDeps p)+ 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 = catMaybes $ map (lookupPkg db) (lookupDependants db n) d2 = map (\ p -> (pkgName p, getDependencyOn n p)) d1- fails = filter (not . withinRange v . depVersionRange . fromJust . snd) d2+ fails = filter (not . V.withinRange v . _depVersionRange . fromJust . snd) d2 in fails -transitiveDependants db pkgs = keepLast $ concat $ map transUsersOfOne pkgs- where- transUsersOfOne pkg = pkg : (keepLast $ concat $ map (transUsersOfOne) (lookupDependants db pkg))- keepLast = reverse . nub . reverse--lookupRelease :: CblDB -> String -> Maybe Int-lookupRelease db n = lookupPkg db n >>= return . pkgRelease--bumpRelease db n = let- bump (n', (v', d', r')) = (n', (v', d', r' + 1))- in maybe db (addPkg2 db . bump) (lookupPkg db n) readDb :: FilePath -> IO CblDB readDb fp = (flip CE.catch) (\ e -> if isDoesNotExistError e@@ -122,4 +179,53 @@ saveDb :: CblDB -> FilePath -> IO () saveDb db fp = writeFile fp s where- s = unlines $ map (encode . showJSON) db+ s = unlines $ map encode $ sort db++-- {{{1 JSON instances+instance JSON CblPkg where+ showJSON (CP n p) = showJSON (n, p)++ readJSON object = do+ (n,p) <- readJSON object+ return (CP n p)++instance JSON V.Version where+ showJSON v = makeObj [ ("Version", showJSON $ display v) ]++ readJSON object = do+ obj <- readJSON object+ version <- valFromObj "Version" obj+ maybe (fail "Not a Version object") return (simpleParse version)++instance JSON P.Dependency where+ showJSON d = makeObj [ ("Dependency", showJSON $ display d) ]++ readJSON object = do+ obj <- readJSON object+ dep <- valFromObj "Dependency" obj+ maybe (fail "Not a Dependency object") return (simpleParse dep)++instance JSON Pkg where+ showJSON p@(GhcPkg { version = v}) = makeObj [("GhcPkg", showJSON v)]+ showJSON p@(DistroPkg { version = v, release = r}) =+ makeObj [("DistroPkg", showJSON (v, r))]+ showJSON p@(RepoPkg { version = v, deps = d, release = r }) =+ makeObj [("RepoPkg", showJSON (v, d, r))]++ readJSON object = let+ readGhc = do+ obj <- readJSON object+ v <- valFromObj "GhcPkg" obj >>= readJSON+ return $ GhcPkg v++ readDistro = do+ obj <- readJSON object+ (v, r) <- valFromObj "DistroPkg" obj >>= readJSON+ return $ DistroPkg v r++ readRepo = do+ obj <- readJSON object+ (v, d, r) <- valFromObj "RepoPkg" obj >>= readJSON+ return $ RepoPkg v d r++ in readGhc `mplus` readDistro `mplus` readRepo `mplus` fail "Not a Pkg object"
src/PkgBuild.hs view
@@ -40,15 +40,14 @@ mapM (runErrorT . generatePkgBuild db pD) pkgs >>= exitOnErrors >> return () -- TODO:--- - flags -- generatePkgBuild :: CblDB -> String -> String -> ErrorT String IO () generatePkgBuild db patchDir pkg = let appendPkgVer = pkg ++ "," ++ (display $ pkgVersion $ fromJust $ lookupPkg db pkg) in do maybe (throwError $ "Unknown package: " ++ pkg) (const $ return ()) (lookupPkg db pkg) genericPkgDesc <- withTempDirErrT "/tmp/cblrepo." (readCabal patchDir appendPkgVer)- pkgDesc <- either (const $ throwError ("Failed to finalize package: " ++ pkg)) (return . fst) (finalizePkg db genericPkgDesc)- let archPkg = translate db pkgDesc+ pkgDescAndFlags <- either (const $ throwError ("Failed to finalize package: " ++ pkg)) return (finalizePkg db genericPkgDesc)+ let archPkg = translate db (snd pkgDescAndFlags) (fst pkgDescAndFlags) archPkgWPatches <- liftIO $ addPatches patchDir archPkg archPkgWHash <- withTempDirErrT "/tmp/cblrepo." (addHashes archPkgWPatches) liftIO $ createDirectoryIfMissing False (apPkgName archPkgWHash)
src/PkgDB.hs view
@@ -38,7 +38,7 @@ data Pkg = GhcPkg { version :: V.Version } | DistroPkg { version :: V.Version, release :: String }- | RepoPkg { version :: V.Version, deps :: [P.Dependency], release :: String }+ | RepoPkg { version :: V.Version, deps :: [P.Dependency], flags :: FlagAssignment, release :: String } deriving (Eq, Show) data CblPkg = CP String Pkg@@ -80,6 +80,10 @@ pkgDeps (CP _ RepoPkg { deps = d}) = d pkgDeps _ = [] +pkgFlags :: CblPkg -> FlagAssignment+pkgFlags (CP _ RepoPkg { flags = fa}) = fa+pkgFlags _ = []+ pkgRelease :: CblPkg -> String pkgRelease (CP _ GhcPkg {}) = "xx" pkgRelease (CP _ DistroPkg { release = r }) = r@@ -87,10 +91,10 @@ createGhcPkg n v = CP n (GhcPkg v) createDistroPkg n v r = CP n (DistroPkg v r)-createRepoPkg n v d r = CP n (RepoPkg v d r)+createRepoPkg n v d fa r = CP n (RepoPkg v d fa r) -createCblPkg :: PackageDescription -> CblPkg-createCblPkg pd = createRepoPkg name version deps "1"+createCblPkg :: PackageDescription -> FlagAssignment -> CblPkg+createCblPkg pd fa = createRepoPkg name version deps fa "1" where name = (\ (P.PackageName n) -> n) (P.pkgName $ package pd) version = P.pkgVersion $ package pd@@ -205,12 +209,20 @@ dep <- valFromObj "Dependency" obj maybe (fail "Not a Dependency object") return (simpleParse dep) +instance JSON FlagName where+ showJSON (FlagName n) = makeObj [ ("FlagName", showJSON n) ]++ readJSON object = do+ obj <- readJSON object+ n <- valFromObj "FlagName" obj+ return $ FlagName n+ instance JSON Pkg where showJSON p@(GhcPkg { version = v}) = makeObj [("GhcPkg", showJSON v)] showJSON p@(DistroPkg { version = v, release = r}) = makeObj [("DistroPkg", showJSON (v, r))]- showJSON p@(RepoPkg { version = v, deps = d, release = r }) =- makeObj [("RepoPkg", showJSON (v, d, r))]+ showJSON p@(RepoPkg { version = v, deps = d, flags = fa, release = r }) =+ makeObj [("RepoPkg", showJSON (v, d, fa, r))] readJSON object = let readGhc = do@@ -225,7 +237,7 @@ readRepo = do obj <- readJSON object- (v, d, r) <- valFromObj "RepoPkg" obj >>= readJSON- return $ RepoPkg v d r+ (v, d, fa, r) <- valFromObj "RepoPkg" obj >>= readJSON+ return $ RepoPkg v d fa r in readGhc `mplus` readDistro `mplus` readRepo `mplus` fail "Not a Pkg object"
src/Util/Misc.hs view
@@ -79,7 +79,7 @@ | BumpPkgs { appDir :: FilePath, dbFile :: FilePath, dryRun :: Bool, inclusive :: Bool, pkgs :: [String] } | Sync { appDir :: FilePath } | Versions { appDir :: FilePath, pkgs :: [String] }- | CmdListPkgs { appDir :: FilePath, dbFile :: FilePath, listGhc :: Bool, listDistro :: Bool, noListRepo :: Bool }+ | CmdListPkgs { appDir :: FilePath, dbFile :: FilePath, listGhc :: Bool, listDistro :: Bool, noListRepo :: Bool, hackageFmt :: Bool } | Updates { appDir :: FilePath, dbFile :: FilePath, idxStyle :: Bool } | Urls { appDir :: FilePath, pkgVers :: [(String, String)] } | PkgBuild { appDir :: FilePath, dbFile :: FilePath, patchDir :: FilePath, pkgs :: [String] }@@ -92,7 +92,7 @@ defBumpPkgs = BumpPkgs "" "" False False [] defSync = Sync "" defVersions = Versions "" []-defCmdListPkgs = CmdListPkgs "" "" False False False+defCmdListPkgs = CmdListPkgs "" "" False False False False defUpdates = Updates "" "" False defUrls = Urls "" [] defPkgBuild = PkgBuild "" "" "" []
src/Util/Translation.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleInstances, OverlappingInstances #-} {- - Copyright 2011 Per Magnus Therning -@@ -72,7 +73,6 @@ pretty (ShVar n v) = text n <> char '=' <> pretty v -- {{{1 ArchPkg--- TODO: flags data ArchPkg = ArchPkg { apPkgName :: String , apHkgName :: String@@ -95,6 +95,7 @@ , apShSource :: ShVar ShArray , apShInstall :: Maybe (ShVar ShQuotedString) , apShSha256Sums :: ShVar ShArray+ , apFlags :: FlagAssignment } deriving (Eq, Show) -- {{{2 baseArchPkg@@ -122,6 +123,7 @@ -- checking in makepkg.conf isn't used, as long as this array contains -- something non-empty it will overrule , apShSha256Sums = ShVar "sha256sums" (ShArray ["0"])+ , apFlags = [] } -- {{{2 Pretty instance@@ -143,6 +145,7 @@ , apShSource = source , apShInstall = install , apShSha256Sums = sha256sums+ , apFlags = flags }) = vsep [ text "# custom variables" , pretty hkgName@@ -179,7 +182,7 @@ buildPatchFile <$> nest 4 (text "runhaskell Setup configure -O -p --enable-split-objs --enable-shared \\" <$> text "--prefix=/usr --docdir=/usr/share/doc/${pkgname} \\" <$>- text "--libsubdir=\\$compiler/site-local/\\$pkgid") <$>+ text "--libsubdir=\\$compiler/site-local/\\$pkgid" <> confFlags) <$> text "runhaskell Setup build" <$> text "runhaskell Setup haddock" <$> text "runhaskell Setup register --gen-script" <$>@@ -196,11 +199,16 @@ maybe empty (\ _ -> text $ "patch -p4 < ${srcdir}/source.patch") buildPatchFile <$>- text "runhaskell Setup configure -O --prefix=/usr --docdir=/usr/share/doc/${pkgname}" <$>+ text "runhaskell Setup configure -O --prefix=/usr --docdir=/usr/share/doc/${pkgname}" <> confFlags <$> text "runhaskell Setup build" ) <$> char '}' + confFlags = if null flags+ then empty+ else text " \\" <>+ nest 4 (empty <$> (hsep . map (uncurry (<>)) $ zip (repeat $ text "-f") (map pretty flags)))+ libPackageFunction = text "package() {" <> nest 4 (empty <$> text "cd ${srcdir}/${_hkgname}-${pkgver}" <$>@@ -273,11 +281,14 @@ instance Pretty Version where pretty (Version b _) = encloseSep empty empty (char '.') (map pretty b) +instance Pretty (FlagName, Bool) where+ pretty (FlagName n, True) = text n+ pretty (FlagName n, False) = text $ '-' : n+ -- {{{1 translate -- TODO:--- • add flags -- • translation of extraLibDepends-libs to Arch packages-translate db pd = let+translate db fa pd = let ap = baseArchPkg (PackageName hkgName) = packageName pd pkgVer = packageVersion pd@@ -307,6 +318,7 @@ , apShMakeDepends = shVarNewValue (apShMakeDepends ap) (ShArray makeDepends) , apShDepends = shVarNewValue (apShDepends ap) (ShArray $ depends ++ extraLibDepends) , apShInstall = install+ , apFlags = fa } -- Calculate exact dependencies based on the package in a CblDB. We assume the