haskell / haskell/cabal

Support for `--dump-dot-install-plan <outfile>` in `cabal install`

Open
#2,728 9 comments 0 reactions 0 assignees View on GitHub
blocked: decision-needed type: enhancement
Dominant language
Haskell
Stars
1.7k
Forks
750
Avg merge
4d 3h
Merged PRs (30d)
28

Description

I've made some progress regarding https://github.com/haskell/cabal/pull/2569#issuecomment-98603278:

The straw-man implementation below generates GraphViz output (even more below) showing
- packages to be installed (with non-default flag-assignments) as solid boxes
- packages already installed (which belong to the current install-plan)
- inter-package dependencies

This exposes all information I need to fully describe (and reproduce) an install-plan, going beyond `cabal freeze`, as well as providing me with me a more complete graph than what is compactly provided already by #2569

However, I'm a bit stuck on how to retrieve flag assignments of pre-existing/installed packages... as that information is needed to pin down any degree of freedom the solver may have... :-/

``` haskell
-- | Dumps the full install-plan graphviz digraph to dotfile
dumpPlan :: Verbosity -> FilePath -> InstallPlan -> IO ()
dumpPlan _verbosity dotfile installPlan =
writeFile dotfile $
unlines (["digraph {"] ++ concatMap dumpPkg (InstallPlan.toList installPlan) ++ ["}"])
where
dumpPkg pkg = nodeSpec : depSpecs
where
nodeSpec = concat [ "\"", pkgn, "\" [", style, "shape=box,label=\"", lab, "\"];" ]

depSpecs = [ concat [ "\"", pkgn, "\"", " -> ", "\"", display (packageName dep), "\"", ";" ]
| dep <- depends pkg
]

lab = display (packageId pkg) ++ flgs
pkgn = display (packageName pkg)
(style,flgs) = case pkg of
InstallPlan.PreExisting _ -> do
("style=dashed,","") -- FIXME: any way to retrieve flag assignments of installed packages?
InstallPlan.Configured cpkg ->
("",showFlagAssignment (nonDefaultFlags cpkg))
_ -> error "dumpPlan: the impossible happened"

showFlagAssignment :: FlagAssignment -> String
showFlagAssignment = concatMap (("\\n" ++) . showFlagValue)
showFlagValue (FlagName f, True) = '+' : f
showFlagValue (FlagName f, False) = '-' : f

toFlagAssignment :: [Flag] -> FlagAssignment
toFlagAssignment = map (\ f -> (flagName f, flagDefault f))

nonDefaultFlags :: ConfiguredPackage -> FlagAssignment
nonDefaultFlags (ConfiguredPackage spkg fa _ _) =
let defaultAssignment =
toFlagAssignment
(genPackageFlags (Source.packageDescription spkg))
in fa \\ defaultAssignment
```

![installplan](https://cloud.githubusercontent.com/assets/285533/8768193/6ad0095c-2e77-11e5-9353-fa22224b24d2.png)

/cc @kosmikus @dcoutts @23Skidoo

Contributor guide

Open the contributing guide

Assessment

This issue has not been assessed yet.

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.