diff --git a/cblrepo.cabal b/cblrepo.cabal --- a/cblrepo.cabal +++ b/cblrepo.cabal @@ -1,5 +1,5 @@ name: cblrepo -version: 0.4.1 +version: 0.5.0 cabal-version: >= 1.6 license: OtherLicense license-file: LICENSE-2.0 @@ -19,30 +19,20 @@ category: Utils, Distribution build-type: Custom -flag BuildTests - Description: Build tests - Default: False - executable cblrepo hs-source-dirs: src main-is: Main.hs other-modules: Util.Misc PkgDB Add BumpPkgs BuildPkgs Sync Versions Updates ListPkgs Urls PkgBuild Util.Translation OldPkgDB ConvertDB Remove - build-depends: base ==4.3.*, cmdargs ==0.7.*, filepath ==1.2.*, - directory ==1.1.*, Cabal ==1.10.*, json ==0.4.*, - bytestring ==0.9.*, tar ==0.3.*, zlib ==0.5.*, mtl ==2.0.*, - process ==1.0.*, Unixutils ==1.46.*, unix ==2.4.*, + build-depends: base ==4.5.*, cmdargs ==0.9.*, filepath ==1.3.*, + directory ==1.1.*, Cabal ==1.14.*, json ==0.5.*, + bytestring ==0.9.*, tar ==0.4.*, zlib ==0.5.*, mtl ==2.0.*, + process ==1.1.*, Unixutils ==1.48.*, unix ==2.5.*, ansi-wl-pprint ==0.6.* -executable tests - hs-source-dirs: tst src - main-is: tst.hs - other-modules: TestSystem TestPkgDB - if flag(BuildTests) - build-depends: base ==4.3.*, test-framework-th ==0.2.*, HUnit ==1.2.*, - test-framework-hunit ==0.2.*, test-framework ==0.4.* - else - buildable: False +Source-Repository head + Type: git + Location: https://github.com/magthe/cblrepo.git -- vim: set tw=0 : diff --git a/src/Add.hs b/src/Add.hs --- a/src/Add.hs +++ b/src/Add.hs @@ -24,135 +24,105 @@ import Util.Misc -- {{{2 system -import Codec.Archive.Tar as Tar -import Codec.Compression.GZip as GZip -import Control.Monad import Control.Monad.Error import Control.Monad.Reader import Data.Either import Data.List import Data.Maybe -import Data.Version -import Distribution.Compiler import Distribution.PackageDescription -import Distribution.PackageDescription.Configuration -import Distribution.PackageDescription.Parse -import Distribution.System import Distribution.Text -import Distribution.Verbosity import Distribution.Version -import System.Directory -import System.FilePath -import qualified Data.ByteString.Lazy.Char8 as BS import qualified Distribution.Package as P -import System.Posix.Files -import System.Unix.Directory -import System.Process -import System.Exit -import System.IO +-- {{{1 types +data PkgType + = GhcType String Version + | DistroType String Version String + | RepoType GenericPackageDescription + deriving (Eq, Show) + -- {{{1 add -add :: ReaderT Cmds IO () +add :: Command () add = do - t <- cfgGet pkgType - case t of - GhcPkgT -> addGhc - DistroPkgT -> addDistro - RepoPkgT -> addRepo - --- {{{2 Add ghc package -addGhc :: ReaderT Cmds IO () -addGhc = let - unpackPkgVer s = (p, v) - where - (p, _:v) = span (/= ',') s - in do - pkgs <- liftM (map unpackPkgVer) (cfgGet cbls) - dR <- cfgGet dryRun - guard $ isJust $ (sequence $ map (simpleParse . snd) pkgs :: Maybe [Version]) - let ps = map (\ (n, v) -> (n, fromJust $ (simpleParse v :: Maybe Version))) pkgs - dbFn <- cfgGet dbFile - db <- liftIO $ readDb dbFn - case doAddGhc db ps of - Left brkOthrs -> liftIO $ mapM_ printBrksOth brkOthrs - Right newDb -> liftIO $ unless dR $ saveDb newDb dbFn - -doAddGhc db pkgs = let - canBeAdded db n v = null $ checkDependants db n v - (_, fails) = partition (\ (n, v) -> canBeAdded db n v) pkgs - newDb = foldl (\ d (n, v) -> addGhcPkg d n v) db pkgs - brkOthrs = map (\ (n, v) -> ((n, v), checkDependants db n v)) fails - in if null fails - then Right newDb - else Left brkOthrs - --- {{{2 Add distro package -addDistro :: ReaderT Cmds IO () -addDistro = let - unpackPkgVer s = (p, v, r) - where - (p, _:s2) = span (/= ',') s - (v, _:r) = span (/= ',') s2 - getVersion (_, v, _) = simpleParse v :: Maybe Version - in do - pkgs <- liftM (map unpackPkgVer) (cfgGet cbls) - dR <- cfgGet dryRun - guard $ isJust $ sequence $ map getVersion pkgs - let ps = map (\ p@(n, v, r) -> (n, fromJust $ getVersion p, r)) pkgs - dbFn <- cfgGet dbFile - db <- liftIO $ readDb dbFn - case doAddDistro db ps of - Left brkOthrs -> liftIO $ mapM_ printBrksOth brkOthrs - Right newDb -> liftIO $ unless dR $ saveDb newDb dbFn - -doAddDistro db pkgs = let - canBeAdded db n v = null $ checkDependants db n v - (_, fails) = partition (\ (n, v, _) -> canBeAdded db n v) pkgs - newDb = foldl (\ d (n, v, r) -> addDistroPkg d n v r) db pkgs - brkOthrs = map (\ (n, v, _) -> ((n, v), checkDependants db n v)) fails - in if null fails - then Right newDb - else Left brkOthrs - --- {{{2 Add repo package -addRepo :: ReaderT Cmds IO () -addRepo = do dbFn <- cfgGet dbFile db <- liftIO $ readDb dbFn - pD <- cfgGet patchDir - cbls <- cfgGet cbls - dR <- cfgGet dryRun - genPkgs <- mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabal pD c d)) cbls >>= exitOnErrors - let pkgNames = map ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) genPkgs - exitOnErrors $ map (Left . (++) "Trying to add base package: ") (filter (maybe False isBasePkg . lookupPkg db) pkgNames) - let tmpDb = filter (\ p -> not $ pkgName p `elem` pkgNames) db - case doAddRepo tmpDb genPkgs of - Left (unSats, brksOthrs) -> liftIO (mapM_ printUnSat unSats >> mapM_ printBrksOth brksOthrs) - Right newDb -> liftIO $ unless dR $ saveDb newDb dbFn + pd <- cfgGet patchDir + dr <- cfgGet dryRun + -- + ghcPkgs <- cfgGet cmdAddGhcPkgs + distroPkgs <- cfgGet cmdAddDistroPkgs + genUrlPkgs <- cfgGet cmdAddUrlCbls >>= mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabalFromUrl pd c d)) + genFilePkgs <- cfgGet cmdAddFileCbls >>= mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabalFromFile pd c d)) + genIdxPkgs <- cfgGet cmdAddCbls >>= mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabalFromIdx pd c d)) + pkgs <- exitOnErrors $ argsToPkgType ghcPkgs distroPkgs (genUrlPkgs ++ genFilePkgs ++ genIdxPkgs) + -- + let pkgNames = map getName pkgs + let tmpDb = foldl delPkg db pkgNames + case addPkgs tmpDb pkgs of + Left (unsatisfiables, breaksOthers) -> liftIO (mapM_ printUnSat unsatisfiables >> mapM_ printBrksOth breaksOthers) + Right newDb -> liftIO $ unless dr $ saveDb newDb dbFn -doAddRepo db pkgs = let +argsToPkgType ghcPkgs distroPkgs repoPkgs = let + toGhcType (n, v) = maybe + (Left $ "Not a valid version given for " ++ n ++ " (" ++ v ++ ")") + (Right . GhcType n) + (simpleParse v :: Maybe Version) + toDistroType (n, v, r) = maybe + (Left $ "Not a valid version given for " ++ n ++ " (" ++ v ++ ")") + (\ v' -> Right $ DistroType n v' r) + (simpleParse v :: Maybe Version) + toRepoType = either Left (Right . RepoType) + in map toGhcType ghcPkgs ++ map toDistroType distroPkgs ++ map toRepoType repoPkgs + +getName (GhcType n _) = n +getName (DistroType n _ _) = n +getName (RepoType gpd) = (\ (P.PackageName n) -> n) $ P.pkgName $ package $ packageDescription gpd + +-- {{{1 addPkgs +addPkgs db pkgs = let (succs, fails) = partition (canBeAdded db) pkgs - newDb = foldl addPkg2 db (map (fromJust . finalizeToCblPkg db) succs) - unSats = catMaybes $ map (finalizeToDeps db) fails - genPkgName = ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) - genPkgVer = P.pkgVersion . package . packageDescription - brksOthrs = filter (not . null . snd) $ map (\ p -> ((genPkgName p, genPkgVer p), checkDependants db (genPkgName p) (genPkgVer p))) fails + newDb = foldl addPkg2 db (map (pkgTypeToCblPkg db) succs) + unsatisfieds = mapMaybe (finalizeToUnsatisfiableDeps db) fails + breaksOthers = mapMaybe (findBreaking db) fails in case (succs, fails) of (_, []) -> Right newDb - ([], _) -> Left (unSats, brksOthrs) - (_, _) -> doAddRepo newDb fails + ([], _) -> Left (unsatisfieds, breaksOthers) + (_, _) -> addPkgs newDb fails -canBeAdded db p = let - finable = either (const False) (const True) (finalizePkg db p) - n = ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) p - v = P.pkgVersion $ package $ packageDescription p +canBeAdded db (GhcType n v) = null $ checkDependants db n v +canBeAdded db (DistroType n v _) = null $ checkDependants db n v +canBeAdded db (RepoType gpd) = let + finable = either (const False) (const True) (finalizePkg db gpd) + n = ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd + v = P.pkgVersion $ package $ packageDescription gpd depsOK = null $ checkDependants db n v in finable && depsOK -finalizeToCblPkg db p = case finalizePkg db p of +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 - _ -> Nothing + Left _ -> Nothing -finalizeToDeps db p = case finalizePkg db p of - Left ds -> Just $ (((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) p, ds) +finalizeToUnsatisfiableDeps db (RepoType gpd) = case finalizePkg db gpd of + Left ds -> Just $ (((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd, ds) _ -> Nothing +finalizeToUnsatisfiableDeps _ _ = Nothing + +findBreaking db (GhcType n v) = let + d = checkDependants db n v + in if null d + then Nothing + else Just ((n, v), d) +findBreaking db (DistroType n v _) = let + d = checkDependants db n v + in if null d + then Nothing + else Just ((n, v), d) +findBreaking db (RepoType gpd) = let + n = (\ (P.PackageName n) -> n) $ P.pkgName $ package $ packageDescription gpd + v = P.pkgVersion $ package $ packageDescription gpd + d = checkDependants db n v + in if null d + then Nothing + else Just ((n, v), d) diff --git a/src/BuildPkgs.hs b/src/BuildPkgs.hs --- a/src/BuildPkgs.hs +++ b/src/BuildPkgs.hs @@ -25,7 +25,7 @@ import Data.Maybe import System.FilePath -buildPkgs :: ReaderT Cmds IO () +buildPkgs :: Command () buildPkgs = do db <- cfgGet dbFile >>= liftIO . readDb pkgs <- cfgGet pkgs diff --git a/src/BumpPkgs.hs b/src/BumpPkgs.hs --- a/src/BumpPkgs.hs +++ b/src/BumpPkgs.hs @@ -25,7 +25,7 @@ import Data.Maybe import System.FilePath -bumpPkgs :: ReaderT Cmds IO () +bumpPkgs :: Command () bumpPkgs = do dbFn <- cfgGet dbFile db <- liftIO $ readDb dbFn diff --git a/src/ConvertDB.hs b/src/ConvertDB.hs --- a/src/ConvertDB.hs +++ b/src/ConvertDB.hs @@ -27,7 +27,7 @@ import Data.Version import System.IO -convertDb :: ReaderT Cmds IO () +convertDb :: Command () convertDb = do inDb <- cfgGet inDbFile >>= \ fn -> liftIO $ ODB.readDb fn outDbFn <- cfgGet outDbFile diff --git a/src/ListPkgs.hs b/src/ListPkgs.hs --- a/src/ListPkgs.hs +++ b/src/ListPkgs.hs @@ -25,15 +25,16 @@ import Distribution.Text import System.FilePath -listPkgs :: ReaderT Cmds IO () +listPkgs :: Command () listPkgs = do - lA <- cfgGet listAll + lG <- cfgGet listGhc + lD <- cfgGet listDistro + lR <- cfgGet noListRepo db <- cfgGet dbFile >>= liftIO . readDb - let pkgs = if not lA - then filter (not . isBasePkg) db - else db + let pkgs = filter (pkgFilter lG lD lR) db liftIO $ mapM_ printCblPkgShort pkgs --- printCblPkgShort (p, (v, _, r)) = +pkgFilter g d r p = (g && isGhcPkg p) || (d && isDistroPkg p) || (not r && isRepoPkg p) + printCblPkgShort p = putStrLn $ pkgName p ++ " " ++ (display $ pkgVersion p) ++ "-" ++ pkgRelease p diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -47,19 +47,12 @@ [ argAppDir, argDbFile , patchDir := "patches" += explicit += name "patchdir" += help "location of patches" += typDir , argDryRun - , pkgType := RepoPkgT += explicit += name "t" += name "type" += typ "TYPE" += help "type of package ((g)hcpkg, (d)istropkg, or (r)epopkg, default: r)" - --, isBase := False += explicit += name "b" += name "base" += help "add a base package" - , cbls := def += args += typ "PKGVERSPEC" - ] += name "add" += help "add a package from a Cabal file" += details - [ "The package version depends on the type of the package that's added:" - , " 1. For a ghc package specify the name and version, e.g. 'base,4.3'" - , " 2. For a distro package specify the name, version, and release, e.g. 'HUnit,1.2.2.3,2.1" - , " 3. For a repo package provide a Cabal file by either" - , " - provide the filename of the Cabal file" - , " - specify the URL where the Cabal file can be found (for file:// URLs the full absolute path is required" - , " - specify the name and version to load the Cabal file out of an index file (see idxupdate)" - , " All three format may be mixed on the command line." - ] + , cmdAddGhcPkgs := def += explicit += name "g" += name "ghc-pkg" += typ "PKG,VER" += help "GHC base package (multiple)" + , cmdAddDistroPkgs := def += explicit += name "d" += name "distro-pkg" += typ "PKG,VER,REL" += help "distro package (multiple)" + , cmdAddUrlCbls := def += explicit += name "u" += name "cbl-url" += typ "URL" += help "url of Cabal file (multiple)" + , cmdAddFileCbls := def += explicit += name "f" += name "cbl-file" += typFile += help "Cabal file (multiple)" + , cmdAddCbls := def += args += typ "PKG,VER" + ] += name "add" += help "add a package to the database" cmdBumpPkgs = record defBumpPkgs [ argAppDir, argDbFile @@ -80,11 +73,13 @@ , pkgs := def += args += typ "PKG" ] += name "versions" += help "list available versions" -cmdUpdates = record defUpdates [ argAppDir , argDbFile ] += name "updates" += help "check for availabale updates" +cmdUpdates = record defUpdates [ argAppDir , argDbFile ] += name "updates" += help "check for available updates" -cmdListPkgs = record defListPkgs +cmdListPkgs = record defCmdListPkgs [ argAppDir, argDbFile - , listAll := False += name "a" += explicit += help "list all packages" + , 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" ] += name "list" += help "list packages in repo" cmdUrls = record defUrls @@ -135,14 +130,14 @@ let c' = c { appDir = aD } createDirectoryIfMissing True (aD) case c' of - CmdAdd {} -> runReaderT add c' - BuildPkgs {} -> runReaderT buildPkgs c' - BumpPkgs {} -> runReaderT bumpPkgs c' - Sync {} -> runReaderT sync c' - Versions {} -> runReaderT versions c' - ListPkgs {} -> runReaderT listPkgs c' - Updates {} -> runReaderT updates c' - Urls {} -> runReaderT urls c' - PkgBuild {} -> runReaderT pkgBuild c' - ConvertDb {} -> runReaderT convertDb c' - RemovePkg {} -> runReaderT remove c' + CmdAdd {} -> runCommand c' add + BuildPkgs {} -> runCommand c' buildPkgs + BumpPkgs {} -> runCommand c' bumpPkgs + Sync {} -> runCommand c' sync + Versions {} -> runCommand c' versions + CmdListPkgs {} -> runCommand c' listPkgs + Updates {} -> runCommand c' updates + Urls {} -> runCommand c' urls + PkgBuild {} -> runCommand c' pkgBuild + ConvertDb {} -> runCommand c' convertDb + RemovePkg {} -> runCommand c' remove diff --git a/src/PkgBuild.hs b/src/PkgBuild.hs --- a/src/PkgBuild.hs +++ b/src/PkgBuild.hs @@ -31,7 +31,7 @@ import System.Unix.Directory import Text.PrettyPrint.ANSI.Leijen -pkgBuild :: ReaderT Cmds IO () +pkgBuild :: Command () pkgBuild = do db <- cfgGet dbFile >>= liftIO . readDb pD <- cfgGet patchDir @@ -39,8 +39,6 @@ mapM (runErrorT . generatePkgBuild db pD) pkgs >>= exitOnErrors >> return () -- TODO: --- - patches: --- build patch - put into source array, copied into package dir -- - flags -- generatePkgBuild :: CblDB -> String -> String -> ErrorT String IO () generatePkgBuild db patchDir pkg = let diff --git a/src/Remove.hs b/src/Remove.hs --- a/src/Remove.hs +++ b/src/Remove.hs @@ -27,7 +27,7 @@ import System.Exit -- {{{1 remove -remove :: ReaderT Cmds IO () +remove :: Command () remove = do dbFn <- cfgGet dbFile db <- liftIO $ readDb dbFn diff --git a/src/Sync.hs b/src/Sync.hs --- a/src/Sync.hs +++ b/src/Sync.hs @@ -22,7 +22,7 @@ import System.FilePath import Control.Monad.Error -sync :: ReaderT Cmds IO () +sync :: Command () sync = do aD <- cfgGet appDir liftIO $ getFromURL "http://hackage.haskell.org/packages/archive/00-index.tar.gz" (aD "00-index.tar.gz") diff --git a/src/Updates.hs b/src/Updates.hs --- a/src/Updates.hs +++ b/src/Updates.hs @@ -29,7 +29,7 @@ import System.FilePath import qualified Data.ByteString.Lazy.Char8 as BS -updates :: ReaderT Cmds IO () +updates :: Command () updates = do db <- cfgGet dbFile >>= liftIO . readDb aD <- cfgGet appDir diff --git a/src/Urls.hs b/src/Urls.hs --- a/src/Urls.hs +++ b/src/Urls.hs @@ -20,7 +20,7 @@ import Control.Monad.Reader -urls :: ReaderT Cmds IO () +urls :: Command () urls = do pkgs <- cfgGet pkgVers liftIO $ mapM_ (putStrLn . createUrl) pkgs diff --git a/src/Util/Misc.hs b/src/Util/Misc.hs --- a/src/Util/Misc.hs +++ b/src/Util/Misc.hs @@ -66,16 +66,17 @@ dbName = progName ++ ".db" -- {{{1 command line argument type -data PkgType = GhcPkgT | DistroPkgT | RepoPkgT - deriving (Show, Data, Typeable) data Cmds - = CmdAdd { appDir :: FilePath, dbFile :: FilePath, patchDir :: FilePath, dryRun :: Bool, pkgType :: PkgType, cbls :: [FilePath] } + = CmdAdd + { appDir :: FilePath, dbFile :: FilePath, patchDir :: FilePath, dryRun :: Bool + , cmdAddGhcPkgs :: [(String,String)], cmdAddDistroPkgs :: [(String, String, String)] + , cmdAddUrlCbls :: [String], cmdAddFileCbls :: [FilePath], cmdAddCbls :: [(String, String)] } | BuildPkgs { appDir :: FilePath, dbFile :: FilePath, pkgs :: [String] } | BumpPkgs { appDir :: FilePath, dbFile :: FilePath, dryRun :: Bool, inclusive :: Bool, pkgs :: [String] } | Sync { appDir :: FilePath } | Versions { appDir :: FilePath, pkgs :: [String] } - | ListPkgs { appDir :: FilePath, dbFile :: FilePath, listAll :: Bool } + | CmdListPkgs { appDir :: FilePath, dbFile :: FilePath, listGhc :: Bool, listDistro :: Bool, noListRepo :: Bool } | Updates { appDir :: FilePath, dbFile :: FilePath } | Urls { appDir :: FilePath, pkgVers :: [(String, String)] } | PkgBuild { appDir :: FilePath, dbFile :: FilePath, patchDir :: FilePath, pkgs :: [String] } @@ -83,12 +84,12 @@ | RemovePkg { appDir :: FilePath, dbFile :: FilePath, dryRun :: Bool, pkgs :: [String] } deriving (Show, Data, Typeable) -defCmdAdd = CmdAdd "" "" "" True RepoPkgT [] +defCmdAdd = CmdAdd "" "" "" True [] [] [] [] [] defBuildPkgs = BuildPkgs "" "" [] defBumpPkgs = BumpPkgs "" "" False False [] defSync = Sync "" defVersions = Versions "" [] -defListPkgs = ListPkgs "" "" False +defCmdListPkgs = CmdListPkgs "" "" False False False defUpdates = Updates "" "" defUrls = Urls "" [] defPkgBuild = PkgBuild "" "" "" [] @@ -123,6 +124,10 @@ data LocType = Url | Idx | File -- | Read in a Cabal file. +readCabalFromUrl = readCabal +readCabalFromFile = readCabal +readCabalFromIdx pd (p, v) td = readCabal pd (p ++ "," ++ v) td + readCabal :: FilePath -> String -> FilePath -> ErrorT String IO GenericPackageDescription readCabal patchDir loc tmpDir = let locType @@ -197,26 +202,18 @@ Nothing -> False Just (_, p) -> withinRange (DB.version p) dVR --- {{{1 allPatches -allPatches pn patchDir = let - cblPatch = patchDir pn <.> "cabal" - pkgPatch = patchDir pn <.> "pkgbuild" - bldPatch = patchDir pn <.> "build" - in do - cE <- fileExist cblPatch - pE <- fileExist pkgPatch - bE <- fileExist bldPatch - return (if cE then Just cblPatch else Nothing, - if pE then Just pkgPatch else Nothing, - if bE then Just bldPatch else Nothing) +-- {{{1 Command type +type Command a = ReaderT Cmds IO a --- {{{1 ErrorT -reWrapErrT (Left e) = throwError e -reWrapErrT (Right v) = return v +runCommand cmds func = runReaderT func cmds -withTempDirErrT fp func = do - r <- liftIO $ withTemporaryDirectory fp (\ p -> runErrorT $ func p) - reWrapErrT r +-- {{{1 ErrorT +withTempDirErrT fp func = let + reWrapErrT (Left e) = throwError e + reWrapErrT (Right v) = return v + in do + r <- liftIO $ withTemporaryDirectory fp (\ p -> runErrorT $ func p) + reWrapErrT r exitOnErrors vs = let es = lefts vs diff --git a/src/Util/Translation.hs b/src/Util/Translation.hs --- a/src/Util/Translation.hs +++ b/src/Util/Translation.hs @@ -30,7 +30,7 @@ import Data.Char import Data.List import Data.Maybe -import Data.Monoid +import Data.Monoid hiding ((<>)) import Data.Version import Distribution.Package as P import Distribution.PackageDescription @@ -73,7 +73,7 @@ pretty (ShVar n v) = text n <> char '=' <> pretty v -- {{{1 ArchPkg --- TODO: patches, flags +-- TODO: flags data ArchPkg = ArchPkg { apPkgName :: String , apHkgName :: String @@ -81,6 +81,7 @@ , apLicenseFile :: Maybe FilePath , apCabalPatch :: Maybe FilePath , apPkgbuildPatch :: Maybe FilePath + , apBuildPatch :: Maybe FilePath -- shell bits , apShHkgName :: ShVar String , apShPkgName :: ShVar String @@ -104,6 +105,7 @@ , apLicenseFile = Nothing , apCabalPatch = Nothing , apPkgbuildPatch = Nothing + , apBuildPatch = Nothing , apShHkgName = ShVar "_hkgname" "" , apShPkgName = ShVar "pkgname" "" , apShPkgVer = ShVar "pkgver" (Version [] []) @@ -127,6 +129,7 @@ { apHasLibrary = hasLib , apLicenseFile = licenseFile , apCabalPatch = cabalPatchFile + , apBuildPatch = buildPatchFile , apShHkgName = hkgName , apShPkgName = pkgName , apShPkgVer = pkgVer @@ -170,6 +173,9 @@ maybe empty (\ _ -> text $ "patch " ++ shVarValue hkgName ++ ".cabal ${srcdir}/cabal.patch ") cabalPatchFile <$> + maybe empty (\ _ -> + text $ "patch -p4 < ${srcdir}/source.patch") + 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") <$> @@ -186,6 +192,9 @@ maybe empty (\ _ -> text $ "patch " ++ shVarValue hkgName ++ ".cabal ${srcdir}/cabal.patch ") cabalPatchFile <$> + maybe empty (\ _ -> + text $ "patch -p4 < ${srcdir}/source.patch") + buildPatchFile <$> text "runhaskell Setup configure -O --prefix=/usr --docdir=/usr/share/doc/${pkgname}" <$> text "runhaskell Setup build" ) <$> @@ -266,7 +275,6 @@ -- {{{1 translate -- TODO: -- • add flags --- • add patches to sources -- • translation of extraLibDepends-libs to Arch packages translate db pd = let ap = baseArchPkg @@ -279,8 +287,8 @@ pkgDesc = synopsis pd url = if null (homepage pd) then "http://hackage.haskell.org/package/${_hkgname}" else (homepage pd) lic = display (license pd) - makeDepends = if hasLib then [] else ["ghc=7.0.3-2"] ++ calcExactDeps db pd - depends = if hasLib then ["ghc=7.0.3-2"] ++ calcExactDeps db pd else [] + makeDepends = if hasLib then ["haddock"] else ["ghc=7.4.1-1", "haddock"] ++ calcExactDeps db pd + depends = if hasLib then ["ghc=7.4.1-1"] ++ calcExactDeps db pd else [] extraLibDepends = maybe [] (extraLibs . libBuildInfo) (library pd) install = if hasLib then (apShInstall ap) else Nothing in ap @@ -324,30 +332,33 @@ -- {{{1 stuff with patches -- {{{2 addPatches --- TODO: --- • add build patch addPatches patchDir ap = let hkgName = apHkgName ap sources = apShSource ap fi tF fF v = if v then tF else fF cabalPatchFn = patchDir hkgName <.> "cabal" pkgbuildPatchFn = patchDir hkgName <.> "pkgbuild" + buildPatchFn = patchDir hkgName <.> "source" in do cabalPatch <- doesFileExist cabalPatchFn >>= fi (liftM Just $ canonicalizePath cabalPatchFn) (return Nothing) pkgBuildPatch <- doesFileExist pkgbuildPatchFn >>= fi (liftM Just $ canonicalizePath pkgbuildPatchFn) (return Nothing) - let sources' = shVarAppendValue sources (ShArray $ maybe [] (const ["cabal.patch"]) cabalPatch) + 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]) return ap { apCabalPatch = cabalPatch , apPkgbuildPatch = pkgBuildPatch + , apBuildPatch = buildPatch , apShSource = sources' } -- {{{2 copyPatches --- TODO: --- • add build patch copyPatches destDir ap = let cabalPatch = apCabalPatch ap - in maybe (return ()) (\ fn -> copyFile fn (destDir "cabal.patch")) cabalPatch + buildPatch = apBuildPatch ap + in do + maybe (return ()) (\ fn -> copyFile fn (destDir "cabal.patch")) cabalPatch + maybe (return ()) (\ fn -> copyFile fn (destDir "source.patch")) buildPatch -- {{{1 addHashes addHashes ap tmpDir = let diff --git a/src/Versions.hs b/src/Versions.hs --- a/src/Versions.hs +++ b/src/Versions.hs @@ -29,7 +29,7 @@ import System.FilePath import qualified Data.ByteString.Lazy.Char8 as BS -versions :: ReaderT Cmds IO () +versions :: Command () versions = do aD <- cfgGet appDir pkgs <- cfgGet pkgs diff --git a/tst/TestPkgDB.hs b/tst/TestPkgDB.hs deleted file mode 100644 --- a/tst/TestPkgDB.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# OPTIONS_GHC -XTemplateHaskell #-} -{- - - Copyright 2011 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. - - You may obtain a copy of the License at - - - - http://www.apache.org/licenses/LICENSE-2.0 - - - - Unless required by applicable law or agreed to in writing, software - - distributed under the License is distributed on an "AS IS" BASIS, - - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - - See the License for the specific language governing permissions and - - limitations under the License. - -} - -module TestPkgDB - ( testGroup - ) where - -import PkgDB - -import Data.Maybe -import Distribution.Text -import Test.Framework.Providers.HUnit -import Test.Framework.TH -import Test.HUnit -import Text.JSON -import qualified Distribution.Package as P -import qualified Distribution.Version as V - --- {{{1 transitiveDependants -theDb :: CblDB -theDb = - [ createRepoPkg "pkgA" (fromJust $ simpleParse "1.0") [] "1" -- nothing depends on this pkg - -- a chain of two - , createRepoPkg "pkgB" (fromJust $ simpleParse "1.0") [] "1" - , createRepoPkg "pkgC" (fromJust $ simpleParse "1.0") - (map (fromJust . simpleParse) ["pkgB"]) "1" - -- a chain of three - , createRepoPkg "pkgD" (fromJust $ simpleParse "1.0") [] "1" - , createRepoPkg "pkgE" (fromJust $ simpleParse "1.0") - (map (fromJust . simpleParse) ["pkgD"]) "1" - , createRepoPkg "pkgF" (fromJust $ simpleParse "1.0") - (map (fromJust . simpleParse) ["pkgE"]) "1" - ] - -case_TD_one = do transitiveDependants theDb ["pkgA"] @=? ["pkgA"] -case_TD_two = do transitiveDependants theDb ["pkgB"] @=? ["pkgB", "pkgC"] -case_TD_three = do transitiveDependants theDb ["pkgD"] @=? ["pkgD", "pkgE", "pkgF"] --- pass in packages in correct order -case_TD_ordering1 = do transitiveDependants theDb ["pkgD", "pkgF"] @=? ["pkgD", "pkgE", "pkgF"] --- pass in packages in reverse order -case_TD_ordering2 = do transitiveDependants theDb ["pkgF", "pkgD"] @=? ["pkgD", "pkgE", "pkgF"] - --- {{{1 JSON instances -case_json_version = let - v1_i = V.Version [1, 2, 3] [] - v1_s = "{\"Version\":\"1.2.3\"}" - v2_i = V.Version [1, 2, 3] ["foo"] - in do - assertEqual "JSON Version showJSON 1" v1_s (encode $ showJSON v1_i) - assertEqual "JSON Version showJSON 2" v1_s (encode $ showJSON v2_i) - assertEqual "JSON Version readJSON 1" (Ok v1_i) (decode v1_s) - -case_json_dependency = let - (Just d1_i) = simpleParse "package -any" :: Maybe P.Dependency - d1_s = "{\"Dependency\":\"package -any\"}" - (Just d2_i) = simpleParse "ConfigFile >=1 && <1.1" :: Maybe P.Dependency - d2_s = "{\"Dependency\":\"ConfigFile >=1 && <1.1\"}" - in do - assertEqual "JSON Dependency showJSON 1" d1_s (encode $ showJSON d1_i) - assertEqual "JSON Dependency showJSON 2" d2_s (encode $ showJSON d2_i) - assertEqual "JSON Dependency readJSON 1" (Ok d1_i) (decode d1_s) - assertEqual "JSON Dependency readJSON 2" (Ok d2_i) (decode d2_s) - --- {{{1 testGroup -testGroup = $(testGroupGenerator) diff --git a/tst/TestSystem.hs b/tst/TestSystem.hs deleted file mode 100644 --- a/tst/TestSystem.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# OPTIONS_GHC -XTemplateHaskell #-} -{- - - Copyright 2011 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. - - You may obtain a copy of the License at - - - - http://www.apache.org/licenses/LICENSE-2.0 - - - - Unless required by applicable law or agreed to in writing, software - - distributed under the License is distributed on an "AS IS" BASIS, - - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - - See the License for the specific language governing permissions and - - limitations under the License. - -} - -module TestSystem - ( testGroup - ) where - -import Data.List -import Test.Framework.Providers.HUnit -import Test.Framework.TH -import Test.HUnit - --- {{{1 nub works as expected -case_nub_order = do nub [1,2,1,3,1] @=? [1,2,3] - --- {{{1 testGroup -testGroup = $(testGroupGenerator) diff --git a/tst/tst.hs b/tst/tst.hs deleted file mode 100644 --- a/tst/tst.hs +++ /dev/null @@ -1,28 +0,0 @@ -{- - - Copyright 2011 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. - - You may obtain a copy of the License at - - - - http://www.apache.org/licenses/LICENSE-2.0 - - - - Unless required by applicable law or agreed to in writing, software - - distributed under the License is distributed on an "AS IS" BASIS, - - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - - See the License for the specific language governing permissions and - - limitations under the License. - -} - -module Main where - -import qualified TestPkgDB -import qualified TestSystem - -import Test.Framework - -main = defaultMain - [ TestPkgDB.testGroup - , TestSystem.testGroup - ] -