Log soft dependencies as "A -S> B" and parse them in the visualizer.

4 files changed, 15 insertions, 10 deletions

diff --git a/tools/resolver-visualize/Main.hs b/tools/resolver-visualize/Main.hs
index 93ed9b71..dfc17ff1 100755
--- a/tools/resolver-visualize/Main.hs
+++ b/tools/resolver-visualize/Main.hs
@@ -458,7 +458,10 @@ instance PP Package where
     ppS (Package pkgName) = (unpack pkgName++)
 
 instance PP Dep where
-    ppS (Dep src solvers) = ppS src . (" -> {"++) . (\x -> foldr (++) x $ intersperse ", " $ map pp solvers) . ('}':)
+    ppS (Dep src solvers isSoft) = let arrow = if isSoft
+                                               then " -S> {"
+                                               else " -> {" in
+                                   ppS src . (arrow++) . (\x -> foldr (++) x $ intersperse ", " $ map pp solvers) . ('}':)
 
 pp x = ppS x ""
 
diff --git a/tools/resolver-visualize/Resolver/Log.hs b/tools/resolver-visualize/Resolver/Log.hs
index 597d8430..5c741648 100644
--- a/tools/resolver-visualize/Resolver/Log.hs
+++ b/tools/resolver-visualize/Resolver/Log.hs
@@ -603,7 +603,7 @@ forceEverything a =
           ()
       forceSol sol = ()
       forcePromotion p = ()
-      forceDep (Dep source solvers) = forceMap forceVersion solvers `seq` forceVersion source `seq` ()
+      forceDep (Dep source solvers isSoft) = forceMap forceVersion solvers `seq` forceVersion source `seq` isSoft `seq` ()
       forceChoice (InstallVersion ver dep fromDepSource) =
           forceVersion ver `seq` forceMaybe forceDep dep `seq` forceMaybe id fromDepSource `seq` ()
       forceChoice (BreakSoftDep dep) =
diff --git a/tools/resolver-visualize/Resolver/Parse.hs b/tools/resolver-visualize/Resolver/Parse.hs
index 9775419f..bee72f17 100644
--- a/tools/resolver-visualize/Resolver/Parse.hs
+++ b/tools/resolver-visualize/Resolver/Parse.hs
@@ -102,12 +102,12 @@ instance Internable Version where
            versions' `seq` (pkgName $ verPkg rval) `seq` verName rval `seq` return rval
 
 instance Internable Dep where
-    intern d@(Dep source solvers) =
+    intern d@(Dep source solvers isSoft) =
         do source'  <- intern source
            solvers' <- sequence $ map intern solvers
            st       <- getState
            let deps              = internedDeps st
-               (deps', rval)     = doIntern deps d (Dep source' solvers')
+               (deps', rval)     = doIntern deps d (Dep source' solvers' isSoft)
            putState st { internedDeps = deps' }
            deps' `seq` (pkgName $ verPkg $ depSource rval) `seq` (verName $ depSource rval)
                  `seq` (seqList $ depSolvers rval) `seq` return rval
@@ -243,17 +243,18 @@ package = packageWithoutTerminators []
 -- | A dependency looks like this: version -> { ver ver ver }
 depWithoutTerminators :: [Parser t] -> Parser Dep
 depWithoutTerminators terminators =
-    (do let term'  = [t >> return () | t <- terminators]
-            arrow  = symbol "->"
+    (do let term'     = [t >> return () | t <- terminators]
+            arrow     = char '-' >> ((char '>' >> spaces >> return False) <|>
+                                     (char 'S' >> char '>' >> spaces >> return True))
         source <- versionWithoutTerminators $ (try arrow >> return ()):term'
-        arrow
+        soft   <- arrow
         leftBrace
         -- Throw away the input terminators and just use } instead,
         -- since we have a balanced group.  e.g., this means that in
         -- [a -> {b [UNINST]}] everything parses correctly.
         solvers <- lexeme $ manyTill (versionWithoutTerminators [rightBrace]) (try rightBrace)
-        rval <- intern $ Dep { depSource = source, depSolvers = solvers }
-        source `seq` seqList solvers `seq` return rval) <?> "dependency"
+        rval <- intern $ Dep { depSource = source, depSolvers = solvers, depIsSoft = soft }
+        source `seq` seqList solvers `seq` soft `seq` return rval) <?> "dependency"
 
 dep :: Parser Dep
 dep = depWithoutTerminators []
diff --git a/tools/resolver-visualize/Resolver/Types.hs b/tools/resolver-visualize/Resolver/Types.hs
index a01db531..92bc7021 100644
--- a/tools/resolver-visualize/Resolver/Types.hs
+++ b/tools/resolver-visualize/Resolver/Types.hs
@@ -30,7 +30,8 @@ data Version = Version { -- | The package that this version is
 data Dep = Dep { -- | The version that declares this dependency.
                  depSource :: Version,
                  -- | A list of versions that solve this dependency.
-                 depSolvers :: [Version] }
+                 depSolvers :: [Version],
+                 depIsSoft :: Bool}
          deriving(Ord, Eq, Show)