cblrepo 0.4.1 → 0.5.0
raw patch · 18 files changed
+166/−342 lines, 18 filesdep −HUnitdep −test-frameworkdep −test-framework-hunitdep ~Cabaldep ~Unixutilsdep ~base
Dependencies removed: HUnit, test-framework, test-framework-hunit, test-framework-th
Dependency ranges changed: Cabal, Unixutils, base, cmdargs, filepath, json, process, tar, unix
Files
- cblrepo.cabal +8/−18
- src/Add.hs +77/−107
- src/BuildPkgs.hs +1/−1
- src/BumpPkgs.hs +1/−1
- src/ConvertDB.hs +1/−1
- src/ListPkgs.hs +7/−6
- src/Main.hs +22/−27
- src/PkgBuild.hs +1/−3
- src/Remove.hs +1/−1
- src/Sync.hs +1/−1
- src/Updates.hs +1/−1
- src/Urls.hs +1/−1
- src/Util/Misc.hs +21/−24
- src/Util/Translation.hs +22/−11
- src/Versions.hs +1/−1
- tst/TestPkgDB.hs +0/−79
- tst/TestSystem.hs +0/−31
- tst/tst.hs +0/−28
cblrepo.cabal view
@@ -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 :
src/Add.hs view
@@ -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)
src/BuildPkgs.hs view
@@ -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
src/BumpPkgs.hs view
@@ -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
src/ConvertDB.hs view
@@ -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
src/ListPkgs.hs view
@@ -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
src/Main.hs view
@@ -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
src/PkgBuild.hs view
@@ -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
src/Remove.hs view
@@ -27,7 +27,7 @@ import System.Exit -- {{{1 remove-remove :: ReaderT Cmds IO ()+remove :: Command () remove = do dbFn <- cfgGet dbFile db <- liftIO $ readDb dbFn
src/Sync.hs view
@@ -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")
src/Updates.hs view
@@ -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
src/Urls.hs view
@@ -20,7 +20,7 @@ import Control.Monad.Reader -urls :: ReaderT Cmds IO ()+urls :: Command () urls = do pkgs <- cfgGet pkgVers liftIO $ mapM_ (putStrLn . createUrl) pkgs
src/Util/Misc.hs view
@@ -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
src/Util/Translation.hs view
@@ -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
src/Versions.hs view
@@ -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
− tst/TestPkgDB.hs
@@ -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)
− tst/TestSystem.hs
@@ -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)
− tst/tst.hs
@@ -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- ]-