cabal-install's Dependency Tree and its Zipper

In the simplest case, a tree could be defined like so

  data Tree a = Leaf a | Node a [Tree a]

A zipper for that kind of tree would be a Pointer

  data Pointer a = Pointer (Tree a) (Path a)

which consist of the tree we are pointing at and a path

  data Path a = Top | Point (Path a) [Tree a] a [Tree a]

back to the root.

So how does that work? Suppose we wanted to go up the tree. That would be a function

  focusUp :: Pointer a -> Maybe (Pointer a)
  focusUp (Pointer _ Top) = Nothing
  focusUp (Pointer t (Point path lefts nodeLabel rights)) = Just $ Pointer (Node node ( lefts ++ [t] ++ rights )) path

(You might have been wondering why I am not making Path a a list of triples ([Tree a], a, [Tree a])'s. It's just that I prefer matching for Top over [])

This generalizes easily to trees of the form

  data Tree a = LeafType | Node (NodeType a) (ContainerType (Tree a)).

where LeafType and NodeTypes are the types of leafs and nodes, respectively, and
ContainerType should be "something like" [].

cabal-install's Tree

Now, to the case at hand!


As of ghc 7 and higher, cabal-install uses a new modular solver and its tree is defined thus

  data Tree a =
    PChoice     QPN a           (PSQ I        (Tree a))
  | FChoice     QFN a Bool Bool (PSQ Bool     (Tree a))
  | SChoice     QSN a Bool      (PSQ Bool     (Tree a))
  | GoalChoice                  (PSQ OpenGoal (Tree a))
  | Done        RevDepMap
  | Fail        (ConflictSet QPN) FailReason

Unfortunately, I don't know of an easy way (short of TypeFamilies (which is not supposed to be used in cabal-install)) to transform that to a tree of the form above.
So this leads to some unnecessary code, but it should not be too bad.
Let us ignore the nodetypes for the moment, as they are not important for the zipper and I hope that stuff will become clear once we look at the interactive part of the solver.

The important part is the ContainerType. Here it is

  newtype PSQ k v = PSQ [(k, v)].

Just an association-list (but the order of the elements is important, PSQ = PrioritySearchQueue)

Above, we split the containerlist into lefts, rights, and the current label. Let's do that here, too:

  data PSQContext k v = PSQContext (PSQ k v) k (PSQ k v)

To define a "focusUp", we are going to need to concatenate PSQs, so let's get that out of the way:

  joinPSQ :: PSQ k v -> PSQ k v -> PSQ k v

  joinPSQ (PSQ a) (PSQ b) = PSQ (a ++ b)


  joinContext :: v -> PSQContext k v -> PSQ k v

  joinContext value (PSQContext left key right) = left `joinPSQ` PSQ [(key, value)] `joinPSQ` right

e.g. joinContext "bar" (PSQContext (PSQ [(1, "foo")]) 4 (PSQ [(3, "baz")]) = PSQ [(1, "foo"), (4, "bar"), (3, "baz")]

The Zipper

Now, the zipper, in all of its glory:

data Path a =
    Top
  | PChoicePoint (Path a) (PSQContext I (Tree a))           QPN a
  | FChoicePoint (Path a) (PSQContext Bool (Tree a))        QFN a Bool Bool
  | SChoicePoint (Path a) (PSQContext Bool (Tree a))        QSN a Bool
  | GChoicePoint (Path a) (PSQContext OpenGoal (Tree a))  

data Pointer a = Pointer { context :: Path a, tree :: Tree a }


and again, we define focusUp

  focusUp :: Pointer a -> Maybe (Pointer a)
  focusUp (Pointer Top t) = Nothing

  focusUp (Pointer (PChoicePoint path context q a ) t) = Just $ Pointer path newTree
    where newTree = PChoice q a newPSQ
          newPSQ  = joinContext t context

  focusUp (Pointer (FChoicePoint path context q a b1 b2 ) t) = Just $ Pointer path newTree
    where newTree = FChoice q a b1 b2 newPSQ
          newPSQ  = joinContext t context

  focusUp (Pointer (SChoicePoint path context q a b ) t) = Just $ Pointer path newTree
    where newTree = SChoice q a b newPSQ
          newPSQ  = joinContext t context

  focusUp (Pointer (GChoicePoint path context) t) = Just $ Pointer path newTree
    where newTree = GoalChoice  newPSQ
          newPSQ  = joinContext t context

As you can see, a lot of repeated code. If you know of a better way, please let me know!

The full code is at TreeZipper.hs and PSQ.hs.

Next time, we'll look at the interactive solver..