From e8b73f47aa5b0791c96139a171cb0d8bb73d3207 Mon Sep 17 00:00:00 2001 From: "Rune K. Svendsen" Date: Fri, 27 Oct 2023 14:46:10 +0200 Subject: [PATCH] WIP: Something broke test "strict ByteString to lazy Text" --- cabal.project | 2 +- src/lib/MyLib.hs | 71 +++++++++++++++++++++++++++--------------------- test/Spec.hs | 10 ++++--- 3 files changed, 47 insertions(+), 36 deletions(-) diff --git a/cabal.project b/cabal.project index 76262f6..466662c 100644 --- a/cabal.project +++ b/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 diff --git a/src/lib/MyLib.hs b/src/lib/MyLib.hs index a5f4004..1ffe722 100644 --- a/src/lib/MyLib.hs +++ b/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,40 +389,56 @@ 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 @@ -436,7 +446,6 @@ querySingleResult , 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 diff --git a/test/Spec.hs b/test/Spec.hs index 5d50b05..e1f9111 100644 --- a/test/Spec.hs +++ b/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)