inventory (empty) → 0.1.0.0

raw patch · 41 files changed

+1625/−0 lines, 41 filesdep +appendmapdep +basedep +bytestringsetup-changed

Dependencies added: appendmap, base, bytestring, containers, directory, filepath, ghc, ghc-paths, inventory, mtl, tasty, tasty-hunit

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +75/−0
• Setup.hs +2/−0
• app/Main.hs +10/−0
• inventory.cabal +125/−0
• src/DefCounts/Output.hs +60/−0
• src/DefCounts/ProcessHie.hs +79/−0
• src/GHC/DynFlags.hs +24/−0
• src/HieFile.hs +100/−0
• src/MatchSigs/Matching.hs +142/−0
• src/MatchSigs/Matching/Env.hs +100/−0
• src/MatchSigs/Output.hs +37/−0
• src/MatchSigs/ProcessHie.hs +56/−0
• src/MatchSigs/Sig.hs +220/−0
• src/Output.hs +46/−0
• src/UseCounts/Output.hs +47/−0
• src/UseCounts/ProcessHie.hs +94/−0
• src/Utils.hs +18/−0
• test/HieSource/T1.hs +7/−0
• test/HieSource/T10.hs +16/−0
• test/HieSource/T11.hs +8/−0
• test/HieSource/T12.hs +7/−0
• test/HieSource/T13.hs +9/−0
• test/HieSource/T14.hs +14/−0
• test/HieSource/T15.hs +7/−0
• test/HieSource/T16.hs +9/−0
• test/HieSource/T17.hs +41/−0
• test/HieSource/T18.hs +32/−0
• test/HieSource/T19.hs +11/−0
• test/HieSource/T2.hs +7/−0
• test/HieSource/T20.hs +17/−0
• test/HieSource/T21.hs +13/−0
• test/HieSource/T3.hs +7/−0
• test/HieSource/T4.hs +7/−0
• test/HieSource/T5.hs +8/−0
• test/HieSource/T6.hs +11/−0
• test/HieSource/T7.hs +10/−0
• test/HieSource/T8.hs +13/−0
• test/HieSource/T9.hs +10/−0
• test/Spec.hs +93/−0

@@ -0,0 +1,3 @@+# Changelog for inventory++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Aaron Allen (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Aaron Allen nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,75 @@+# Inventory++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.+- 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++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.++## How to generate `.hie` files+### Cabal++Add this to your `cabal.project.local` file:++```+package *+  ghc-options: -fwrite-ide-info -hiedir=.hie+```++Then do a full rebuild of the project:++```+cabal clean+cabal build all+```++### Stack++Add this to your `stack.yaml` file:++```+ghc-options:+  "$locals": -fwrite-ide-info+             -hiedir=.hie+```++Then do a full rebuild:++```+stack clean+stack build+```++## Examples++Here are some excerpts of the output that was produced by running `inventory`+on the `stack` codebase:++### Definition counts+![Definiton counts image](images/defcounts.png)++### Most used definitions+![Most used image](images/mostused.png)++### Matching type signatures+![Equivalent signatures image](images/dupesigs.png)++The output for matching signatures can be useful for discovering functions that+are duplicates of one another. For instance, the `packageIdent` and+`packageIdentifier` functions in the above output turned out to be duplicates.++### Known Issues/Limitations+- Context such as constraints and foralls do not appear in the printed type+  signatures.+- 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,10 @@+module Main where++import           GHC.DynFlags+import           HieFile+import           Output++main :: IO ()+main = do+  dynFlags <- baseDynFlags+  getCounters dynFlags >>= printResults dynFlags

@@ -0,0 +1,125 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 5170dfcf2cd239f3acaa89982a23f501fd0928316833b05a3c3aa0d6364032d7++name:           inventory+version:        0.1.0.0+synopsis:       Project statistics and definition analysis+description:    Please see the README on GitHub at <https://github.com/aaronallen8455/inventory#readme>+category:       Utility+homepage:       https://github.com/aaronallen8455/inventory#readme+bug-reports:    https://github.com/aaronallen8455/inventory/issues+author:         Aaron Allen+maintainer:     aaronallen8455@gmail.com+copyright:      2021 Aaron Allen+license:        BSD3+license-file:   LICENSE+tested-with:    ghc ==8.8.4 ghc ==8.10.3+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/aaronallen8455/inventory++library+  exposed-modules:+      DefCounts.Output+      DefCounts.ProcessHie+      GHC.DynFlags+      HieFile+      MatchSigs.Matching+      MatchSigs.Matching.Env+      MatchSigs.Output+      MatchSigs.ProcessHie+      MatchSigs.Sig+      Output+      UseCounts.Output+      UseCounts.ProcessHie+      Utils+  other-modules:+      Paths_inventory+  hs-source-dirs:+      src+  ghc-options: -Wall -fwarn-incomplete-patterns+  build-depends:+      appendmap >=0.1.5 && <0.2+    , base >=4.7 && <5+    , bytestring >=0.10.12 && <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-paths >=0.1.0 && <0.2+    , mtl >=2.2.2 && <2.3+  default-language: Haskell2010++executable inventory+  main-is: Main.hs+  other-modules:+      Paths_inventory+  hs-source-dirs:+      app+  ghc-options: -Wall -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-A16m+  build-depends:+      appendmap >=0.1.5 && <0.2+    , base >=4.7 && <5+    , bytestring >=0.10.12 && <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-paths >=0.1.0 && <0.2+    , inventory+    , mtl >=2.2.2 && <2.3+  default-language: Haskell2010++test-suite inventory-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      HieSource.T1+      HieSource.T10+      HieSource.T11+      HieSource.T12+      HieSource.T13+      HieSource.T14+      HieSource.T15+      HieSource.T16+      HieSource.T17+      HieSource.T18+      HieSource.T19+      HieSource.T2+      HieSource.T20+      HieSource.T21+      HieSource.T3+      HieSource.T4+      HieSource.T5+      HieSource.T6+      HieSource.T7+      HieSource.T8+      HieSource.T9+      Paths_inventory+  hs-source-dirs:+      test+  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+    , base >=4.7 && <5+    , bytestring >=0.10.12 && <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-paths >=0.1.0 && <0.2+    , inventory+    , mtl >=2.2.2 && <2.3+    , tasty+    , tasty-hunit+  default-language: Haskell2010

@@ -0,0 +1,60 @@+{-# LANGUAGE LambdaCase #-}+module DefCounts.Output+  ( defCountOutput+  ) where++import           Data.Foldable+import           Data.Map.Append.Strict (AppendMap(..))+import qualified Data.Map.Strict as M+import           Data.Monoid+import           Text.Printf++import           Outputable+import           PprColour++import           DefCounts.ProcessHie (DefCounter, DefType(..))++defCountOutput :: DefCounter -> Sum Int -> SDoc+defCountOutput (AppendMap defCount) (Sum totalLines) =+  vcat [ header+       , vcat $ uncurry defOutput <$> M.toList defCount+       , otherCount+       , text ""+       , text "Total Lines:" <+> coloured colCyanFg (intWithCommas totalLines)+       ]+  where+    defLineTotal = getSum . fst $ fold defCount+    otherLines = totalLines - defLineTotal :: Int++    header = keyword . coloured colMagentaFg+           $ text "Type of Definition"+          $$ nest 30 (text "Num Lines")+          $$ nest 45 (text "Num Defs")+          $$ nest 60 (text "% of Total Lines")++    defOutput defType (Sum numLines, Sum numOccs)+      = pprDefType defType+     $$ nest 30 (coloured colCyanFg $ intWithCommas numLines)+     $$ nest 45 (coloured colCyanFg $ intWithCommas numOccs)+     $$ nest 60 (pprPerc $ (fromIntegral numLines :: Float) / fromIntegral totalLines * 100)++    otherCount+      = text "Miscellaneous"+     $$ nest 30 (coloured colCyanFg $ intWithCommas otherLines)+     $$ nest 60 (pprPerc $ (fromIntegral otherLines :: Float) / fromIntegral totalLines * 100)++    pprPerc = coloured colCyanFg . text . printf "%.1f%%"++pprDefType :: DefType -> SDoc+pprDefType = \case+  Func        -> text "Function"+  Fam         -> text "Type/Data Family"+  Data        -> text "Data"+  Class       -> text "Type Class"+  TyFamInst   -> text "Type/Data Family Instance"+  ClassInst   -> text "Type Class Instance"+  Syn         -> text "Type Synonym"+  PatSyn      -> text "Pattern Synonym"+  ModImport   -> text "Import"+  ExportThing -> text "Export"+

@@ -0,0 +1,79 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ViewPatterns #-}+module DefCounts.ProcessHie+  ( DefCounter+  , DefType(..)+  , declLines+  ) where++import           Data.Map.Append.Strict (AppendMap(..))+import qualified Data.Map.Strict as M+import           Data.Monoid++import           HieTypes+import           SrcLoc++import           Utils++-- TODO standalone kind sigs+data DefType+  = Class+  | Data+  | Fam+  | Func+  | PatSyn+  | Syn+  | ClassInst+  | TyFamInst+  | ModImport+  | ExportThing+  deriving (Eq, Ord, Show)++type DefCounter =+  AppendMap DefType+            ( Sum Int -- num lines+            , Sum Int -- num occurrences+            )++-- | Counts up the different types of definitions in the given 'HieAST'.+declLines :: HieAST a -> DefCounter+declLines node+  | nodeHasAnnotation "ClsInstD" "InstDecl" node+  || nodeHasAnnotation "DerivDecl" "DerivDecl" node+  = AppendMap $ M.singleton ClassInst (numLines $ nodeSpan node, 1)++  | nodeHasAnnotation "TypeSig" "Sig" node+  = AppendMap $ M.singleton Func (numLines $ nodeSpan node, 0)++  | nodeHasAnnotation "FunBind" "HsBindLR" node+  = AppendMap $ M.singleton Func (numLines $ nodeSpan node, 1)++  | nodeHasAnnotation "ImportDecl" "ImportDecl" node+  = AppendMap $ M.singleton ModImport (numLines $ nodeSpan node, 1)++  | nodeHasAnnotation "IEName" "IEWrappedName" node+  = AppendMap $ M.singleton ExportThing (numLines $ nodeSpan node, 1)++  | otherwise = foldMap ( foldMap (foldMap tyDeclLines . identInfo)+                        . nodeIdentifiers+                        . nodeInfo )+              $ nodeChildren node++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)+  _ -> mempty+  where+    toDefType = \case+      FamDec    -> Just Fam+      SynDec    -> Just Syn+      DataDec   -> Just Data+      PatSynDec -> Just PatSyn+      ClassDec  -> Just Class+      InstDec   -> Just TyFamInst+      _         -> Nothing+

@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}+module GHC.DynFlags+  ( baseDynFlags,+  ) where++import           DynFlags hiding (settings)+import           GHC.Paths (libdir)+import           SysTools+import           Util++fakeLlvmConfig :: LlvmConfig+fakeLlvmConfig =+#if __GLASGOW_HASKELL__ < 810+  ([], [])+#else+  LlvmConfig [] []+#endif++baseDynFlags :: IO DynFlags+baseDynFlags = do+  settings <- initSysTools libdir+  pure $ (defaultDynFlags settings fakeLlvmConfig)+    { useColor = Always }+

@@ -0,0 +1,100 @@+module HieFile+  ( Counters+  , getCounters+  , hieFileToCounters+  , mkNameCache+  ) where++import           Control.Exception (onException)+import           Control.Monad.State+import           Data.Bifunctor+import qualified Data.ByteString.Char8 as BS+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           MatchSigs.ProcessHie+import           UseCounts.ProcessHie+import           Utils++type Counters = ( DefCounter+                , UsageCounter+                , SigMap+                , Sum Int -- total num lines+                )++getCounters :: DynFlags -> IO Counters+getCounters dynFlags =+  foldMap (hieFileToCounters dynFlags) <$> getHieFiles++hieFileToCounters :: DynFlags+                  -> HieFile+                  -> Counters+hieFileToCounters dynFlags hieFile =+  let hies = hie_asts hieFile+      asts = getAsts hies+      types = hie_types hieFile+      fullHies = flip recoverFullType types <$> hies++   in ( foldMap (foldNodeChildren declLines) asts+      , foldMap (foldNodeChildren usageCounter) asts+      , foldMap (mkSigMap dynFlags) $ getAsts fullHies+      , Sum . length . BS.lines $ hie_hs_src hieFile+      )++getHieFiles :: IO [HieFile]+getHieFiles = do+  hieDir <- fromMaybe ".hie" <$> lookupEnv "HIE_DIR"+  let notPathsFile = (/= "Paths_") . take 6+  filePaths <- filter notPathsFile <$> getHieFilesIn hieDir+    `onException` error "HIE file directory does not exist"+  nameCache <- mkNameCache+  evalStateT (traverse getHieFile filePaths) nameCache++getHieFile :: FilePath -> StateT NameCache IO HieFile+getHieFile filePath = StateT $ \nameCache ->+  first hie_file_result <$> readHieFile nameCache filePath++mkNameCache :: IO NameCache+mkNameCache = do+  uniqueSupply <- mkSplitUniqSupply 'z'+  pure $ initNameCache uniqueSupply []++-- | Recursively search for .hie files in given directory+getHieFilesIn :: FilePath -> IO [FilePath]+-- ignore Paths_* files generated by cabal+getHieFilesIn path | take 6 path == "Paths_" = pure []+getHieFilesIn path = do+  exists <-+    doesPathExist path++  if exists+    then do+      isFile <- doesFileExist path+      if isFile && "hie" `isExtensionOf` path+        then do+          path' <- canonicalizePath path+          return [path']+        else do+          isDir <-+            doesDirectoryExist path+          if isDir+            then do+              cnts <-+                listDirectory path+              withCurrentDirectory path (foldMap getHieFilesIn cnts)+            else+              return []+    else+      return []+

@@ -0,0 +1,142 @@+module MatchSigs.Matching+  ( MatchedSigs(..)+  ) where++import           Control.Monad.State.Strict+import           Data.List++import           Name++import           MatchSigs.Matching.Env+import           MatchSigs.Sig++type SigMatches = ( [Sig FreeVarIdx] -- Sig shared by these 'Name's+                  , String -- rendered sig+                  , [Name] -- Names that share this signature+                  )++newtype MatchedSigs =+  MatchedSigs { getMatchedSigs :: [SigMatches] }++instance Semigroup MatchedSigs where+  (<>) = unionMatchedSigs++instance Monoid MatchedSigs where+  mempty = MatchedSigs mempty++-- | Create the union of two 'MatchedSigs' by checking if there a match in one+-- group for each sig in the other.+-- This is O(n^2) since there is no suitable ordering for sigs due to different+-- potential ordering of free vars.+unionMatchedSigs :: MatchedSigs -> MatchedSigs -> MatchedSigs+unionMatchedSigs (MatchedSigs a) (MatchedSigs b)+  = MatchedSigs+  . uncurry (++)+  -- fold compatible sigs from b in a, append the ones that are not compatible+  $ foldl' go (a, []) b+  where+    go (aSigs, nonMatches) bSig+      = let check (ss, False) aSig+              = case compatibleSigs aSig bSig of+                  Just s' -> (s' : ss, True)+                  Nothing -> (aSig : ss, False)+            check (ss, True) aSig = (aSig : ss, True)+         in case foldl' check ([], False) aSigs of+              (res, False) -> (res, bSig : nonMatches)+              (res, True) -> (res, nonMatches)++-- | Combines the names in two 'SigMatches' if the sigs match+compatibleSigs :: SigMatches -> SigMatches -> Maybe SigMatches+compatibleSigs (sigA, str, namesA) (sigB, _, namesB) =+  if evalState (checkMatch sigA sigB) initEnv+     then Just (sigA, str, namesA ++ namesB)+     else Nothing++-- | Check that two sigs are isomorphic+-- First step is to check that the contexts match.+checkMatch :: [Sig FreeVarIdx]+           -> [Sig FreeVarIdx]+           -> State Env Bool+-- VarCtx and Qual are both expected to occur at the front of the list+checkMatch (VarCtx va : restA) (VarCtx vb : restB)+  = introVars va vb+ /\ checkMatch restA restB+checkMatch (VarCtx _ : _) _ = pure False+checkMatch _ (VarCtx _ : _) = pure False++-- Appearance order of quals not significant+checkMatch (Qual qa : restA) bs@(Qual _ : _) =+  let (qualsB, restB) = span isQual bs+      splits = zip (inits qualsB) (tails qualsB)+      go (i, Qual f : rest)+        = checkMatch qa f+       /\ checkMatch restA (i ++ rest ++ restB)+      go _ = pure False+   in checkOr $ go <$> splits+checkMatch (Qual _ : _) _ = pure False+checkMatch _ (Qual _ : _) = pure False++checkMatch sa sb = checkResult sa sb++-- | Extract the result types and make sure they match before going any further.+checkResult :: [Sig FreeVarIdx]+            -> [Sig FreeVarIdx]+            -> State Env Bool+checkResult sa sb+  | ra : restA <- reverse sa+  , rb : restB <- reverse sb+  = checkArguments [ra] [rb]+ /\ checkArguments restA restB+checkResult _ _ = pure True++-- | After the result type has been removed, check the argument types.+checkArguments :: [Sig FreeVarIdx]+               -> [Sig FreeVarIdx]+               -> State Env Bool+checkArguments [] [] = pure True+checkArguments (FreeVar ai : restA) (FreeVar bi : restB)+  = tryAssignVar ai bi+ /\ checkArguments restA restB++checkArguments (TyDescriptor sa na : restA) (TyDescriptor sb nb : restB)+  | sa == sb+  , na == nb+  = checkArguments restA restB+  | otherwise = pure False++-- this is where we need to check for a failure and rotate the list+checkArguments (Arg aa : restA) sb =+  let splits = zip (inits sb) (tails sb)+      go (i, Arg ab : rest)+        = checkMatch aa ab+       /\ checkArguments restA (i ++ rest)+      go _  = pure False+   in checkOr $ go <$> splits++checkArguments (Apply ca aa : restA) (Apply cb ab : restB)+  | length aa == length ab+  = checkMatch ca cb+ /\ checkAnd (zipWith checkMatch aa ab)+ /\ checkArguments restA restB+  | otherwise = pure False++checkArguments (Tuple [] : restA) (Tuple [] : restB)+  = checkArguments restA restB+checkArguments (Tuple (a : as) : restA) (Tuple bs : restB)+  | length as + 1 == length bs+  , let splits = zip (inits bs) (tails bs)+        go (i, b : rest)+            = checkMatch a b+           /\ checkArguments [Tuple as] [Tuple $ i ++ rest]+           /\ checkArguments restA restB+        go _ = pure False+  = checkOr $ go <$> splits+  | otherwise = pure False++checkArguments (KindSig ta ka : restA) (KindSig tb kb : restB)+  = checkMatch ta tb+ /\ checkMatch ka kb+ /\ checkArguments restA restB++checkArguments _ _ = pure False+

@@ -0,0 +1,100 @@+{-# LANGUAGE MultiWayIf #-}+module MatchSigs.Matching.Env+  ( Env+  , (/\)+  , checkOr+  , checkAnd+  , introVars+  , tryAssignVar+  , initEnv+  ) where++import           Control.Monad.State.Strict+import           Data.List+import qualified Data.IntMap.Strict as IM++import           MatchSigs.Sig (FreeVarIdx)++type Level = Int+type VarLevel = IM.IntMap Int+type VarAssign = IM.IntMap FreeVarIdx++-- | Context for matching the free vars in two 'Sigs'+data Env =+  MkEnv { level    :: !Level -- current var level+        , vass     :: !VarAssign -- map from B vars to A vars+        , vlA      :: !VarLevel -- the level at which an A var with introduced+        , vlB      :: !VarLevel+        }++initEnv :: Env+initEnv =+  MkEnv { level    = 0+        , vass     = mempty+        , vlA      = mempty+        , vlB      = mempty+        }++-- | Identify var from one sig with var in other sig+tryAssignVar :: FreeVarIdx+             -> FreeVarIdx+             -> State Env Bool+tryAssignVar ai bi = do+  env <- get+  let mb = IM.lookup bi $ vass env+  if -- already assigned+     | Just x <- mb+     , x == ai -> pure True++     -- not assigned and levels match+     | Nothing <- mb+     , Just lA <- IM.lookup ai $ vlA env+     , Just lB <- IM.lookup bi $ vlB env+     , lA == lB+     -> do put env { vass = IM.insert bi ai $ vass env }+           pure True++     | otherwise -> pure False++-- | Add vars from both sigs to the context, accounting for level+introVars :: [FreeVarIdx]+          -> [FreeVarIdx]+          -> State Env Bool+introVars [] [] = pure True+introVars va vb+  | length va == length vb+  = (True <$) . modify' $ \env ->+      let lvl = level env+       in env { vlA = IM.fromList (zip va $ repeat lvl) <> vlA env+              , vlB = IM.fromList (zip vb $ repeat lvl) <> vlB env+              , level = lvl + 1+              }+  | otherwise = pure False++-- | Logical conjuction+(/\) :: State env Bool+     -> State env Bool+     -> State env Bool+a /\ b = do+  r <- a+  if r then b else pure False++checkAnd :: [State Env Bool]+         -> State Env Bool+checkAnd = foldl' (/\) (pure True)++-- | Logical disjunction. Discards state if False+(\/) :: State env Bool+     -> State env Bool+     -> State env Bool+a \/ b = StateT $ \env ->+  let (ar, as) = runState a env+      ~(br, bs) = runState b env+   in if ar then pure (ar, as)+            else if br then pure (br, bs)+                 else pure (False, env)++checkOr :: [State env Bool]+        -> State env Bool+checkOr = foldl' (\/) (pure False)+

@@ -0,0 +1,37 @@+module MatchSigs.Output+  ( sigDuplicateOutput+  ) where++import           Data.Map.Append.Strict (AppendMap(..))+import qualified Data.Map.Strict as M++import           Name+import           Outputable+import           PprColour++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++  where+    multipleNames (_, _, names) = length names > 1+    sigLine (_, renderedSig, names) =+      vcat+        [ coloured colCyanFg $ dcolon <+> text renderedSig+        , nest 2 $ count (length names)+        , vcat $ printName <$> names+        , text ""+        ]++    printName name =+      let nameDoc = coloured colYellowFg $ ppr name+          locDoc = coloured colMagentaFg . parens $ pprDefinedAt name+       in char '•' <+> nameDoc <+> locDoc+    count x = coloured colCyanFg (int x) <+> text "matches:"+

@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+module MatchSigs.ProcessHie+  ( SigMap+  , MatchedSigs(..)+  , mkSigMap+  ) where++import qualified Data.Map.Strict as M+import           Data.Map.Append.Strict (AppendMap(..))++import           HieTypes+import           HieUtils++import           DynFlags+import           Name+import           MatchSigs.Matching (MatchedSigs(..))+import           MatchSigs.Sig (Sig, sigFingerprint, sigsFromHie)+import           Utils++type SigMap = AppendMap [Sig ()] MatchedSigs++-- | Collect all the function definitions in the 'HieAST' that have isomorphic+-- type signatures.+mkSigMap :: DynFlags -> HieAST HieTypeFix -> SigMap+mkSigMap dynFlags node =+  let renderedSigs = foldNodeChildren (nameSigRendered dynFlags) node+      sigReps = foldNodeChildren sigsFromHie node+      mkMatch n s r = (sigFingerprint r, MatchedSigs [(r, s, [n])])+      sigMatches = M.elems $ M.intersectionWithKey mkMatch renderedSigs sigReps+   in AppendMap $ M.fromListWith (<>) sigMatches++-- | Produce a 'Map' from function 'Name's to their rendered type signatures+nameSigRendered :: DynFlags -> HieAST HieTypeFix -> M.Map Name String+nameSigRendered dynFlags node+  | nodeHasAnnotation "FunBind" "HsBindLR" node+  , Just ident <- mIdent+  , Right name : _ <- M.keys . nodeIdentifiers $ nodeInfo ident+  , let renderedTy = unwords+                   . map (renderHieType dynFlags)+                   . nodeType+                   $ nodeInfo node+  = M.singleton name renderedTy++  | otherwise = mempty+  where+    mIdent+      | c : _ <- nodeChildren node+      -- multiple decls result in Match nodes+      , nodeHasAnnotation "Match" "Match" c+      , i : _ <- nodeChildren c+      = Just i++      | i : _ <- nodeChildren node+      = Just i++      | otherwise = Nothing

@@ -0,0 +1,220 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+module MatchSigs.Sig+  ( FreeVarIdx+  , Sig(..)+  , sigsFromHie+  , sigFingerprint+  , isQual+  ) where++import           Control.Monad.State+import           Data.Either+import           Data.List+import qualified Data.Map.Strict as M+import qualified Data.Set as S++import           HieTypes++import           Name+import           FastString+import           Utils++type FreeVarIdx = Int++-- TODO linear types+-- | The internal representation of a type. Function types are represented as a+-- 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)+  | FreeVar !varIx+  | Arg ![Sig varIx]+  | Qual ![Sig varIx]+  | Apply ![Sig varIx] ![[Sig varIx]]+  | VarCtx ![varIx]+  | Tuple ![[Sig varIx]]+  | KindSig ![Sig varIx] ![Sig varIx]+  deriving (Eq, Ord, Foldable, Functor)++instance Show varIx => Show (Sig varIx) where+  show (TyDescriptor fs _) = "TyDescriptor " <> show fs+  show (FreeVar ix) = "Var " <> show ix+  show (Arg a) = show a <> " -> "+  show (Qual q) = show q <> " => "+  show (Apply c args) = "App " <> show c <> " " <> show args+  show (VarCtx a) = "forall " <> show a <> ". "+  show (Tuple t) = "Tuple " <> show t+  show (KindSig x s) = show x <> " :: " <> show s++isQual :: Sig a -> Bool+isQual (Qual _) = True+isQual _ = False++isVarDecl :: Sig a -> Bool+isVarDecl (VarCtx _) = True+isVarDecl _ = False++-- | Produce a 'Map' from function 'Name's to their type signature's+-- internal representation.+sigsFromHie :: HieAST a -> M.Map Name [Sig FreeVarIdx]+sigsFromHie node+  | nodeHasAnnotation "TypeSig" "Sig" node+  , identNode : sigNode : _ <- nodeChildren node+  , Right name : _ <- M.keys . nodeIdentifiers $ nodeInfo identNode+  , let freeVars = extractFreeVars+  , let sig = evalState (mkSig sigNode) freeVars+        sig' | M.null freeVars = sig+             | otherwise = VarCtx (M.elems freeVars) : sig+        -- move qualifiers and var decls to front, collapsing var decls+        sig'' = frontLoadVarDecls $ frontLoadQuals sig'+  , not $ null sig''+  = M.singleton name sig''++  | otherwise = mempty++  where+    extractFreeVars = M.fromList . (`zip` [0..])+                    . rights . M.keys+                    . nodeIdentifiers+                    $ nodeInfo node++-- | Traverses the 'HieAST', building the representation for a function sig.+-- The `State` is for tracking free vars.+mkSig :: HieAST a -> State (M.Map Name FreeVarIdx) [Sig FreeVarIdx]+mkSig node+  -- function ty+  | nodeHasAnnotation "HsFunTy" "HsType" node+  , arg : rest : _ <- nodeChildren node+  = do+    sigArg <- mkSig arg+    -- curry tuple arguments+    let sigArg' = case sigArg of+                    [Tuple xs] | not (null xs) -> Arg <$> xs+                    a -> [Arg a]+    (sigArg' ++) <$> mkSig rest++  -- application+  | nodeHasAnnotation "HsAppTy" "HsType" node+  , con : rest <- nodeChildren node+  = fmap (:[]) $ Apply <$> mkSig con+                       <*> traverse mkSig rest++  -- constraint (qualifier)+  | nodeHasAnnotation "HsQualTy" "HsType" node+  , constraint : rest : _ <- nodeChildren node+  = do+    quals <- mkQuals constraint+    (quals ++) <$> mkSig rest++  -- parens+  | nodeHasAnnotation "HsParTy" "HsType" node+  , child : _ <- nodeChildren node+  = mkSig child++  -- free var decl+  | nodeHasAnnotation "HsForAllTy" "HsType" node+  , rest : userVarNodes <- reverse $ nodeChildren node+  = do+    vars <- foldM extractFreeVar [] userVarNodes+    (VarCtx vars :) <$> mkSig rest++  -- tuples+  | nodeHasAnnotation "HsTupleTy" "HsType" node+  , let children = nodeChildren node+  = fmap (:[]) $ Tuple <$> traverse mkSig children++  -- list ty+  | nodeHasAnnotation "HsListTy" "HsType" node+  , child : _ <- nodeChildren node+  = do+    c <- mkSig child+    pure [Apply [TyDescriptor "HsListTy" Nothing] [c]]++  -- kind sigs+  | nodeHasAnnotation "HsKindSig" "HsType" node+  , ty : ki : _ <- nodeChildren node+  = fmap (:[])+  $ KindSig <$> mkSig ty+            <*> mkSig ki++  -- any other type+  | (ty, "HsType") : _ <- S.toList . nodeAnnotations $ nodeInfo node+  , let mbName = extractName node+  = do+    freeVars <- get+    case mbName of+      Just name+        | Just idx <- freeVars M.!? name+        -> pure [FreeVar idx]+      _ -> pure [TyDescriptor ty mbName]++  | otherwise = pure []++  where+    extractName :: HieAST a -> Maybe Name+    extractName n+      | Right name : _ <- M.keys . nodeIdentifiers $ nodeInfo n+      = Just name+      | otherwise = Nothing++    extractFreeVar ixs n+      | nodeHasAnnotation "UserTyVar" "HsTyVarBndr" n+      , Just name <- extractName n+      = do+        ix <- gets M.size+        ix : ixs <$ modify' (M.insert name ix)+      | otherwise = pure ixs++    -- produce one ore more Quals from a constraint node+    mkQuals c+      | S.null . nodeAnnotations $ nodeInfo c+      = fmap Qual <$> traverse mkSig (nodeChildren c)+      | otherwise = fmap (:[]) $ Qual <$> mkSig c++-- | Recursively transform a '[Sig a]'.+recurseSig :: ([Sig a] -> [Sig a]) -> [Sig a] -> [Sig a]+recurseSig f = f . map go where+  go (Arg s) = Arg $ recurseSig f s+  go (Qual s) = Qual $ recurseSig f s+  go (Apply a as) =+    Apply (recurseSig f a)+          (recurseSig f <$> as)+  go (Tuple es) =+    Tuple (recurseSig f <$> es)+  go (KindSig ty ks) =+    KindSig (recurseSig f ty)+            (recurseSig f ks)+  go x@TyDescriptor{} = x+  go x@FreeVar{} = x+  go x@VarCtx{} = x++-- | Used to produce an orderable key for matching up signatures that are+-- likely to be equivalent. To allow for this, free vars must be homogenized+-- which is what 'void' does here.+sigFingerprint :: [Sig a] -> [Sig ()]+sigFingerprint = recurseSig go . map void+  where+    go = sort . map sortTuple+    sortTuple (Tuple es) = Tuple $ sort es+    sortTuple x = x++-- | Move qualifiers to the front of a sig, and recursively for sub-sigs+frontLoadQuals :: [Sig a] -> [Sig a]+frontLoadQuals = recurseSig go where+  go = uncurry (++) . partition isQual++-- | Move free var decls to the front of a sig, and recursively for sub-sigs+frontLoadVarDecls :: [Sig a] -> [Sig a]+frontLoadVarDecls = recurseSig go+  where+  go sig =+    let (varSigs, rest) = partition isVarDecl sig+     in collapseVarCtx varSigs : rest++  collapseVarCtx = VarCtx . concatMap getVars+  getVars (VarCtx vs) = vs+  getVars _ = []+

@@ -0,0 +1,46 @@+module Output+  ( printResults+  ) where++import           DynFlags+import           Outputable+import           PprColour+import           Pretty (Mode(PageMode))+import           System.IO (stdout)++import           DefCounts.Output+import           HieFile (Counters)+import           MatchSigs.Output+import           UseCounts.Output++printResults :: DynFlags+             -> Counters+             -> IO ()+printResults dynFlags (defCounter, usageCounter, sigDupeMap, totalLines) = do+  let output = vcat+        [ separator+        , text ""+        , keyword $ text "Duplicate Type Signatures"+        , text ""+        , sigDuplicateOutput sigDupeMap+        , text ""+        , separator+        , text ""+        , keyword $ text "Usage Totals"+        , text ""+        , usageOutput usageCounter+        , text ""+        , separator+        , text ""+        , keyword $ text "Definition Counts"+        , text ""+        , defCountOutput defCounter totalLines+        , text ""+        , separator+        ]+      pprStyle = setStyleColoured True $ defaultUserStyle dynFlags++      separator = coloured colGreenFg $ text "********************************************************************************"++  printSDocLn PageMode dynFlags stdout pprStyle output+

@@ -0,0 +1,47 @@+module UseCounts.Output+  ( usageOutput+  ) where++import           Data.List+import           Data.Map.Append.Strict (AppendMap(..))+import qualified Data.Map.Strict as M+import           Data.Ord (Down(..))++import           Name+import           Outputable+import           PprColour++import           UseCounts.ProcessHie (UsageCounter, UsageCount(..))++limit :: Int+limit = 15++usageOutput :: UsageCounter -> SDoc+usageOutput (AppendMap usageCounter) =+  if length uses < limit+     then vcat uses+     else vcat [ text $ show limit ++ " Least used definitions:"+               , vcat . take limit $ reverse uses+               , text ""+               , text $ show limit ++ " Most used definitions:"+               , vcat $ take limit uses+               ]+  where+    uses = fmap (uncurry usageLine)+         . sortOn (Down . usages . snd)+         . M.toList+         $ M.filter locallyDefined usageCounter++usageLine :: Name -> UsageCount -> SDoc+usageLine name usage+  = let numUses = usages usage+        u | numUses == 1 = text "use"+          | otherwise = text "uses"+        in  nameOutput name+        $+$ nest 2 (coloured colCyanFg (intWithCommas numUses) <+> u)++nameOutput :: Name -> SDoc+nameOutput name = nameDoc <+> locDoc where+  nameDoc = coloured colYellowFg $ ppr name+  locDoc = coloured colMagentaFg . parens $ pprDefinedAt name+

@@ -0,0 +1,94 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+module UseCounts.ProcessHie+  ( UsageCounter+  , UsageCount(..)+  , usageCounter+  ) where++import qualified Data.Map.Strict as M+import           Data.Map.Append.Strict (AppendMap(..))+import           Data.Maybe++import           HieTypes++import           Name+import           Utils++data UsageCount =+  UsageCount+    { usages :: !Int+    , locallyDefined :: !Bool+    } deriving Show++instance Semigroup UsageCount where+  UsageCount na da <> UsageCount nb db+    = UsageCount (na + nb) (da || db)++instance Monoid UsageCount where+  mempty = UsageCount 0 False++type UsageCounter = AppendMap Name UsageCount++usageCounter :: HieAST a -> UsageCounter+usageCounter node+  | nodeHasAnnotation "FunBind" "HsBindLR" node+  = foldMap findUsage (nodeChildren node)+ <> foldMap declaration (listToMaybe $ nodeChildren node)++  -- only get usages from instance declarations+  | any ((== "InstDecl") . snd) (nodeAnnotations $ nodeInfo node)+  = foldMap findUsage (nodeChildren node)++  | otherwise+  = foldMap declaration (nodeChildren node)+ <> foldMap findUsage (nodeChildren node)++-- | Accrues all the top-level declarations if all different types+declaration :: HieAST a -> UsageCounter+declaration node+  | any ((== "ConDecl") . snd) (nodeAnnotations $ nodeInfo node)+  = dataConDecl node+declaration node = M.foldMapWithKey f . nodeIdentifiers $ nodeInfo node+  where+    f (Right name) details = foldMap g (identInfo details) where+      declare = AppendMap $ M.singleton name (UsageCount 0 True)+      g (ValBind RegularBind ModuleScope _) = declare+      g (PatternBind ModuleScope _ _)       = declare+      g (Decl t _) | checkDeclType t        = declare+      g TyDecl                              = declare+      g ClassTyDecl{}                       = declare+      g _                                   = mempty+    f _ _ = mempty++    checkDeclType = \case+      InstDec -> False -- type fam instance is not a declaration+      _       -> True++-- | Handles data constructor declarations+dataConDecl :: HieAST a -> UsageCounter+dataConDecl node = foldMap declaration dec+                <> foldMap conField (nodeChildren =<< fields)+  where+    (dec, rest) = splitAt 1 $ nodeChildren node+    (fields, _) = splitAt 1 rest+    conField n+      | nodeHasAnnotation "ConDeclField" "ConDeclField" n+      = foldMap declaration (nodeChildren n)+      | otherwise = mempty++-- | Counts up the uses of all symbols in the AST.+findUsage :: HieAST a -> UsageCounter+findUsage node = (M.foldMapWithKey f . nodeIdentifiers . nodeInfo) node+              <> foldMap findUsage (nodeChildren node)+  where+    f (Right name) details = foldMap g (identInfo details) where+      use = AppendMap $ M.singleton name (UsageCount 1 False)+      g Use                                  = use+      g (ValBind InstanceBind ModuleScope _) = use+      g (Decl InstDec _)                     = use+      g (RecField RecFieldAssign _)          = use+      g (RecField RecFieldMatch _)           = use+      g _                                    = mempty+    f _ _ = mempty+

@@ -0,0 +1,18 @@+module Utils+  ( nodeHasAnnotation+  , foldNodeChildren+  ) where++import qualified Data.Set as S+import           Data.String++import           HieTypes++nodeHasAnnotation :: String -> String -> HieAST a -> Bool+nodeHasAnnotation constructor ty =+    S.member (fromString constructor, fromString ty)+  . nodeAnnotations+  . nodeInfo++foldNodeChildren :: Monoid m => (HieAST a -> m) -> HieAST a -> m+foldNodeChildren f = foldMap f . nodeChildren

@@ -0,0 +1,7 @@+module HieSource.T1 where++t1A :: String -> Int+t1A = undefined++t1B :: String -> Int+t1B = undefined

@@ -0,0 +1,16 @@+module HieSource.T10 where++t10A :: (Int, a) -> String -> Bool+t10A = undefined++t10B :: a -> String -> Int -> Bool+t10B = undefined++t10C :: Int -> (a, String) -> Bool+t10C = undefined++t10D :: (Int, String) -> a -> Bool+t10D = undefined++t10E :: (Int, a, String) -> Bool+t10E = undefined

@@ -0,0 +1,8 @@+{-# LANGUAGE RankNTypes #-}+module HieSource.T11 where++t11A :: a -> (b -> Int) -> a+t11A = undefined++t11B :: a -> (forall b. b -> Int) -> a+t11B a _ = a

@@ -0,0 +1,7 @@+module HieSource.T12 where++t12A :: Monad m => a -> Either (m a) Int+t12A = undefined++t12B :: Functor m => a -> Either (m a) Int+t12B = undefined

@@ -0,0 +1,9 @@+{-# LANGUAGE RankNTypes #-}+module HieSource.T13 where++t13A :: Monad m => (forall b m'. Monad m => a -> (m' (a -> b), m b)) -> m Int+t13A _ = undefined++t13B :: Monad m => (forall b m'. Monad m => a -> (m b, m' (a -> b))) -> m Int+t13B _ = undefined+

@@ -0,0 +1,14 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+module HieSource.T14 where++import           Data.Proxy++t14A :: Proxy (a :: [b]) -> b -> k a b+t14A = undefined++t14B :: b -> Proxy (a :: [b]) -> k a b+t14B = undefined++t14C :: Proxy (a :: b) -> b -> k a b+t14C = undefined

@@ -0,0 +1,7 @@+module HieSource.T15 where++class C a where+  c :: a -> ()++instance C Int where+  c _ = ()

@@ -0,0 +1,9 @@+module HieSource.T16 where++newtype T = T { f :: () }++instance Show T where+  show x = show $ foo x++foo :: T -> T+foo a@T{ f = () } = a

@@ -0,0 +1,41 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE StandaloneDeriving #-}+module HieSource.T17+  ( foo+  , D(..)+  , T(..)+  , C+  , TF+  , TF'+  , pattern P+  , TS+  ) where++import           Data.Void++data D = D { a :: Void, b :: Int }++deriving instance Show D++newtype T = T { unT :: Int }+  deriving (Eq, Show)++class C a where++instance C Int++type family TF a++type instance TF Bool = Int++type family TF' a where+  TF' Bool = Int++foo :: a -> a+foo = id++pattern P :: Int+pattern P = 4++type TS = ()

@@ -0,0 +1,32 @@+module HieSource.T18 where++import qualified Data.IntMap.Strict as IM++data Sig a = X a | Y a++type FreeVarIdx = Int++t18A :: IM.IntMap FreeVarIdx+     -> [Sig FreeVarIdx]+     -> [Sig FreeVarIdx]+     -> Bool+t18A _ [] = undefined+t18A _ _ = undefined++t18B :: IM.IntMap FreeVarIdx+     -> [Sig FreeVarIdx]+     -> [Sig FreeVarIdx]+     -> Bool+t18B = undefined++t18C :: IM.IntMap FreeVarIdx+     -> [Sig FreeVarIdx]+     -> [Sig FreeVarIdx]+     -> Bool+t18C = undefined++t18D :: IM.IntMap FreeVarIdx+     -> [Sig FreeVarIdx]+     -> [Sig FreeVarIdx]+     -> Bool+t18D = undefined

@@ -0,0 +1,11 @@+{-# LANGUAGE RankNTypes #-}+module HieSource.T19 where++t19A :: forall a. a -> forall b. b -> Either a b+t19A = undefined++t19B :: forall b a. a -> b -> Either a b+t19B = undefined++t19C :: forall b a. b -> a -> Either a b+t19C = undefined

@@ -0,0 +1,7 @@+module HieSource.T2 where++t2A :: String -> Bool -> Int+t2A = undefined++t2B :: Bool -> String -> Int+t2B = undefined

@@ -0,0 +1,17 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+module HieSource.T20 where++import           Data.Proxy++t20A :: Proxy (a :: [b] -> Bool -> Either b c) -> b -> c+t20A = undefined++t20B :: b -> Proxy (a :: Bool -> [b] -> Either b c) -> c+t20B = undefined++t20C :: b -> Proxy (a :: Bool -> [b] -> Either c b) -> c+t20C = undefined++t20D :: b -> Proxy (a :: Bool -> Either c b -> [b]) -> c+t20D = undefined

@@ -0,0 +1,13 @@+module HieSource.T21 where++t21A :: a -> b -> a+t21A = undefined++t21B :: a -> a -> a+t21B = undefined++t21D :: a -> b -> c+t21D = undefined++t21C :: a -> a -> c+t21C = undefined

@@ -0,0 +1,7 @@+module HieSource.T3 where++t3A :: a -> String -> Int+t3A = undefined++t3B :: String -> b -> Int+t3B = undefined

@@ -0,0 +1,7 @@+module HieSource.T4 where++t4A :: a -> b -> Either a b+t4A = undefined++t4B :: b -> a -> Either a b+t4B = undefined

@@ -0,0 +1,8 @@+{-# LANGUAGE RankNTypes #-}+module HieSource.T5 where++t5A :: Monad m => a -> m a+t5A = undefined++t5B :: forall b m. Monad m => b -> m b+t5B = undefined

@@ -0,0 +1,11 @@+{-# LANGUAGE RankNTypes #-}+module HieSource.T6 where++t6A :: (Show a, Num b) => a -> b -> (a, b)+t6A = undefined++t6B :: (Num b, Show a) => a -> b -> (a, b)+t6B = undefined++t6C :: Num b => b -> Show a => a -> (a, b)+t6C = undefined

@@ -0,0 +1,10 @@+module HieSource.T7 where++t7A :: (a, b -> c) -> (a -> b, ()) -> c+t7A = undefined++t7B :: (a -> b, ()) -> (a, b -> c) -> c+t7B = undefined++t7C :: (a -> c, ()) -> (a, b -> c) -> c+t7C = undefined

@@ -0,0 +1,13 @@+module HieSource.T8 where++t8A :: a -> Int -> (a, Int)+t8A = undefined++t8B :: a -> Int -> (Int, a)+t8B = undefined++t8C :: a -> Int -> (Int, (Int -> a, a))+t8C = undefined++t8D :: Int -> a -> ((a, Int -> a), Int)+t8D = undefined

@@ -0,0 +1,10 @@+module HieSource.T9 where++t9A :: Int -> Bool -> String+t9A = undefined++t9B :: (Bool, Int) -> String+t9B = undefined++t9C :: (Int, Bool) -> String+t9C = undefined

@@ -0,0 +1,93 @@+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.DynFlags+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 ->+  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]++    , testCase "Definition Counting" $ do+        (nameCache, dynFlags) <- ioResources+        defCountTest "T15" nameCache dynFlags+          . AppendMap $ M.fromList [(Class, (2, 1)), (ClassInst, (2, 1))]+        defCountTest "T17" nameCache dynFlags+          . AppendMap $ M.fromList+              [ (Class, (1, 1))+              , (Data, (3, 2))+              , (Fam, (2, 2))+              , (Func, (2, 1))+              , (PatSyn, (1, 1))+              , (Syn, (1, 1))+              , (ClassInst, (2, 2))+              , (TyFamInst, (2, 2))+              , (ModImport, (1, 1))+              , (ExportThing, (5, 5))+              ]++    , testCase "Use Counts" $ do+        (nameCache, dynFlags) <- ioResources+        useCountTest "T16" nameCache dynFlags [1,1,1,3]+    ]++sigMatchTest :: String -> NameCache -> DynFlags -> [Int] -> IO ()+sigMatchTest testName nc dynFlags sigGroupSizes = do+  (_, _, AppendMap sigMap, _) <- getCounters testName nc 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+  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)++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