WIP: Something broke test "strict ByteString to lazy Text"

cabal.project

@@ -9,7 +9,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/runeksvendsen/bellman-ford.git
-    tag: 3b3c720e152a2e6248971d6dd183acd5d63dbe6a
+    tag: e27303d32241058cd99d57f54d5ceb4d9ab23d36
 
 source-repository-package
     type: git

src/lib/MyLib.hs

@@ -44,9 +44,9 @@ import Data.Functor ((<&>))
 import qualified Codec.Binary.UTF8.String as UTF8
 import qualified Control.Monad.ST as ST
 import Data.String (IsString)
-import Control.Monad (forM_, unless, guard)
-import Debug.Trace (traceM)
-import Data.List (intersperse, foldl', sortOn)
+import Control.Monad (forM_, unless, guard, forM)
+import Debug.Trace (traceM, trace)
+import Data.List (intersperse, foldl', sortOn, subsequences)
 import Data.Containers.ListUtils (nubOrdOn)
 import qualified Data.STRef as STM
 import qualified Data.List.NonEmpty as NE
@@ -113,7 +113,7 @@ spTreePathsCount = do
 
 functionWeight :: (FullyQualifiedType, FullyQualifiedType) -> TypedFunction -> Double
 functionWeight (src, dst) function
-  | srcPkg == fnPkg || dstPkg == fnPkg = 0
+  | srcPkg == fnPkg || dstPkg == fnPkg = 0.5
   | otherwise = 1
   where
     fnPkg = _function_package function
@@ -125,7 +125,7 @@ runQueryAll
   -> (DG.IDigraph FullyQualifiedType (NE.NonEmpty TypedFunction))
   -> [[TypedFunction]]
 runQueryAll maxCount (src, dst) graph =
-  ST.runST $ runQueryAllST maxCount (src, dst) graph
+  ST.runST $ DG.thaw graph >>= runQueryAllST maxCount (src, dst)
 
 -- | Build an immutable graph
 buildGraph
@@ -195,7 +195,7 @@ buildGraphMut declarationMapJsonList = do
 runQueryAllST
   :: Int
   -> (FullyQualifiedType, FullyQualifiedType)
-  -> (DG.IDigraph FullyQualifiedType (NE.NonEmpty TypedFunction))
+  -> (DG.Digraph s FullyQualifiedType (NE.NonEmpty TypedFunction))
   -> ST s [[TypedFunction]]
 runQueryAllST maxCount (src, dst) graph = do
   res <- queryAll weightCombine' initialWeight src dst dispFun maxCount graph
@@ -211,7 +211,7 @@ runQueryAllST maxCount (src, dst) graph = do
 
     dispFun fns =
       if debug
-        then show (length fns) <> ": " <> disp' fns
+        then show (length fns) <> ":\n" <> disp' fns
         else ""
 
     disp' :: [NE.NonEmpty (Function typeSig)] -> String
@@ -236,7 +236,7 @@ runQuerySingleResultST (src, dst) =
 
 -- TODO: why not 0?
 initialWeight :: Double
-initialWeight = 1
+initialWeight = 0
 
 weightCombine
   :: (FullyQualifiedType, FullyQualifiedType)
@@ -249,12 +249,6 @@ weightCombine (src, dst) w functions =
     edgeWeightNE =
       minimum $ map (functionWeight (src, dst)) (NE.toList functions)
 
-instance DG.HasWeight (Function typeSig) Double where
-  weight = const 1
-
-instance DG.HasWeight (NE.NonEmpty (Function typeSig)) Double where
-  weight = const 1
-
 -- | A function that takes a single non-function argument and returns a non-function value.
 --
 -- Generic over type signature.
@@ -395,48 +389,63 @@ queryAll
      , Show v
      , Show meta
      , Eq meta
-     , DG.HasWeight meta Double, DG.HasWeight (NE.NonEmpty meta) Double)
+     )
   => (Double -> NE.NonEmpty meta -> Double)
   -> Double
   -> v -- ^ src
   -> v -- ^ dst
   -> ([NE.NonEmpty meta] -> String)
   -> Int -- ^ max number of results
-  -> DG.IDigraph v (NE.NonEmpty meta)
+  -> DG.Digraph s v (NE.NonEmpty meta)
   -> ST.ST s [[DG.IdxEdge v (NE.NonEmpty meta)]]
 queryAll f w src dst disp maxCount graph = fmap (filter $ not . null) $ do
   resultRef <- STM.newSTRef (0, [])
-  go resultRef graph
+  go resultRef
   reverse . snd <$> STM.readSTRef resultRef
   where
-    getResult g = querySingleResult f w src dst g
+    f' a b =
+      let newWeight = f a b
+      in -- trace (unwords ["Old weight:", show a, "New weight:", show newWeight, "Edges:", disp [b]] )
+         newWeight
 
-    go resultRef ig = do
+    getResult = querySingleResult f' w src dst graph
+
+    go resultRef = do
       let whenMissingResults action = do
             (count', _) <- STM.readSTRef resultRef
             unless (count' >= maxCount) action
-      res <- DG.thaw ig >>= getResult
-      case res of
+          accumulateResult res = do
+            STM.modifySTRef' resultRef $ \(!count', !res') ->
+              (count' + 1, res : res')
+            let traceStr = disp (map DG.eMeta res)
+            unless (null traceStr) $ traceM traceStr
+
+      mPath <- getResult
+      case mPath of
         Nothing -> pure () -- no path
         Just [] -> pure () -- src == dst
         Just path -> do
-          STM.modifySTRef' resultRef $ \(!count', !res') -> (count' + 1, path : res')
-          let traceStr = disp (map DG.eMeta path)
-          unless (null traceStr) $ traceM traceStr
-          forM_ path $ \edge -> do
+          accumulateResult path
+
+          forM_ (nonEmptySubsequences path) $ \edges -> do
             whenMissingResults $ do
-              g' <- DG.thaw ig
-              DG.removeEdge g' edge
-              ig' <- DG.freeze g'
-              go resultRef ig'
+              forM_ edges (DG.removeEdge graph)
+              mRes <- getResult
+              forM_ mRes accumulateResult
+              forM_ edges (DG.insertEdge graph)
+
+          whenMissingResults $ do
+            forM_ path (DG.removeEdge graph)
+            go resultRef
+
+    nonEmptySubsequences = tail . subsequences
 
 querySingleResult
   :: ( Ord v
      , Hashable v
      , Show v
      , Show meta
      , Eq meta
-     , DG.HasWeight (NE.NonEmpty meta) Double
      )
   => (Double -> NE.NonEmpty meta -> Double)
   -> Double
@@ -461,7 +470,7 @@ type Meta = TypedFunction
     -> Vertex
     -> ([NE.NonEmpty Meta] -> String)
     -> Int
-    -> DG.IDigraph Vertex (NE.NonEmpty Meta)
+    -> DG.Digraph s Vertex (NE.NonEmpty Meta)
     -> ST.ST s [[DG.IdxEdge Vertex (NE.NonEmpty Meta)]] #-}
 
 {-# SPECIALISE

test/Spec.hs

@@ -13,6 +13,7 @@ import Data.Maybe (fromMaybe)
 import qualified Data.ByteString.Char8 as BSC8
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Set as Set
+import qualified Debug.Trace
 
 testDataFileName :: FilePath
 testDataFileName = "data/all3.json"
@@ -21,7 +22,7 @@ main :: IO ()
 main = MyLib.withGraphFromFile testDataFileName $ \graph -> do
   let getResults' maxCount = map (PPFunctions . map void) . getResults maxCount graph
       testCase maxCount (from, to) expectedList =
-        HSpec.it (unwords [snd from, "to", snd to, "(max:", show maxCount <> ")"]) $ do
+        HSpec.it (unwords [snd from, "to", snd to]) $ do
           getResults' maxCount (fst from, fst to)
             `isSupersetOf`
               fns expectedList
@@ -34,7 +35,7 @@ main = MyLib.withGraphFromFile testDataFileName $ \graph -> do
         testCase 1
           (string, strictByteString)
           ["bytestring-0.11.4.0:Data.ByteString.Char8.pack"]
-        testCase 30
+        testCase 15
           (lazyText, strictByteString)
           [ "bytestring-0.11.4.0:Data.ByteString.Char8.pack . text-2.0.2:Data.Text.Lazy.unpack"
           , "text-2.0.2:Data.Text.Encoding.encodeUtf16BE . text-2.0.2:Data.Text.Lazy.toStrict"
@@ -44,7 +45,7 @@ main = MyLib.withGraphFromFile testDataFileName $ \graph -> do
           , "bytestring-0.11.4.0:Data.ByteString.toStrict . text-2.0.2:Data.Text.Lazy.Encoding.encodeUtf32BE"
           , "bytestring-0.11.4.0:Data.ByteString.toStrict . text-2.0.2:Data.Text.Lazy.Encoding.encodeUtf8"
           ]
-        testCase 45
+        testCase 50
           (strictByteString, lazyText)
           [ "text-2.0.2:Data.Text.Lazy.pack . bytestring-0.11.4.0:Data.ByteString.Char8.unpack"
           , "text-2.0.2:Data.Text.Lazy.fromStrict . text-2.0.2:Data.Text.Encoding.decodeASCII"
@@ -87,4 +88,5 @@ isSupersetOf :: (Show a, Ord a) => [a] -> [a] -> IO ()
 isSupersetOf superSetLst subSetLst =
   let superSet = Set.fromList superSetLst
       subSet = Set.fromList subSetLst
-  in Set.intersection superSet subSet `shouldBe` subSet
+  in -- Debug.Trace.trace (unlines $ map show superSetLst)
+  (Set.intersection superSet subSet `shouldBe` subSet)