{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}-- |Figure out the dependency relation between debianized source-- directories. The code to actually solve these dependency relations-- for a particular set of binary packages is in Debian.Repo.Dependency.moduleDebian.GenBuildDeps(DepInfo(..)-- * Preparing dependency info,buildDependencies,RelaxInfo,relaxDeps,OldRelaxInfo(..),oldRelaxDeps-- * Using dependency info,BuildableInfo(..),buildable,compareSource-- * Obsolete?,orderSource,genDeps,failPackage,getSourceOrder)whereimportControl.Monad(filterM)importDebian.ControlimportData.EitherimportData.Graph(Graph,buildG,topSort,reachable,transposeG,vertices,edges)importData.ListimportqualifiedData.MapasMapimportData.MaybeimportqualifiedData.SetasSetimportDebian.RelationimportSystem.Directory(getDirectoryContents,doesFileExist)-- | This type describes the build dependencies of a source package.dataDepInfo=DepInfo{sourceName::SrcPkgName-- ^ source package name,relations::Relations-- ^ dependency relations,binaryNames::[BinPkgName]-- ^ binary dependency names (is this a function of relations?)}-- |Turn a list of eithers into an either of lists-- copied from Extra.EitherconcatEithers::[Eitherab]->Either[a][b]concatEithersxs=casepartitionEithersxsof([],rs)->Rightrs(ls,_)->Leftls-- |Return the dependency info for a source package with the given dependency relaxation.-- |According to debian policy, only the first paragraph in debian\/control can be a source package-- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-sourcecontrolfiles>buildDependencies::Control->EitherStringDepInfobuildDependencies(Control[])=error"Control file seems to be empty"buildDependencies(Control(source:binaries))=either(Left.concat)(\deps->Right(DepInfo{sourceName=sourcePackage,relations=deps,binaryNames=bins}))depswheresourcePackage=maybe(error"First Paragraph in control file lacks a Source field")SrcPkgName$assoc"Source"source-- The raw list of build dependencies for this packagedeps=eitherLeft(Right.concat)(concatEithers[buildDeps,buildDepsIndep])buildDeps=caseassoc"Build-Depends"sourceofJustv->either(\e->Left("Error parsing Build-Depends for"++showsourcePackage++": "++showe))Right(parseRelationsv)_->Right[]buildDepsIndep=caseassoc"Build-Depends-Indep"sourceof(Justv)->either(\e->Left("Error parsing Build-Depends-Indep for"++showsourcePackage++": "++showe))Right(parseRelationsv)_->Right[]bins=mapMaybelookupPkgNamebinarieslookupPkgName::Paragraph->MaybeBinPkgNamelookupPkgNamep=maybeNothing(Just.BinPkgName)(assoc"Package"p)-- |Specifies build dependencies that should be ignored during the build-- decision. If the pair is (BINARY, Nothing) it means the binary package-- BINARY should always be ignored when deciding whether to build. If the-- pair is (BINARY, Just SOURCE) it means that binary package BINARY should-- be ignored when deiciding whether to build package SOURCE.newtypeOldRelaxInfo=RelaxInfo[(BinPkgName,MaybeSrcPkgName)]derivingShow-- | Given a source package name and a binary package name, return-- False if the binary package should be ignored hwen deciding whether-- to build the source package. This is used to prevent build-- dependency cycles from triggering unnecessary rebuilds. (This is a-- replacement for the RelaxInfo type, which we temporarily rename-- OldRelaxInfo.)typeRelaxInfo=SrcPkgName->BinPkgName->BoolmakeRelaxInfo::OldRelaxInfo->RelaxInfomakeRelaxInfo(RelaxInfoxs)srcPkgNamebinPkgName=Set.memberbinPkgNameglobal||maybeFalse(Set.memberbinPkgName)(Map.lookupsrcPkgNamemp)where(global::Set.SetBinPkgName,mp::Map.MapSrcPkgName(Set.SetBinPkgName))=foldr(\entry(global',mp')->caseentryof(b,Justs)->(global',Map.insertWithSet.unions(Set.singletonb)mp')(b,Nothing)->(Set.insertbglobal',mp'))(Set.empty,Map.empty)xs-- |Remove any dependencies that are designated \"relaxed\" by relaxInfo.relaxDeps::RelaxInfo->[DepInfo]->[DepInfo]relaxDepsrelaxInfodeps=maprelaxDepdepswhererelaxDep::DepInfo->DepInforelaxDepinfo=info{relations=filteredDependencies}where-- Discard any dependencies not on the filtered package name list. If-- this results in an empty list in an or-dep the entire dependency can-- be discarded.filteredDependencies::RelationsfilteredDependencies=filter(/=[])(map(filterkeepDep)(relationsinfo))keepDep::Relation->BoolkeepDep(Relname__)=not(relaxInfo(sourceNameinfo)name)-- |Remove any dependencies that are designated \"relaxed\" by relaxInfo.oldRelaxDeps::OldRelaxInfo->[DepInfo]->[DepInfo]oldRelaxDepsrelaxInfodeps=maprelaxDepdepswhererelaxDep::DepInfo->DepInforelaxDepinfo=info{relations=filteredDependencies}where-- Discard any dependencies not on the filtered package name list. If-- this results in an empty list in an or-dep the entire dependency can-- be discarded.filteredDependencies::RelationsfilteredDependencies=filter(/=[])(map(filterkeepDep)(relationsinfo))keepDep::Relation->BoolkeepDep(Relname__)=not(elemnameignored)-- Binary packages to be ignored wrt this source package's build decisionignored=ignoredForSourcePackage(sourceNameinfo)relaxInfo-- Return a list of binary packages which should be ignored for this-- source package.ignoredForSourcePackage::SrcPkgName->OldRelaxInfo->[BinPkgName]ignoredForSourcePackagesource(RelaxInfopairs)=mapfst.filter(maybeTrue(==source).snd)$pairs-- concat . map binaries . catMaybes . map snd . filter (\ (_, x) -> maybe True (== source) x) $ pairsdataBuildableInfoa=BuildableInfo{readyTriples::[(a,[a],[a])],allBlocked::[a]}|CycleInfo{depPairs::[(a,a)]}-- |Given an ordering function representing the dependencies on a-- list of packages, return a triple: One ready package, the packages-- that depend on the ready package directly or indirectly, and all-- the other packages.buildable::(a->a->Ordering)->[a]->BuildableInfoabuildablecmppackages=-- Find all packages which can't reach any other packages in the-- graph of the "has build dependency" relation.casepartition(\x->reachablehasDepx==[x])vertsof-- None of the packages are buildable, return information-- about how to break this build dependency cycle.([],_)->CycleInfo{depPairs=mapofEdge(cycleEdgeshasDep)}-- We have some buildable packages, return them along with-- the list of packages each one directly blocks(allReady,blocked)->BuildableInfo{readyTriples=map(makeTripleblockedallReady)allReady,allBlocked=mapofVertexblocked}wheremakeTripleblockedreadythisReady=letotherReady=filter(/=thisReady)ready(directlyBlocked,otherBlocked)=partition(\x->elemx(reachableisDepthisReady))blockedin(ofVertexthisReady,mapofVertexdirectlyBlocked,mapofVertex(otherReady++otherBlocked))--allDeps x = (ofVertex x, map ofVertex (filter (/= x) (reachable hasDep x)))isDep=buildG(0,lengthpackages-1)edges'edges'=map(\(a,b)->(b,a))edgeshasDep=buildG(0,lengthpackages-1)edgesedges::[(Int,Int)]edges=nub(foldrf[](tailsvertPairs))wheref[]edges=edgesf(x:xs)edges=catMaybes(map(toEdgex)xs)++edgestoEdge(xv,xa)(yv,ya)=casecmpxayaofEQ->NothingLT->Just(yv,xv)GT->Just(xv,yv)ofEdge(a,b)=(ofVertexa,ofVertexb)ofVertexn=fromJust(Map.findWithDefaultNothingn(Map.fromList(zip[0..](mapJustpackages))))verts::[Int]verts=mapfstvertPairsvertPairs=zip[0..]packagescycleEdgesg=filter(`elem`(edgesg))(Set.toList(Set.intersection(Set.fromList(closureg))(Set.fromList(closure(transposeGg)))))whereclosureg=concat(map(\v->(map(\u->(v,u))(reachablegv)))(verticesg))--self (a, b) = a == b--distrib = concat . map (\ (n, ms) -> map (\ m -> (n, m)) ms) --swap (a, b) = (b, a)-- | Remove any packages which can't be built given that a package has failed.failPackage::Eqa=>(a->a->Ordering)->a->[a]->([a],[a])failPackagecomparefailedpackages=letgraph=buildGraphcomparepackagesinletroot=elemIndexfailedpackagesinletvictims=maybe[](map(fromJust.vertex).reachablegraph)rootinpartition(\x->not.elemx$victims)packageswherevertexn=Map.findWithDefaultNothingnvertexMapvertexMap=Map.fromList(zip[0..](mapJustpackages))-- | Given a list of packages, sort them according to their apparant-- build dependencies so that the first element doesn't depend on any-- of the other packages.orderSource::(a->a->Ordering)->[a]->[a]orderSourcecomparepackages=map(fromJust.vertex)(topSortgraph)wheregraph=buildGraphcomparepackagesvertexn=Map.findWithDefaultNothingnvertexMapvertexMap=Map.fromList(zip[0..](mapJustpackages))-- | Build a graph with the list of packages as its nodes and the-- build dependencies as its edges.buildGraph::(a->a->Ordering)->[a]->GraphbuildGraphcomparepackages=letedges=someEdges(zippackages[0..])inbuildG(0,lengthpackages-1)edgeswheresomeEdges[]=[]someEdges(a:etc)=aEdgesaetc++someEdgesetcaEdges(ap,an)etc=concat(map(\(bp,bn)->casecompareapbpofLT->[(an,bn)]GT->[(bn,an)]EQ->[])etc)-- |This is a nice start. It ignores circular build depends and takes-- a pretty simplistic approach to 'or' build depends. However, I-- think this should work pretty nicely in practice.compareSource::DepInfo->DepInfo->OrderingcompareSource(DepInfo{relations=depends1,binaryNames=bins1})(DepInfo{relations=depends2,binaryNames=bins2})|any(\rel->isJust(find(checkPackageNameReqrel)bins2))(concatdepends1)=GT|any(\rel->isJust(find(checkPackageNameReqrel)bins1))(concatdepends2)=LT|otherwise=EQwherecheckPackageNameReq::Relation->BinPkgName->BoolcheckPackageNameReq(RelrPkgName__)bPkgName=rPkgName==bPkgName-- |Return the dependency info for a list of control files.genDeps::[FilePath]->IO(EitherString[DepInfo])genDepscontrolFiles=mapMgenDep'controlFiles>>=return.either(Left.concat)(Right.orderSourcecompareSource).concatEitherswheregenDep'::FilePath->IO(EitherStringDepInfo)genDep'controlPath=parseControlFromFilecontrolPath>>=return.either(Left.show)buildDependencies-- |One example of how to tie the below functions together. In this-- case 'fp' is the path to a directory that contains a bunch of-- checked out source packages. The code will automatically look for-- debian\/control. It returns a list with the packages in the-- order they should be built.getSourceOrder::FilePath->IO(EitherString[SrcPkgName])getSourceOrderfp=findControlFilesfp>>=genDeps>>=return.eitherLeft(Right.mapsourceName.orderSourcecompareSource)where-- Return a list of the files that look like debian\/control.findControlFiles::FilePath->IO[FilePath]findControlFilesroot=getDirectoryContentsroot>>=mapM(\x->return$root++"/"++x++"/debian/control")>>=filterMdoesFileExistassoc::String->Paragraph->MaybeStringassocnamefields=maybeNothing(\(Field(_,v))->Just(stripWSv))(lookupPnamefields)