stan 0.0.0.0 → 0.0.1.0
raw patch · 32 files changed
+544/−125 lines, 32 filesdep +microaesondep +processnew-uploader
Dependencies added: microaeson, process
Files
- CHANGELOG.md +16/−0
- README.md +144/−5
- app/Main.hs +3/−1
- src/Stan.hs +25/−16
- src/Stan/Analysis.hs +19/−1
- src/Stan/Analysis/Analyser.hs +12/−7
- src/Stan/Analysis/Pretty.hs +10/−10
- src/Stan/Browse.hs +62/−0
- src/Stan/Cabal.hs +8/−6
- src/Stan/Category.hs +2/−1
- src/Stan/Cli.hs +44/−22
- src/Stan/Core/Id.hs +2/−1
- src/Stan/Core/ModuleName.hs +3/−1
- src/Stan/FileInfo.hs +11/−0
- src/Stan/Hie.hs +8/−5
- src/Stan/Hie/Compat.hs +4/−3
- src/Stan/Hie/MatchAst.hs +12/−6
- src/Stan/Info.hs +4/−2
- src/Stan/Inspection.hs +11/−0
- src/Stan/Inspection/AntiPattern.hs +1/−1
- src/Stan/Observation.hs +44/−21
- src/Stan/Pattern/Ast.hs +9/−0
- src/Stan/Report/Html.hs +2/−2
- src/Stan/Report/Settings.hs +4/−4
- src/Stan/Severity.hs +4/−0
- src/Stan/Toml.hs +3/−3
- stan.cabal +5/−2
- target/Target/AntiPattern/Stan0206.hs +19/−1
- test/.stan-example.toml +22/−0
- test/Test/Stan/Analysis.hs +2/−2
- test/Test/Stan/Analysis/AntiPattern.hs +27/−0
- test/Test/Stan/Analysis/Common.hs +2/−2
CHANGELOG.md view
@@ -3,6 +3,22 @@ `stan` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +## 0.0.1.0 — Jul 9, 2020++* [#320](https://github.com/kowainik/stan/issues/320):+ Add `-b|--browse` option to the `report` command.+* [#327](https://github.com/kowainik/stan/issues/327):+ When the generated HIE files are incomplete (missing the source code),+ print `<UNAVAILABLE>` as the source instead of failing.+* [#329](https://github.com/kowainik/stan/issues/329):+ Add GHC version to the `--version` output.+* [#326](https://github.com/kowainik/stan/issues/326):+ Handle constraints before constructors in `STAN-0206`.+* [#323](https://github.com/kowainik/stan/issues/323):+ Add `--json-output` option that output the results in machine readable JSON+ format instead. Also all other printing is turned off then.+* Minor documentation improvements.+ ## 0.0.0.0 * Initially created.
README.md view
@@ -20,6 +20,10 @@ * [Installation instructions](#installation-instructions) * [Using Cabal](#using-cabal) * [Using Stack](#using-stack)+ * [Hackage](#hackage)+ * [Homebrew](#homebrew)+ * [Ubuntu PPA](#ubuntu-ppa)+ * [Download binary](#download-binary) * [Usage instructions](#usage-instructions) * [General configuration info](#general-configuration-info) * [TOML configurations](#toml-configurations)@@ -27,6 +31,7 @@ * [Main command](#main-command) * [Inspections](#inspections) * [Converting between TOML and CLI configurations](#converting-between-toml-and-cli-configurations)+ * [Other tools](#other-tools) * [Roadmap](#roadmap) * [Links to Wiki](#links-to-wiki) @@ -103,7 +108,7 @@ To analyse HIE files easily, we developed an eDSL for defining AST and Type patterns based on the-[_final taggless_](http://okmij.org/ftp/tagless-final/course/lecture.pdf)+[_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.@@ -208,6 +213,80 @@ $ cp "$(stack path --local-install-root)/bin/stan" ~/.local/bin/stan ``` +### Hackage++[[Back to the Table of Contents] ↑](#table-of-contents)++Stan is available on Hackage. You can install the tool from there as well:++```shell+$ cabal v2-install stan --install-method=copy --overwrite-policy=always+```++You can also choose with which GHC version you want to have Stan installed, and+optionally add some suffix to the executable name:++```shell+$ cabal v2-install stan \+ -w ghc-8.10.1 \+ --install-method=copy \+ --overwrite-policy=always \+ --program-suffix=-8.10.1+```++### Homebrew++[[Back to the Table of Contents] ↑](#table-of-contents)++If you are on MacOS, you can get Stan using Homebrew Kowainik's Tap.++You need to run the following command for that:++```shell+$ brew install kowainik/tap/stan+```++> NOTE: Homebrew installs the Stan version build with the latest supported GHC+> version. This means that this version of Stan is working with the project with+> the same GHC version due to the GHC issues described above.++### Ubuntu PPA++[[Back to the Table of Contents] ↑](#table-of-contents)++If you are on Ubuntu, you can get Stan using+[Kowainik's PPA](https://launchpad.net/~kowainik/+archive/ubuntu/stan).++You need to run the following commands for that:++```shell+$ sudo add-apt-repository ppa:kowainik/stan+$ sudo apt update+$ sudo apt install stan+```++> NOTE: `apt-get` installs the Stan version build with the latest supported GHC+> version. This means that this version of Stan is working with the project with+> the same GHC version due to the GHC issues described above.++### Download binary++[[Back to the Table of Contents] ↑](#table-of-contents)++You can download binary directly+[from GitHub releases](https://github.com/kowainik/stan/releases/latest).++After downloading binary, make it executable and copy it under+convenient location, e.g.:++```shell+$ chmod +x stan-0.0.1.0-Linux-ghc-8.10.1+$ mv stan-0.0.1.0-Linux-ghc-8.10.1 ~/.local/bin/stan+```++> NOTE: you need to download binary for your specific OS and+> specicific GHC version you use due to the GHC issues described above.+ ## Usage instructions [[Back to the Table of Contents] ↑](#table-of-contents)@@ -286,7 +365,16 @@ them only in particular Haskell modules, ignore some observations or completely remove some files from the analysis. -See Haddock documentation for explanation of how the TOML+Specifically, you can use the following variables to set up custom configurations with TOML:++| Variable | Description | Examples |+|----------|-------------|----------|+| `check` | Set up rules to control the set of inspections per scope. | `check = [{type = "Exclude", id = "STAN-0101", scope = "all"}]` |+| `remove` | Remove some files from the analysis completely. Stan won't be run in the specified scope at all. | `remove = [ {file = "src/File.hs"}, {directory = "folder/"} ]` |+| `ignore` | Ignore specific observation that was found in your project | `ignore = [{ id = "OBS-STAN-0001-YrzpQi-11:42" }]` |++See [Haddock documentation](http://hackage.haskell.org/package/stan-0.0.0.0/docs/Stan-Config.html#g:5)+for explanation of how the TOML configuration works and examples of the different use cases. In case you have a number of TOML files locally, the following rules@@ -341,7 +429,16 @@ categories or severities - Generate the HTML report file - Set up the output verbosity+- Choose to have machine readable JSON output instead +Here is the high-level explanation of the available sub-commands:++| 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` |+| `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"` |+ More precisely the commands and options are described in here: ```@@ -357,6 +454,7 @@ [--no-default] [-s|--short] [--hide-solution]+ [--json-output] [-h|--help] [-v|--version] @@ -373,6 +471,7 @@ --no-default Ignore local .stan.toml configuration file -s,--short Hide verbose output information for observations --hide-solution Hide verbose solution information for observations+ --json-output Output the machine-readable output in JSON format instead -h,--help Show this help text -v,--version Show Stan's version @@ -392,14 +491,20 @@ --directory=DIRECTORY_PATH Directory to exclude or include --scope-all Apply check to all files++Report options:++ -b,--browse Open report in a browser ``` -For example, if you want to run Stan analysis only on a single file,-you can use the following command:+For example, if you want to run Stan analysis only on a single file, generate+the HTML report and immediately open report in a browser, you can use+the following command: ```shell $ stan check --exclude --filter-all --scope-all \- check --include --filter-all --file=src/Stan/Example.hs+ check --include --filter-all --file=src/Stan/Example.hs \+ report --browse ``` #### Inspections@@ -462,6 +567,40 @@ | IGNOREs {ID option} ] ```++## Other tools++[[Back to the Table of Contents] ↑](#table-of-contents)++* [GHC](https://www.haskell.org/ghc/) — __Glasgow Haskell Compiler__++ GHC is the most popular Haskell compiler. As it has access to all steps of the+ code compilation, GHC can warn about different aspects of your code:+ non-exhaustive pattern matching, unused variables, etc.++ However, it is not supposed to be used as a static analysis tool. It provides+ errors and warnings as a part of the whole compilation pipeline.++* [Weeder](https://github.com/ocharles/weeder) — __Haskell dead-code analysis tool__++ Weeder is a tool that analyses the code but in a very specific and limited+ case. It helps to eliminate unreachable code in your project. Similarly to+ Stan, the Weeder tool is also working with the HIE files to get this+ information.++* [HLint](https://github.com/ndmitchell/hlint) — __Haskell Linter Tool__++ HLint is a linter tool that suggests code improvements to make code simpler.++ Unlike Stan, that uses the HIE files for analysis and accesses the complete+ compile-time info produced by GHC, HLint relies only on parsing, which has its+ own benefits but also limits its capabilities.++ Stan and HLint are complementary tools that have different scopes and goals.+ There is no intention to duplicate HLint in Stan.++To learn more about the implementation and goals of our project, please read the+sections above that describe the Stan project in detail. ## Roadmap
app/Main.hs view
@@ -1,7 +1,9 @@ module Main (main) where +import GHC.IO.Encoding (setLocaleEncoding, utf8)+ import Stan (run) main :: IO ()-main = run+main = setLocaleEncoding utf8 >> run
src/Stan.hs view
@@ -14,6 +14,7 @@ ) where 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)@@ -22,9 +23,10 @@ import Stan.Analysis (Analysis (..), runAnalysis) import Stan.Analysis.Pretty (prettyShowAnalysis)+import Stan.Browse (openBrowser) import Stan.Cabal (createCabalExtensionsMap, usedCabalFiles)-import Stan.Cli (CliToTomlArgs (..), InspectionArgs (..), StanArgs (..), StanCommand (..),- TomlToCliArgs (..), runStanCli)+import Stan.Cli (CliToTomlArgs (..), InspectionArgs (..), ReportArgs (..), StanArgs (..),+ StanCommand (..), TomlToCliArgs (..), runStanCli) import Stan.Config (ConfigP (..), applyConfig, configToCliCommand, defaultConfig, finaliseConfig) import Stan.Config.Pretty (prettyConfigCli) import Stan.Core.Id (Id (..))@@ -53,39 +55,45 @@ runStan :: StanArgs -> IO () runStan StanArgs{..} = do+ let notJson = not stanArgsJsonOut -- ENV vars env@EnvVars{..} <- getEnvVars let defConfTrial = envVarsUseDefaultConfigFile <> stanArgsUseDefaultConfigFile- infoMessage "Checking environment variables and CLI arguments for default configurations file usage..."- putTextLn $ indent $ prettyTaggedTrial defConfTrial+ when notJson $ do+ infoMessage "Checking environment variables and CLI arguments for default configurations file usage..."+ putTextLn $ indent $ prettyTaggedTrial defConfTrial let useDefConfig = maybe True snd (trialToMaybe defConfTrial) -- config- tomlConfig <- getTomlConfig useDefConfig stanArgsConfigFile+ tomlConfig <- getTomlConfig notJson useDefConfig stanArgsConfigFile let configTrial = finaliseConfig $ defaultConfig <> tomlConfig <> stanArgsConfig- infoMessage "The following Configurations are used:\n"- putTextLn $ indent $ prettyTrialWith (toString . prettyConfigCli) configTrial+ when notJson $ do+ infoMessage "The following Configurations are used:\n"+ putTextLn $ indent $ prettyTrialWith (toString . prettyConfigCli) configTrial whenResult_ configTrial $ \warnings config -> do hieFiles <- readHieFiles stanArgsHiedir -- create cabal default extensions map- cabalExtensionsMap <- createCabalExtensionsMap stanArgsCabalFilePath hieFiles+ cabalExtensionsMap <- createCabalExtensionsMap notJson stanArgsCabalFilePath hieFiles -- get checks for each file let checksMap = applyConfig (map hie_hs_file hieFiles) config let analysis = runAnalysis cabalExtensionsMap checksMap (configIgnored config) hieFiles -- show what observations are ignored- putText $ indent $ prettyShowIgnoredObservations+ when notJson $ putText $ indent $ prettyShowIgnoredObservations (configIgnored config) (analysisIgnoredObservations analysis) -- show the result let observations = analysisObservations analysis let isNullObs = null observations- if isNullObs- then successMessage "All clean! Stan did not find any observations at the moment."- else warningMessage "Stan found the following observations for the project:\n"- putTextLn $ prettyShowAnalysis analysis stanArgsReportSettings+ if notJson+ then do+ if isNullObs+ then successMessage "All clean! Stan did not find any observations at the moment."+ else warningMessage "Stan found the following observations for the project:\n"+ putTextLn $ prettyShowAnalysis analysis stanArgsOutputSettings+ else putLBSLn $ encode analysis -- report generation- when stanArgsReport $ do+ whenJust stanArgsReport $ \ReportArgs{..} -> do -- Project Info piName <- takeFileName <$> getCurrentDirectory piCabalFiles <- usedCabalFiles stanArgsCabalFilePath@@ -99,7 +107,8 @@ , .. } generateReport analysis config warnings stanEnv ProjectInfo{..}- infoMessage "Report is generated here -> stan.html"+ when notJson $ infoMessage "Report is generated here -> stan.html"+ when reportArgsBrowse $ openBrowser "stan.html" -- decide on exit status when@@ -126,7 +135,7 @@ runTomlToCli :: TomlToCliArgs -> IO () runTomlToCli TomlToCliArgs{..} = do let useDefConfig = isNothing tomlToCliArgsFilePath- partialConfig <- getTomlConfig useDefConfig tomlToCliArgsFilePath+ partialConfig <- getTomlConfig True useDefConfig tomlToCliArgsFilePath case finaliseConfig partialConfig of Result _ res -> putTextLn $ configToCliCommand res fiasco -> do
src/Stan/Analysis.hs view
@@ -11,8 +11,9 @@ , runAnalysis ) where +import Data.Aeson.Micro (ToJSON (..), object, (.=)) import Extensions (ExtensionsError (..), OnOffExtension, ParsedExtensions (..),- SafeHaskellExtension, parseSourceWithPath)+ SafeHaskellExtension, parseSourceWithPath, showOnOffExtension) import Relude.Extra.Lens (Lens', lens, over) import Stan.Analysis.Analyser (analysisByInspection)@@ -43,6 +44,23 @@ , analysisIgnoredObservations :: !Observations , analysisFileMap :: !FileMap } deriving stock (Show)++instance ToJSON Analysis where+ toJSON Analysis{..} = object+ [ "modulesNum" .= analysisModulesNum+ , "linesOfCode" .= analysisLinesOfCode+ , "usedExtensions" .=+ let (ext, safeExt) = analysisUsedExtensions+ in map showOnOffExtension (toList ext)+ <> map (show @Text) (toList safeExt)+ , "inspections" .= toList analysisInspections+ , "observations" .= toJsonObs analysisObservations+ , "ignoredObservations" .= toJsonObs analysisIgnoredObservations+ , "fileMap" .= map (first toText) (Map.toList analysisFileMap)+ ]+ where+ toJsonObs :: Observations -> [Observation]+ toJsonObs = toList . S.sortOn observationSrcSpan modulesNumL :: Lens' Analysis Int modulesNumL = lens
src/Stan/Analysis/Analyser.hs view
@@ -29,9 +29,9 @@ import Stan.NameMeta (NameMeta, ghcPrimNameFrom) import Stan.Observation (Observations, mkObservation) import Stan.Pattern.Ast (Literal (..), PatternAst (..), anyNamesToPatternAst, case', constructor,- dataDecl, fixity, fun, guardBranch, lambdaCase, lazyField, literalPat,- opApp, patternMatchArrow, patternMatchBranch, patternMatch_, rhs, tuple,- typeSig)+ constructorNameIdentifier, dataDecl, fixity, fun, guardBranch, lambdaCase,+ lazyField, literalPat, opApp, patternMatchArrow, patternMatchBranch,+ patternMatch_, rhs, tuple, typeSig) import Stan.Pattern.Edsl (PatternBool (..)) import qualified Data.HashMap.Strict as HM@@ -184,12 +184,13 @@ -- Extract fields as AST nodes. Return empty list if only one field -- (as a workaround for the @newtype@ problem) --- -- record constructors have 2 children:- -- 1. Constructor name.- -- 2. Dummy child with all fields as childrens+ -- record constructors have the following children:+ -- 1. One or many constraints (e.g. forall a . Num a =>)+ -- 2. Constructor name.+ -- 3. Dummy child with all fields as childrens -- plain constructors have constructor name and children in the same list extractFields :: Bool -> HieAST TypeIndex -> [HieAST TypeIndex]- extractFields hasManyCtors ctor = case drop 1 $ nodeChildren ctor of+ extractFields hasManyCtors ctor = case drop 1 $ dropWhile isConstraint $ nodeChildren ctor of [] -> [] -- no fields [n] -> -- single field, maybe dummy record node if isDummyRecordNode n@@ -203,6 +204,10 @@ -- simple check for the dummy AST node isDummyRecordNode :: HieAST TypeIndex -> Bool isDummyRecordNode = Set.null . nodeAnnotations . nodeInfo++ -- Not the constructor identifier+ isConstraint :: HieAST TypeIndex -> Bool+ isConstraint n = not $ hieMatchPatternAst hie n constructorNameIdentifier -- matches record fields non-recursively matchField :: HieAST TypeIndex -> Slist RealSrcSpan
src/Stan/Analysis/Pretty.hs view
@@ -25,7 +25,7 @@ import Stan.Core.ModuleName (ModuleName (..)) import Stan.FileInfo (FileInfo (..), extensionsToText) import Stan.Observation (Observation (..), prettyShowObservation)-import Stan.Report.Settings (ReportSettings (..), Verbosity (..))+import Stan.Report.Settings (OutputSettings (..), Verbosity (..)) import qualified Data.HashSet as HS import qualified Data.Map.Strict as Map@@ -37,8 +37,8 @@ {- | Shows analysed output of Stan work. This functions groups 'Observation's by 'FilePath' they are found in. -}-prettyShowAnalysis :: Analysis -> ReportSettings -> Text-prettyShowAnalysis an rs@ReportSettings{..} = case reportSettingsVerbosity of+prettyShowAnalysis :: Analysis -> OutputSettings -> Text+prettyShowAnalysis an rs@OutputSettings{..} = case outputSettingsVerbosity of Verbose -> groupedObservations <> summary (analysisToNumbers an) NonVerbose -> unlines $ toList $ prettyShowObservation rs <$> analysisObservations an where@@ -123,9 +123,9 @@ , mid , alignText "Analysed Lines of Code" <> alignNum anLoc , mid- , alignText "Total Haskel2010 extensions" <> alignNum anExts+ , alignText "Total Haskell2010 extensions" <> alignNum anExts , mid- , alignText "Total SafeHaskel extensions" <> alignNum anSafeExts+ , alignText "Total SafeHaskell extensions" <> alignNum anSafeExts , mid , alignText "Total checked inspections" <> alignNum anIns , mid@@ -144,17 +144,17 @@ alignVal x = " ┃ " <> Text.justifyLeft 6 ' ' x <> " ┃" alignText :: Text -> Text- alignText txt ="┃ " <> Text.justifyLeft 27 ' ' txt+ alignText txt ="┃ " <> Text.justifyLeft 28 ' ' txt separator :: Text -> Text -> Text -> Text- separator l c r = l <> Text.replicate 29 "━" <> c <> Text.replicate 8 "━" <> r+ separator l c r = l <> Text.replicate 30 "━" <> c <> Text.replicate 8 "━" <> r top, mid, bot :: Text top = separator "┏" "┳" "┓" mid = separator "┣" "╋" "┫" bot = separator "┗" "┻" "┛" -showByFile :: ReportSettings -> FileInfo -> Text-showByFile reportSettings FileInfo{..} = if len == 0 then "" else unlines+showByFile :: OutputSettings -> FileInfo -> Text+showByFile outputSettings FileInfo{..} = if len == 0 then "" else unlines [ i " File: " <> b (toText fileInfoPath) , i " Module: " <> b (unModuleName fileInfoModuleName) , i " LoC: " <> b (show fileInfoLoc)@@ -165,7 +165,7 @@ ] <> Text.intercalate (" ┃\n ┃" <> Text.replicate 78 "~" <> "\n ┃\n")- (toList $ prettyShowObservation reportSettings <$> S.sortOn observationLoc fileInfoObservations)+ (toList $ prettyShowObservation outputSettings <$> S.sortOn observationSrcSpan fileInfoObservations) where len :: Int len = length fileInfoObservations
+ src/Stan/Browse.hs view
@@ -0,0 +1,62 @@+{- |+Copyright: (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Contains implementation of a function that opens a given file in a+browser.+-}++module Stan.Browse+ ( openBrowser+ ) where++import Colourista (errorMessage, infoMessage)+import System.Directory (findExecutable)+import System.Environment (lookupEnv)+import System.Info (os)+import System.Process (callCommand, showCommandForUser)+++{- | Open a given file in a browser. The function has the following algorithm:++* Check the @BROWSER@ environment variable+* If it's not set, try to guess browser depending on OS+* If unsuccsessful, print a message+-}+openBrowser :: FilePath -> IO ()+openBrowser file = lookupEnv "BROWSER" >>= \case+ Just browser -> runCommand browser [file]+ Nothing -> case os of+ "darwin" -> runCommand "open" [file]+ "mingw32" -> runCommand "cmd" ["/c", "start", file]+ curOs -> do+ browserExe <- findFirstExecutable+ [ "xdg-open"+ , "cygstart"+ , "x-www-browser"+ , "firefox"+ , "opera"+ , "mozilla"+ , "netscape"+ ]+ case browserExe of+ Just browser -> runCommand browser [file]+ Nothing -> do+ errorMessage $ "Cannot guess browser for the OS: " <> toText curOs+ infoMessage "Please set the $BROWSER environment variable to a web launcher"+ exitFailure++-- | Execute a command with arguments.+runCommand :: FilePath -> [String] -> IO ()+runCommand cmd args = do+ let cmdStr = showCommandForUser cmd args+ putStrLn $ "⚙ " ++ cmdStr+ callCommand cmdStr++findFirstExecutable :: [FilePath] -> IO (Maybe FilePath)+findFirstExecutable = \case+ [] -> pure Nothing+ exe:exes -> findExecutable exe >>= \case+ Nothing -> findFirstExecutable exes+ Just path -> pure $ Just path
src/Stan/Cabal.hs view
@@ -42,17 +42,19 @@ (that are in .cabal file) to the resulting parsed extensions for each. -} createCabalExtensionsMap- :: [FilePath] -- ^ @.cabal@ files+ :: Bool -- ^ Do print into terminal?+ -> [FilePath] -- ^ @.cabal@ files -> [HieFile] -> IO (Map FilePath (Either ExtensionsError ParsedExtensions))-createCabalExtensionsMap cabalPath hies = case cabalPath of+createCabalExtensionsMap isLoud cabalPath hies = case cabalPath of -- if cabal files are not specified via CLI option -- try to find cabal files in current directory [] -> findCabalFiles >>= \case -- if cabal file is not found, pass the empty map instead [] -> do- warningMessage ".cabal file not found in the current directory."- infoMessage " 💡 Try using --cabal-file-path option to specify the path to the .cabal file.\n"+ when isLoud $ do+ warningMessage ".cabal file not found in the current directory."+ infoMessage " 💡 Try using --cabal-file-path option to specify the path to the .cabal file.\n" pure mempty -- else concat map for each @.cabal@ file. cabals -> mconcat <$> mapM getExtensionsWithCabal cabals@@ -66,7 +68,7 @@ :: FilePath -> IO (Map FilePath (Either ExtensionsError ParsedExtensions)) getExtensionsWithCabal cabal = do- infoMessage $ "Using the following .cabal file: " <> toText cabal <> "\n"+ when isLoud $ infoMessage $ "Using the following .cabal file: " <> toText cabal <> "\n" (Right <<$>> parseCabalFileExtensions cabal) `catch` handleCabalErr where@@ -74,7 +76,7 @@ :: CabalException -> IO (Map FilePath (Either ExtensionsError ParsedExtensions)) handleCabalErr err = do- errorMessage "Error when parsing cabal file. Stan will continue without information from .cabal file"+ when isLoud $ errorMessage "Error when parsing cabal file. Stan will continue without information from .cabal file" pure $ Map.fromList $ map (toSnd (const $ Left $ CabalError err) . hie_hs_file) hies
src/Stan/Category.hs view
@@ -25,12 +25,13 @@ ) where import Colourista (formatWith, magentaBg)+import Data.Aeson.Micro (ToJSON) -- | A type of the inspection. newtype Category = Category { unCategory :: Text- } deriving newtype (Show, Eq, Hashable)+ } deriving newtype (Show, Eq, Hashable, ToJSON) -- | Show 'Category' in a human-friendly format. prettyShowCategory :: Category -> Text
src/Stan/Cli.hs view
@@ -11,6 +11,7 @@ module Stan.Cli ( StanCommand (..) , StanArgs (..)+ , ReportArgs (..) , InspectionArgs (..) , TomlToCliArgs (..) , CliToTomlArgs (..)@@ -27,7 +28,7 @@ helpLongEquals, helper, hidden, hsubparser, info, infoOption, internal, long, metavar, multiSuffix, option, prefs, progDesc, short, showDefaultWith, showHelpOnEmpty, showHelpOnError, strArgument,- strOption, subparserInline, value)+ strOption, subparserInline, switch, value) import Options.Applicative.Help.Chunk (stringChunk) import Trial (TaggedTrial, fiascoOnEmpty) import Trial.OptparseApplicative (taggedTrialParser)@@ -36,10 +37,10 @@ import Stan.Config (Check (..), CheckFilter (..), CheckType (..), ConfigP (..), PartialConfig, Scope (..)) import Stan.Core.Id (Id (..))-import Stan.Info (prettyStanVersion, stanVersion)+import Stan.Info (prettyStanVersion, stanSystem, stanVersion) import Stan.Inspection (Inspection) import Stan.Observation (Observation)-import Stan.Report.Settings (ReportSettings (..), ToggleSolution (..), Verbosity (..))+import Stan.Report.Settings (OutputSettings (..), ToggleSolution (..), Verbosity (..)) -- | Commands used in Stan CLI.@@ -54,13 +55,18 @@ data StanArgs = StanArgs { stanArgsHiedir :: !FilePath -- ^ Directory with HIE files , stanArgsCabalFilePath :: ![FilePath] -- ^ Path to @.cabal@ files.- , stanArgsReportSettings :: !ReportSettings -- ^ Settings for report- , stanArgsReport :: !Bool -- ^ Create @HTML@ report?+ , stanArgsOutputSettings :: !OutputSettings -- ^ Settings for output terminal report+ , stanArgsReport :: !(Maybe ReportArgs) -- ^ @HTML@ report settings , stanArgsUseDefaultConfigFile :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file , stanArgsConfigFile :: !(Maybe FilePath) -- ^ Path to a custom configurations file. , stanArgsConfig :: !PartialConfig+ , stanArgsJsonOut :: !Bool -- ^ Output the machine-readable output in JSON format instead. } +newtype ReportArgs = ReportArgs+ { reportArgsBrowse :: Bool -- ^ Open HTML report in a browser+ }+ -- | Options used for the @stan inspection@ command. newtype InspectionArgs = InspectionArgs { inspectionArgsId :: Maybe (Id Inspection)@@ -114,7 +120,8 @@ stanArgsCabalFilePath <- cabalFilePathP stanArgsConfigFile <- configFileP stanArgsUseDefaultConfigFile <- useDefaultConfigFileP- stanArgsReportSettings <- reportSettingsP+ stanArgsOutputSettings <- outputSettingsP+ stanArgsJsonOut <- jsonOutputP pure $ Stan StanArgs{..} -- | @stan inspection@ command parser.@@ -197,22 +204,37 @@ , help "Ignore local .stan.toml configuration file" ] -reportP :: Parser Bool-reportP = do- res <- optional $ hsubparser $- command "report"- (info pass (progDesc "Generate HTML Report"))- <> commandGroup "Reporting"- <> commandVar "REPORT"- <> help "Command to generate an HTML Report"- pure $ isJust res+jsonOutputP :: Parser Bool+jsonOutputP = switch $ mconcat+ [ long "json-output"+ , help "Output the machine-readable output in JSON format instead"+ ] -reportSettingsP :: Parser ReportSettings-reportSettingsP = do- reportSettingsVerbosity <- verbosityP- reportSettingsSolutionVerbosity <- toggleSolutionP- pure ReportSettings{..}+reportP :: Parser (Maybe ReportArgs)+reportP = optional+ $ hsubparser+ $ command "report" (info reportArgsP (progDesc "Generate HTML Report"))+ <> commandGroup "Reporting"+ <> commandVar "REPORT"+ <> help "Command to generate an HTML Report"+ where+ reportArgsP :: Parser ReportArgs+ reportArgsP = do+ reportArgsBrowse <- browseP+ pure ReportArgs{..} + browseP :: Parser Bool+ browseP = switch+ $ long "browse"+ <> short 'b'+ <> help "Open report in a browser"++outputSettingsP :: Parser OutputSettings+outputSettingsP = do+ outputSettingsVerbosity <- verbosityP+ outputSettingsSolutionVerbosity <- toggleSolutionP+ pure OutputSettings{..}+ -- | The solution is shown by default and gets hidden when option is specified. toggleSolutionP :: Parser ToggleSolution toggleSolutionP = flag ShowSolution HideSolution $ mconcat@@ -317,8 +339,8 @@ -- | Show the version of the tool. versionP :: Parser (a -> a)-versionP = infoOption (prettyStanVersion stanVersion)- $ long "version"+versionP = infoOption (prettyStanVersion stanVersion stanSystem)+ $ long "version" <> short 'v' <> help "Show Stan's version" <> hidden
src/Stan/Core/Id.hs view
@@ -19,6 +19,7 @@ , castId ) where +import Data.Aeson.Micro (ToJSON) import Data.Type.Equality (type (==)) @@ -28,7 +29,7 @@ newtype Id a = Id { unId :: Text } deriving stock (Show)- deriving newtype (Eq, Ord, Hashable)+ deriving newtype (Eq, Ord, Hashable, ToJSON) {- | A type alias for the situations when we don't care about the parameter of 'Id' but don't want to deal with type variables.
src/Stan/Core/ModuleName.hs view
@@ -13,6 +13,8 @@ , fromGhcModuleName ) where +import Data.Aeson.Micro (ToJSON)+ import qualified Stan.Ghc.Compat as Ghc @@ -20,7 +22,7 @@ newtype ModuleName = ModuleName { unModuleName :: Text } deriving stock (Show)- deriving newtype (Eq, Hashable, IsString)+ deriving newtype (Eq, Hashable, IsString, ToJSON) -- | Convert 'GHC.ModuleName' to 'ModuleName'. fromGhcModuleName :: Ghc.ModuleName -> ModuleName
src/Stan/FileInfo.hs view
@@ -14,6 +14,7 @@ , isExtensionDisabled ) where +import Data.Aeson.Micro (ToJSON (..), object, (.=)) import Extensions (Extensions (..), ExtensionsError, ExtensionsResult, OnOffExtension (..), ParsedExtensions (..), showOnOffExtension) import GHC.LanguageExtensions.Type (Extension)@@ -34,6 +35,16 @@ , fileInfoMergedExtensions :: !ExtensionsResult , fileInfoObservations :: !Observations } deriving stock (Show, Eq)++instance ToJSON FileInfo where+ toJSON FileInfo{..} = object+ [ "path" .= toText fileInfoPath+ , "moduleName" .= fileInfoModuleName+ , "loc" .= fileInfoLoc+ , "cabalExtensions" .= extensionsToText fileInfoCabalExtensions+ , "extensions" .= extensionsToText fileInfoExtensions+ , "observations" .= toList fileInfoObservations+ ] type FileMap = Map FilePath FileInfo
src/Stan/Hie.hs view
@@ -30,7 +30,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.Set as Set-import qualified Relude.Unsafe as Unsafe {- | Returns contents of all @.hie@ files recursively in the given@@ -66,13 +65,17 @@ {- | Take sub-bytestring according to a given span. +When the given source is empty returns 'Nothing'.+ TODO: currently works only with single-line spans -}-slice :: RealSrcSpan -> ByteString -> ByteString+slice :: RealSrcSpan -> ByteString -> Maybe ByteString slice span =- BS.take (srcSpanEndCol span - srcSpanStartCol span)- . BS.drop (srcSpanStartCol span - 1)- . Unsafe.at (srcSpanStartLine span - 1)+ fmap+ ( BS.take (srcSpanEndCol span - srcSpanStartCol span)+ . BS.drop (srcSpanStartCol span - 1)+ )+ . flip (!!?) (srcSpanStartLine span - 1) . BS8.lines {- | Compare two AST nodes on equality. This is a more relaxed version
src/Stan/Hie/Compat.hs view
@@ -21,6 +21,7 @@ , IdentifierDetails (..) , NodeInfo (..) , TypeIndex+ , DeclType (..) -- * Binary interface to hie files , HieFileResult (hie_file_result)@@ -33,8 +34,8 @@ ) where import HieBin (HieFileResult (hie_file_result), readHieFile)-import HieTypes (ContextInfo (..), HieAST (..), HieASTs (..), HieArgs (..), HieFile (..),- HieType (..), HieTypeFlat, IEType (..), Identifier, IdentifierDetails (..),- NodeInfo (..), TypeIndex)+import HieTypes (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..),+ HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier,+ IdentifierDetails (..), NodeInfo (..), TypeIndex) import NameCache (NameCache, initNameCache) import UniqSupply (mkSplitUniqSupply)
src/Stan/Hie/MatchAst.hs view
@@ -21,8 +21,8 @@ import Stan.Core.List (checkWith) import Stan.Ghc.Compat (FastString, nameOccName, occNameString) import Stan.Hie (slice)-import Stan.Hie.Compat (HieAST (..), HieFile (..), Identifier, IdentifierDetails, NodeInfo (..),- TypeIndex)+import Stan.Hie.Compat (ContextInfo (..), DeclType, HieAST (..), HieFile (..), Identifier,+ IdentifierDetails (..), NodeInfo (..), TypeIndex) import Stan.Hie.MatchType (hieMatchPatternType) import Stan.NameMeta (NameMeta, hieMatchNameMeta) import Stan.Pattern.Ast (Literal (..), PatternAst (..), literalAnns)@@ -55,10 +55,10 @@ PatternAstConstant lit -> Set.member literalAnns (nodeAnnotations nodeInfo) && ( let span = slice nodeSpan hie_hs_src in case lit of- ExactNum n -> readMaybe (decodeUtf8 span) == Just n- ExactStr s -> span == s- PrefixStr s -> s `BS.isPrefixOf` span- ContainStr s -> s `BS.isInfixOf` span+ ExactNum n -> (span >>= readMaybe . decodeUtf8) == Just n+ ExactStr s -> span == Just s+ PrefixStr s -> maybe False (s `BS.isPrefixOf`) span+ ContainStr s -> maybe False (s `BS.isInfixOf`) span AnyLiteral -> True ) PatternAstName nameMeta patType ->@@ -76,6 +76,8 @@ Left _ -> False ) $ Map.keys $ nodeIdentifiers nodeInfo+ 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@@ -90,3 +92,7 @@ && case nodeType nodeInfo of [] -> False t : _ -> hieMatchPatternType hie_types patType t++ isDecl :: DeclType -> ContextInfo -> Bool+ isDecl myDeclType (Decl curDeclType _) = myDeclType == curDeclType+ isDecl _declType _otherContext = False
src/Stan/Info.hs view
@@ -51,11 +51,12 @@ {- | Colourful pretty 'StanVersion' representation used in the @CLI@. -}-prettyStanVersion :: StanVersion -> String-prettyStanVersion StanVersion{..} = toString $ intercalate "\n"+prettyStanVersion :: StanVersion -> StanSystem -> String+prettyStanVersion StanVersion{..} StanSystem{..} = toString $ intercalate "\n" [ sVersion , sHash , sDate+ , sGhc ] where fmt :: String -> String@@ -65,6 +66,7 @@ sVersion = fmt $ "Stan " <> "v" <> svVersion sHash = " ➤ " <> fmt "Git revision: " <> svGitRevision sDate = " ➤ " <> fmt "Commit date: " <> svCommitDate+ sGhc = " ➤ " <> fmt "GHC version: " <> ssCompilerVersion {- | Contains all @stan@ System information -}
src/Stan/Inspection.hs view
@@ -32,6 +32,7 @@ import Colourista (blue, bold, formatWith, green) import Colourista.Short (b, i)+import Data.Aeson.Micro (ToJSON (..), object, (.=)) import Stan.Category (Category (..), prettyShowCategory) import Stan.Core.Id (Id (..))@@ -54,6 +55,16 @@ , inspectionSeverity :: !Severity , inspectionAnalysis :: !InspectionAnalysis } deriving stock (Show, Eq)++instance ToJSON Inspection where+ toJSON Inspection{..} = object+ [ "id" .= inspectionId+ , "name" .= inspectionName+ , "description" .= inspectionDescription+ , "solution" .= inspectionSolution+ , "category" .= toList inspectionCategory+ , "severity" .= inspectionSeverity+ ] descriptionL :: Lens' Inspection Text descriptionL = lens
src/Stan/Inspection/AntiPattern.hs view
@@ -232,7 +232,7 @@ (FindAst $ PatternAstName lenNameMeta (textPattern |-> (?))) & descriptionL .~ "Usage of 'length' for 'Text' that runs in linear time" & solutionL .~- [ "{Extra dependency} Switch to 'ByteString' from 'bytesting'"+ [ "{Extra dependency} Switch to 'ByteString' from 'bytestring'" ] & severityL .~ Performance where
src/Stan/Observation.hs view
@@ -24,8 +24,8 @@ import Colourista (blue, bold, formatWith, green, italic, reset, yellow) import Colourista.Short (b, i)+import Data.Aeson.Micro (ToJSON (..), object, (.=)) import Data.List (partition)-import Relude.Unsafe ((!!)) import Slist (Slist) import Stan.Category (prettyShowCategory)@@ -36,7 +36,7 @@ import Stan.Hie.Compat (HieFile (..)) import Stan.Inspection (Inspection (..)) import Stan.Inspection.All (getInspectionById)-import Stan.Report.Settings (ReportSettings (..), Verbosity (..), isHidden)+import Stan.Report.Settings (OutputSettings (..), Verbosity (..), isHidden) import Stan.Severity (prettyShowSeverity, severityColour) import qualified Crypto.Hash.SHA1 as SHA1@@ -53,12 +53,25 @@ data Observation = Observation { observationId :: !(Id Observation) , observationInspectionId :: !(Id Inspection)- , observationLoc :: !RealSrcSpan+ , observationSrcSpan :: !RealSrcSpan , observationFile :: !FilePath , observationModuleName :: !ModuleName , observationFileContent :: !ByteString } deriving stock (Show, Eq) +instance ToJSON Observation where+ toJSON Observation{..} = object+ [ "id" .= observationId+ , "inspectionId" .= observationInspectionId+ , "srcSpan" .= showSpan observationSrcSpan+ , "startLine" .= srcSpanStartLine observationSrcSpan+ , "startCol" .= srcSpanStartCol observationSrcSpan+ , "endLine" .= srcSpanEndLine observationSrcSpan+ , "endCol" .= srcSpanEndCol observationSrcSpan+ , "file" .= toText observationFile+ , "moduleName" .= observationModuleName+ ]+ -- | Type alias for the sized list of 'Observation's. type Observations = Slist Observation @@ -71,7 +84,7 @@ mkObservation insId HieFile{..} srcSpan = Observation { observationId = mkObservationId insId moduleName srcSpan , observationInspectionId = insId- , observationLoc = srcSpan+ , observationSrcSpan = srcSpan , observationFile = hie_hs_file , observationModuleName = moduleName , observationFileContent = hie_hs_src@@ -82,8 +95,8 @@ -- | Show 'Observation' in a human-friendly format.-prettyShowObservation :: ReportSettings -> Observation -> Text-prettyShowObservation ReportSettings{..} o@Observation{..} = case reportSettingsVerbosity of+prettyShowObservation :: OutputSettings -> Observation -> Text+prettyShowObservation OutputSettings{..} o@Observation{..} = case outputSettingsVerbosity of NonVerbose -> simpleShowObservation Verbose -> unlines $ map (" ┃ " <>) $ observationTable@@ -95,17 +108,10 @@ " ✦ " <> b (unId observationId) <>" [" <> sev <> "] "- <> i (showSpan observationLoc)+ <> i (showSpan observationSrcSpan) <> " — " <> inspectionName inspection - showSpan :: RealSrcSpan -> Text- showSpan s = show (srcSpanFile s)- <> "(" <> show (srcSpanStartLine s)- <> ":" <> show (srcSpanStartCol s)- <> "-" <> show (srcSpanEndLine s)- <> ":" <> show (srcSpanEndCol s)- <> ")" observationTable :: [Text] observationTable =@@ -133,10 +139,11 @@ solution :: [Text] solution- | isHidden reportSettingsSolutionVerbosity || null sols = []+ | isHidden outputSettingsSolutionVerbosity || null sols = [] | otherwise = "💡 " <> formatWith [italic, green] "Possible solution:" : map (" ⍟ " <>) sols where+ sols :: [Text] sols = inspectionSolution inspection @@ -150,15 +157,17 @@ ++ [alignLine (endL + 1) <> arrows] where n, endL :: Int- n = srcSpanStartLine observationLoc- endL = srcSpanEndLine observationLoc+ n = srcSpanStartLine observationSrcSpan+ endL = srcSpanEndLine observationSrcSpan alignLine :: Int -> Text alignLine x = Text.justifyRight 4 ' ' (show x) <> " ┃ " getSourceLine :: Int -> Text- getSourceLine x = decodeUtf8 $- BS.lines observationFileContent !! (x - 1)+ getSourceLine x = maybe+ "<UNAVAILABLE> Open the issue in the tool that created the HIE files for you."+ decodeUtf8+ (BS.lines observationFileContent !!? (x - 1)) arrows :: Text arrows = whenColour isColour (severityColour $ inspectionSeverity $ getInspectionById observationInspectionId)@@ -166,8 +175,22 @@ <> Text.replicate arrow "^" <> whenColour isColour reset where- start = srcSpanStartCol observationLoc - 1- arrow = srcSpanEndCol observationLoc - start - 1+ start = srcSpanStartCol observationSrcSpan - 1+ arrow = srcSpanEndCol observationSrcSpan - start - 1++{- | Show 'RealSrcSpan' in the following format:++@+filename.ext(11:12-13:14)+@+-}+showSpan :: RealSrcSpan -> Text+showSpan s = show (srcSpanFile s)+ <> "(" <> show (srcSpanStartLine s)+ <> ":" <> show (srcSpanStartCol s)+ <> "-" <> show (srcSpanEndLine s)+ <> ":" <> show (srcSpanEndCol s)+ <> ")" {- | Checkes the predicate on colourfulness and returns an empty text when the colouroing is disabled.
src/Stan/Pattern/Ast.hs view
@@ -21,6 +21,7 @@ , app , opApp , constructor+ , constructorNameIdentifier , dataDecl , fixity , fun@@ -45,6 +46,7 @@ ) where import Stan.Ghc.Compat (FastString)+import Stan.Hie.Compat (DeclType (..)) import Stan.NameMeta (NameMeta (..)) import Stan.Pattern.Edsl (PatternBool (..)) import Stan.Pattern.Type (PatternType)@@ -79,6 +81,8 @@ | PatternAstAnd !PatternAst !PatternAst -- | Negation of pattern. Should match everything except this pattern. | PatternAstNeg !PatternAst+ -- | AST node with the specified Identifier details (only 'DeclType')+ | PatternAstIdentifierDetailsDecl !DeclType deriving stock (Show, Eq) instance PatternBool PatternAst where@@ -210,6 +214,11 @@ -} constructor :: PatternAst constructor = PatternAstNode $ one ("ConDeclH98", "ConDecl")++{- | Constructor name Identifier info+-}+constructorNameIdentifier :: PatternAst+constructorNameIdentifier = PatternAstIdentifierDetailsDecl ConDec {- | Lazy data type field. Comes in two shapes:
src/Stan/Report/Html.hs view
@@ -138,7 +138,7 @@ tableRow "Modules" anModules tableRow "LoC" anLoc tableRow "Extensions" anExts- tableRow "SafeHaskel Extensions" anSafeExts+ tableRow "SafeHaskell Extensions" anSafeExts tableRow "Available inspections" (HM.size inspectionsMap) tableRow "Checked inspections" anIns tableRow "Found Observations" anFoundObs@@ -242,7 +242,7 @@ stanExtensions "module" (extensionsToText fileInfoExtensions) li ! A.class_ "col-12 obs-li" $ divClass "observations col-12" $ do h4 "Observations"- traverse_ stanObservation $ S.sortOn observationLoc fileInfoObservations+ traverse_ stanObservation $ S.sortOn observationSrcSpan fileInfoObservations stanExtensions :: Text -> [Text] -> Html stanExtensions from exts = divClass "col-6" $ do
src/Stan/Report/Settings.hs view
@@ -7,7 +7,7 @@ -} module Stan.Report.Settings- ( ReportSettings (..)+ ( OutputSettings (..) -- * Verbosity , Verbosity (..)@@ -20,9 +20,9 @@ {- | Settings for produced report. -}-data ReportSettings = ReportSettings- { reportSettingsVerbosity :: !Verbosity- , reportSettingsSolutionVerbosity :: !ToggleSolution+data OutputSettings = OutputSettings+ { outputSettingsVerbosity :: !Verbosity+ , outputSettingsSolutionVerbosity :: !ToggleSolution } data Verbosity
src/Stan/Severity.hs view
@@ -17,6 +17,7 @@ ) where import Colourista (blue, bold, cyan, formatWith, magenta, red, yellow)+import Data.Aeson.Micro (ToJSON (..)) {- | Severity level of the inspection.@@ -48,6 +49,9 @@ -- | Dangerous behaviour. | Error deriving stock (Show, Read, Eq, Ord, Enum, Bounded)++instance ToJSON Severity where+ toJSON = toJSON . show @Text -- | Description of each 'Severity' level. severityDescription :: Severity -> Text
src/Stan/Toml.hs view
@@ -55,8 +55,8 @@ memptyIfNotExist :: FilePath -> IO [FilePath] memptyIfNotExist fp = ifM (doesFileExist fp) (pure [fp]) (pure []) -getTomlConfig :: Bool -> Maybe FilePath -> IO PartialConfig-getTomlConfig useDefault mTomlFile = do+getTomlConfig :: Bool -> Bool -> Maybe FilePath -> IO PartialConfig+getTomlConfig isLoud useDefault mTomlFile = do def <- if useDefault then defaultCurConfigFile >>= readToml >>= \case@@ -74,7 +74,7 @@ isFile <- doesFileExist file if isFile then do- infoMessage $ "Reading Configurations from " <> toText file <> " ..."+ when isLoud $ infoMessage $ "Reading Configurations from " <> toText file <> " ..." pure <$> Toml.decodeFile configCodec file else pure $ fiasco $ "TOML Configurations file doesn't exist: " <> toText file
stan.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: stan-version: 0.0.0.0+version: 0.0.1.0 synopsis: Haskell STatic ANalyser description: Stan is a Haskell __ST__atic __AN__alysis CLI tool.@@ -17,6 +17,7 @@ stability: experimental extra-doc-files: README.md CHANGELOG.md+extra-source-files: test/.stan-example.toml tested-with: GHC == 8.8.3 GHC == 8.10.1 @@ -71,7 +72,6 @@ , Relude.Extra.Lens , Relude.Extra.Map , Relude.Extra.Tuple- , Relude.Unsafe ) library@@ -83,6 +83,7 @@ Stan.Analysis.Analyser Stan.Analysis.Pretty Stan.Analysis.Summary+ Stan.Browse Stan.Cabal Stan.Category Stan.Cli@@ -137,8 +138,10 @@ , ghc >= 8.8 && < 8.11 , ghc-boot-th >= 8.8 && < 8.11 , gitrev ^>= 1.3.1+ , microaeson ^>= 0.1.0.0 , optparse-applicative ^>= 0.15 , pretty-simple ^>= 3.2+ , process ^>= 1.6.8.0 , slist ^>= 0.1 , text ^>= 1.2 , tomland ^>= 1.3.0.0
target/Target/AntiPattern/Stan0206.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-missing-export-lists #-}-+{-# LANGUAGE ExistentialQuantification #-} module Target.AntiPattern.Stan0206 where @@ -20,3 +20,21 @@ Int | Mk2 !Int | Mk3 Bool++data ConstraintExample+ = forall a .+ Constr a+ | forall a b .+ Constr2 a+ !b+ | forall a . (Num a) =>+ Constr3 a+ | forall a b . (Num a, Ord b) =>+ Constr4 a+ !b++data ConstraintRecord = forall a . (Num a) =>+ ConstraintRecord+ { crInt :: Int+ , crNum :: a+ }
+ test/.stan-example.toml view
@@ -0,0 +1,22 @@+# exclude everything in the test/ directory+[[check]]+type = "Exclude"+filter = "all"+directory = "test/"++[[check]]+type = "Include"+filter = "all"+scope = "all"++# exclude specific inspection everywhere+[[check]]+type = "Exclude"+id = "STAN-0002"+scope = "all"++# exclude specific inspection only in a specific file+[[check]]+type = "Exclude"+id = "STAN-0001"+file = "src/MyFile.hs"
test/Test/Stan/Analysis.hs view
@@ -21,7 +21,7 @@ analysisSpec :: [HieFile] -> Spec analysisSpec hieFiles = describe "Static Analysis" $ do- extensionsMap <- runIO $ createCabalExtensionsMap ["stan.cabal"] hieFiles+ extensionsMap <- runIO $ createCabalExtensionsMap True ["stan.cabal"] hieFiles let checksMap = mkDefaultChecks (map hie_hs_file hieFiles) -- tests without ignorance@@ -49,7 +49,7 @@ analysisExtensionsSpec :: Analysis -> Spec analysisExtensionsSpec Analysis{..} = describe "Used extensions" $ do it "should correctly count total amount of used extensions" $- Set.size (fst analysisUsedExtensions) `shouldBe` 15+ Set.size (fst analysisUsedExtensions) `shouldBe` 16 it "should correctly count total amount of used safe extensions" $ Set.size (snd analysisUsedExtensions) `shouldBe` 0
test/Test/Stan/Analysis/AntiPattern.hs view
@@ -98,6 +98,33 @@ noObservation AntiPattern.stan0206 21 it "Finds single lazy field in a sum type with multiple constructors" $ checkObservation AntiPattern.stan0206 22 11 15+ it "Doesn't trigger on forall wo constraint with 1 var" $+ noObservation AntiPattern.stan0206 25+ it "Finds single lazy field after forall wo constraint with 1 var" $+ checkObservation AntiPattern.stan0206 26 16 17+ it "Doesn't trigger on forall wo constraint with 2 var" $+ noObservation AntiPattern.stan0206 27+ it "Finds single lazy field after forall wo constraint with 2 var" $+ checkObservation AntiPattern.stan0206 28 17 18+ it "Doesn't trigger on strict field after forall wo constraint with 2 var" $+ noObservation AntiPattern.stan0206 29+ it "Doesn't trigger on forall constraint with 1 var" $+ noObservation AntiPattern.stan0206 30+ it "Finds single lazy field after forall constraint with 1 var" $+ checkObservation AntiPattern.stan0206 31 17 18+ it "Doesn't trigger on forall constraint with 2 var" $+ noObservation AntiPattern.stan0206 32+ it "Finds single lazy field after forall constraint with 2 var" $+ checkObservation AntiPattern.stan0206 33 17 18+ it "Doesn't trigger on strict field after forall constraint with 2 var" $+ noObservation AntiPattern.stan0206 34++ it "Doesn't trigger on forall constraint on record type" $+ noObservation AntiPattern.stan0206 36+ it "Findsa lazy Int field after forall constraint on record type" $+ checkObservation AntiPattern.stan0206 38 7 19+ it "Finds a lazy constrainted field after forall on record type" $+ checkObservation AntiPattern.stan0206 39 7 17 describe "With the 'StrictData' extension" $ do let noObservation = noObservationAssert ["AntiPattern", "Stan0206Extensions"] analysis
test/Test/Stan/Analysis/Common.hs view
@@ -70,7 +70,7 @@ expectedHeadObservation = Observation { observationId = obsId , observationInspectionId = inspectionId- , observationLoc = span+ , observationSrcSpan = span , observationFile = path , observationModuleName = moduleName , observationFileContent = maybe "" observationFileContent foundPartialObservation@@ -113,7 +113,7 @@ observationInspectionId == inspectionId && observationFile == filePathFromParts parts && observationModuleName == moduleFromParts parts- && srcSpanStartLine observationLoc == line+ && srcSpanStartLine observationSrcSpan == line ) (analysisObservations analysis)