diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 `` 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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/src/Stan.hs b/src/Stan.hs --- a/src/Stan.hs +++ b/src/Stan.hs @@ -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 diff --git a/src/Stan/Analysis.hs b/src/Stan/Analysis.hs --- a/src/Stan/Analysis.hs +++ b/src/Stan/Analysis.hs @@ -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 diff --git a/src/Stan/Analysis/Analyser.hs b/src/Stan/Analysis/Analyser.hs --- a/src/Stan/Analysis/Analyser.hs +++ b/src/Stan/Analysis/Analyser.hs @@ -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 diff --git a/src/Stan/Analysis/Pretty.hs b/src/Stan/Analysis/Pretty.hs --- a/src/Stan/Analysis/Pretty.hs +++ b/src/Stan/Analysis/Pretty.hs @@ -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 diff --git a/src/Stan/Browse.hs b/src/Stan/Browse.hs new file mode 100644 --- /dev/null +++ b/src/Stan/Browse.hs @@ -0,0 +1,62 @@ +{- | +Copyright: (c) 2020 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +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 diff --git a/src/Stan/Cabal.hs b/src/Stan/Cabal.hs --- a/src/Stan/Cabal.hs +++ b/src/Stan/Cabal.hs @@ -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 diff --git a/src/Stan/Category.hs b/src/Stan/Category.hs --- a/src/Stan/Category.hs +++ b/src/Stan/Category.hs @@ -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 diff --git a/src/Stan/Cli.hs b/src/Stan/Cli.hs --- a/src/Stan/Cli.hs +++ b/src/Stan/Cli.hs @@ -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 diff --git a/src/Stan/Core/Id.hs b/src/Stan/Core/Id.hs --- a/src/Stan/Core/Id.hs +++ b/src/Stan/Core/Id.hs @@ -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. diff --git a/src/Stan/Core/ModuleName.hs b/src/Stan/Core/ModuleName.hs --- a/src/Stan/Core/ModuleName.hs +++ b/src/Stan/Core/ModuleName.hs @@ -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 diff --git a/src/Stan/FileInfo.hs b/src/Stan/FileInfo.hs --- a/src/Stan/FileInfo.hs +++ b/src/Stan/FileInfo.hs @@ -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 diff --git a/src/Stan/Hie.hs b/src/Stan/Hie.hs --- a/src/Stan/Hie.hs +++ b/src/Stan/Hie.hs @@ -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 diff --git a/src/Stan/Hie/Compat.hs b/src/Stan/Hie/Compat.hs --- a/src/Stan/Hie/Compat.hs +++ b/src/Stan/Hie/Compat.hs @@ -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) diff --git a/src/Stan/Hie/MatchAst.hs b/src/Stan/Hie/MatchAst.hs --- a/src/Stan/Hie/MatchAst.hs +++ b/src/Stan/Hie/MatchAst.hs @@ -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 diff --git a/src/Stan/Info.hs b/src/Stan/Info.hs --- a/src/Stan/Info.hs +++ b/src/Stan/Info.hs @@ -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 -} diff --git a/src/Stan/Inspection.hs b/src/Stan/Inspection.hs --- a/src/Stan/Inspection.hs +++ b/src/Stan/Inspection.hs @@ -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 diff --git a/src/Stan/Inspection/AntiPattern.hs b/src/Stan/Inspection/AntiPattern.hs --- a/src/Stan/Inspection/AntiPattern.hs +++ b/src/Stan/Inspection/AntiPattern.hs @@ -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 diff --git a/src/Stan/Observation.hs b/src/Stan/Observation.hs --- a/src/Stan/Observation.hs +++ b/src/Stan/Observation.hs @@ -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 + " 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. diff --git a/src/Stan/Pattern/Ast.hs b/src/Stan/Pattern/Ast.hs --- a/src/Stan/Pattern/Ast.hs +++ b/src/Stan/Pattern/Ast.hs @@ -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: diff --git a/src/Stan/Report/Html.hs b/src/Stan/Report/Html.hs --- a/src/Stan/Report/Html.hs +++ b/src/Stan/Report/Html.hs @@ -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 diff --git a/src/Stan/Report/Settings.hs b/src/Stan/Report/Settings.hs --- a/src/Stan/Report/Settings.hs +++ b/src/Stan/Report/Settings.hs @@ -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 diff --git a/src/Stan/Severity.hs b/src/Stan/Severity.hs --- a/src/Stan/Severity.hs +++ b/src/Stan/Severity.hs @@ -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 diff --git a/src/Stan/Toml.hs b/src/Stan/Toml.hs --- a/src/Stan/Toml.hs +++ b/src/Stan/Toml.hs @@ -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 diff --git a/stan.cabal b/stan.cabal --- a/stan.cabal +++ b/stan.cabal @@ -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 diff --git a/target/Target/AntiPattern/Stan0206.hs b/target/Target/AntiPattern/Stan0206.hs --- a/target/Target/AntiPattern/Stan0206.hs +++ b/target/Target/AntiPattern/Stan0206.hs @@ -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 + } diff --git a/test/.stan-example.toml b/test/.stan-example.toml new file mode 100644 --- /dev/null +++ b/test/.stan-example.toml @@ -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" diff --git a/test/Test/Stan/Analysis.hs b/test/Test/Stan/Analysis.hs --- a/test/Test/Stan/Analysis.hs +++ b/test/Test/Stan/Analysis.hs @@ -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 diff --git a/test/Test/Stan/Analysis/AntiPattern.hs b/test/Test/Stan/Analysis/AntiPattern.hs --- a/test/Test/Stan/Analysis/AntiPattern.hs +++ b/test/Test/Stan/Analysis/AntiPattern.hs @@ -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 diff --git a/test/Test/Stan/Analysis/Common.hs b/test/Test/Stan/Analysis/Common.hs --- a/test/Test/Stan/Analysis/Common.hs +++ b/test/Test/Stan/Analysis/Common.hs @@ -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)