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: 2c217de02982da803d30a671d986dea8bc36b776a638aafdd2b1599609a962f1 +-- hash: e0077ffac241039a12a7c4c25cbf73cc19bcf4b81132d5a8194a2747df9c137a name: inventory -version: 0.1.0.2 +version: 0.1.0.3 synopsis: Project statistics and definition analysis description: Please see the README on GitHub at category: Utility @@ -52,6 +52,7 @@ ghc-options: -Wall -fwarn-incomplete-patterns build-depends: appendmap >=0.1.5 && <0.2 + , array >=0.5.4 && <0.6 , base >=4.7 && <5 , bytestring >=0.10.10 && <0.11 , containers >=0.6.2 && <0.7 @@ -71,6 +72,7 @@ ghc-options: -Wall -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-A16m build-depends: appendmap >=0.1.5 && <0.2 + , array >=0.5.4 && <0.6 , base >=4.7 && <5 , bytestring >=0.10.10 && <0.11 , containers >=0.6.2 && <0.7 @@ -113,6 +115,7 @@ ghc-options: -Wall -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N -fwrite-ide-info -hiedir=test/hie build-depends: appendmap >=0.1.5 && <0.2 + , array >=0.5.4 && <0.6 , base >=4.7 && <5 , bytestring >=0.10.10 && <0.11 , containers >=0.6.2 && <0.7 diff --git a/src/DefCounts/Output.hs b/src/DefCounts/Output.hs --- a/src/DefCounts/Output.hs +++ b/src/DefCounts/Output.hs @@ -48,6 +48,7 @@ Func -> text "Function" Fam -> text "Type/Data Family" Data -> text "Data" + Newtype -> text "Newtype" Class -> text "Type Class" TyFamInst -> text "Type/Data Family Instance" ClassInst -> text "Type Class Instance" diff --git a/src/DefCounts/ProcessHie.hs b/src/DefCounts/ProcessHie.hs --- a/src/DefCounts/ProcessHie.hs +++ b/src/DefCounts/ProcessHie.hs @@ -1,11 +1,13 @@ {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} module DefCounts.ProcessHie ( DefCounter , DefType(..) , declLines ) where +import qualified Data.Array as A +import qualified Data.ByteString as BS import Data.Map.Append.Strict (AppendMap(..)) import qualified Data.Map.Strict as M import Data.Monoid @@ -15,14 +17,15 @@ -- TODO standalone kind sigs data DefType - = Class + = Func | Data - | Fam - | Func - | PatSyn - | Syn + | Newtype + | Class | ClassInst + | Fam | TyFamInst + | Syn + | PatSyn | ModImport | ExportThing deriving (Eq, Ord, Show) @@ -33,9 +36,12 @@ , Sum Int -- num occurrences ) +-- | Supports indexing into the source code by line number +type SourceCode = A.Array Int BS.ByteString + -- | Counts up the different types of definitions in the given 'HieAST'. -declLines :: HieAST a -> DefCounter -declLines node +declLines :: SourceCode -> HieAST a -> DefCounter +declLines src node | nodeHasAnnotation "ClsInstD" "InstDecl" node || nodeHasAnnotation "DerivDecl" "DerivDecl" node = AppendMap $ M.singleton ClassInst (numLines $ nodeSpan node, 1) @@ -52,7 +58,7 @@ | nodeHasAnnotation "IEName" "IEWrappedName" node = AppendMap $ M.singleton ExportThing (numLines $ nodeSpan node, 1) - | otherwise = foldMap ( foldMap (foldMap tyDeclLines . identInfo) + | otherwise = foldMap ( foldMap (foldMap (tyDeclLines src) . identInfo) . nodeIdentifiers . getNodeInfo ) $ nodeChildren node @@ -60,18 +66,28 @@ numLines :: Span -> Sum Int numLines s = Sum $ srcSpanEndLine s - srcSpanStartLine s + 1 -tyDeclLines :: ContextInfo -> DefCounter -tyDeclLines = \case - Decl (toDefType -> Just declType) (Just srcSpan) - -> AppendMap $ M.singleton declType (numLines srcSpan, 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 where - toDefType = \case - FamDec -> Just Fam - SynDec -> Just Syn - DataDec -> Just Data - PatSynDec -> Just PatSyn - ClassDec -> Just Class - InstDec -> Just TyFamInst - _ -> Nothing + 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) diff --git a/src/HieFile.hs b/src/HieFile.hs --- a/src/HieFile.hs +++ b/src/HieFile.hs @@ -9,6 +9,7 @@ import Control.Exception (onException) import Control.Monad.State +import qualified Data.Array as A #if __GLASGOW_HASKELL__ < 900 import Data.Bifunctor #endif @@ -47,11 +48,14 @@ asts = getAsts hies types = hie_types hieFile fullHies = flip recoverFullType types <$> hies + sourceLines = BS.lines $ hie_hs_src hieFile + numLines = length sourceLines + source = A.listArray (0, numLines - 1) sourceLines - in ( foldMap (foldNodeChildren declLines) asts + in ( foldMap (foldNodeChildren (declLines source)) asts , foldMap (foldNodeChildren usageCounter) asts , foldMap (mkSigMap dynFlags) $ getAsts fullHies - , Sum . length . BS.lines $ hie_hs_src hieFile + , Sum numLines ) getHieFiles :: IO [HieFile] diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -45,7 +45,8 @@ defCountTest "T17" dynFlags . AppendMap $ M.fromList [ (Class, (1, 1)) - , (Data, (3, 2)) + , (Data, (1, 1)) + , (Newtype, (2, 1)) , (Fam, (2, 2)) , (Func, (2, 1)) , (PatSyn, (1, 1))