diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,14 +3,17 @@ This is a utility that provides a variety of statistics about your Haskell project. These include: -- A list of type signatures that are shared among multiple functions, - enumerating those functions along with their definition sites. +- A list of type signatures that are shared among multiple locally defined + functions, enumerating those functions along with their definition sites. - Lists of the most used and least used definitions in the project. - A breakdown of local definitions, telling you the number of each type of definition as well as how many lines of code they take up. ## Using inventory +Install with `stack update && stack install inventory` or `cabal update && +cabal install inventory`. + Inventory uses `.hie` files to gather information about all haskell files in the project. Once you have generated `.hie` files for your project, execute `inventory` from your project's root. @@ -49,6 +52,10 @@ stack build ``` +By default `inventory` looks for HIE files in the `.hie` directory. You can +override this using the `HIE_DIR` environment variable: `HIE_DIR=path/to/dir +inventory`. + ## Examples Here are some excerpts of the output that was produced by running `inventory` @@ -69,7 +76,9 @@ ### Known Issues/Limitations - Context such as constraints and foralls do not appear in the printed type - signatures. + signatures for GHC versions less than 9.0.1. - Standalone kind signatures are not yet included in definition counts. -- GHC versions other than 8.8 and 8.10 are not currently supported. - Does not unfold type synonyms when comparing type signatures. +- GHC versions other than 8.8, 8.10, and 9.0 are not currently supported. +- You may encounter errors if the version of GHC used to compile `inventory` is + different from the version used to compile your project. diff --git a/inventory.cabal b/inventory.cabal --- a/inventory.cabal +++ b/inventory.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 5170dfcf2cd239f3acaa89982a23f501fd0928316833b05a3c3aa0d6364032d7 +-- hash: fee986bf906b9590bf18ee9a5c29116d193fe782a4027076edfdc92f4e418ce3 name: inventory -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Project statistics and definition analysis description: Please see the README on GitHub at category: Utility @@ -18,7 +18,7 @@ copyright: 2021 Aaron Allen license: BSD3 license-file: LICENSE -tested-with: ghc ==8.8.4 ghc ==8.10.3 +tested-with: GHC ==8.8.4 || ==8.10.4 || ==9.0.1 build-type: Simple extra-source-files: README.md @@ -32,7 +32,9 @@ exposed-modules: DefCounts.Output DefCounts.ProcessHie + GHC.Api GHC.DynFlags + GHC.Output HieFile MatchSigs.Matching MatchSigs.Matching.Env @@ -51,11 +53,11 @@ build-depends: appendmap >=0.1.5 && <0.2 , base >=4.7 && <5 - , bytestring >=0.10.12 && <0.11 + , bytestring >=0.10.10 && <0.11 , containers >=0.6.2 && <0.7 , directory >=1.3.6 && <1.4 , filepath >=1.4.2 && <1.5 - , ghc >=8.8 && <8.11 + , ghc >=8.8 && <9.1 , ghc-paths >=0.1.0 && <0.2 , mtl >=2.2.2 && <2.3 default-language: Haskell2010 @@ -70,11 +72,11 @@ build-depends: appendmap >=0.1.5 && <0.2 , base >=4.7 && <5 - , bytestring >=0.10.12 && <0.11 + , bytestring >=0.10.10 && <0.11 , containers >=0.6.2 && <0.7 , directory >=1.3.6 && <1.4 , filepath >=1.4.2 && <1.5 - , ghc >=8.8 && <8.11 + , ghc >=8.8 && <9.1 , ghc-paths >=0.1.0 && <0.2 , inventory , mtl >=2.2.2 && <2.3 @@ -112,11 +114,11 @@ build-depends: appendmap >=0.1.5 && <0.2 , base >=4.7 && <5 - , bytestring >=0.10.12 && <0.11 + , bytestring >=0.10.10 && <0.11 , containers >=0.6.2 && <0.7 , directory >=1.3.6 && <1.4 , filepath >=1.4.2 && <1.5 - , ghc >=8.8 && <8.11 + , ghc >=8.8 && <9.1 , ghc-paths >=0.1.0 && <0.2 , inventory , mtl >=2.2.2 && <2.3 diff --git a/src/DefCounts/Output.hs b/src/DefCounts/Output.hs --- a/src/DefCounts/Output.hs +++ b/src/DefCounts/Output.hs @@ -9,9 +9,7 @@ import Data.Monoid import Text.Printf -import Outputable -import PprColour - +import GHC.Output import DefCounts.ProcessHie (DefCounter, DefType(..)) defCountOutput :: DefCounter -> Sum Int -> SDoc diff --git a/src/DefCounts/ProcessHie.hs b/src/DefCounts/ProcessHie.hs --- a/src/DefCounts/ProcessHie.hs +++ b/src/DefCounts/ProcessHie.hs @@ -10,9 +10,7 @@ import qualified Data.Map.Strict as M import Data.Monoid -import HieTypes -import SrcLoc - +import GHC.Api import Utils -- TODO standalone kind sigs @@ -56,7 +54,7 @@ | otherwise = foldMap ( foldMap (foldMap tyDeclLines . identInfo) . nodeIdentifiers - . nodeInfo ) + . getNodeInfo ) $ nodeChildren node numLines :: Span -> Sum Int diff --git a/src/GHC/Api.hs b/src/GHC/Api.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Api.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE CPP #-} +module GHC.Api + ( module X + ) where + +#if __GLASGOW_HASKELL__ >= 900 + +import GHC.Core.TyCo.Rep as X +import GHC.Data.FastString as X +import GHC.Driver.Session as X +import GHC.Iface.Env as X +import GHC.SysTools as X +import GHC.Types.Name as X +import GHC.Types.Name.Cache as X +import GHC.Types.SrcLoc as X +import GHC.Types.Unique.Supply as X +import GHC.Utils.Misc as X + +import GHC.Iface.Ext.Binary as X +import GHC.Iface.Ext.Types as X +import GHC.Iface.Ext.Utils as X + +#else + +import DynFlags as X +import FastString as X +import Name as X +import NameCache as X +import SrcLoc as X +import SysTools as X +import TyCoRep as X +import UniqSupply as X +import Util as X + +import HieBin as X +import HieTypes as X +import HieUtils as X + +#endif diff --git a/src/GHC/DynFlags.hs b/src/GHC/DynFlags.hs --- a/src/GHC/DynFlags.hs +++ b/src/GHC/DynFlags.hs @@ -3,10 +3,8 @@ ( baseDynFlags, ) where -import DynFlags hiding (settings) +import GHC.Api hiding (settings) import GHC.Paths (libdir) -import SysTools -import Util fakeLlvmConfig :: LlvmConfig fakeLlvmConfig = diff --git a/src/GHC/Output.hs b/src/GHC/Output.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Output.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE CPP #-} +module GHC.Output + ( module X + , Mode(..) + ) where + +#if __GLASGOW_HASKELL__ >= 900 + +import GHC.Utils.Outputable as X +import GHC.Utils.Ppr (Mode(..)) +import GHC.Utils.Ppr.Colour as X + +#else + +import Outputable as X +import PprColour as X +import Pretty (Mode(..)) + +#endif diff --git a/src/HieFile.hs b/src/HieFile.hs --- a/src/HieFile.hs +++ b/src/HieFile.hs @@ -1,28 +1,29 @@ +{-# LANGUAGE CPP #-} module HieFile ( Counters , getCounters , hieFileToCounters + , hieFilesFromPaths , mkNameCache ) where import Control.Exception (onException) import Control.Monad.State +#if __GLASGOW_HASKELL__ < 900 import Data.Bifunctor +#endif import qualified Data.ByteString.Char8 as BS +#if __GLASGOW_HASKELL__ >= 900 +import Data.IORef +#endif import Data.Maybe import Data.Monoid import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, doesPathExist, listDirectory, withCurrentDirectory) import System.Environment (lookupEnv) import System.FilePath (isExtensionOf) -import DynFlags (DynFlags) -import HieBin -import HieTypes -import HieUtils -import NameCache -import UniqSupply (mkSplitUniqSupply) - import DefCounts.ProcessHie +import GHC.Api hiding (hieDir) import MatchSigs.ProcessHie import UseCounts.ProcessHie import Utils @@ -55,15 +56,34 @@ getHieFiles :: IO [HieFile] getHieFiles = do hieDir <- fromMaybe ".hie" <$> lookupEnv "HIE_DIR" - let notPathsFile = (/= "Paths_") . take 6 - filePaths <- filter notPathsFile <$> getHieFilesIn hieDir + filePaths <- getHieFilesIn hieDir `onException` error "HIE file directory does not exist" + when (null filePaths) . error $ "No HIE files found in dir: " <> hieDir + hieFiles <- hieFilesFromPaths filePaths + let srcFileExists = doesPathExist . hie_hs_file + filterM srcFileExists hieFiles + +#if __GLASGOW_HASKELL__ >= 900 + +hieFilesFromPaths :: [FilePath] -> IO [HieFile] +hieFilesFromPaths filePaths = do + nameCacheRef <- newIORef =<< mkNameCache + let updater = NCU $ atomicModifyIORef' nameCacheRef + traverse (fmap hie_file_result . readHieFile updater) + filePaths + +#else + +hieFilesFromPaths :: [FilePath] -> IO [HieFile] +hieFilesFromPaths filePaths = do nameCache <- mkNameCache evalStateT (traverse getHieFile filePaths) nameCache getHieFile :: FilePath -> StateT NameCache IO HieFile getHieFile filePath = StateT $ \nameCache -> first hie_file_result <$> readHieFile nameCache filePath + +#endif mkNameCache :: IO NameCache mkNameCache = do diff --git a/src/MatchSigs/Matching.hs b/src/MatchSigs/Matching.hs --- a/src/MatchSigs/Matching.hs +++ b/src/MatchSigs/Matching.hs @@ -5,8 +5,7 @@ import Control.Monad.State.Strict import Data.List -import Name - +import GHC.Api import MatchSigs.Matching.Env import MatchSigs.Sig diff --git a/src/MatchSigs/Output.hs b/src/MatchSigs/Output.hs --- a/src/MatchSigs/Output.hs +++ b/src/MatchSigs/Output.hs @@ -5,21 +5,21 @@ import Data.Map.Append.Strict (AppendMap(..)) import qualified Data.Map.Strict as M -import Name -import Outputable -import PprColour - +import GHC.Api hiding (count) +import GHC.Output import MatchSigs.ProcessHie (SigMap, MatchedSigs(..)) sigDuplicateOutput :: SigMap -> SDoc -sigDuplicateOutput (AppendMap m) | null m = text "(No duplicated signatures)" --- TODO check length after filtering sigDuplicateOutput (AppendMap sigMap) = - vcat . map sigLine . filter multipleNames - . concatMap getMatchedSigs - $ M.elems sigMap + if null outputLines + then text "(No duplicated signatures)" + else vcat outputLines where + outputLines = map sigLine . filter multipleNames + . concatMap getMatchedSigs + $ M.elems sigMap + multipleNames (_, _, names) = length names > 1 sigLine (_, renderedSig, names) = vcat diff --git a/src/MatchSigs/ProcessHie.hs b/src/MatchSigs/ProcessHie.hs --- a/src/MatchSigs/ProcessHie.hs +++ b/src/MatchSigs/ProcessHie.hs @@ -8,11 +8,7 @@ import qualified Data.Map.Strict as M import Data.Map.Append.Strict (AppendMap(..)) -import HieTypes -import HieUtils - -import DynFlags -import Name +import GHC.Api import MatchSigs.Matching (MatchedSigs(..)) import MatchSigs.Sig (Sig, sigFingerprint, sigsFromHie) import Utils @@ -34,11 +30,11 @@ nameSigRendered dynFlags node | nodeHasAnnotation "FunBind" "HsBindLR" node , Just ident <- mIdent - , Right name : _ <- M.keys . nodeIdentifiers $ nodeInfo ident + , Right name : _ <- M.keys . nodeIdentifiers $ getNodeInfo ident , let renderedTy = unwords . map (renderHieType dynFlags) . nodeType - $ nodeInfo node + $ getNodeInfo node = M.singleton name renderedTy | otherwise = mempty diff --git a/src/MatchSigs/Sig.hs b/src/MatchSigs/Sig.hs --- a/src/MatchSigs/Sig.hs +++ b/src/MatchSigs/Sig.hs @@ -16,10 +16,7 @@ import qualified Data.Map.Strict as M import qualified Data.Set as S -import HieTypes - -import Name -import FastString +import GHC.Api import Utils type FreeVarIdx = Int @@ -63,7 +60,7 @@ sigsFromHie node | nodeHasAnnotation "TypeSig" "Sig" node , identNode : sigNode : _ <- nodeChildren node - , Right name : _ <- M.keys . nodeIdentifiers $ nodeInfo identNode + , Right name : _ <- M.keys . nodeIdentifiers $ getNodeInfo identNode , let freeVars = extractFreeVars , let sig = evalState (mkSig sigNode) freeVars sig' | M.null freeVars = sig @@ -79,7 +76,7 @@ extractFreeVars = M.fromList . (`zip` [0..]) . rights . M.keys . nodeIdentifiers - $ nodeInfo node + $ getNodeInfo node -- | Traverses the 'HieAST', building the representation for a function sig. -- The `State` is for tracking free vars. @@ -141,7 +138,7 @@ <*> mkSig ki -- any other type - | (ty, "HsType") : _ <- S.toList . nodeAnnotations $ nodeInfo node + | (ty, "HsType") : _ <- S.toList . nodeAnnotations $ getNodeInfo node , let mbName = extractName node = do freeVars <- get @@ -156,7 +153,7 @@ where extractName :: HieAST a -> Maybe Name extractName n - | Right name : _ <- M.keys . nodeIdentifiers $ nodeInfo n + | Right name : _ <- M.keys . nodeIdentifiers $ getNodeInfo n = Just name | otherwise = Nothing @@ -170,7 +167,7 @@ -- produce one ore more Quals from a constraint node mkQuals c - | S.null . nodeAnnotations $ nodeInfo c + | S.null . nodeAnnotations $ getNodeInfo c = fmap Qual <$> traverse mkSig (nodeChildren c) | otherwise = fmap (:[]) $ Qual <$> mkSig c diff --git a/src/Output.hs b/src/Output.hs --- a/src/Output.hs +++ b/src/Output.hs @@ -1,14 +1,13 @@ +{-# LANGUAGE CPP #-} module Output ( printResults ) where -import DynFlags -import Outputable -import PprColour -import Pretty (Mode(PageMode)) import System.IO (stdout) import DefCounts.Output +import GHC.Api (DynFlags) +import GHC.Output import HieFile (Counters) import MatchSigs.Output import UseCounts.Output @@ -38,9 +37,17 @@ , text "" , separator ] - pprStyle = setStyleColoured True $ defaultUserStyle dynFlags - separator = coloured colGreenFg $ text "********************************************************************************" - printSDocLn PageMode dynFlags stdout pprStyle output + outputSDoc dynFlags output +outputSDoc :: DynFlags -> SDoc -> IO () +outputSDoc dynFlags sDoc = do +#if __GLASGOW_HASKELL__ >= 900 + let pprStyle = setStyleColoured True defaultUserStyle + sDocCtx = initSDocContext dynFlags pprStyle + printSDocLn sDocCtx PageMode stdout sDoc +#else + let pprStyle = setStyleColoured True $ defaultUserStyle dynFlags + printSDocLn PageMode dynFlags stdout pprStyle sDoc +#endif diff --git a/src/UseCounts/Output.hs b/src/UseCounts/Output.hs --- a/src/UseCounts/Output.hs +++ b/src/UseCounts/Output.hs @@ -7,10 +7,8 @@ import qualified Data.Map.Strict as M import Data.Ord (Down(..)) -import Name -import Outputable -import PprColour - +import GHC.Api (Name, pprDefinedAt) +import GHC.Output import UseCounts.ProcessHie (UsageCounter, UsageCount(..)) limit :: Int diff --git a/src/UseCounts/ProcessHie.hs b/src/UseCounts/ProcessHie.hs --- a/src/UseCounts/ProcessHie.hs +++ b/src/UseCounts/ProcessHie.hs @@ -10,9 +10,7 @@ import Data.Map.Append.Strict (AppendMap(..)) import Data.Maybe -import HieTypes - -import Name +import GHC.Api import Utils data UsageCount = @@ -37,7 +35,7 @@ <> foldMap declaration (listToMaybe $ nodeChildren node) -- only get usages from instance declarations - | any ((== "InstDecl") . snd) (nodeAnnotations $ nodeInfo node) + | any ((== "InstDecl") . snd) (nodeAnnotations $ getNodeInfo node) = foldMap findUsage (nodeChildren node) | otherwise @@ -47,9 +45,9 @@ -- | Accrues all the top-level declarations if all different types declaration :: HieAST a -> UsageCounter declaration node - | any ((== "ConDecl") . snd) (nodeAnnotations $ nodeInfo node) + | any ((== "ConDecl") . snd) (nodeAnnotations $ getNodeInfo node) = dataConDecl node -declaration node = M.foldMapWithKey f . nodeIdentifiers $ nodeInfo node +declaration node = M.foldMapWithKey f . nodeIdentifiers $ getNodeInfo node where f (Right name) details = foldMap g (identInfo details) where declare = AppendMap $ M.singleton name (UsageCount 0 True) @@ -79,7 +77,7 @@ -- | Counts up the uses of all symbols in the AST. findUsage :: HieAST a -> UsageCounter -findUsage node = (M.foldMapWithKey f . nodeIdentifiers . nodeInfo) node +findUsage node = (M.foldMapWithKey f . nodeIdentifiers . getNodeInfo) node <> foldMap findUsage (nodeChildren node) where f (Right name) details = foldMap g (identInfo details) where diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -1,18 +1,40 @@ +{-# LANGUAGE CPP #-} module Utils ( nodeHasAnnotation + , getNodeInfo , foldNodeChildren ) where +#if __GLASGOW_HASKELL__ >= 900 +import qualified Data.Map as M +#endif import qualified Data.Set as S import Data.String -import HieTypes +import GHC.Api +#if __GLASGOW_HASKELL__ >= 900 +mergeNodeInfo :: NodeInfo a -> NodeInfo a -> NodeInfo a +mergeNodeInfo (NodeInfo as ai ad) (NodeInfo bs bi bd) = + NodeInfo (as <> bs) (ai <> bi) (M.unionWith (<>) ad bd) +#endif + +-- | Extract node info for an AST. GHC 9 includes generated things that need to +-- be removed. +getNodeInfo :: HieAST a -> NodeInfo a +#if __GLASGOW_HASKELL__ >= 900 +getNodeInfo = M.foldl' mergeNodeInfo emptyNodeInfo + . M.delete GeneratedInfo -- removed ghc generated nodes + . getSourcedNodeInfo . sourcedNodeInfo +#else +getNodeInfo = nodeInfo +#endif + nodeHasAnnotation :: String -> String -> HieAST a -> Bool nodeHasAnnotation constructor ty = S.member (fromString constructor, fromString ty) . nodeAnnotations - . nodeInfo + . getNodeInfo foldNodeChildren :: Monoid m => (HieAST a -> m) -> HieAST a -> m foldNodeChildren f = foldMap f . nodeChildren diff --git a/test/HieSource/T19.hs b/test/HieSource/T19.hs --- a/test/HieSource/T19.hs +++ b/test/HieSource/T19.hs @@ -2,7 +2,7 @@ module HieSource.T19 where t19A :: forall a. a -> forall b. b -> Either a b -t19A = undefined +t19A _ _ = undefined t19B :: forall b a. a -> b -> Either a b t19B = undefined diff --git a/test/HieSource/T6.hs b/test/HieSource/T6.hs --- a/test/HieSource/T6.hs +++ b/test/HieSource/T6.hs @@ -8,4 +8,4 @@ t6B = undefined t6C :: Num b => b -> Show a => a -> (a, b) -t6C = undefined +t6C _ = undefined diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,52 +1,48 @@ +import Data.Bifunctor import Data.Map.Append.Strict (AppendMap(..)) import qualified Data.Map.Strict as M import Data.Monoid import Test.Tasty import Test.Tasty.HUnit -import DynFlags -import HieBin -import NameCache - import DefCounts.ProcessHie +import GHC.Api import GHC.DynFlags +import GHC.Output hiding ((<>)) import HieFile hiding (getCounters) import MatchSigs.ProcessHie import UseCounts.ProcessHie -getResources :: IO (NameCache, DynFlags) -getResources = (,) <$> mkNameCache <*> baseDynFlags - main :: IO () main = defaultMain $ - withResource getResources mempty $ \ioResources -> + withResource baseDynFlags mempty $ \ioResources -> testGroup "Unit Tests" [ testCase "Valid Signature Matching" $ do - (nameCache, dynFlags) <- ioResources - sigMatchTest "T1" nameCache dynFlags [2] - sigMatchTest "T2" nameCache dynFlags [2] - sigMatchTest "T3" nameCache dynFlags [2] - sigMatchTest "T4" nameCache dynFlags [2] - sigMatchTest "T5" nameCache dynFlags [2] - sigMatchTest "T6" nameCache dynFlags [3] - sigMatchTest "T7" nameCache dynFlags [2,1] - sigMatchTest "T8" nameCache dynFlags [2,2] - sigMatchTest "T9" nameCache dynFlags [3] - sigMatchTest "T10" nameCache dynFlags [5] - sigMatchTest "T11" nameCache dynFlags [1,1] - sigMatchTest "T12" nameCache dynFlags [1,1] - sigMatchTest "T13" nameCache dynFlags [2] - sigMatchTest "T14" nameCache dynFlags [1,2] - sigMatchTest "T18" nameCache dynFlags [4] - sigMatchTest "T19" nameCache dynFlags [3] - sigMatchTest "T20" nameCache dynFlags [2,1,1] - sigMatchTest "T21" nameCache dynFlags [1,1,1,1] + dynFlags <- ioResources + sigMatchTest "T1" dynFlags [2] + sigMatchTest "T2" dynFlags [2] + sigMatchTest "T3" dynFlags [2] + sigMatchTest "T4" dynFlags [2] + sigMatchTest "T5" dynFlags [2] + sigMatchTest "T6" dynFlags [3] + sigMatchTest "T7" dynFlags [2,1] + sigMatchTest "T8" dynFlags [2,2] + sigMatchTest "T9" dynFlags [3] + sigMatchTest "T10" dynFlags [5] + sigMatchTest "T11" dynFlags [1,1] + sigMatchTest "T12" dynFlags [1,1] + sigMatchTest "T13" dynFlags [2] + sigMatchTest "T14" dynFlags [1,2] + sigMatchTest "T18" dynFlags [4] + sigMatchTest "T19" dynFlags [3] + sigMatchTest "T20" dynFlags [2,1,1] + sigMatchTest "T21" dynFlags [1,1,1,1] , testCase "Definition Counting" $ do - (nameCache, dynFlags) <- ioResources - defCountTest "T15" nameCache dynFlags + dynFlags <- ioResources + defCountTest "T15" dynFlags . AppendMap $ M.fromList [(Class, (2, 1)), (ClassInst, (2, 1))] - defCountTest "T17" nameCache dynFlags + defCountTest "T17" dynFlags . AppendMap $ M.fromList [ (Class, (1, 1)) , (Data, (3, 2)) @@ -61,33 +57,40 @@ ] , testCase "Use Counts" $ do - (nameCache, dynFlags) <- ioResources - useCountTest "T16" nameCache dynFlags [1,1,1,3] + dynFlags <- ioResources + useCountTest "T16" dynFlags + [ ("foo", 1) + , ("f", 1) + , ("T", 1) + , ("T", 3) + ] ] -sigMatchTest :: String -> NameCache -> DynFlags -> [Int] -> IO () -sigMatchTest testName nc dynFlags sigGroupSizes = do - (_, _, AppendMap sigMap, _) <- getCounters testName nc dynFlags +sigMatchTest :: String -> DynFlags -> [Int] -> IO () +sigMatchTest testName dynFlags sigGroupSizes = do + (_, _, AppendMap sigMap, _) <- getCounters testName dynFlags assertEqual testName sigGroupSizes . concatMap (map (\(_, _, names) -> length names) . getMatchedSigs) $ M.elems sigMap -defCountTest :: FilePath -> NameCache -> DynFlags -> DefCounter -> IO () -defCountTest testName nc dynFlags expectedDefCount = do - (defCount, _, _, _) <- getCounters testName nc dynFlags +defCountTest :: FilePath -> DynFlags -> DefCounter -> IO () +defCountTest testName dynFlags expectedDefCount = do + (defCount, _, _, _) <- getCounters testName dynFlags assertEqual testName expectedDefCount defCount -useCountTest :: FilePath -> NameCache -> DynFlags -> [Int] -> IO () -useCountTest testName nc dynFlags expectedUseCount = do - (_, AppendMap useCount, _, _) <- getCounters testName nc dynFlags - assertEqual testName expectedUseCount - (map usages . M.elems $ M.filter locallyDefined useCount) +useCountTest :: FilePath -> DynFlags -> [(String, Int)] -> IO () +useCountTest testName dynFlags expectedUseCount = do + (_, AppendMap useCount, _, _) <- getCounters testName dynFlags + let printName = showSDoc dynFlags . pprNameUnqualified + actualCount = map (bimap printName usages) . M.toList + $ M.filter locallyDefined useCount + assertEqual testName expectedUseCount actualCount getHiePath :: String -> FilePath getHiePath testName = "test/hie/HieSource/" <> testName <> ".hie" -getCounters :: String -> NameCache -> DynFlags -> IO (DefCounter, UsageCounter, SigMap, Sum Int) -getCounters testName nc dynFlags = do - (hieFile, _) <- readHieFile nc $ getHiePath testName - pure . hieFileToCounters dynFlags $ hie_file_result hieFile +getCounters :: String -> DynFlags -> IO (DefCounter, UsageCounter, SigMap, Sum Int) +getCounters testName dynFlags = do + [hieFile] <- hieFilesFromPaths . (:[]) $ getHiePath testName + pure $ hieFileToCounters dynFlags hieFile