stan 0.0.1.0 → 0.1.0.0
raw patch · 39 files changed
+1404/−467 lines, 39 filesdep ~basedep ~bytestringdep ~claynew-uploader
Dependency ranges changed: base, bytestring, clay, colourista, containers, extensions, ghc, ghc-boot-th, hedgehog, hspec, hspec-hedgehog, optparse-applicative, pretty-simple, relude, slist, text, unordered-containers
Files
- CHANGELOG.md +11/−0
- README.md +27/−14
- src/Stan.hs +0/−1
- src/Stan/Analysis.hs +4/−5
- src/Stan/Analysis/Analyser.hs +111/−145
- src/Stan/Analysis/Visitor.hs +126/−0
- src/Stan/Browse.hs +0/−1
- src/Stan/EnvVars.hs +0/−1
- src/Stan/Ghc/Compat.hs +11/−57
- src/Stan/Ghc/Compat810.hs +75/−0
- src/Stan/Ghc/Compat900.hs +80/−0
- src/Stan/Ghc/Compat902.hs +74/−0
- src/Stan/Hie.hs +10/−11
- src/Stan/Hie/Compat.hs +11/−39
- src/Stan/Hie/Compat810.hs +77/−0
- src/Stan/Hie/Compat900.hs +97/−0
- src/Stan/Hie/Compat902.hs +115/−0
- src/Stan/Hie/Compat904.hs +103/−0
- src/Stan/Hie/Debug.hs +11/−78
- src/Stan/Hie/Debug810.hs +84/−0
- src/Stan/Hie/Debug900.hs +102/−0
- src/Stan/Hie/Debug902.hs +102/−0
- src/Stan/Hie/MatchAst.hs +10/−6
- src/Stan/Hie/MatchType.hs +3/−2
- src/Stan/Inspection/AntiPattern.hs +5/−5
- src/Stan/Inspection/Partial.hs +6/−0
- src/Stan/NameMeta.hs +3/−3
- src/Stan/Observation.hs +2/−2
- src/Stan/Pattern/Ast.hs +44/−38
- src/Stan/Pattern/Type.hs +35/−5
- src/Stan/Report/Css.hs +12/−1
- src/Stan/Report/Html.hs +9/−10
- stan.cabal +37/−34
- test/Spec.hs +1/−1
- test/Test/Stan/Analysis.hs +1/−1
- test/Test/Stan/Analysis/Common.hs +2/−2
- test/Test/Stan/Analysis/Partial.hs +1/−3
- test/Test/Stan/Number.hs +1/−1
- test/Test/Stan/Observation.hs +1/−1
CHANGELOG.md view
@@ -3,6 +3,17 @@ `stan` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +## 0.1.0.0++* Add support for GHCs 9.0, 9.2 and 9.4+* [#55](https://github.com/kowainik/stan/issues/55):+ Implement single-pass HIE AST traversal.+* [#348](https://github.com/kowainik/stan/issues/348):+ Compress binaries for GitHub releases.+* [#368](https://github.com/kowainik/stan/issues/368):+ Fix inspections for `unordered-containers` functions to support the+ latest package version.+ ## 0.0.1.0 — Jul 9, 2020 * [#320](https://github.com/kowainik/stan/issues/320):
README.md view
@@ -4,7 +4,7 @@ [](https://github.com/kowainik/stan/actions) [](https://hackage.haskell.org/package/stan)-[](https://github.com/kowainik/stan/blob/master/LICENSE)+[](https://github.com/kowainik/stan/blob/main/LICENSE) Stan is a Haskell **ST**atic **AN**alysis tool. @@ -33,15 +33,17 @@ * [Converting between TOML and CLI configurations](#converting-between-toml-and-cli-configurations) * [Other tools](#other-tools) * [Roadmap](#roadmap)+ * [Users](#users) * [Links to Wiki](#links-to-wiki) ## What this tool is about [[Back to the Table of Contents] ↑](#table-of-contents) -Stan is a command-line tool for analysing Haskell projects and-outputting discovered vulnerabilities in a helpful way with possible-solutions for detected problems. Stan is searching for not only+Stan is a command-line tool for analysing Haskell projects.+It discovers which parts of the code can potentially be improved,+and offers suggestions on how to do so.+Stan is searching for not only performance or error-prone code pieces, but it also can help with establishing and applying best-practices from the whole Haskell ecosystem.@@ -56,13 +58,19 @@ more guarantees from your code, not provided by the Haskell type system or GHC. +For a crash course to Stan, watch the talk about Stan, presented by+Veronika Romashkina and Dmitrii Kovanikov at the Haskell Love+conference.++[](https://www.youtube.com/watch?v=wb5PLv6-e6I)+ ## Goals [[Back to the Table of Contents] ↑](#table-of-contents) Stan design and implementation is driven by the following goals: -- Catch common vulnerabilities, anti-patterns, performance issues+- Catch common errors, anti-patterns, performance issues - Provide meaningful insights on the projects generally - Point out potential bugs and weak points in the programs flow for users, so they can carefully evaluate each problem with the code@@ -111,7 +119,7 @@ [_final tagless_](http://okmij.org/ftp/tagless-final/course/lecture.pdf) approach. Stan algorithm traverses HIE AST for each HIE file in the project, and matches every AST node with the given pattern to find-potential vulnerabilities in the code.+potential improvement areas in the code. Each Stan analysis check is represented by the __inspection__ with the unique ID. Each inspection has a name, description, __severity__, list@@ -119,8 +127,8 @@ and possible solutions to the problem. When an inspection is casted on the project, it produces zero or more-__observations__ — vulnerabilities in the specific parts of the-code. You can think of an _observation_ as a pair of an inspection and+__observations__ —.+You can think of an _observation_ as a pair of an inspection and a piece of source code where this inspection was triggered. Each observation is assigned an unique stable ID depending on the source location, so you can refer to them later or ignore.@@ -178,12 +186,9 @@ so: ```shell-$ cp dist-newstyle/build/x86_64-linux/ghc-8.8.3/stan-0.0.0.0/x/stan/build/stan/stan ~/.local/bin/stan+$ cp "$(cabal v2-exec --verbose=0 --offline sh -- -c 'command -v stan')" ~/.local/bin/stan ``` -> The path to the executable will be outputted as the last line of the-> previous command.- ### Using Stack [[Back to the Table of Contents] ↑](#table-of-contents)@@ -318,7 +323,7 @@ $ stan ``` -to see all found vulnerabilities in your terminal.+to see all found suggestions in your terminal. If you want to see a more detailed information in a more structured way, you can generate an HTML report (to the `stan.html` file) using@@ -435,7 +440,7 @@ | Sub-command | Description | Examples | |-------------|-------------|----------|-| `check` | Set up rules to control the set of inspections per scope. | `stan check --exclude --category=Infinity --scope=all check --include --id "STAN-0101" --file=src/File.hs` |+| `check` | Set up rules to control the set of inspections per scope. | `stan check --exclude --category=Infinity --scope-all check --include --id "STAN-0101" --file=src/File.hs` | | `remove` | Remove some files from the analysis completely. Stan won't be run in the specified scope at all. | `stan remove --file=src/File.hs remove --directory=folder/` | | `ignore` | Ignore specific observation that was found in your project | `stan ignore --id "OBS-STAN-0001-YrzpQi-11:42"` | @@ -615,6 +620,14 @@ We have much more ideas to work on. See more detailed plan in the dedicated [GitHub Project page](https://github.com/kowainik/stan/projects/1).++## Users++Stan is known to be adopted by the following companies:++* A major international bank+* [ITProTV](https://www.itpro.tv/)+* [Soisy](https://www.soisy.it/) ## Links to Wiki
src/Stan.hs view
@@ -16,7 +16,6 @@ import Colourista (errorMessage, formatWith, infoMessage, italic, successMessage, warningMessage) import Data.Aeson.Micro (encode) import System.Directory (doesFileExist, getCurrentDirectory)-import System.Environment (getArgs) import System.FilePath (takeFileName) import Trial (Trial (..), prettyTaggedTrial, prettyTrial, prettyTrialWith, trialToMaybe, whenResult_)
src/Stan/Analysis.hs view
@@ -16,7 +16,7 @@ SafeHaskellExtension, parseSourceWithPath, showOnOffExtension) import Relude.Extra.Lens (Lens', lens, over) -import Stan.Analysis.Analyser (analysisByInspection)+import Stan.Analysis.Analyser (analyseAst) import Stan.Cabal (mergeParsedExtensions) import Stan.Core.Id (Id) import Stan.Core.ModuleName (fromGhcModule)@@ -184,10 +184,9 @@ -- merge cabal and module extensions and update overall exts let fileInfoMergedExtensions = mergeParsedExtensions fileInfoCabalExtensions fileInfoExtensions -- get list of inspections for the file- let ins = mapMaybe lookupInspectionById (toList insIds)- let allObservations = S.concatMap- (\iId -> analysisByInspection fileInfoMergedExtensions iId hieFile)- ins+ let inss = mapMaybe lookupInspectionById (toList insIds)+ -- get all observations by analysing ast+ let allObservations = analyseAst hieFile fileInfoMergedExtensions inss let (ignoredObs, fileInfoObservations) = S.partition ((`elem` obs) . observationId) allObservations incModulesNum
src/Stan/Analysis/Analyser.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE BangPatterns #-}- {- | Copyright: (c) 2020 Kowainik SPDX-License-Identifier: MPL-2.0@@ -10,20 +8,21 @@ -} module Stan.Analysis.Analyser- ( analysisByInspection+ ( analyseAst ) where import Extensions (ExtensionsResult) import GHC.LanguageExtensions.Type (Extension (Strict, StrictData))-import Slist (Slist, slist)+import Slist (Slist) +import Stan.Analysis.Visitor (Visitor (..), VisitorState (..), addFixity, addObservation,+ addObservations, addOpDecl, getFinalObservations) import Stan.Core.Id (Id) import Stan.Core.List (nonRepeatingPairs) import Stan.FileInfo (isExtensionDisabled) import Stan.Ghc.Compat (RealSrcSpan, isSymOcc, nameOccName, occNameString) import Stan.Hie (eqAst)-import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieFile (..), Identifier, NodeInfo (..),- TypeIndex)+import Stan.Hie.Compat (HieAST (..), HieFile (..), Identifier, NodeInfo (..), TypeIndex, nodeInfo) import Stan.Hie.MatchAst (hieMatchPatternAst) import Stan.Inspection (Inspection (..), InspectionAnalysis (..)) import Stan.NameMeta (NameMeta, ghcPrimNameFrom)@@ -34,39 +33,38 @@ patternMatch_, rhs, tuple, typeSig) import Stan.Pattern.Edsl (PatternBool (..)) -import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Slist as S --{- | Create analysing function for 'Inspection' by pattern-matching-over 'InspectionAnalysis'.+{- | Analyses the whole AST starting from the very top. -}-analysisByInspection- :: ExtensionsResult- -> Inspection- -> HieFile+analyseAst+ :: HieFile+ -> ExtensionsResult+ -> [Inspection] -> Observations-analysisByInspection exts Inspection{..} = case inspectionAnalysis of- FindAst patAst -> analyseAst inspectionId patAst- Infix -> analyseInfix inspectionId- LazyField -> memptyIfFalse- (isExtensionDisabled StrictData exts && isExtensionDisabled Strict exts)- (analyseLazyFields inspectionId)- BigTuples -> analyseBigTuples inspectionId- PatternMatchOn_ -> analysePatternMatch_ inspectionId- UseCompare -> analyseCompare inspectionId+analyseAst hie exts = getFinalObservations hie . createVisitor hie exts -{- | Check for occurrences of the specified function given via 'NameMeta'.+{- | Create a sinble 'Visitor' value from a list of 'Inspection's and+additional read-only context. This 'Visitor' can be used to traverse+HIE AST in a single pass. -}-analyseAst- :: Id Inspection- -> PatternAst- -> HieFile- -> Observations-analyseAst insId patAst hie =- mkObservation insId hie <$> analyseAstWith (createMatch patAst hie) hie+createVisitor+ :: HieFile+ -> ExtensionsResult+ -> [Inspection]+ -> Visitor+createVisitor hie exts inspections = Visitor $ \node ->+ forM_ inspections $ \Inspection{..} -> case inspectionAnalysis of+ FindAst patAst -> matchAst inspectionId patAst hie node+ Infix -> analyseInfix hie node+ LazyField -> when+ (isExtensionDisabled StrictData exts && isExtensionDisabled Strict exts)+ (analyseLazyFields inspectionId hie node)+ BigTuples -> analyseBigTuples inspectionId hie node+ PatternMatchOn_ -> analysePatternMatch_ inspectionId hie node+ UseCompare -> analyseCompare inspectionId hie node {- | Check for big tuples (size >= 4) in the following places: @@ -76,11 +74,9 @@ analyseBigTuples :: Id Inspection -> HieFile- -> Observations-analyseBigTuples insId hie =- S.map (mkObservation insId hie . nodeSpan)- $ S.filter isBigTuple- $ analyseAstWith (createMatchAst tuple hie) hie+ -> HieAST TypeIndex+ -> State VisitorState ()+analyseBigTuples insId = matchAstWith isBigTuple insId tuple where isBigTuple :: HieAST TypeIndex -> Bool isBigTuple Node{..} = case nodeChildren of@@ -98,9 +94,10 @@ analyseCompare :: Id Inspection -> HieFile- -> Observations-analyseCompare insId hie =- mkObservation insId hie <$> analyseAstWith matchComparisonGuards hie+ -> HieAST TypeIndex+ -> State VisitorState ()+analyseCompare insId hie curNode =+ addObservations $ mkObservation insId hie <$> matchComparisonGuards curNode where matchComparisonGuards :: HieAST TypeIndex -> Slist RealSrcSpan matchComparisonGuards node = memptyIfFalse@@ -161,9 +158,10 @@ analyseLazyFields :: Id Inspection -> HieFile- -> Observations-analyseLazyFields insId hie =- mkObservation insId hie <$> analyseAstWith matchLazyField hie+ -> HieAST TypeIndex+ -> State VisitorState ()+analyseLazyFields insId hie curNode =+ addObservations $ mkObservation insId hie <$> matchLazyField curNode where matchLazyField :: HieAST TypeIndex -> Slist RealSrcSpan matchLazyField node = memptyIfFalse@@ -216,9 +214,13 @@ {- | Check for occurrences of pattern matching on @_@ for sum types (except literals). -}-analysePatternMatch_ :: Id Inspection -> HieFile -> Observations-analysePatternMatch_ insId hie =- mkObservation insId hie <$> analyseAstWith matchPatternMatch hie+analysePatternMatch_+ :: Id Inspection+ -> HieFile+ -> HieAST TypeIndex+ -> State VisitorState ()+analysePatternMatch_ insId hie curNode =+ addObservations $ mkObservation insId hie <$> matchPatternMatch curNode where matchPatternMatch :: HieAST TypeIndex -> Slist RealSrcSpan matchPatternMatch node = memptyIfFalse@@ -286,129 +288,93 @@ declaration. -} analyseInfix- :: Id Inspection- -> HieFile- -> Observations-analyseInfix insId hie =- let opDecls = analyseAstWith (matchInfix <> matchOperator) hie- (fixities, topOperators) = partitionDecls opDecls- operatorsWithoutFixity = HM.difference topOperators fixities- in mkObservation insId hie <$> slist (toList operatorsWithoutFixity)+ :: HieFile+ -> HieAST TypeIndex+ -> State VisitorState ()+analyseInfix hie curNode = do+ matchInfix curNode+ matchOperator curNode where- -- returns list of operator names defined in a single fixity declaration:+ -- adds to the state list of operator names defined in a single+ -- fixity declaration: -- infix 5 ***, +++, ???- matchInfix :: HieAST TypeIndex -> Slist OperatorDecl- matchInfix node@Node{..} = memptyIfFalse+ matchInfix :: HieAST TypeIndex -> State VisitorState ()+ matchInfix node@Node{..} = when (hieMatchPatternAst hie node fixity)- (S.concatMap nodeIds nodeChildren)+ (traverse_ addFixity $ concatMap nodeIds nodeChildren) - -- singleton or empty list with the top-level operator definition- matchOperator :: HieAST TypeIndex -> Slist OperatorDecl- matchOperator node@Node{..} = memptyIfFalse+ -- add to state a singleton or empty list with the top-level+ -- operator definition:+ -- (+++) :: ...+ matchOperator :: HieAST TypeIndex -> State VisitorState ()+ matchOperator node@Node{..} = when (hieMatchPatternAst hie node typeSig)- (maybeToMonoid $ viaNonEmpty (extractOperatorName . head) nodeChildren)- -- first child of a parent is a name of a function/operator+ (whenJust+ -- do nothing when cannot extract name+ -- first child of a parent is a name of a function/operator+ (viaNonEmpty (extractOperatorName . head) nodeChildren)+ -- add each operator decl from a list (should be singleton list)+ (traverse_ (uncurry addOpDecl))+ ) -- return AST node identifier names as a sized list of texts- nodeIds :: HieAST TypeIndex -> Slist OperatorDecl+ nodeIds :: HieAST TypeIndex -> [Text] nodeIds =- S.concatMap identifierName+ concatMap fixityName . Map.keys . nodeIdentifiers . nodeInfo - identifierName :: Identifier -> Slist OperatorDecl- identifierName = \case- Left _ -> mempty- Right name -> S.one $ Fixity $ toText $ occNameString $ nameOccName name+ fixityName :: Identifier -> [Text]+ fixityName = \case+ Left _ -> []+ Right name -> [toText $ occNameString $ nameOccName name] - extractOperatorName :: HieAST TypeIndex -> Slist OperatorDecl- extractOperatorName Node{..} =- S.concatMap (topLevelOperatorName nodeSpan)+ extractOperatorName :: HieAST TypeIndex -> [(Text, RealSrcSpan)]+ extractOperatorName n@Node{..} =+ concatMap (topLevelOperatorName nodeSpan) $ Map.keys- $ nodeIdentifiers nodeInfo+ $ nodeIdentifiers (Stan.Hie.Compat.nodeInfo n) - topLevelOperatorName :: RealSrcSpan -> Identifier -> Slist OperatorDecl+ topLevelOperatorName :: RealSrcSpan -> Identifier -> [(Text, RealSrcSpan)] topLevelOperatorName srcSpan = \case- Left _ -> mempty+ Left _ -> [] Right name -> let occName = nameOccName name- in memptyIfFalse- (isSymOcc occName) -- check if operator- (S.one $ Operator (toText $ occNameString occName) srcSpan)---- | Either top-level operator or fixity declaration-data OperatorDecl- = Fixity !Text- -- | Operator name with its position to display later- | Operator !Text !RealSrcSpan--{- | Partition a foldable of operator declarations into two maps:--1. Fixity declarations (mapped to @()@).-2. Top-level operator names (mapped to their source positions.+ -- return empty list if identifier name is not operator name+ in [(toText $ occNameString occName, srcSpan) | isSymOcc occName] -'Map' is used to be able to use the nice @merge@ function.--}-partitionDecls- :: Foldable f- => f OperatorDecl- -> (HashMap Text (), HashMap Text RealSrcSpan)-partitionDecls = foldl' insertDecl mempty- where- insertDecl- :: (HashMap Text (), HashMap Text RealSrcSpan)- -> OperatorDecl- -> (HashMap Text (), HashMap Text RealSrcSpan)- insertDecl (!fixities, !topOperators) = \case- Fixity name -> (HM.insert name () fixities, topOperators)- Operator name srcSpan -> (fixities, HM.insert name srcSpan topOperators)+-- | Returns source spans of matched AST nodes.+createMatch+ :: PatternAst+ -> HieFile+ -> HieAST TypeIndex+ -> Slist RealSrcSpan+createMatch patAst hie node =+ memptyIfFalse (hieMatchPatternAst hie node patAst) (S.one $ nodeSpan node) -{- | Analyses the whole AST starting from the very top.+{- | Specialized version of 'matchAstWith' where custom predicate+always returns 'True'. -}-analyseAstWith- :: forall a- . (HieAST TypeIndex -> Slist a)- -- ^ Function to match AST node to some arbitrary type and return a- -- sized list of matched elements+matchAst+ :: Id Inspection+ -> PatternAst -> HieFile- -> Slist a-analyseAstWith match = findNodes . hie_asts- where- findNodes :: HieASTs TypeIndex -> Slist a- findNodes =- S.concatMap (matchAstWith match)- . Map.elems- . getAsts+ -> HieAST TypeIndex -- ^ Current node+ -> State VisitorState ()+matchAst = matchAstWith (const True) -{- | Recursively match AST nodes starting from a given AST.+{- | Add observation to the state if the given node matches the given+'PatternAst' exactly (non-recursively) and if the given custom+predicate returns 'True'.. -} matchAstWith- :: forall a- . (HieAST TypeIndex -> Slist a)- -- ^ Function to match AST node to some arbitrary type and return a- -- sized list of matched elements- -> HieAST TypeIndex- -> Slist a-matchAstWith match = matchAst- where- matchAst :: HieAST TypeIndex -> Slist a- matchAst node@Node{..} =- match node <> S.concatMap matchAst nodeChildren---- | Like 'createMatchAst' but returns source spans of AST nodes.-createMatch :: PatternAst -> HieFile -> (HieAST TypeIndex -> Slist RealSrcSpan)-createMatch patAst hie = fmap nodeSpan . createMatchAst patAst hie--{- | Create a non-recursive matching function for 'PatternAst' that-returns sized list of nodes that match this pattern.--* If the pattern matches 'Node', return it-* Otherwise return empty list--}-createMatchAst- :: PatternAst+ :: (HieAST TypeIndex -> Bool) -- ^ Custom node check+ -> Id Inspection+ -> PatternAst -> HieFile- -> (HieAST TypeIndex -> Slist (HieAST TypeIndex))-createMatchAst patAst hie node =- memptyIfFalse (hieMatchPatternAst hie node patAst) (S.one node)+ -> HieAST TypeIndex -- ^ Current node+ -> State VisitorState ()+matchAstWith check insId patAst hie node@Node{..} =+ when (hieMatchPatternAst hie node patAst && check node) $+ addObservation $ mkObservation insId hie nodeSpan
+ src/Stan/Analysis/Visitor.hs view
@@ -0,0 +1,126 @@+{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++HIE AST visitor for single-pass traversal.+-}++module Stan.Analysis.Visitor+ ( VisitorState (..)+ , getFinalObservations+ , addObservation+ , addObservations+ , addFixity+ , addOpDecl++ , Visitor (..)+ , visitAst+ ) where++import Relude.Extra.Lens (Lens', lens, over)++import Stan.Ghc.Compat (RealSrcSpan)+import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieFile (..), TypeIndex)+import Stan.Inspection (inspectionId)+import Stan.Inspection.Style (stan0301)+import Stan.Observation (Observation, Observations, mkObservation)++import qualified Data.HashMap.Strict as HM+import qualified Data.Map.Strict as Map+import qualified Slist as S+++{- | State for the 'Visitor' object that stores all values during a+single HIE AST traversal.+-}+data VisitorState = VisitorState+ { visitorStateObservations :: !Observations++ -- Operators for STAN-0301+ , visitorStateFixities :: !(HashMap Text ())+ , visitorStateOpDecls :: !(HashMap Text RealSrcSpan)+ }++-- | Initial empty state.+initialVisitorState :: VisitorState+initialVisitorState = VisitorState+ { visitorStateObservations = mempty+ , visitorStateFixities = mempty+ , visitorStateOpDecls = mempty+ }++{- | Transform 'VisitorState' to the final list of observations for+the given 'HieFile'. 'VisitorState' stores not only ready+'Observations' but also additional metadata collected during tree+traversal, so this metadata is converted to 'Observations' for the+corresponding 'Inspection's.+-}+finaliseState :: HieFile -> VisitorState -> Observations+finaliseState hie VisitorState{..} =+ -- STAN-0301: missing fixity declaration+ -- detected by finding a difference between two sets:+ -- 1. Top-level defined operators+ -- 2. Fixity declarations for operators in module+ let operatorsWithoutFixity = HM.difference visitorStateOpDecls visitorStateFixities+ stan0301inss = mkObservation (inspectionId stan0301) hie <$> S.slist (toList operatorsWithoutFixity)+ -- combine final observations+ in visitorStateObservations <> stan0301inss++-- | Get sized list of all 'Observations' from the given HIE file+-- using the created 'Visitor'.+getFinalObservations :: HieFile -> Visitor -> Observations+getFinalObservations hie visitor =+ let visitAction = traverse_ (visitAst visitor) allHieAsts+ resultState = execState visitAction initialVisitorState+ in finaliseState hie resultState+ where+ allHieAsts :: [HieAST TypeIndex]+ allHieAsts = Map.elems $ getAsts $ hie_asts hie++observationsL :: Lens' VisitorState Observations+observationsL = lens+ visitorStateObservations+ (\vstate new -> vstate { visitorStateObservations = new })++fixitiesL :: Lens' VisitorState (HashMap Text ())+fixitiesL = lens+ visitorStateFixities+ (\vstate new -> vstate { visitorStateFixities = new })++opDeclsL :: Lens' VisitorState (HashMap Text RealSrcSpan)+opDeclsL = lens+ visitorStateOpDecls+ (\vstate new -> vstate { visitorStateOpDecls = new })++-- | Add single 'Observation' to the existing 'VisitorState'.+addObservation :: Observation -> State VisitorState ()+addObservation obs = modify' $ over observationsL (S.one obs <>)++-- | Add 'Observations' to the existing 'VisitorState'.+addObservations :: Observations -> State VisitorState ()+addObservations obss+ | null obss = pass+ | otherwise = modify' $ over observationsL (obss <>)++-- | Add single operator infix declaration.+addFixity :: Text -> State VisitorState ()+addFixity fixity = modify' $ over fixitiesL (HM.insert fixity ())++-- | Add single operator top-level defintion with its position.+addOpDecl :: Text -> RealSrcSpan -> State VisitorState ()+addOpDecl opDecl srcSpan = modify' $ over opDeclsL (HM.insert opDecl srcSpan)++-- | Object that implements the /Visitor pattern/.+newtype Visitor = Visitor+ { unVisitor :: HieAST TypeIndex -> State VisitorState ()+ }++-- | Traverse HIE AST starting from a given node using 'Visitor'.+visitAst :: Visitor -> HieAST TypeIndex -> State VisitorState ()+visitAst (Visitor visit) = go+ where+ go :: HieAST TypeIndex -> State VisitorState ()+ go node@Node{..} = do+ visit node+ traverse_ go nodeChildren
src/Stan/Browse.hs view
@@ -13,7 +13,6 @@ import Colourista (errorMessage, infoMessage) import System.Directory (findExecutable)-import System.Environment (lookupEnv) import System.Info (os) import System.Process (callCommand, showCommandForUser)
src/Stan/EnvVars.hs view
@@ -13,7 +13,6 @@ , envVarsToText ) where -import System.Environment (lookupEnv) import Trial (TaggedTrial, Trial (..), fiasco, withTag)
src/Stan/Ghc/Compat.hs view
@@ -1,59 +1,13 @@-{- |-Copyright: (c) 2020 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>--Compatibility module for GHC types and functions. Reexports all-required API to work with the GHC API.--}--module Stan.Ghc.Compat- ( -- * Modules- Module- , ModuleName- , moduleNameString- , moduleName- , moduleStableString- , moduleUnitId-- -- * Names- , Name- , isExternalName- , isSymOcc- , nameModule- , nameOccName- , nameStableString- , occNameString-- -- * Source locations- , RealSrcSpan- , srcSpanEndCol- , srcSpanStartCol- , srcSpanStartLine- , srcSpanEndLine- , srcSpanFile+{-# LANGUAGE CPP #-} - -- * Other common types (for debugging and not only)- , ArgFlag (..)- , AvailInfo (..)- , FastString- , FieldLbl (..)- , IfaceTyCon (..)- , IfaceTyConInfo (..)- , IfaceTyConSort (..)- , IfaceTyLit (..)- , PromotionFlag (..)- , TupleSort (..)- ) where+module Stan.Ghc.Compat (module Compat) where -import Avail (AvailInfo (..))-import BasicTypes (PromotionFlag (..), TupleSort (..))-import FastString (FastString)-import FieldLabel (FieldLbl (..))-import IfaceType (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..))-import Module (Module, ModuleName, moduleName, moduleNameString, moduleStableString, moduleUnitId)-import Name (Name, isExternalName, nameModule, nameOccName, nameStableString)-import OccName (isSymOcc, occNameString)-import SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,- srcSpanStartLine)-import Var (ArgFlag (..))+#if __GLASGOW_HASKELL__ <= 810+import Stan.Ghc.Compat810 as Compat+#elif __GLASGOW_HASKELL__ == 900+import Stan.Ghc.Compat900 as Compat+#elif __GLASGOW_HASKELL__ == 902+import Stan.Ghc.Compat902 as Compat+#elif __GLASGOW_HASKELL__ == 904+import Stan.Ghc.Compat902 as Compat+#endif
+ src/Stan/Ghc/Compat810.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE CPP #-}++{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Compatibility module for GHC types and functions. Reexports all+required API to work with the GHC API.+-}++module Stan.Ghc.Compat810+#if __GLASGOW_HASKELL__ <= 810+ ( -- * Modules+ Module+ , ModuleName+ , moduleNameString+ , moduleName+ , moduleStableString+ , moduleUnitId++ -- * Names+ , Name+ , isExternalName+ , isSymOcc+ , nameModule+ , nameOccName+ , nameStableString+ , occNameString++ -- * Source locations+ , RealSrcSpan+ , srcSpanEndCol+ , srcSpanStartCol+ , srcSpanStartLine+ , srcSpanEndLine+ , srcSpanFile+ , mkRealSrcLoc+ , mkRealSrcSpan++ -- * Other common types (for debugging and not only)+ , ArgFlag (..)+ , AvailInfo (..)+ , FastString+ , mkFastString+ , FieldLbl (..)+ , IfaceTyCon (..)+ , IfaceTyConInfo (..)+ , IfaceTyConSort (..)+ , IfaceTyLit (..)+ , PromotionFlag (..)+ , TupleSort (..)+ , showTUnitId+ ) where++import Avail (AvailInfo (..))+import BasicTypes (PromotionFlag (..), TupleSort (..))+import FastString (FastString, mkFastString)+import FieldLabel (FieldLbl (..))+import IfaceType (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..))+import Module (Module, ModuleName, moduleName, moduleNameString, moduleStableString, moduleUnitId,+ UnitId, unitIdString)+import Name (Name, isExternalName, nameModule, nameOccName, nameStableString)+import OccName (isSymOcc, occNameString)+import SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,+ srcSpanStartLine, mkRealSrcLoc, mkRealSrcSpan)+import Var (ArgFlag (..))++import qualified Data.Text as T++showTUnitId :: UnitId -> Text+showTUnitId = T.pack . unitIdString+#else+ where+#endif
+ src/Stan/Ghc/Compat900.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE CPP #-}++{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Compatibility module for GHC types and functions. Reexports all+required API to work with the GHC API.+-}++module Stan.Ghc.Compat900+#if __GLASGOW_HASKELL__ == 900+ ( -- * Modules+ Module+ , ModuleName+ , moduleNameString+ , moduleName+ , moduleStableString+ , moduleUnitId++ -- * Names+ , Name+ , isExternalName+ , isSymOcc+ , nameModule+ , nameOccName+ , nameStableString+ , occNameString++ -- * Source locations+ , RealSrcSpan+ , srcSpanEndCol+ , srcSpanStartCol+ , srcSpanStartLine+ , srcSpanEndLine+ , srcSpanFile+ , mkRealSrcLoc+ , mkRealSrcSpan++ -- * Other common types (for debugging and not only)+ , ArgFlag (..)+ , AvailInfo (..)+ , FastString+ , mkFastString+ , FieldLbl (..)+ , IfaceTyCon (..)+ , IfaceTyConInfo (..)+ , IfaceTyConSort (..)+ , IfaceTyLit (..)+ , PromotionFlag (..)+ , TupleSort (..)+ , showTUnitId+ ) where++import GHC.Types.Avail (AvailInfo (..))+import GHC.Types.Basic (PromotionFlag (..), TupleSort (..))+import GHC.Data.FastString (FastString, mkFastString)+import GHC.Types.FieldLabel (FieldLbl (..))+import GHC.Iface.Type (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..))+import GHC.Unit.Types (Module, moduleName)+import GHC.Unit.Module (moduleStableString)+import GHC.Unit (moduleUnit, toUnitId, UnitId, unitIdString)+import GHC.Unit.Module.Name (ModuleName, moduleNameString)+import GHC.Types.Name (Name, isExternalName, nameModule, nameOccName, nameStableString)+import GHC.Types.Name.Occurrence (isSymOcc, occNameString)+import GHC.Types.SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,+ srcSpanStartLine, mkRealSrcSpan, mkRealSrcLoc)+import GHC.Types.Var (ArgFlag (..))++import qualified Data.Text as T++moduleUnitId :: Module -> UnitId+moduleUnitId = toUnitId . moduleUnit++showTUnitId :: UnitId -> Text+showTUnitId = T.pack . unitIdString+#else+ () where+#endif
+ src/Stan/Ghc/Compat902.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}++module Stan.Ghc.Compat902+#if __GLASGOW_HASKELL__ == 902 || __GLASGOW_HASKELL__ == 904+ ( -- * Modules+ Module+ , ModuleName+ , moduleNameString+ , moduleName+ , moduleStableString+ , moduleUnitId++ -- * Names+ , Name+ , isExternalName+ , isSymOcc+ , nameModule+ , nameOccName+ , nameStableString+ , occNameString++ -- * Source locations+ , RealSrcSpan+ , srcSpanEndCol+ , srcSpanStartCol+ , srcSpanStartLine+ , srcSpanEndLine+ , srcSpanFile+ , mkRealSrcLoc+ , mkRealSrcSpan++ -- * Other common types (for debugging and not only)+ , ArgFlag (..)+ , AvailInfo (..)+ , FastString+ , mkFastString+ , FieldLbl+ , FieldLabel (..)+ , IfaceTyCon (..)+ , IfaceTyConInfo (..)+ , IfaceTyConSort (..)+ , IfaceTyLit (..)+ , PromotionFlag (..)+ , TupleSort (..)+ , showTUnitId+ ) where++import GHC.Types.Avail (AvailInfo (..))+import GHC.Types.Basic (PromotionFlag (..), TupleSort (..))+import GHC.Data.FastString (FastString, mkFastString)+import GHC.Types.FieldLabel (FieldLabel (..))+import GHC.Iface.Type (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..))+import GHC.Unit.Types (Module, moduleName)+import GHC.Unit.Module (moduleStableString)+import GHC.Unit (moduleUnit, toUnitId, UnitId, unitIdString)+import GHC.Unit.Module.Name (ModuleName, moduleNameString)+import GHC.Types.Name (Name, isExternalName, nameModule, nameOccName, nameStableString)+import GHC.Types.Name.Occurrence (isSymOcc, occNameString)+import GHC.Types.SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,+ srcSpanStartLine, mkRealSrcSpan, mkRealSrcLoc)+import GHC.Types.Var (ArgFlag (..))++import qualified Data.Text as T++moduleUnitId :: Module -> UnitId+moduleUnitId = toUnitId . moduleUnit++showTUnitId :: UnitId -> Text+showTUnitId = T.pack . unitIdString++type FieldLbl = FieldLabel+#else+ () where+#endif
src/Stan/Hie.hs view
@@ -22,8 +22,9 @@ import Stan.Core.List (checkWith) import Stan.Ghc.Compat (RealSrcSpan, srcSpanEndCol, srcSpanStartCol, srcSpanStartLine)-import Stan.Hie.Compat (HieAST (..), HieFile (..), HieFileResult (hie_file_result), NameCache,- NodeInfo (..), initNameCache, mkSplitUniqSupply, readHieFile)+import Stan.Hie.Compat (HieAST (..), HieFile (..), HieFileResult (hie_file_result),+ NodeInfo (..), readHieFileWithNameCache, nodeInfo,+ toNodeAnnotation) import Stan.Hie.Debug () import Stan.Pattern.Ast (literalAnns) @@ -42,7 +43,7 @@ infoMessage "Use the '--hiedir' CLI option to specify path to the directory with HIE files" exitFailure - nameCache <- createNameCache+ readHieFile <- readHieFileWithNameCache hieContent <- getDirRecursive hieDir let isHieFile f = (&&) (takeExtension f == ".hie") <$> doesFileExist f hiePaths <- filterM isHieFile hieContent@@ -51,14 +52,9 @@ "The directory with HIE files doesn't contain any HIE files: " <> toText hieDir forM hiePaths $ \hiePath -> do- (hieFileResult, _newCache) <- readHieFile nameCache hiePath+ hieFileResult <- readHieFile hiePath pure $ hie_file_result hieFileResult -createNameCache :: IO NameCache-createNameCache = do- uniqSupply <- mkSplitUniqSupply 'z'- pure $ initNameCache uniqSupply []- -- | Get the number of lines of code in the file by analising 'HieFile'. countLinesOfCode :: HieFile -> Int countLinesOfCode HieFile{..} = length $ BS8.lines hie_hs_src@@ -91,12 +87,15 @@ eqAst HieFile{..} = eqNodes where eqNodes :: HieAST a -> HieAST a -> Bool- eqNodes (Node info1 span1 children1) (Node info2 span2 children2) =+ eqNodes n1@(Node _ span1 children1) n2@(Node _ span2 children2) = eqInfo info1 info2 && checkWith eqNodes children1 children2 where+ info1 = nodeInfo n1+ info2 = nodeInfo n2+ eqInfo :: NodeInfo a -> NodeInfo a -> Bool eqInfo (NodeInfo anns1 types1 ids1) (NodeInfo anns2 types2 ids2) = anns1 == anns2 && types1 == types2 && ids1 == ids2 &&- if Set.member literalAnns anns1+ if Set.member literalAnns (Set.map toNodeAnnotation anns1) then slice span1 hie_hs_src == slice span2 hie_hs_src else True
src/Stan/Hie/Compat.hs view
@@ -1,41 +1,13 @@-{- |-Copyright: (c) 2020 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>--Compatibility module for HIE types from GHC API. Reexports all-required API to work with HIE types.--}--module Stan.Hie.Compat- ( -- * Main HIE types- ContextInfo (..)- , HieArgs (..)- , HieAST (..)- , HieASTs (..)- , HieFile (..)- , HieType (..)- , HieTypeFlat- , IEType (..)- , Identifier- , IdentifierDetails (..)- , NodeInfo (..)- , TypeIndex- , DeclType (..)-- -- * Binary interface to hie files- , HieFileResult (hie_file_result)- , readHieFile+{-# LANGUAGE CPP #-} - -- * Name cache to read HIE files- , NameCache- , initNameCache- , mkSplitUniqSupply- ) where+module Stan.Hie.Compat (module Compat) where -import HieBin (HieFileResult (hie_file_result), readHieFile)-import HieTypes (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..),- HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier,- IdentifierDetails (..), NodeInfo (..), TypeIndex)-import NameCache (NameCache, initNameCache)-import UniqSupply (mkSplitUniqSupply)+#if __GLASGOW_HASKELL__ <= 810+import Stan.Hie.Compat810 as Compat+#elif __GLASGOW_HASKELL__ == 900+import Stan.Hie.Compat900 as Compat+#elif __GLASGOW_HASKELL__ == 902+import Stan.Hie.Compat902 as Compat+#elif __GLASGOW_HASKELL__ == 904+import Stan.Hie.Compat904 as Compat+#endif
+ src/Stan/Hie/Compat810.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}++{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Compatibility module for HIE types from GHC API. Reexports all+required API to work with HIE types.+-}++module Stan.Hie.Compat810+#if __GLASGOW_HASKELL__ <= 810+ ( -- * Main HIE types+ ContextInfo (..)+ , HieArgs (..)+ , HieAST (..)+ , HieASTs (..)+ , HieFile (..)+ , HieType (..)+ , HieTypeFlat+ , IEType (..)+ , Identifier+ , IdentifierDetails (..)+ , NodeInfo (..)+ , TypeIndex+ , DeclType (..)+ , hFunTy2+ , conDec+ , eqDeclType++ , NodeAnnotation+ , mkNodeAnnotation+ , toNodeAnnotation++ -- * Binary interface to hie files+ , HieFileResult (hie_file_result)+ , readHieFileWithNameCache+ ) where++import HieBin (HieFileResult (hie_file_result), readHieFile)+import HieTypes (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..),+ HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier,+ IdentifierDetails (..), NodeInfo (..), TypeIndex)+import NameCache (initNameCache)+import UniqSupply (mkSplitUniqSupply)+import FastString (FastString)++type NodeAnnotation = (FastString, FastString)++mkNodeAnnotation :: FastString -> FastString -> NodeAnnotation+mkNodeAnnotation = (,)++toNodeAnnotation :: NodeAnnotation -> NodeAnnotation+toNodeAnnotation = id++-- For forward compatibility: the two-argument function type+-- constructor.+hFunTy2 :: HieType b -> Maybe (b, b)+hFunTy2 t = case t of+ HFunTy i1 i2 -> Just (i1, i2)+ _ -> Nothing++readHieFileWithNameCache :: IO (FilePath -> IO HieFileResult)+readHieFileWithNameCache = do+ uniqSupply <- mkSplitUniqSupply 'z'+ let nameCache = initNameCache uniqSupply []+ pure (fmap fst . readHieFile nameCache)++conDec :: DeclType+conDec = ConDec++eqDeclType :: DeclType -> DeclType -> Bool+eqDeclType d1 d2 = d1 == d2+#else+ () where+#endif
+ src/Stan/Hie/Compat900.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE CPP #-}++module Stan.Hie.Compat900+#if __GLASGOW_HASKELL__ == 900+ ( -- * Main HIE types+ ContextInfo (..)+ , HieArgs (..)+ , HieAST (..)+ , HieASTs (..)+ , HieFile (..)+ , HieType (..)+ , HieTypeFlat+ , IEType (..)+ , Identifier+ , IdentifierDetails (..)+ , NodeInfo (..)+ , TypeIndex+ , Stan.Hie.Compat900.DeclType (..)+ , hFunTy2+ , conDec+ , eqDeclType++ , NodeAnnotation+ , mkNodeAnnotation+ , toNodeAnnotation++ -- * Binary interface to hie files+ , HieFileResult (hie_file_result)+ , readHieFileWithNameCache+ , nodeInfo+ ) where++import GHC.Iface.Ext.Binary (HieFileResult (hie_file_result), readHieFile)+import GHC.Iface.Ext.Types+ (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..),+ HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier,+ IdentifierDetails (..), NodeInfo (..), TypeIndex, NodeOrigin(SourceInfo, GeneratedInfo),+ getSourcedNodeInfo)+import GHC.Types.Name.Cache (initNameCache)+import GHC.Types.Unique.Supply (mkSplitUniqSupply)+import GHC.Data.FastString (FastString)+import GHC.Iface.Env (NameCacheUpdater(NCU))+import GHC.Utils.Outputable (ppr, showSDocUnsafe)++import qualified Data.Map.Strict as Map++import Text.Show (show)++-- It's not clear if this is completely correct, or whether+--+-- 1. we should merge in the GeneratedInfo, and/or+-- 2. return a NodeInfo with empty fields when the SourceInfo is empty+--+-- It works though.+nodeInfo :: HieAST a -> NodeInfo a+nodeInfo h = case (lookup' SourceInfo, lookup' GeneratedInfo) of+ (Nothing, Nothing) -> error "nodeInfo"+ (Just n1, Nothing) -> n1+ (Nothing, Just{}) -> error "nodeInfo"+ (Just n1, Just{}) -> n1+ where lookup' k = Map.lookup k (getSourcedNodeInfo (sourcedNodeInfo h))++type NodeAnnotation = (FastString, FastString)++mkNodeAnnotation :: FastString -> FastString -> NodeAnnotation+mkNodeAnnotation = (,)++toNodeAnnotation :: NodeAnnotation -> NodeAnnotation+toNodeAnnotation = id++-- For forward compatibility: the two-argument function type+-- constructor.+hFunTy2 :: HieType b -> Maybe (b, b)+hFunTy2 t = case t of+ HFunTy _multiplicity i1 i2 -> Just (i1, i2)+ _ -> Nothing++readHieFileWithNameCache :: IO (FilePath -> IO HieFileResult)+readHieFileWithNameCache = do+ uniqSupply <- mkSplitUniqSupply 'z'+ let nameCache = initNameCache uniqSupply []+ pure (readHieFile (NCU (\f -> pure $ snd $ f nameCache)))++newtype DeclType = DeclType GHC.Iface.Ext.Types.DeclType+ deriving stock Eq++instance Show Stan.Hie.Compat900.DeclType where+ show (DeclType d) = Text.Show.show (showSDocUnsafe (ppr d))++conDec :: Stan.Hie.Compat900.DeclType+conDec = DeclType ConDec++eqDeclType :: Stan.Hie.Compat900.DeclType -> GHC.Iface.Ext.Types.DeclType -> Bool+eqDeclType (DeclType d1) d2 = d1 == d2+#else+ () where+#endif
+ src/Stan/Hie/Compat902.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE CPP #-}++module Stan.Hie.Compat902+#if __GLASGOW_HASKELL__ == 902+ ( -- * Main HIE types+ ContextInfo (..)+ , HieArgs (..)+ , HieAST (..)+ , HieASTs (..)+ , HieFile (..)+ , HieType (..)+ , HieTypeFlat+ , IEType (..)+ , Identifier+ , IdentifierDetails (..)+ , NodeInfo (..)+ , TypeIndex+ , Stan.Hie.Compat902.DeclType (..)+ , hFunTy2+ , conDec+ , eqDeclType+ , Stan.Hie.Compat902.NodeAnnotation+ , mkNodeAnnotation+ , toNodeAnnotation++ -- * Binary interface to hie files+ , HieFileResult (hie_file_result)+ , readHieFileWithNameCache+ , nodeInfo+ ) where++import GHC.Iface.Ext.Binary (HieFileResult (hie_file_result), readHieFile)+import GHC.Iface.Ext.Types+ (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..),+ HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier,+ IdentifierDetails (..), NodeInfo (..), TypeIndex, NodeOrigin(SourceInfo, GeneratedInfo),+ getSourcedNodeInfo, NodeAnnotation(..))+import GHC.Types.Name.Cache (initNameCache)+import GHC.Types.Unique.Supply (mkSplitUniqSupply)+import GHC.Data.FastString (FastString)+import GHC.Iface.Env (NameCacheUpdater(NCU))+import GHC.Utils.Outputable (ppr, showSDocUnsafe)++import qualified Data.Map.Strict as Map++import Text.Show (show)++-- It's not clear if this is completely correct, or whether+--+-- 1. we should merge in the GeneratedInfo, and/or+-- 2. return a NodeInfo with empty fields when the SourceInfo is empty+--+-- It works though.+nodeInfo :: HieAST a -> NodeInfo a+nodeInfo h = case (lookup' SourceInfo, lookup' GeneratedInfo) of+ (Nothing, Nothing) -> error "nodeInfo"+ (Just n1, Nothing) -> n1+ (Nothing, Just{}) -> error "nodeInfo"+ (Just n1, Just{}) -> n1+ where lookup' k = Map.lookup k (getSourcedNodeInfo (sourcedNodeInfo h))++mkNodeAnnotation :: FastString+ -> FastString+ -> Stan.Hie.Compat902.NodeAnnotation+mkNodeAnnotation f1 f2 =+ Stan.Hie.Compat902.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation f1 f2)++data NodeAnnotation = NodeAnnotation GHC.Iface.Ext.Types.NodeAnnotation+ deriving stock Eq++-- This is a horrendous hack for 9.2+-- Fixed later by ghc 418295eab741fd420c6f350141c332ef26f9f0a4 I think+instance Ord Stan.Hie.Compat902.NodeAnnotation where+ compare+ (Stan.Hie.Compat902.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation a1 a2))+ (Stan.Hie.Compat902.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation b1 b2)) =+ let s = Text.Show.show+ in compare (s a1) (s b1) <> compare (s a2) (s b2)++instance Show Stan.Hie.Compat902.NodeAnnotation where+ show+ (Stan.Hie.Compat902.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation a1 a2)) =+ Text.Show.show (a1, a2)++toNodeAnnotation :: GHC.Iface.Ext.Types.NodeAnnotation+ -> Stan.Hie.Compat902.NodeAnnotation+toNodeAnnotation = Stan.Hie.Compat902.NodeAnnotation++-- For forward compatibility: the two-argument function type+-- constructor.+hFunTy2 :: HieType b -> Maybe (b, b)+hFunTy2 t = case t of+ HFunTy _multiplicity i1 i2 -> Just (i1, i2)+ _ -> Nothing++readHieFileWithNameCache :: IO (FilePath -> IO HieFileResult)+readHieFileWithNameCache = do+ uniqSupply <- mkSplitUniqSupply 'z'+ let nameCache = initNameCache uniqSupply []+ pure (readHieFile (NCU (\f -> pure $ snd $ f nameCache)))++newtype DeclType = DeclType GHC.Iface.Ext.Types.DeclType+ deriving stock Eq++instance Show Stan.Hie.Compat902.DeclType where+ show (DeclType d) = Text.Show.show (showSDocUnsafe (ppr d))++conDec :: Stan.Hie.Compat902.DeclType+conDec = DeclType ConDec++eqDeclType :: Stan.Hie.Compat902.DeclType -> GHC.Iface.Ext.Types.DeclType -> Bool+eqDeclType (DeclType d1) d2 = d1 == d2+#else+ () where+#endif
+ src/Stan/Hie/Compat904.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE CPP #-}++module Stan.Hie.Compat904+#if __GLASGOW_HASKELL__ == 904+ ( -- * Main HIE types+ ContextInfo (..)+ , HieArgs (..)+ , HieAST (..)+ , HieASTs (..)+ , HieFile (..)+ , HieType (..)+ , HieTypeFlat+ , IEType (..)+ , Identifier+ , IdentifierDetails (..)+ , NodeInfo (..)+ , TypeIndex+ , Stan.Hie.Compat904.DeclType (..)+ , hFunTy2+ , conDec+ , eqDeclType+ , Stan.Hie.Compat904.NodeAnnotation+ , mkNodeAnnotation+ , toNodeAnnotation++ -- * Binary interface to hie files+ , HieFileResult (hie_file_result)+ , readHieFileWithNameCache+ , nodeInfo+ ) where++import GHC.Iface.Ext.Binary (HieFileResult (hie_file_result), readHieFile)+import GHC.Iface.Ext.Types+ (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..),+ HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier,+ IdentifierDetails (..), NodeInfo (..), TypeIndex, NodeOrigin(SourceInfo, GeneratedInfo),+ getSourcedNodeInfo, NodeAnnotation(..))+import GHC.Types.Name.Cache (initNameCache)+import GHC.Data.FastString (FastString)+import GHC.Utils.Outputable (ppr, showSDocUnsafe)++import qualified Data.Map.Strict as Map++import Text.Show (show)++-- It's not clear if this is completely correct, or whether+--+-- 1. we should merge in the GeneratedInfo, and/or+-- 2. return a NodeInfo with empty fields when the SourceInfo is empty+--+-- It works though.+nodeInfo :: HieAST a -> NodeInfo a+nodeInfo h = case (lookup' SourceInfo, lookup' GeneratedInfo) of+ (Nothing, Nothing) -> error "nodeInfo"+ (Just n1, Nothing) -> n1+ (Nothing, Just{}) -> error "nodeInfo"+ (Just n1, Just{}) -> n1+ where lookup' k = Map.lookup k (getSourcedNodeInfo (sourcedNodeInfo h))++mkNodeAnnotation :: FastString+ -> FastString+ -> Stan.Hie.Compat904.NodeAnnotation+mkNodeAnnotation f1 f2 =+ Stan.Hie.Compat904.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation f1 f2)++data NodeAnnotation = NodeAnnotation GHC.Iface.Ext.Types.NodeAnnotation+ deriving stock (Eq, Ord)++instance Show Stan.Hie.Compat904.NodeAnnotation where+ show+ (Stan.Hie.Compat904.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation a1 a2)) =+ Text.Show.show (a1, a2)++toNodeAnnotation :: GHC.Iface.Ext.Types.NodeAnnotation+ -> Stan.Hie.Compat904.NodeAnnotation+toNodeAnnotation = Stan.Hie.Compat904.NodeAnnotation++-- For forward compatibility: the two-argument function type+-- constructor.+hFunTy2 :: HieType b -> Maybe (b, b)+hFunTy2 t = case t of+ HFunTy _multiplicity i1 i2 -> Just (i1, i2)+ _ -> Nothing++readHieFileWithNameCache :: IO (FilePath -> IO HieFileResult)+readHieFileWithNameCache = do+ nameCache <- initNameCache 'z' []+ pure (readHieFile nameCache)++newtype DeclType = DeclType GHC.Iface.Ext.Types.DeclType+ deriving stock Eq++instance Show Stan.Hie.Compat904.DeclType where+ show (DeclType d) = Text.Show.show (showSDocUnsafe (ppr d))++conDec :: Stan.Hie.Compat904.DeclType+conDec = DeclType ConDec++eqDeclType :: Stan.Hie.Compat904.DeclType -> GHC.Iface.Ext.Types.DeclType -> Bool+eqDeclType (DeclType d1) d2 = d1 == d2+#else+ () where+#endif
src/Stan/Hie/Debug.hs view
@@ -1,80 +1,13 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-# LANGUAGE StandaloneDeriving #-}--{- |-Copyright: (c) 2020 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>--Useful debugging and printing utilities for HIE types. They are-implemented in two ways:--1. Using derived 'Show' instances.-2. Using @ghc@ pretty-printing.--To make full use of derived 'Show' instances, add the @pretty-simple@-package to dependencies and use the @pPrint@ function from the-@Text.Pretty.Simple@ module.--}--module Stan.Hie.Debug- ( debugHieFile- ) where--import Text.Pretty.Simple (pPrint)--import Stan.Core.ModuleName (fromGhcModule)-import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLbl (..), IfaceTyCon (..),- IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module,- ModuleName, Name, PromotionFlag (..), TupleSort (..), isExternalName,- moduleNameString, moduleStableString, moduleUnitId, nameModule, nameOccName,- nameStableString, occNameString)-import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..),- IdentifierDetails (..), NodeInfo (..))-import Stan.NameMeta (NameMeta (..))--import qualified Text.Show---debugHieFile :: FilePath -> [HieFile] -> IO ()-debugHieFile path hieFiles = do- let mHieFile = find (\HieFile{..} -> hie_hs_file == path) hieFiles- whenJust mHieFile pPrint---- orphan intances-deriving stock instance Show HieFile-deriving stock instance Show a => Show (HieType a)-deriving stock instance Show a => Show (HieAST a)-deriving newtype instance Show a => Show (HieASTs a)-deriving newtype instance Show a => Show (HieArgs a)-deriving stock instance Show a => Show (NodeInfo a)-deriving stock instance Show a => Show (IdentifierDetails a)-deriving stock instance Show IfaceTyCon-deriving stock instance Show IfaceTyConInfo-deriving stock instance Show IfaceTyConSort-deriving stock instance Show IfaceTyLit-deriving stock instance Show PromotionFlag-deriving stock instance Show TupleSort-deriving stock instance Show ArgFlag-deriving stock instance Show AvailInfo-deriving stock instance Show a => Show (FieldLbl a)--instance Show Module where- show = moduleStableString+{-# LANGUAGE CPP #-} -instance Show ModuleName where- show = moduleNameString+module Stan.Hie.Debug (module Compat) where -instance Show Name where- show nm =- if isExternalName nm- then show $ toNameMeta nm- else nameStableString nm- where- toNameMeta :: Name -> NameMeta- toNameMeta name =- let nameMetaName = toText $ occNameString $ nameOccName name- nameMetaModuleName = fromGhcModule $ nameModule name- nameMetaPackage = show @Text $ moduleUnitId $ nameModule name- in NameMeta{..}+#if __GLASGOW_HASKELL__ <= 810+import Stan.Hie.Debug810 as Compat+#elif __GLASGOW_HASKELL__ == 900+import Stan.Hie.Debug900 as Compat+#elif __GLASGOW_HASKELL__ == 902+import Stan.Hie.Debug902 as Compat+#elif __GLASGOW_HASKELL__ == 904+import Stan.Hie.Debug902 as Compat+#endif
+ src/Stan/Hie/Debug810.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE CPP #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Useful debugging and printing utilities for HIE types. They are+implemented in two ways:++1. Using derived 'Show' instances.+2. Using @ghc@ pretty-printing.++To make full use of derived 'Show' instances, add the @pretty-simple@+package to dependencies and use the @pPrint@ function from the+@Text.Pretty.Simple@ module.+-}++module Stan.Hie.Debug810+#if __GLASGOW_HASKELL__ <= 810+ ( debugHieFile+ ) where++import Text.Pretty.Simple (pPrint)++import Stan.Core.ModuleName (fromGhcModule)+import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLbl (..), IfaceTyCon (..),+ IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module,+ ModuleName, Name, PromotionFlag (..), TupleSort (..), isExternalName,+ moduleNameString, moduleStableString, moduleUnitId, nameModule, nameOccName,+ nameStableString, occNameString, showTUnitId)+import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..),+ IdentifierDetails (..), NodeInfo (..))+import Stan.NameMeta (NameMeta (..))++import qualified Text.Show+++debugHieFile :: FilePath -> [HieFile] -> IO ()+debugHieFile path hieFiles = do+ let mHieFile = find (\HieFile{..} -> hie_hs_file == path) hieFiles+ whenJust mHieFile pPrint++-- orphan intances+deriving stock instance Show HieFile+deriving stock instance Show a => Show (HieType a)+deriving stock instance Show a => Show (HieAST a)+deriving newtype instance Show a => Show (HieASTs a)+deriving newtype instance Show a => Show (HieArgs a)+deriving stock instance Show a => Show (NodeInfo a)+deriving stock instance Show a => Show (IdentifierDetails a)+deriving stock instance Show IfaceTyCon+deriving stock instance Show IfaceTyConInfo+deriving stock instance Show IfaceTyConSort+deriving stock instance Show IfaceTyLit+deriving stock instance Show PromotionFlag+deriving stock instance Show TupleSort+deriving stock instance Show ArgFlag+deriving stock instance Show AvailInfo+deriving stock instance Show a => Show (FieldLbl a)++instance Show Module where+ show = moduleStableString++instance Show ModuleName where+ show = moduleNameString++instance Show Name where+ show nm =+ if isExternalName nm+ then show $ toNameMeta nm+ else nameStableString nm+ where+ toNameMeta :: Name -> NameMeta+ toNameMeta name =+ let nameMetaName = toText $ occNameString $ nameOccName name+ nameMetaModuleName = fromGhcModule $ nameModule name+ nameMetaPackage = showTUnitId $ moduleUnitId $ nameModule name+ in NameMeta{..}+#else+ () where+#endif
+ src/Stan/Hie/Debug900.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE CPP #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE FlexibleInstances #-}++{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Useful debugging and printing utilities for HIE types. They are+implemented in two ways:++1. Using derived 'Show' instances.+2. Using @ghc@ pretty-printing.++To make full use of derived 'Show' instances, add the @pretty-simple@+package to dependencies and use the @pPrint@ function from the+@Text.Pretty.Simple@ module.+-}++module Stan.Hie.Debug900+#if __GLASGOW_HASKELL__ == 900+ ( debugHieFile+ ) where++import Text.Pretty.Simple (pPrint)++import Stan.Core.ModuleName (fromGhcModule)+import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLbl (..), IfaceTyCon (..),+ IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module,+ ModuleName, Name, PromotionFlag (..), TupleSort (..), isExternalName,+ moduleNameString, moduleStableString, moduleUnitId, nameModule, nameOccName,+ nameStableString, occNameString, showTUnitId)+import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..),+ IdentifierDetails (..), NodeInfo (..))+import Stan.NameMeta (NameMeta (..))++import qualified Text.Show++import GHC.Iface.Ext.Types (SourcedNodeInfo(..), NodeOrigin(..), ContextInfo(..), IEType(..), BindType(..), Scope(..), DeclType(..), TyVarScope(..), RecFieldContext(..), EvVarSource(..), EvBindDeps(..), DeclType(..))+import GHC.Types.Var (Specificity(..))++debugHieFile :: FilePath -> [HieFile] -> IO ()+debugHieFile path hieFiles = do+ let mHieFile = find (\HieFile{..} -> hie_hs_file == path) hieFiles+ whenJust mHieFile pPrint++deriving stock instance Show a => Show (SourcedNodeInfo a)+deriving stock instance Show NodeOrigin+deriving stock instance Show ContextInfo+deriving stock instance Show IEType+deriving stock instance Show BindType+deriving stock instance Show Scope+deriving stock instance Show DeclType+deriving stock instance Show TyVarScope+deriving stock instance Show EvBindDeps+deriving stock instance Show EvVarSource+deriving stock instance Show RecFieldContext++deriving stock instance Show Specificity++-- orphan intances+deriving stock instance Show HieFile+deriving stock instance Show a => Show (HieType a)+deriving stock instance Show a => Show (HieAST a)+deriving newtype instance Show a => Show (HieASTs a)+deriving newtype instance Show a => Show (HieArgs a)+deriving stock instance Show a => Show (NodeInfo a)+deriving stock instance Show a => Show (IdentifierDetails a)+deriving stock instance Show IfaceTyCon+deriving stock instance Show IfaceTyConInfo+deriving stock instance Show IfaceTyConSort+deriving stock instance Show IfaceTyLit+deriving stock instance Show PromotionFlag+deriving stock instance Show TupleSort+deriving stock instance Show ArgFlag+deriving stock instance Show AvailInfo+deriving stock instance Show a => Show (FieldLbl a)++instance Show Module where+ show = moduleStableString++instance Show ModuleName where+ show = moduleNameString++instance Show Name where+ show nm =+ if isExternalName nm+ then show $ toNameMeta nm+ else nameStableString nm+ where+ toNameMeta :: Name -> NameMeta+ toNameMeta name =+ let nameMetaName = toText $ occNameString $ nameOccName name+ nameMetaModuleName = fromGhcModule $ nameModule name+ nameMetaPackage = showTUnitId $ moduleUnitId $ nameModule name+ in NameMeta{..}+#else+ () where+#endif
+ src/Stan/Hie/Debug902.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE CPP #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE FlexibleInstances #-}++{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Useful debugging and printing utilities for HIE types. They are+implemented in two ways:++1. Using derived 'Show' instances.+2. Using @ghc@ pretty-printing.++To make full use of derived 'Show' instances, add the @pretty-simple@+package to dependencies and use the @pPrint@ function from the+@Text.Pretty.Simple@ module.+-}++module Stan.Hie.Debug902+#if __GLASGOW_HASKELL__ == 902 || __GLASGOW_HASKELL__ == 904+ ( debugHieFile+ ) where++import Text.Pretty.Simple (pPrint)++import Stan.Core.ModuleName (fromGhcModule)+import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLabel (..), IfaceTyCon (..),+ IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module,+ Name, PromotionFlag (..), TupleSort (..), isExternalName,+ moduleStableString, moduleUnitId, nameModule, nameOccName,+ nameStableString, occNameString, showTUnitId)+import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..),+ IdentifierDetails (..), NodeInfo (..))+import Stan.NameMeta (NameMeta (..))++import qualified Text.Show++import GHC.Iface.Ext.Types (SourcedNodeInfo(..), NodeOrigin(..), ContextInfo(..), IEType(..), BindType(..), Scope(..), DeclType(..), TyVarScope(..), RecFieldContext(..), EvVarSource(..), EvBindDeps(..), DeclType(..), NodeAnnotation (..))+import GHC.Types.Avail (GreName (..))+import GHC.Types.Var (Specificity(..))++debugHieFile :: FilePath -> [HieFile] -> IO ()+debugHieFile path hieFiles = do+ let mHieFile = find (\HieFile{..} -> hie_hs_file == path) hieFiles+ whenJust mHieFile pPrint++deriving stock instance Show a => Show (SourcedNodeInfo a)+deriving stock instance Show NodeOrigin+deriving stock instance Show ContextInfo+deriving stock instance Show IEType+deriving stock instance Show BindType+deriving stock instance Show Scope+deriving stock instance Show DeclType+deriving stock instance Show TyVarScope+deriving stock instance Show EvBindDeps+deriving stock instance Show EvVarSource+deriving stock instance Show RecFieldContext++deriving stock instance Show Specificity++-- orphan intances+deriving stock instance Show HieFile+deriving stock instance Show a => Show (HieType a)+deriving stock instance Show a => Show (HieAST a)+deriving newtype instance Show a => Show (HieASTs a)+deriving newtype instance Show a => Show (HieArgs a)+deriving stock instance Show a => Show (NodeInfo a)+deriving stock instance Show a => Show (IdentifierDetails a)+deriving stock instance Show IfaceTyCon+deriving stock instance Show IfaceTyConInfo+deriving stock instance Show IfaceTyConSort+deriving stock instance Show IfaceTyLit+deriving stock instance Show PromotionFlag+deriving stock instance Show TupleSort+deriving stock instance Show ArgFlag+deriving stock instance Show AvailInfo+deriving stock instance Show FieldLabel+deriving stock instance Show NodeAnnotation+deriving stock instance Show GreName++instance Show Module where+ show = moduleStableString++instance Show Name where+ show nm =+ if isExternalName nm+ then show $ toNameMeta nm+ else nameStableString nm+ where+ toNameMeta :: Name -> NameMeta+ toNameMeta name =+ let nameMetaName = toText $ occNameString $ nameOccName name+ nameMetaModuleName = fromGhcModule $ nameModule name+ nameMetaPackage = showTUnitId $ moduleUnitId $ nameModule name+ in NameMeta{..}+#else+ () where+#endif
src/Stan/Hie/MatchAst.hs view
@@ -19,10 +19,11 @@ import Data.Char (toLower) import Stan.Core.List (checkWith)-import Stan.Ghc.Compat (FastString, nameOccName, occNameString)+import Stan.Ghc.Compat (nameOccName, occNameString) import Stan.Hie (slice) import Stan.Hie.Compat (ContextInfo (..), DeclType, HieAST (..), HieFile (..), Identifier,- IdentifierDetails (..), NodeInfo (..), TypeIndex)+ IdentifierDetails (..), NodeInfo (..), TypeIndex, nodeInfo,+ eqDeclType, NodeAnnotation, toNodeAnnotation) import Stan.Hie.MatchType (hieMatchPatternType) import Stan.NameMeta (NameMeta, hieMatchNameMeta) import Stan.Pattern.Ast (Literal (..), PatternAst (..), literalAnns)@@ -53,7 +54,7 @@ hieMatchPatternAst hie node p1 && hieMatchPatternAst hie node p2 PatternAstConstant lit ->- Set.member literalAnns (nodeAnnotations nodeInfo)+ Set.member literalAnns (Set.map toNodeAnnotation (nodeAnnotations nodeInfo)) && ( let span = slice nodeSpan hie_hs_src in case lit of ExactNum n -> (span >>= readMaybe . decodeUtf8) == Just n ExactStr s -> span == Just s@@ -79,9 +80,12 @@ PatternAstIdentifierDetailsDecl declType -> any (any (isDecl declType) . identInfo) $ Map.elems $ nodeIdentifiers nodeInfo where- matchAnnotations :: Set (FastString, FastString) -> NodeInfo TypeIndex -> Bool- matchAnnotations tags NodeInfo{..} = tags `Set.isSubsetOf` nodeAnnotations+ matchAnnotations :: Set NodeAnnotation -> NodeInfo TypeIndex -> Bool+ matchAnnotations tags NodeInfo{..} =+ tags `Set.isSubsetOf` Set.map toNodeAnnotation nodeAnnotations + nodeInfo = Stan.Hie.Compat.nodeInfo node+ matchNameAndType :: NameMeta -> PatternType@@ -94,5 +98,5 @@ t : _ -> hieMatchPatternType hie_types patType t isDecl :: DeclType -> ContextInfo -> Bool- isDecl myDeclType (Decl curDeclType _) = myDeclType == curDeclType+ isDecl myDeclType (Decl curDeclType _) = myDeclType `eqDeclType` curDeclType isDecl _declType _otherContext = False
src/Stan/Hie/MatchType.hs view
@@ -34,7 +34,7 @@ import Stan.Core.List (checkWith) import Stan.Ghc.Compat (IfaceTyCon (..), IfaceTyConInfo (..), PromotionFlag (NotPromoted))-import Stan.Hie.Compat (HieArgs (..), HieType (..), HieTypeFlat, TypeIndex)+import Stan.Hie.Compat (HieArgs (..), HieType (..), HieTypeFlat, TypeIndex, hFunTy2) import Stan.NameMeta (compareNames) import Stan.Pattern.Type (PatternType (..)) @@ -75,7 +75,8 @@ ifaceTyConIsPromoted ifaceTyConInfo == NotPromoted && compareNames nameMeta ifaceTyConName && checkWith (\(_, ix) a -> match a ix) hieArgs args- satisfyPattern (HFunTy i1 i2) (PatternTypeFun p1 p2) =+ satisfyPattern t (PatternTypeFun p1 p2)+ | Just (i1, i2) <- hFunTy2 t = match p1 i1 && match p2 i2 satisfyPattern (HQualTy _ ix) p = match p ix
src/Stan/Inspection/AntiPattern.hs view
@@ -162,15 +162,15 @@ :| [(mkBaseFoldableMeta "length", hmPat)] sizeNameMeta :: NameMeta- sizeNameMeta = "size" `unorderedNameFrom` "Data.HashMap.Base"+ sizeNameMeta = "size" `unorderedNameFrom` "Data.HashMap.Internal" hm :: NameMeta- hm = "HashMap" `unorderedNameFrom` "Data.HashMap.Base"+ hm = "HashMap" `unorderedNameFrom` "Data.HashMap.Internal" hmPat :: PatternType hmPat = (hm |:: [(?), (?)]) |-> (?) --- | 'Inspection' — slow 'Data.HashMap.Strict.size' @STAN-0205@.+-- | 'Inspection' — slow 'Data.HashSet.size' @STAN-0205@. stan0205 :: Inspection stan0205 = mkAntiPatternInspection (Id "STAN-0205") "HashSet size" (FindAst $ namesToPatternAst pats)@@ -185,10 +185,10 @@ :| [(mkBaseFoldableMeta "length", hsPat)] sizeNameMeta :: NameMeta- sizeNameMeta = "size" `unorderedNameFrom` "Data.HashSet.Base"+ sizeNameMeta = "size" `unorderedNameFrom` "Data.HashSet.Internal" hs :: NameMeta- hs = "HashSet" `unorderedNameFrom` "Data.HashSet.Base"+ hs = "HashSet" `unorderedNameFrom` "Data.HashSet.Internal" hsPat :: PatternType hsPat = (hs |:: [(?)]) |-> (?)
src/Stan/Inspection/Partial.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {- | Copyright: (c) 2020 Kowainik SPDX-License-Identifier: MPL-2.0@@ -277,7 +279,11 @@ & analysisL .~ FindAst (namesToPatternAst $ (exts, pat) :| [(ne, pat)]) where pat = listPattern |-> nonEmptyPattern+#if __GLASGOW_HASKELL__ < 904 exts = "fromList" `baseNameFrom` "GHC.Exts"+#else+ exts = "fromList" `baseNameFrom` "GHC.IsList"+#endif ne = "fromList" `baseNameFrom` "Data.List.NonEmpty" -- | 'Inspection' — partial 'GHC.Num.fromInteger' @STAN-0021@.
src/Stan/NameMeta.hs view
@@ -31,9 +31,9 @@ ) where import Stan.Core.ModuleName (ModuleName (..), fromGhcModule)-import Stan.Ghc.Compat (Name, isExternalName, moduleUnitId, nameModule, nameOccName, occNameString)+import Stan.Ghc.Compat (Name, isExternalName, moduleUnitId, nameModule, nameOccName, occNameString, showTUnitId) import Stan.Hie.Compat (ContextInfo (IEThing), HieAST (..), IEType (Import), Identifier,- IdentifierDetails (..), NodeInfo (..), TypeIndex)+ IdentifierDetails (..), NodeInfo (..), TypeIndex, nodeInfo) import qualified Data.Map.Strict as Map import qualified Data.Set as Set@@ -60,7 +60,7 @@ compareNames NameMeta{..} name = let occName = toText $ occNameString $ nameOccName name moduleName = fromGhcModule $ nameModule name- package = show @Text $ moduleUnitId $ nameModule name+ package = showTUnitId $ moduleUnitId $ nameModule name in isExternalName name && occName == nameMetaName
src/Stan/Observation.hs view
@@ -3,7 +3,7 @@ SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com> -__Observation__ — a vulnerability found in the target project by @Stan@.+__Observation__ — a suggestion found in the target project by @Stan@. -} module Stan.Observation@@ -48,7 +48,7 @@ import qualified Slist as S -{- | Data type to represent discovered by Stan vulnerabilities.+{- | Data type to represent discovered by Stan suggestions. -} data Observation = Observation { observationId :: !(Id Observation)
src/Stan/Pattern/Ast.hs view
@@ -45,8 +45,7 @@ , literalAnns ) where -import Stan.Ghc.Compat (FastString)-import Stan.Hie.Compat (DeclType (..))+import Stan.Hie.Compat (DeclType, NodeAnnotation, mkNodeAnnotation, conDec) import Stan.NameMeta (NameMeta (..)) import Stan.Pattern.Edsl (PatternBool (..)) import Stan.Pattern.Type (PatternType)@@ -67,11 +66,11 @@ | PatternAstVarName !String -- | AST node with tags for current node and any children. | PatternAstNode- !(Set (FastString, FastString)) -- ^ Set of context info (pairs of tags)+ !(Set NodeAnnotation) -- ^ Set of context info (pairs of tags) -- | AST node with tags for current node and children -- patterns. This pattern should match the node exactly. | PatternAstNodeExact- !(Set (FastString, FastString)) -- ^ Set of context info (pairs of tags)+ !(Set NodeAnnotation) -- ^ Set of context info (pairs of tags) ![PatternAst] -- ^ Node children -- | AST wildcard, matches anything. | PatternAstAnything@@ -124,46 +123,46 @@ -- | @app f x@ is a pattern for function application @f x@. app :: PatternAst -> PatternAst -> PatternAst-app f x = PatternAstNodeExact (one ("HsApp", "HsExpr")) [f, x]+app f x = PatternAstNodeExact (one (mkNodeAnnotation "HsApp" "HsExpr")) [f, x] -- | @opApp x op y@ is a pattern for operator application @x `op` y@. opApp :: PatternAst -> PatternAst -> PatternAst -> PatternAst-opApp x op y = PatternAstNodeExact (one ("OpApp", "HsExpr")) [x, op, y]+opApp x op y = PatternAstNodeExact (one (mkNodeAnnotation "OpApp" "HsExpr")) [x, op, y] -- | @range a b@ is a pattern for @[a .. b]@ range :: PatternAst -> PatternAst -> PatternAst-range from to = PatternAstNodeExact (one ("ArithSeq", "HsExpr")) [from, to]+range from to = PatternAstNodeExact (one (mkNodeAnnotation "ArithSeq" "HsExpr")) [from, to] -- | 'lambdaCase' is a pattern for @\case@ expression (not considering branches). lambdaCase :: PatternAst-lambdaCase = PatternAstNode (one ("HsLamCase", "HsExpr"))+lambdaCase = PatternAstNode (one (mkNodeAnnotation "HsLamCase" "HsExpr")) -- | 'case'' is a pattern for @case EXP of@ expression (not considering branches). case' :: PatternAst-case' = PatternAstNode (one ("HsCase", "HsExpr"))+case' = PatternAstNode (one (mkNodeAnnotation "HsCase" "HsExpr")) -- | Pattern to represent one pattern matching branch. patternMatchBranch :: PatternAst-patternMatchBranch = PatternAstNode (one ("Match", "Match"))+patternMatchBranch = PatternAstNode (one (mkNodeAnnotation "Match" "Match")) {- | Pattern for @_@ in pattern matching. __Note:__ presents on GHC >=8.10 only. -} wildPat :: PatternAst-wildPat = PatternAstNode (one ("WildPat", "Pat"))+wildPat = PatternAstNode (one (mkNodeAnnotation "WildPat" "Pat")) {- | Pattern for literals in pattern matching. __Note:__ presents on GHC >=8.10 only. -} literalPat :: PatternAst-literalPat = PatternAstNode (one ("NPat", "Pat"))- ||| PatternAstNode (one ("LitPat", "Pat"))+literalPat = PatternAstNode (one (mkNodeAnnotation "NPat" "Pat"))+ ||| PatternAstNode (one (mkNodeAnnotation "LitPat" "Pat")) -- | Pattern to represent one pattern matching branch on @_@. patternMatch_ :: PatternAst -> PatternAst-patternMatch_ val = PatternAstNodeExact (one ("Match", "Match"))+patternMatch_ val = PatternAstNodeExact (one (mkNodeAnnotation "Match" "Match")) #if __GLASGOW_HASKELL__ >= 810 $ wildPat : #endif@@ -171,7 +170,7 @@ -- | Pattern to represent right side of the pattern matching, e.g. @-> "foo"@. patternMatchArrow :: PatternAst -> PatternAst-patternMatchArrow x = PatternAstNodeExact (one ("GRHS", "GRHS")) [x]+patternMatchArrow x = PatternAstNodeExact (one (mkNodeAnnotation "GRHS" "GRHS")) [x] {- | Pattern for the top-level fixity declaration: @@ -180,7 +179,7 @@ @ -} fixity :: PatternAst-fixity = PatternAstNode $ one ("FixitySig", "FixitySig")+fixity = PatternAstNode $ one (mkNodeAnnotation "FixitySig" "FixitySig") {- | Pattern for the function type signature declaration: @@ -189,8 +188,15 @@ @ -} typeSig :: PatternAst-typeSig = PatternAstNode $ one ("TypeSig", "Sig")+typeSig = PatternAstNode $ one (mkNodeAnnotation "TypeSig" "Sig") +absBinds =+#if __GLASGOW_HASKELL__ < 904+ mkNodeAnnotation "AbsBinds" "HsBindLR"+#else+ mkNodeAnnotation "XHsBindsLR" "HsBindLR"+#endif+ {- | Pattern for the function definition: @@@ -199,26 +205,26 @@ -} fun :: PatternAst fun = PatternAstNode $ Set.fromList- [ ("AbsBinds", "HsBindLR")- , ("FunBind", "HsBindLR")- , ("Match", "Match")+ [ absBinds+ , mkNodeAnnotation "FunBind" "HsBindLR"+ , mkNodeAnnotation "Match" "Match" ] {- | @data@ or @newtype@ declaration. -} dataDecl :: PatternAst-dataDecl = PatternAstNode $ one ("DataDecl", "TyClDecl")+dataDecl = PatternAstNode $ one (mkNodeAnnotation "DataDecl" "TyClDecl") {- | Constructor of a plain data type or newtype. Children of node that matches this pattern are constructor fields. -} constructor :: PatternAst-constructor = PatternAstNode $ one ("ConDeclH98", "ConDecl")+constructor = PatternAstNode $ one (mkNodeAnnotation "ConDeclH98" "ConDecl") {- | Constructor name Identifier info -} constructorNameIdentifier :: PatternAst-constructorNameIdentifier = PatternAstIdentifierDetailsDecl ConDec+constructorNameIdentifier = PatternAstIdentifierDetailsDecl conDec {- | Lazy data type field. Comes in two shapes: @@ -240,17 +246,17 @@ -} type_ :: PatternAst type_ =- PatternAstNode (one ("HsTyVar", "HsType")) -- simple type: Int, Bool+ PatternAstNode (one (mkNodeAnnotation "HsTyVar" "HsType")) -- simple type: Int, Bool |||- PatternAstNode (one ("HsAppTy", "HsType")) -- composite: Maybe Int+ PatternAstNode (one (mkNodeAnnotation "HsAppTy" "HsType")) -- composite: Maybe Int |||- PatternAstNode (one ("HsParTy", "HsType")) -- type in ()+ PatternAstNode (one (mkNodeAnnotation "HsParTy" "HsType")) -- type in () |||- PatternAstNode (one ("HsTupleTy", "HsType")) -- tuple types: (Int, Bool)+ PatternAstNode (one (mkNodeAnnotation "HsTupleTy" "HsType")) -- tuple types: (Int, Bool) |||- PatternAstNode (one ("HsListTy", "HsType")) -- list types: [Int]+ PatternAstNode (one (mkNodeAnnotation "HsListTy" "HsType")) -- list types: [Int] |||- PatternAstNode (one ("HsFunTy", "HsType")) -- function types: Int -> Bool+ PatternAstNode (one (mkNodeAnnotation "HsFunTy" "HsType")) -- function types: Int -> Bool {- | Pattern for the field without the explicit bang pattern: @@ -260,11 +266,11 @@ -} lazyRecordField :: PatternAst lazyRecordField = PatternAstNodeExact- (one ("ConDeclField", "ConDeclField"))+ (one (mkNodeAnnotation "ConDeclField" "ConDeclField")) [ PatternAstNode (fromList- [ ("AbsBinds", "HsBindLR")- , ("FunBind", "HsBindLR")+ [ absBinds+ , mkNodeAnnotation "FunBind" "HsBindLR" ] ) , type_@@ -277,9 +283,9 @@ -} tuple :: PatternAst tuple =- PatternAstNode (one ("HsTupleTy", "HsType")) -- tuple type+ PatternAstNode (one (mkNodeAnnotation "HsTupleTy" "HsType")) -- tuple type |||- PatternAstNode (one ("ExplicitTuple", "HsExpr")) -- tuple literal+ PatternAstNode (one (mkNodeAnnotation "ExplicitTuple" "HsExpr")) -- tuple literal {- | Pattern for a single @guard@ branch: @@ -288,7 +294,7 @@ @ -} guardBranch :: PatternAst-guardBranch = PatternAstNode $ one ("BodyStmt", "StmtLR")+guardBranch = PatternAstNode $ one (mkNodeAnnotation "BodyStmt" "StmtLR") {- | Pattern for the right-hand-side. Usually an equality sign. @@ -297,8 +303,8 @@ @ -} rhs :: PatternAst-rhs = PatternAstNode $ one ("GRHS", "GRHS")+rhs = PatternAstNode $ one (mkNodeAnnotation "GRHS" "GRHS") -- | Annotations for constants: 0, "foo", etc.-literalAnns :: (FastString, FastString)-literalAnns = ("HsOverLit", "HsExpr")+literalAnns :: NodeAnnotation+literalAnns = mkNodeAnnotation "HsOverLit" "HsExpr"
src/Stan/Pattern/Type.hs view
@@ -1,3 +1,5 @@+{-# LANGuAGE CPP #-}+ {- HLINT ignore "Avoid lambda using `infix`" -} {- |@@ -105,16 +107,44 @@ listFunPattern = listPattern |-> (?) -- | 'PatternType' for 'Integer'.-integerPattern :: PatternType-integerPattern = NameMeta+integerPattern =+#if __GLASGOW_HASKELL__ < 900+ integerPattern810+#elif __GLASGOW_HASKELL__ >= 900+ integerPattern900+#endif++-- | 'PatternType' for 'Natural'.+naturalPattern =+#if __GLASGOW_HASKELL__ < 900+ naturalPattern810+#elif __GLASGOW_HASKELL__ >= 900+ naturalPattern900+#endif++integerPattern810 :: PatternType+integerPattern810 = NameMeta { nameMetaName = "Integer" , nameMetaModuleName = "GHC.Integer.Type" , nameMetaPackage = "integer-wired-in" } |:: [] --- | 'PatternType' for 'Natural'.-naturalPattern :: PatternType-naturalPattern = "Natural" `baseNameFrom` "GHC.Natural" |:: []+integerPattern900 :: PatternType+integerPattern900 = NameMeta+ { nameMetaName = "Integer"+ , nameMetaModuleName = "GHC.Num.Integer"+ , nameMetaPackage = "ghc-bignum"+ } |:: []++naturalPattern810 :: PatternType+naturalPattern810 = "Natural" `baseNameFrom` "GHC.Natural" |:: []++naturalPattern900 :: PatternType+naturalPattern900 = NameMeta+ { nameMetaName = "Natural"+ , nameMetaModuleName = "GHC.Num.Natural"+ , nameMetaPackage = "ghc-bignum"+ } |:: [] charPattern :: PatternType charPattern = primTypeMeta "Char" |:: []
src/Stan/Report/Css.hs view
@@ -1,3 +1,5 @@+{- HLINT ignore "Use zipWithM_" -}+ {-# LANGUAGE PostfixOperators #-} {- |@@ -13,11 +15,20 @@ import Prelude hiding (div, rem, (&), (**)) -import Clay hiding (brown, cols, grid)+import Clay hiding (brown, cols, grid, border, borderRight, borderTop, borderLeft, borderBottom)+import qualified Clay import qualified Clay.Media as M import qualified Data.List.NonEmpty as NE ++border, borderLeft, borderBottom, borderRight, borderTop+ :: Stroke -> Size LengthUnit -> Color -> Css+border x y = Clay.border y x+borderLeft x y = Clay.borderLeft y x+borderBottom x y = Clay.borderBottom y x+borderRight x y = Clay.borderRight y x+borderTop x y = Clay.borderTop y x stanCss :: Css stanCss = do
src/Stan/Report/Html.hs view
@@ -10,8 +10,7 @@ ( stanHtml ) where -import Prelude hiding (div, head)-import Relude.Extra.Enum (universe)+import Prelude hiding (div, head, span) import Clay (compact, renderWith) import Text.Blaze.Html@@ -173,7 +172,7 @@ showHealthConclusions :: ProjectHealth -> Text showHealthConclusions = fold . \case Unhealthy ->- [ "According to the Stan analysis, the project has a lot of vulnerabilities. "+ [ "After analyzing your code, Stan has many suggestions for you on how to improve it." , "But this also means that there is a room for improving code quality! " , "Don't give up and continue doing great work!" ]@@ -186,14 +185,14 @@ , "Nice job, the overall project quality is good. And you can easily make it even better!" ] Healthy ->- [ "Excellent work! Stan haven't found any vulnerabilities in the code."+ [ "Excellent work! Stan does not have any suggestions for your code." ] summary :: Html summary = case createSummary analysis of Nothing -> liSum $ do- h4 "Congratulations! Your project has zero vulnerabilities!"- span "Stan carefully run all configured inspection and found 0 observations and vulnerabilities to the project."+ h4 "Congratulations! Your project has zero suggestions!"+ span "Stan carefully ran all configured inspection and found 0 observations for the project." Just Summary{..} -> do liSum $ do h4 $ toHtml ("Watch out for " <> unId summaryInspectionId)@@ -212,7 +211,7 @@ toHtml @Text "The project has the most problems with inspections from this category" liSum $ do h4 $ toHtml ("Severity: " <> show @Text summarySeverity)- toHtml @Text "The highest severity of found vulnerabilities is "+ toHtml @Text "The highest severity of found observations is " severity (show @Text summarySeverity) liSum :: Html -> Html@@ -221,9 +220,9 @@ stanObservations :: Analysis -> Html stanObservations Analysis{..} = do divClass "row" $ blockP $ fold- [ "Based on the analysis results, Stan found different vulnerabilities "- , "distributed among the analysed files. In Stan terminology, we call such "- , "vulnerability as Observation. Below you can see the more detailed "+ [ "Based on the analysis results, Stan found several areas for improvement "+ , "in the analysed files. In Stan terminology, we call these findings "+ , "Observations. Below you can see the more detailed " , "information about each observation, and find the possible ways to fix " , "them for your project." ]
stan.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: stan-version: 0.0.1.0+version: 0.1.0.0 synopsis: Haskell STatic ANalyser description: Stan is a Haskell __ST__atic __AN__alysis CLI tool.@@ -18,30 +18,29 @@ extra-doc-files: README.md CHANGELOG.md extra-source-files: test/.stan-example.toml-tested-with: GHC == 8.8.3- GHC == 8.10.1+tested-with: GHC == 8.8.4+ GHC == 8.10.7 source-repository head type: git location: https://github.com/kowainik/stan.git common common-options- build-depends: base >= 4.13 && < 4.15+ build-depends: base >= 4.13 && < 4.19 && (< 4.16.3.0 || >= 4.17)+ -- ^^ .hie files don't contain enough type+ -- information on ghc-9.2.[4-8] (base >=+ -- 4.16.3.0 && < 4.17) ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates- if impl(ghc >= 8.0)- ghc-options: -Wredundant-constraints- if impl(ghc >= 8.2)- ghc-options: -fhide-source-paths- if impl(ghc >= 8.4)- ghc-options: -Wmissing-export-lists+ -Wredundant-constraints+ -fhide-source-paths+ -Wmissing-export-lists -Wpartial-fields- if impl(ghc >= 8.8)- ghc-options: -Wmissing-deriving-strategies+ -Wmissing-deriving-strategies -Werror=missing-deriving-strategies -fwrite-ide-info -hiedir=.hie@@ -65,14 +64,10 @@ ViewPatterns common common-relude- build-depends: relude ^>= 0.7.0.0+ build-depends: relude >= 1.0 && < 1.3 mixins: base hiding (Prelude)- , relude (Relude as Prelude- , Relude.Extra.Enum- , Relude.Extra.Lens- , Relude.Extra.Map- , Relude.Extra.Tuple- )+ , relude (Relude as Prelude)+ , relude library import: common-options@@ -83,6 +78,7 @@ Stan.Analysis.Analyser Stan.Analysis.Pretty Stan.Analysis.Summary+ Stan.Analysis.Visitor Stan.Browse Stan.Cabal Stan.Category@@ -122,33 +118,40 @@ autogen-modules: Paths_stan other-modules: Paths_stan+ Stan.Ghc.Compat810+ Stan.Ghc.Compat900+ Stan.Ghc.Compat902+ Stan.Hie.Compat810+ Stan.Hie.Compat900+ Stan.Hie.Compat902+ Stan.Hie.Compat904+ Stan.Hie.Debug810+ Stan.Hie.Debug900+ Stan.Hie.Debug902 build-depends: array ^>= 0.5 , base64 ^>= 0.4.1 , blaze-html ^>= 0.9.1- , bytestring ^>= 0.10- , clay ^>= 0.13- , colourista ^>= 0.1.0.0- , containers ^>= 0.6+ , bytestring >= 0.10 && < 0.12+ , clay ^>= 0.14+ , colourista >= 0.1 && < 0.3 , cryptohash-sha1 ^>= 0.11 , dir-traverse ^>= 0.2.2.2 , directory ^>= 1.3- , extensions ^>= 0.0.0.1+ , extensions ^>= 0.0.0.1 || ^>= 0.1.0.0 , filepath ^>= 1.4- , ghc >= 8.8 && < 8.11- , ghc-boot-th >= 8.8 && < 8.11+ , ghc >= 8.8 && < 9.5+ , ghc-boot-th >= 8.8 && < 9.5 , gitrev ^>= 1.3.1 , microaeson ^>= 0.1.0.0- , optparse-applicative ^>= 0.15- , pretty-simple ^>= 3.2+ , optparse-applicative >= 0.15 && < 0.17+ , pretty-simple ^>= 4.0 , process ^>= 1.6.8.0- , slist ^>= 0.1- , text ^>= 1.2+ , slist >= 0.1 && < 0.3 , tomland ^>= 1.3.0.0 , trial ^>= 0.0.0.0 , trial-optparse-applicative ^>= 0.0.0.0 , trial-tomland ^>= 0.0.0.0- , unordered-containers ^>= 0.2 executable stan import: common-options@@ -196,9 +199,9 @@ , containers , filepath ^>= 1.4 , ghc- , hedgehog ^>= 1.0- , hspec ^>= 2.7- , hspec-hedgehog ^>= 0.0.1.2+ , hedgehog >= 1.0 && < 1.2+ , hspec >= 2.7 && < 2.11+ , hspec-hedgehog >= 0.0.1.2 , optparse-applicative , text , tomland
test/Spec.hs view
@@ -1,6 +1,6 @@ module Main (main) where -import HieTypes (HieFile (..))+import Stan.Hie.Compat (HieFile (..)) import System.FilePath ((</>)) import Test.Hspec (hspec)
test/Test/Stan/Analysis.hs view
@@ -2,7 +2,7 @@ ( analysisSpec ) where -import HieTypes (HieFile (..))+import Stan.Hie.Compat (HieFile (..)) import System.FilePath ((</>)) import Test.Hspec (Spec, describe, it, runIO, shouldBe)
test/Test/Stan/Analysis/Common.hs view
@@ -8,8 +8,8 @@ , unsafeNameMeta ) where -import FastString (FastString, mkFastString)-import SrcLoc (RealSrcSpan, mkRealSrcLoc, mkRealSrcSpan, srcSpanStartLine)+import Prelude hiding (span)+import Stan.Ghc.Compat (FastString, mkFastString, RealSrcSpan, mkRealSrcLoc, mkRealSrcSpan, srcSpanStartLine) import System.FilePath (pathSeparator, (</>)) import Test.Hspec (Expectation, shouldBe)
test/Test/Stan/Analysis/Partial.hs view
@@ -45,8 +45,6 @@ end = start + funLen checkObservationFor :: Inspection -> Int -> Int -> Int -> Expectation- checkObservationFor ins line start end = observationAssert+ checkObservationFor = observationAssert ["Partial"] analysis- ins- line start end
test/Test/Stan/Number.hs view
@@ -3,7 +3,7 @@ , modulesNumSpec ) where -import HieTypes (HieFile (..))+import Stan.Hie.Compat (HieFile (..)) import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) import Stan.Hie (countLinesOfCode)
test/Test/Stan/Observation.hs view
@@ -2,7 +2,7 @@ ( observationSpec ) where -import SrcLoc (mkRealSrcLoc, mkRealSrcSpan)+import Stan.Ghc.Compat (mkRealSrcLoc, mkRealSrcSpan) import Test.Hspec (Spec, describe, it, shouldBe) import Stan.Core.Id (Id (..))