diff --git a/cblrepo.cabal b/cblrepo.cabal --- a/cblrepo.cabal +++ b/cblrepo.cabal @@ -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 diff --git a/src/Add.hs b/src/Add.hs --- a/src/Add.hs +++ b/src/Add.hs @@ -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 diff --git a/src/ConvertDB.hs b/src/ConvertDB.hs --- a/src/ConvertDB.hs +++ b/src/ConvertDB.hs @@ -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) diff --git a/src/ListPkgs.hs b/src/ListPkgs.hs --- a/src/ListPkgs.hs +++ b/src/ListPkgs.hs @@ -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) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/OldPkgDB.hs b/src/OldPkgDB.hs --- a/src/OldPkgDB.hs +++ b/src/OldPkgDB.hs @@ -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" diff --git a/src/PkgBuild.hs b/src/PkgBuild.hs --- a/src/PkgBuild.hs +++ b/src/PkgBuild.hs @@ -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) diff --git a/src/PkgDB.hs b/src/PkgDB.hs --- a/src/PkgDB.hs +++ b/src/PkgDB.hs @@ -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" diff --git a/src/Util/Misc.hs b/src/Util/Misc.hs --- a/src/Util/Misc.hs +++ b/src/Util/Misc.hs @@ -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 "" "" "" [] diff --git a/src/Util/Translation.hs b/src/Util/Translation.hs --- a/src/Util/Translation.hs +++ b/src/Util/Translation.hs @@ -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