Wednesday, July 3, 2013

Quick Update: Improved Interactive Solver

In the past two weeks, I have refactored the dependency resolver a bit.
For example, in Dependency.hs there is a function called "resolveDependencies".
It now takes an optional parameter, which is a "Pointer QGoalReasonChain" (or QPointer) which tells it that it should only resolve whatever is left below that pointer, hence keeping the choices made there.

The Interactive Solver is now started in Install.hs' makeInstallPlan.
However, it checks so in a very pedantic way:

    if fromFlag (installInteractive installFlags) && solver == Modular -- How could this be handled better?
      then do
        notice verbosity "Starting interactive dependency solver..."
        mptr <- runInteractive platform (compilerId comp) solver resolverParams
        case mptr of
            Nothing -> return Nothing                   -- The user does not want to install anything.
            x       -> return $ Just (resolveUsing x)
The case-analysis could be replaced by something shorter,
        return $ mptr >>= return . resolveUsing . return
but I have been told that this is not very readable. ;-) (Possibly hinting at a bad design..)

I will have to look for a better integration..

Also, I have tried to improve the output of the solver, implemented some more commands, (install works now!) and the IDE knows about autocomplete-on-tab now.

Here is the example session:
(If you want to try this: the IDE assumes a terminal with 100 characters worth of width)

cabal install snap --interactive 
Starting interactive dependency solver...
Welcome to cabali!
This interface accepts simple commands separated by ';'. E.g. go 1 ; auto
go n            chooses n - alternatively "n" does the same. Just Enter, picks the first choice
up              goes up one step
top             goes all the way to the top
auto            starts the automatic solver
goto aeson      runs the parser until it sets aeson's version
goto aeson:test runs the parser until it sets the flag test for aeson
prefer aeson    sorts the choices so that aeson comes first if it is available (Same arguments as goto)
bset name       sets a bookmark called name
blist           lists all bookmarks
bjump name      jumps to the bookmark name
indicateAuto    indicates the choices the solver would have made with a little (*)
install         Once the interface says 'Done', you can type 'install' to install the package
showPlan        shows what is going to be installed/used
Missing dependencies
(1) snap   

> 1
Version of snap
(1) 0.12.0     (2) 0.11.3.1   (3) 0.11.3     (4) 0.11.2.2   (5) 0.11.2.1   (6) 0.11.2     (7) 0.11.1     
(8) 0.11.0     (9) 0.10.0.1   (10) 0.10.0    (11) 0.9.2.2   (12) 0.9.2.1   (13) 0.9.2     (14) 0.9.1.1   
(15) 0.9.1     (16) 0.9.0.1   (17) 0.9.0     (18) 0.8.1     (19) 0.8.0.2   (20) 0.8.0.1   (21) 0.8.0     
(22) 0.7       (23) 0.6.0.2   (24) 0.6.0.1   (25) 0.6.0     (26) 0.5.5.1   (27) 0.5.5     (28) 0.5.4     
(29) 0.5.3.1   (30) 0.5.3     (31) 0.5.2     (32) 0.5.1.3   (33) 0.5.1.2   (34) 0.5.1.1   (35) 0.5.1     
(36) 0.5.0     (37) 0.4.3     (38) 0.4.2     (39) 0.4.1     (40) 0.4       (41) 0.3.1     (42) 0.3.0.1   
(43) 0.3.0     

> 1
Missing dependencies
(1) base                         (2) snap-0.12.0:old-base         (3) template-haskell             
(4) old-time                     (5) snap-0.12.0:old-base         (6) xmlhtml                      
(7) vector-algorithms            (8) vector                       (9) unordered-containers         
(10) transformers                (11) time                        (12) text                        
(13) syb                         (14) stm                         (15) snap-server                 
(16) snap-core                   (17) regex-posix                 (18) pwstore-fast                
(19) mwc-random                  (20) mtl                         (21) logict                      
(22) heist                       (23) hashable                    (24) filepath                    
(25) errors                      (26) dlist                       (27) directory-tree              
(28) directory                   (29) containers                  (30) configurator                
(31) comonad                     (32) clientsession               (33) cereal                      
(34) bytestring                  (35) attoparsec                  (36) aeson                       
(37) MonadCatchIO-transformers   

> indicateAuto
Missing dependencies
(1) base (*)                     (2) snap-0.12.0:old-base         (3) template-haskell             
(4) old-time                     (5) snap-0.12.0:old-base         (6) xmlhtml                      
(7) vector-algorithms            (8) vector                       (9) unordered-containers         
(10) transformers                (11) time                        (12) text                        
(13) syb                         (14) stm                         (15) snap-server                 
(16) snap-core                   (17) regex-posix                 (18) pwstore-fast                
(19) mwc-random                  (20) mtl                         (21) logict                      
(22) heist                       (23) hashable                    (24) filepath                    
(25) errors                      (26) dlist                       (27) directory-tree              
(28) directory                   (29) containers                  (30) configurator                
(31) comonad                     (32) clientsession               (33) cereal                      
(34) bytestring                  (35) attoparsec                  (36) aeson                       
(37) MonadCatchIO-transformers   

> prefer stm
Missing dependencies
(1) stm                          (2) base (*)                     (3) snap-0.12.0:old-base         
(4) template-haskell             (5) old-time                     (6) snap-0.12.0:old-base         
(7) xmlhtml                      (8) vector-algorithms            (9) vector                       
(10) unordered-containers        (11) transformers                (12) time                        
(13) text                        (14) syb                         (15) snap-server                 
(16) snap-core                   (17) regex-posix                 (18) pwstore-fast                
(19) mwc-random                  (20) mtl                         (21) logict                      
(22) heist                       (23) hashable                    (24) filepath                    
(25) errors                      (26) dlist                       (27) directory-tree              
(28) directory                   (29) containers                  (30) configurator                
(31) comonad                     (32) clientsession               (33) cereal                      
(34) bytestring                  (35) attoparsec                  (36) aeson                       
(37) MonadCatchIO-transformers   

> indicateAuto
Missing dependencies
(1) stm (*)                      (2) base                         (3) snap-0.12.0:old-base         
(4) template-haskell             (5) old-time                     (6) snap-0.12.0:old-base         
(7) xmlhtml                      (8) vector-algorithms            (9) vector                       
(10) unordered-containers        (11) transformers                (12) time                        
(13) text                        (14) syb                         (15) snap-server                 
(16) snap-core                   (17) regex-posix                 (18) pwstore-fast                
(19) mwc-random                  (20) mtl                         (21) logict                      
(22) heist                       (23) hashable                    (24) filepath                    
(25) errors                      (26) dlist                       (27) directory-tree              
(28) directory                   (29) containers                  (30) configurator                
(31) comonad                     (32) clientsession               (33) cereal                      
(34) bytestring                  (35) attoparsec                  (36) aeson                       
(37) MonadCatchIO-transformers   

> goto dlist
dlist (needed by snap-0.12.0)
(1) 0.5 (*)    (2) 0.4.1 (F)  (3) 0.4 (F)    (4) 0.3.2 (F)  (5) 0.3.1 (F)  (6) 0.3 (F)    (7) 0.2 (F)    

> 1
Missing dependencies
(1) dlist-0.5:applicative-in-base (*)  (2) dlist-0.5:applicative-in-base      
(3) directory-tree                     (4) directory                          
(5) containers                         (6) configurator                       
(7) comonad                            (8) clientsession                      
(9) cereal                             (10) bytestring                        
(11) attoparsec                        (12) aeson                             
(13) MonadCatchIO-transformers         

> auto
Created a valid installplan. 
Type install to install, or showPlan to review
No choices left
> 

Thursday, June 13, 2013

The Interactive Solver

So, I have coerced haskeline into giving me a IDE.

Here is a little demonstration of what it can do so far.

First you can search the tree yourself, using 'go n' and 'up'. (This becomes very tedious very quickly)

On the other end of the spectrum, you can type 'auto' and have the dependency solver solve it for you.

However, one of the more interesting commands lies in between.

Suppose you wanted to install 'async', but you would like to enable the test-stanza, and
have your favourite version of stm which you would really like to use.

Then the following session would seem realistic:

  [hsenv]martin@office:~$ cabal install async --interactive 
  Resolving dependencies...
  Welcome to cabali!
  go n                -- chooses n - alternatively "n" does the same
  up                  -- goes up one step
  top                 -- goes all the way to the top
  autoLog             -- prints the log of an automated run
  auto                -- starts the automatic solver
  goto aeson          -- runs the parser until it sets aeson's version
  got aeson:developer -- runs the parser until it sets the flag developer for aeson
  ;                   -- chains commands (e.g. 1;1;1;top does nothing)
  Node: GoalChoice
  Choices: 
 (1)  OpenGoal: async 
  
  > goto async:test | stm
  Node: SChoice: QSN: async-2.0.1.4:test
    QGoalReason: PDependency (depended by): async-2.0.1.4
    Bool False
  Choices: 
  (1)  False 
  (2)  True 

  > 2
  Node: GoalChoice
  Choices: 
  (1)  OpenGoal: HUnit 
  (2)  OpenGoal: test-framework-hunit 
  (3)  OpenGoal: test-framework 
  (4)  OpenGoal: stm 

  > goto async:test | stm
  Node: PChoice: QPN: stm
    QGoalReason: PDependency (depended by): async-2.0.1.4
  Choices: 
  (1)  Version 2.4.2 (Installed) 
  (2)  Version 2.4.2 
  (3)  Version 2.4 
  (4)  Version 2.3 
  (5)  Version 2.2.0.1 
  (6)  Version 2.2.0.0 
  (7)  Version 2.1.2.2  (fails)
  (8)  Version 2.1.2.1  (fails)
  (9)  Version 2.1.2.0  (fails)
  (10)  Version 2.1.1.2  (fails)
  (11)  Version 2.1.1.0  (fails)
  (12)  Version 2.1  (fails)
 
  > 4
  Node: GoalChoice
  Choices: 
  (1)  OpenGoal: stm-2.3:base4 
  (2)  OpenGoal: stm-2.3:base4 
  
  > auto
  Node: Done! 
  RevDepMap: 
  HUnit: ["test-framework-hunit","async"]
  ansi-terminal: ["ansi-wl-pprint","ansi-wl-pprint","test-framework"]
  ansi-wl-pprint: ["test-framework"]
  array: ["stm","regex-base","regex-posix","text","containers","deepseq"]
  async: []
  base: ["stm","stm","stm","unix","ansi-terminal","ansi-terminal","ansi-wl-pprint","ansi-wl-pprint","transformers","mtl","regex-base","regex-posix","old-locale","time","bytestring","text","xml","hostname","random","containers","test-framework","extensible-exceptions","test-framework-hunit","array","deepseq","HUnit","HUnit","HUnit","async","async"]
  bytestring: ["unix","regex-base","regex-posix","text","xml"]
  containers: ["regex-base","regex-posix","test-framework"]
  deepseq: ["time","bytestring","text","containers","HUnit"]
  extensible-exceptions: ["test-framework","test-framework-hunit"]
  ghc-prim: ["bytestring","text","containers","integer-gmp","base"]
  hostname: ["test-framework"]
  integer-gmp: ["text","base"]
  mtl: ["regex-base"]
  old-locale: ["time","test-framework"]
  random: ["test-framework"]
  regex-base: ["regex-posix"]
  regex-posix: ["test-framework"]
  rts: ["ghc-prim","base"]
  stm: ["async"]
  test-framework: ["test-framework-hunit","async"]
  test-framework-hunit: ["async"]
  text: ["xml"]
  time: ["unix","random","test-framework"]
  transformers: ["mtl"]
  unix: ["ansi-terminal","ansi-terminal"]
  xml: ["test-framework"]
 
  Choices: 
  None
  > install
  Ooops.. not implemented yet.
  > 
  

By the way, suggestions for features are always welcome!

The next big thing to work on is to make it friendlier, with less distracting output.


If you would like to try this out for yourself, here is how that would work:

  $ git clone https://github.com/mr-/cabal
  $ cd cabal
  $ hsenv
  $ source .hsenv/bin/activate
  $ cd Cabal
  $ cabal install
  $ cd ../cabal-install
  $ cabal install
  $ cabal install async --interactive

Have fun!

Friday, June 7, 2013

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..

Thursday, June 6, 2013

The Queens Problem

Before I started hacking on cabal, I wanted to look at a simpler version of the problem.
I decided to write the interactive part for the queens problem.

If you care to see the code, you can find it at https://github.com/mr-/hsQueens 

The queens problem consists of a chess board of size n and m queens. The challenge is to place the queens on the board so that no queen is endangered.

In the program I decided to represent a queen by its position:
type Piece = (Int, Int)
and the board is a list of pieces:
type Board = [Piece]
From this I (lazily) built a tree, where each node is a board. It has as root the empty board, on the first level are all the boards with one piece, on the second are all the boards with two pieces, and so on.

Then I prune the tree, removing all the boards that are inconsistent in the sense that queens are unsafe.
Afterwards comes a (rather stupid) heuristics phase, which sorts the choices by the number of their children. Even though it is so simple, it managed to reduce computation time by quite a bit.

Now, to solve the problem for m queens, you just have to DFS the tree till you find a board that has at least m queens.

Walking the tree is done using Data.Tree.Zipper, which works using trees from Data.Tree.

I have implemented the following commands:
go n       --   takes the n'th choice (Choices are given as n: Piece)
auto n    --   tries to find a board with n queens, given the current choices
up          --   goes up in the tree, i.e. reverts the last choice
          top         --   goes all the way to the root

These commands can be joined using ",". so "go 0, up" would do nothing.


Wrapping it into an UI using haskeline, it looks like that:


  martin@office:~$ hsQueens 4

  ....
  ....
  ....
  ....


  0:(2,2) 1:(2,3) 2:(3,2) 3:(3,3) 4:(1,1) 5:(1,2) 6:(1,3) 7:(1,4) 
  8:(2,1) 9:(2,4) 10:(3,1) 11:(3,4) 12:(4,1) 13:(4,2) 14:(4,3) 
  15:(4,4) 
  17:08:43> go 0
  ....
  .♛..
  ....
  ....


  0:(1,4) 1:(3,4) 2:(4,1) 3:(4,3) 
  17:08:46> go 1
  ....
  .♛..
  ....
  ..♛.


  0:(4,1) 
  17:08:47> up
  ....
  .♛..
  ....
  ....


  0:(1,4) 1:(3,4) 2:(4,1) 3:(4,3) 
  17:08:51> auto 4
  Nothing found
  17:08:54> auto 3
  ....
  .♛..
  ...♛
  ♛...

That's it. The next post will be about cabal-install's tree and its zipper.

Improve the feedback of the cabal-install dependency solver

My project has been selected!

There are exciting times lying ahead! :-)

In the proposal I promised to have my code and progress visible on github, so here it is,
my fork: https://github.com/mr-/cabal

The first milestones of my proposal concern the interactive dependency solver.
So that's what I will be blogging about in the next couple of weeks.

See you then!