inventory 0.1.0.3 → 0.1.0.4

raw patch · 11 files changed

+165/−59 lines, 11 filesdep ~bytestringdep ~ghcdep ~ghc-pathsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bytestring, ghc, ghc-paths, mtl

API changes (from Hackage documentation)

Files

• ChangeLog.md +3/−1
• README.md +1/−1
• inventory.cabal +14/−14
• src/DefCounts/ProcessHie.hs +37/−26
• src/GHC/DynFlags.hs +12/−2
• src/HieFile.hs +23/−3
• src/MatchSigs/Sig.hs +24/−3
• src/Output.hs +11/−2
• src/UseCounts/ProcessHie.hs +17/−2
• src/Utils.hs +6/−1
• test/Spec.hs +17/−4

@@ -1,3 +1,5 @@ # Changelog for inventory -## Unreleased changes+## 0.1.0.4++* Support GHC 9.4.x and 9.6.x

@@ -81,4 +81,4 @@   signatures for GHC versions less than 9.0.1. - Standalone kind signatures are not yet included in definition counts. - Does not unfold type synonyms when comparing type signatures.-- GHC versions other than 8.8, 8.10, and 9.0 are not currently supported.+- GHC versions less than 8.8.x are not supported.

@@ -7,7 +7,7 @@ -- hash: e0077ffac241039a12a7c4c25cbf73cc19bcf4b81132d5a8194a2747df9c137a  name:           inventory-version:        0.1.0.3+version:        0.1.0.4 synopsis:       Project statistics and definition analysis description:    Please see the README on GitHub at <https://github.com/aaronallen8455/inventory#readme> category:       Utility@@ -18,7 +18,7 @@ copyright:      2021 Aaron Allen license:        BSD3 license-file:   LICENSE-tested-with:    GHC ==8.8.4 || ==8.10.4 || ==9.0.1+tested-with:    GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.4 || ==9.6.1 build-type:     Simple extra-source-files:     README.md@@ -54,13 +54,13 @@       appendmap >=0.1.5 && <0.2     , array >=0.5.4 && <0.6     , base >=4.7 && <5-    , bytestring >=0.10.10 && <0.11+    , bytestring >=0.10.10     , containers >=0.6.2 && <0.7     , directory >=1.3.6 && <1.4     , filepath >=1.4.2 && <1.5-    , ghc >=8.8 && <9.1-    , ghc-paths >=0.1.0 && <0.2-    , mtl >=2.2.2 && <2.3+    , ghc >=8.8 && <9.7+    , ghc-paths >=0.1.0+    , mtl >=2.2.2 && <2.4   default-language: Haskell2010  executable inventory@@ -74,14 +74,14 @@       appendmap >=0.1.5 && <0.2     , array >=0.5.4 && <0.6     , base >=4.7 && <5-    , bytestring >=0.10.10 && <0.11+    , bytestring >=0.10.10     , containers >=0.6.2 && <0.7     , directory >=1.3.6 && <1.4     , filepath >=1.4.2 && <1.5-    , ghc >=8.8 && <9.1-    , ghc-paths >=0.1.0 && <0.2+    , ghc >=8.8 && <9.7+    , ghc-paths >=0.1.0     , inventory-    , mtl >=2.2.2 && <2.3+    , mtl >=2.2.2 && <2.4   default-language: Haskell2010  test-suite inventory-test@@ -117,14 +117,14 @@       appendmap >=0.1.5 && <0.2     , array >=0.5.4 && <0.6     , base >=4.7 && <5-    , bytestring >=0.10.10 && <0.11+    , bytestring >=0.10.10     , containers >=0.6.2 && <0.7     , directory >=1.3.6 && <1.4     , filepath >=1.4.2 && <1.5-    , ghc >=8.8 && <9.1-    , ghc-paths >=0.1.0 && <0.2+    , ghc >=8.8 && <9.7+    , ghc-paths >=0.1.0     , inventory-    , mtl >=2.2.2 && <2.3+    , mtl >=2.2.2 && <2.4     , tasty     , tasty-hunit   default-language: Haskell2010

@@ -58,36 +58,47 @@   | nodeHasAnnotation "IEName" "IEWrappedName" node   = AppendMap $ M.singleton ExportThing (numLines $ nodeSpan node, 1) -  | otherwise = foldMap ( foldMap (foldMap (tyDeclLines src) . identInfo)-                        . nodeIdentifiers-                        . getNodeInfo )-              $ nodeChildren node+  | nodeHasAnnotation "IEThingAll" "IE" node+  = AppendMap $ M.singleton ExportThing (numLines $ nodeSpan node, 1) +  | nodeHasAnnotation "IEPattern" "IEWrappedName" node+  = AppendMap $ M.singleton ExportThing (numLines $ nodeSpan node, 1)++  | nodeHasAnnotation "IEVar" "IE" node+  = AppendMap $ M.singleton ExportThing (numLines $ nodeSpan node, 1)++  | otherwise = foldNodeChildren (tyDeclLines src) node+ numLines :: Span -> Sum Int numLines s = Sum $ srcSpanEndLine s - srcSpanStartLine s + 1 -tyDeclLines :: SourceCode -> ContextInfo -> DefCounter-tyDeclLines src = \case-  Decl declTy (Just srcSpan)-    | Just defTy <- toDefType srcSpan declTy-    -> AppendMap $ M.singleton defTy (numLines srcSpan, 1)-  _ -> mempty+tyDeclLines :: SourceCode -> HieAST a -> DefCounter+tyDeclLines src node = fromCurrentNode <> fromChildren   where-    toDefType srcSpan = \case-      FamDec           -> Just Fam-      SynDec           -> Just Syn-      DataDec-        | isNewtypeDec -> Just Newtype-        | otherwise    -> Just Data-      PatSynDec        -> Just PatSyn-      ClassDec         -> Just Class-      InstDec          -> Just TyFamInst-      _                -> Nothing+    fromCurrentNode =+      foldMap (foldMap go . identInfo) . nodeIdentifiers $ getNodeInfo node+    fromChildren = foldNodeChildren (tyDeclLines src) node +    go = \case+      Decl declTy (Just srcSpan)+        | Just defTy <- toDefType srcSpan declTy+        -> AppendMap $ M.singleton defTy (numLines srcSpan, 1)+      _ -> mempty       where-        isNewtypeDec =-          let ln = srcSpanStartLine srcSpan - 1-              col = srcSpanStartCol srcSpan - 1-              (lBnd, uBnd) = A.bounds src-           in ln >= lBnd && ln <= uBnd-           && "newtype" == (BS.take 7 . BS.drop col $ src A.! ln)+        toDefType srcSpan = \case+          FamDec           -> Just Fam+          SynDec           -> Just Syn+          DataDec+            | isNewtypeDec -> Just Newtype+            | otherwise    -> Just Data+          PatSynDec        -> Just PatSyn+          ClassDec         -> Just Class+          InstDec          -> Just TyFamInst+          _                -> Nothing+          where+            isNewtypeDec =+              let ln = srcSpanStartLine srcSpan - 1+                  col = srcSpanStartCol srcSpan - 1+                  (lBnd, uBnd) = A.bounds src+               in ln >= lBnd && ln <= uBnd+               && "newtype" == (BS.take 7 . BS.drop col $ src A.! ln)

@@ -3,9 +3,13 @@   ( baseDynFlags,   ) where +#if MIN_VERSION_ghc(9,4,0)+import           GHC.Data.Bool (OverridingBool(Always))+#endif import           GHC.Api hiding (settings) import           GHC.Paths (libdir) +#if !MIN_VERSION_ghc(9,6,0) fakeLlvmConfig :: LlvmConfig fakeLlvmConfig = #if __GLASGOW_HASKELL__ < 810@@ -13,10 +17,16 @@ #else   LlvmConfig [] [] #endif+#endif  baseDynFlags :: IO DynFlags baseDynFlags = do   settings <- initSysTools libdir-  pure $ (defaultDynFlags settings fakeLlvmConfig)-    { useColor = Always }+  let dynFlags =+#if MIN_VERSION_ghc(9,6,0)+        defaultDynFlags settings+#else+        defaultDynFlags settings fakeLlvmConfig+#endif+  pure dynFlags { useColor = Always } 

@@ -8,13 +8,14 @@   ) where  import           Control.Exception (onException)-import           Control.Monad.State+import           Control.Monad import qualified Data.Array as A #if __GLASGOW_HASKELL__ < 900+import           Control.Monad.State import           Data.Bifunctor #endif import qualified Data.ByteString.Char8 as BS-#if __GLASGOW_HASKELL__ >= 900+#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,4,0) import           Data.IORef #endif import           Data.Maybe@@ -72,10 +73,25 @@   let srcFileExists = doesPathExist . hie_hs_file   filterM srcFileExists hieFiles -#if __GLASGOW_HASKELL__ >= 900+#if MIN_VERSION_ghc(9,4,0)  hieFilesFromPaths :: [FilePath] -> IO [HieFile] hieFilesFromPaths filePaths = do+  nameCache <- mkNameCache+  traverse (getHieFile nameCache) filePaths++getHieFile :: NameCache -> FilePath -> IO HieFile+getHieFile nameCache filePath =+  handleHieVersionMismatch filePath . fmap hie_file_result+    =<< readHieFileWithVersion+          (\(v, _) -> v == hieVersion)+          nameCache+          filePath++#elif __GLASGOW_HASKELL__ >= 900++hieFilesFromPaths :: [FilePath] -> IO [HieFile]+hieFilesFromPaths filePaths = do   nameCacheRef <- newIORef =<< mkNameCache   let updater = NCU $ atomicModifyIORef' nameCacheRef   traverse (getHieFile updater) filePaths@@ -118,8 +134,12 @@  mkNameCache :: IO NameCache mkNameCache = do+#if MIN_VERSION_ghc(9,4,0)+  initNameCache 'z' []+#else   uniqueSupply <- mkSplitUniqSupply 'z'   pure $ initNameCache uniqueSupply []+#endif  -- | Recursively search for .hie files in given directory getHieFilesIn :: FilePath -> IO [FilePath]

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-}@@ -10,7 +11,9 @@   , isQual   ) where +import           Control.Monad import           Control.Monad.State+import qualified Data.ByteString as BS import           Data.Either import           Data.List import qualified Data.Map.Strict as M@@ -26,7 +29,7 @@ -- linked list with the init elems being the context followed by arguments of -- the function and the last being the result type. data Sig varIx-  = TyDescriptor !FastString !(Maybe Name)+  = TyDescriptor !BS.ByteString !(Maybe Name)   | FreeVar !varIx   | Arg ![Sig varIx]   | Qual ![Sig varIx]@@ -137,8 +140,20 @@   $ KindSig <$> mkSig ty             <*> mkSig ki +  -- hs sig+  | nodeHasAnnotation "HsSig" "HsSigType" node+  , rest : userVarNodes <- reverse $ nodeChildren node+  = do+    vars <- foldM extractFreeVar [] userVarNodes+    (VarCtx vars :) <$> mkSig rest+   -- any other type-  | (ty, "HsType") : _ <- S.toList . nodeAnnotations $ getNodeInfo node+#if MIN_VERSION_ghc(9,2,0)+  | NodeAnnotation ty "HsType"+#else+  | (ty, "HsType")+#endif+      : _ <- S.toList . nodeAnnotations $ getNodeInfo node   , let mbName = extractName node   = do     freeVars <- get@@ -146,7 +161,13 @@       Just name         | Just idx <- freeVars M.!? name         -> pure [FreeVar idx]-      _ -> pure [TyDescriptor ty mbName]+      _ -> pure [TyDescriptor+#if MIN_VERSION_ghc(8,10,0)+                   (bytesFS ty)+#else+                   (fastStringToByteString ty)+#endif+                   mbName ]    | otherwise = pure [] 

@@ -6,7 +6,12 @@ import           System.IO (stdout)  import           DefCounts.Output-import           GHC.Api (DynFlags)+import           GHC.Api+#if MIN_VERSION_ghc(9,2,0)+  (DynFlags, initSDocContext)+#else+  (DynFlags)+#endif import           GHC.Output import           HieFile (Counters) import           MatchSigs.Output@@ -43,7 +48,11 @@  outputSDoc :: DynFlags -> SDoc -> IO () outputSDoc dynFlags sDoc = do-#if __GLASGOW_HASKELL__ >= 900+#if MIN_VERSION_ghc(9,2,0)+  let pprStyle = setStyleColoured True defaultUserStyle+      sDocCtx = initSDocContext dynFlags pprStyle+  printSDocLn sDocCtx (PageMode True) stdout sDoc+#elif MIN_VERSION_ghc(9,0,0)   let pprStyle = setStyleColoured True defaultUserStyle       sDocCtx = initSDocContext dynFlags pprStyle   printSDocLn sDocCtx PageMode stdout sDoc

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module UseCounts.ProcessHie@@ -35,18 +36,32 @@  <> foldMap declaration (listToMaybe $ nodeChildren node)    -- only get usages from instance declarations-  | any ((== "InstDecl") . snd) (nodeAnnotations $ getNodeInfo node)+  | any ((== "InstDecl") . annType) (nodeAnnotations $ getNodeInfo node)   = foldMap findUsage (nodeChildren node)    | otherwise   = foldMap declaration (nodeChildren node)  <> foldMap findUsage (nodeChildren node)+  where+    annType =+#if MIN_VERSION_ghc(9,2,0)+      nodeAnnotType+#else+      snd+#endif  -- | Accrues all the top-level declarations if all different types declaration :: HieAST a -> UsageCounter declaration node-  | any ((== "ConDecl") . snd) (nodeAnnotations $ getNodeInfo node)+  | any ((== "ConDecl") . annType) (nodeAnnotations $ getNodeInfo node)   = dataConDecl node+  where+    annType =+#if MIN_VERSION_ghc(9,2,0)+      nodeAnnotType+#else+      snd+#endif declaration node = M.foldMapWithKey f . nodeIdentifiers $ getNodeInfo node   where     f (Right name) details = foldMap g (identInfo details) where

@@ -32,7 +32,12 @@  nodeHasAnnotation :: String -> String -> HieAST a -> Bool nodeHasAnnotation constructor ty =-    S.member (fromString constructor, fromString ty)+    S.member+#if MIN_VERSION_ghc(9,2,0)+      (NodeAnnotation (fromString constructor) (fromString ty))+#else+      (fromString constructor, fromString ty)+#endif   . nodeAnnotations   . getNodeInfo 

@@ -1,4 +1,6 @@+{-# LANGUAGE CPP #-} import           Data.Bifunctor+import           Data.List (sort) import           Data.Map.Append.Strict (AppendMap(..)) import qualified Data.Map.Strict as M import           Data.Monoid@@ -47,14 +49,19 @@               [ (Class, (1, 1))               , (Data, (1, 1))               , (Newtype, (2, 1))+#if MIN_VERSION_ghc(9,2,0)+              , (Fam, (3, 2))+#else               , (Fam, (2, 2))+#endif               , (Func, (2, 1))               , (PatSyn, (1, 1))               , (Syn, (1, 1))               , (ClassInst, (2, 2))               , (TyFamInst, (2, 2))+              , (TyFamInst, (2, 2))               , (ModImport, (1, 1))-              , (ExportThing, (5, 5))+              , (ExportThing, (8, 8))               ]      , testCase "Use Counts" $ do@@ -71,7 +78,8 @@ sigMatchTest testName dynFlags sigGroupSizes = do   (_, _, AppendMap sigMap, _) <- getCounters testName dynFlags -  assertEqual testName sigGroupSizes+  assertEqual testName (sort sigGroupSizes)+    . sort     . concatMap (map (\(_, _, names) -> length names) . getMatchedSigs)     $ M.elems sigMap @@ -83,10 +91,15 @@ useCountTest :: FilePath -> DynFlags -> [(String, Int)] -> IO () useCountTest testName dynFlags expectedUseCount = do   (_, AppendMap useCount, _, _) <- getCounters testName dynFlags-  let printName = showSDoc dynFlags . pprNameUnqualified+  let printName =+#if MIN_VERSION_ghc(9,2,0)+        showSDocOneLine (initDefaultSDocContext dynFlags) . pprNameUnqualified+#else+        showSDoc dynFlags . pprNameUnqualified+#endif       actualCount = map (bimap printName usages) . M.toList                   $ M.filter locallyDefined useCount-  assertEqual testName expectedUseCount actualCount+  assertEqual testName (sort expectedUseCount) (sort actualCount)  getHiePath :: String -> FilePath getHiePath testName = "test/hie/HieSource/" <> testName <> ".hie"