planning for ghc-6.10.1 and hackage [or: combining packages to yield new type correct programs]

[Simon Marlow]

Simon Marlow wrote:

> So I'm not sure exactly how cabal-install works now, but I imagine you 
> could search for a solution with a backtracking algorithm, and prune 
> solutions that involve multiple versions of the same package, unless 
> those two versions are allowed to co-exist (e.g. base-3/base-4).  If 
> backtracking turns out to be too expensive, then maybe more heavyweight 
> constraint-solving would be needed, but I'd try the simple way first.

Attached is a simple backtracking solver.  It doesn't do everything you 
want, e.g. it doesn't distinguish between installed and uninstalled 
packages, and it doesn't figure out for itself which versions are allowed 
together (you have to tell it), but I think it's a good start.  It would be 
interetsing to populate the database with a more realistic collection of 
packages and try out some complicated install plans.

Cheers,
	Simon
-------------- next part --------------
module Main(main) where

import Data.List
import Data.Function
import Prelude hiding (EQ)

type Package = String
type Version = Int
type PackageId = (Package,Version)

data Constraint = EQ Version | GE Version | LE Version
  deriving (Eq,Ord,Show)

satisfies :: Version -> Constraint -> Bool
satisfies v (EQ v') = v == v'
satisfies v (GE v') = v >= v'
satisfies v (LE v') = v <= v'

allowedWith :: PackageId -> PackageId -> Bool
allowedWith (p,v1) (q,v2) = p /= q || v1 == v2 || multipleVersionsAllowed p

type Dep = (Package, Constraint)

depsOf :: PackageId -> [Dep]
depsOf pid = head [ deps | (pid',deps) <- packageDB, pid == pid' ]

packageIds :: Package -> [PackageId]
packageIds pkg = [ pid | (pid@(n,v),_) <- packageDB, n == pkg ]

satisfy :: Dep -> [PackageId]
satisfy (target,constraint) = [ pid | pid@(_,v) <- packageIds target,
                                      v `satisfies` constraint ]

-- | solve takes a list of dependencies to resolve, and a list of
-- packages we have decided on already, and returns a list of
-- solutions.
--
solve :: [Dep] -> [PackageId] -> [[PackageId]]
solve []         sofar = [sofar]       -- no more deps: we win
solve (dep:deps) sofar = 
   [ solution | pid <- satisfy dep,
                pid `consistentWith` sofar,
                solution <- solve (depsOf pid ++ deps) (pid:sofar) ]

consistentWith :: PackageId -> [PackageId] -> Bool
consistentWith pid = all (pid `allowedWith`)

plan :: Package -> [[PackageId]]
plan p = pretty $ solve [(p,GE 0)] []

pretty = nub . map (nub.sort)

main = do print $ plan "p"
          print $ plan "yi"

-- -----------------------------------------------------------------------------
-- Data

packageDB :: [(PackageId, [Dep])]
packageDB = [
  (("base",3), []),
  (("base",4), []),

  (("p", 1),  [("base", LE 4), ("base", GE 3), ("q", GE 1)]),
  (("q", 1),  [("base", LE 3)]),

  (("bytestring",1), [("base", EQ 4)]), -- installed
  (("bytestring",2), [("base", EQ 4)]), -- installed

  (("ghc", 1), [("bytestring", EQ 1)]), -- installed
  (("ghc", 2), [("bytestring", GE 2)]),

  (("yi", 1),  [("ghc", GE 1), ("bytestring", GE 2)])
 ]

multipleVersionsAllowed :: Package -> Bool
multipleVersionsAllowed "base" = True -- approximation, of course
multipleVersionsAllowed _      = False