Settings for VSCode extension

Author: fsoikin

dist/bundle.sh

@@ -10,7 +10,7 @@ description="PureScript linter, extensible, with configurable rules, and one-off
 
 for file in $ROOT/dist/npm/package.json $ROOT/dist/vscode-extension/package.json; do
   sed -i "s/\"version\": \".*\"/\"version\": \"$version\"/g" $file
-  sed -i "s/\"description\": \".*\"/\"description\": \"$description\"/g" $file
+  sed -i "s/\n  \"description\": \".*\"/\n  \"description\": \"$description\"/g" $file
 done
 
 cp $ROOT/LICENSE.txt $ROOT/dist/vscode-extension

dist/npm/package.json

@@ -1,6 +1,6 @@
 {
   "name": "whine",
-  "version": "0.0.13",
+  "version": "0.0.15",
   "description": "PureScript linter, extensible, with configurable rules, and one-off escape hatches",
   "keywords": ["purescript", "lint"],
   "author": "Fyodor Soikin <name.fa@gmail.com>",

dist/vscode-extension/package.json

@@ -3,7 +3,7 @@
   "publisher": "collegevine",
   "displayName": "Whine at PureScript",
   "description": "PureScript linter, extensible, with configurable rules, and one-off escape hatches",
-  "version": "0.0.13",
+  "version": "0.0.15",
   "repository": "https://github.com/collegevine/purescript-whine",
   "engines": {
     "vscode": "^1.95.0"
@@ -12,5 +12,25 @@
     "Other"
   ],
   "activationEvents": ["onLanguage:purescript"],
-  "main": "./extension.js"
+  "main": "./extension.js",
+  "contributes": {
+    "configuration": {
+      "title": "Whine at PureScript",
+      "properties": {
+        "whine.languageServerStartCommand": {
+          "type": "string",
+          "scope": "resource",
+          "default": "npx -y whine language-server --quiet",
+          "description": "Command to start the Whine language server."
+        },
+        "whine.checkOn": {
+          "type": "string",
+          "enum": ["save", "change"],
+          "scope": "resource",
+          "default": "save",
+          "description": "When to check the file for violations. Choosing 'change' may put extra load on your system as Whine will recheck the file on every single keystroke."
+        }
+      }
+    }
+  }
 }

spago.yaml

@@ -43,7 +43,7 @@ package:
     main: Test.Main
     dependencies: []
   publish:
-    version: 0.0.13
+    version: 0.0.15
     license: MIT
     location:
       githubOwner: collegevine

src/Whine/Prelude.purs

@@ -10,7 +10,7 @@ import Control.Monad.Error.Class (try) as Reexport
 import Control.Monad.Except (mapExcept, mapExceptT, runExcept, runExceptT) as Reexport
 import Control.Monad.Writer (class MonadWriter, WriterT, execWriterT, mapWriterT, tell) as Reexport
 
-import Data.Array ((:), (..), nub, null, cons, drop, filter, length, catMaybes, mapMaybe, last, take, zip, zipWith) as Reexport
+import Data.Array ((:), (..), (\\), nub, null, cons, drop, elem, filter, length, catMaybes, mapMaybe, last, take, uncons, zip, zipWith) as Reexport
 import Data.Array.NonEmpty (NonEmptyArray) as Reexport
 import Data.Bifunctor (bimap, lmap, rmap) as Reexport
 import Data.Either (Either(..), fromRight, either, hush, note) as Reexport
@@ -22,6 +22,7 @@ import Data.Newtype (wrap, unwrap, un) as Reexport
 import Data.Nullable (Nullable) as Reexport
 import Data.Profunctor (dimap) as Reexport
 import Data.String (Pattern(..), joinWith) as Reexport
+import Data.String.NonEmpty (NonEmptyString) as Reexport
 import Data.Traversable (any, fold, for, for_, intercalate, traverse, traverse_, sequence, sequence_) as Reexport
 import Data.Tuple (fst, snd) as Reexport
 import Data.Tuple.Nested (type (/\), (/\)) as Reexport

src/Whine/Runner/Cli.purs

@@ -12,7 +12,9 @@ type Args =
   , quiet :: Boolean
   }
 
-data Command = JustWhine | LanguageServer
+data Command = JustWhine | LanguageServer CheckFileWhen
+
+data CheckFileWhen = CheckOnSave | CheckOnChange
 
 parseCliArgs :: ∀ m. MonadEffect m => m Args
 parseCliArgs = liftEffect $
@@ -26,14 +28,17 @@ parseCliArgs = liftEffect $
 commandParser :: O.Parser Command
 commandParser =
   O.subparser $ O.command "language-server" $
-    O.info (ignoreLspOptions $> LanguageServer) (O.progDesc "Start Whine in Language Server mode")
+    O.info
+      (LanguageServer <$> languageServerArgsParser)
+      (O.progDesc "Start Whine in Language Server mode")
 
-ignoreLspOptions :: O.Parser Unit
-ignoreLspOptions = ado
+languageServerArgsParser :: O.Parser CheckFileWhen
+languageServerArgsParser = ado
   _ <- O.switch $ O.long "stdio"
   _ <- O.switch $ O.long "node-ipc"
   _ <- OT.optional $ O.strOption $ O.long "socket"
-  in unit
+  checkWhen <- checkWhenOption
+  in checkWhen # fromMaybe CheckOnSave
 
 argsParser :: O.Parser Args
 argsParser =
@@ -80,3 +85,23 @@ determineLogLevel args =
   if args.debug then LogDebug
   else if args.quiet then LogError
   else LogInfo
+
+checkWhenOption :: O.Parser (Maybe CheckFileWhen)
+checkWhenOption =
+  OT.optional $ O.option checkWhen $ fold
+    [ O.long "check-on"
+    , O.help $ fold
+      [ "When to check files for violations. Possible values are "
+      , "'", saveOption, "' to check when a file is saved or "
+      , "'", changeOption, "' to check on every change. "
+      , "Default is '", saveOption, "'."
+      ]
+    ]
+  where
+    saveOption = "save"
+    changeOption = "change"
+
+    checkWhen = O.eitherReader \s -> do
+      if s == saveOption then Right CheckOnSave
+      else if s == changeOption then Right CheckOnChange
+      else Left $ "Invalid value: " <> s

src/Whine/Runner/Config.purs

@@ -5,26 +5,42 @@ import Whine.Runner.Prelude
 import Codec.JSON.DecodeError as DecodeError
 import Control.Monad.Error.Class (throwError)
 import Control.Monad.Writer (runWriter)
-import Data.Array.NonEmpty as NEA
 import Data.Codec as Codec
 import Data.Codec.JSON as CJ
 import Data.Codec.JSON.Common as CJ.Common
 import Data.Codec.JSON.Strict as CJS
 import Data.Map as Map
+import Data.String.NonEmpty as NES
 import Effect.Exception as Err
 import JSON as JSON
 import Node.FS.Sync (readTextFile)
 import Record (merge)
-import Whine.Types (RuleFactories, RuleSet, Violations, WithFile, WithRule)
+import Whine.Runner.Glob (Globs)
 import Whine.Runner.Yaml (parseYaml)
+import Whine.Types (RuleFactories, RuleId, Violations, WithFile, WithRule, Rule)
 
 data PackageSpec
   = JustPackage
   | PackageVersion String
   | LocalPackage { path :: FilePath, module :: Maybe String }
 
-type Config =
+type Config m =
+  { rules :: RuleSet m
+  , files :: Globs
+  }
+
+-- | For every rule ID we have a rule implementation `Rule m` and some common
+-- | config values that can be applied to any rule and are handled by the
+-- | framework.
+type RuleSet m = Map RuleId
+  { rule :: Rule m
+  , globs :: Globs
+  }
+
+type ConfigJson =
   { rulePackages :: Map { package :: String } PackageSpec
+  , include :: Maybe (Array NonEmptyString)
+  , exclude :: Maybe (Array NonEmptyString)
   , rules :: Maybe (Map String JSON)
   }
 
@@ -54,8 +70,8 @@ type Config =
 -- | The whole thing runs in a writer monad to which it can report any errors
 -- | while parsing the config. The errors doesn't stop the parsing, but
 -- | erroneous rules do not make it into the resulting map.
-parseConfig :: ∀ m n. MonadWriter (Violations (WithRule + ())) m => RuleFactories n -> Map String JSON -> m (RuleSet n)
-parseConfig factories config =
+parseRuleConfigs :: ∀ m n. MonadWriter (Violations (WithRule + ())) m => RuleFactories n -> Map String JSON -> m (RuleSet n)
+parseRuleConfigs factories config =
   Map.fromFoldable <$> catMaybes <$>
     for factories \(ruleId /\ factory) -> do
 
@@ -77,17 +93,17 @@ parseConfig factories config =
             Just value ->
               value # CJ.decode codec # lmap DecodeError.print # orFail ("Malformed '" <> name <> "'")
 
-      include <- commonProp "include" (CJ.array CJ.string)
-      exclude <- commonProp "exclude" (CJ.array CJ.string)
+      include <- commonProp "include" (CJ.array CJ.Common.nonEmptyString)
+      exclude <- commonProp "exclude" (CJ.array CJ.Common.nonEmptyString)
       enabled <- commonProp "enabled" CJ.boolean <#> fromMaybe true
 
       if enabled then
         factory (fromMaybe JSON.null ruleConfig)
           <#> (\rule -> ruleId /\
             { rule
             , globs:
-              { include: include >>= NEA.fromArray
-              , exclude: exclude >>= NEA.fromArray
+              { include: include # fromMaybe []
+              , exclude: exclude # fromMaybe []
               }
             }
           )
@@ -96,7 +112,7 @@ parseConfig factories config =
         pure Nothing
 
 -- | Reads config from a given file and parses it.
-readConfig :: ∀ m n. MonadEffect m => MonadWriter (Violations (WithRule + WithFile + ())) m => RuleFactories n -> FilePath -> m (RuleSet n)
+readConfig :: ∀ m n. MonadEffect m => MonadWriter (Violations (WithRule + WithFile + ())) m => RuleFactories n -> FilePath -> m (Config n)
 readConfig factories configFile = do
   text <- lmap Err.message <$> liftEffect (try $ readTextFile UTF8 configFile)
 
@@ -114,14 +130,22 @@ readConfig factories configFile = do
     Right c ->
       pure c
 
-  let res /\ violations = runWriter $ parseConfig factories (config.rules # fromMaybe Map.empty)
+  let res /\ violations = runWriter $ parseRuleConfigs factories (config.rules # fromMaybe Map.empty)
 
   tell $ violations <#> merge { file: { path: configFile, lines: Nothing } }
-  pure res
-
-configCodec :: CJ.Codec Config
+  pure
+    { rules: res
+    , files:
+        { include: config.include # fromMaybe (NES.fromString `mapMaybe` ["src/**/*.purs", "test/**/*.purs"])
+        , exclude: config.exclude # fromMaybe []
+        }
+    }
+
+configCodec :: CJ.Codec ConfigJson
 configCodec = CJS.objectStrict $ CJS.record
   # CJS.recordProp @"rulePackages" packagesCodec
+  # CJS.recordPropOptional @"include" (CJ.array CJ.Common.nonEmptyString)
+  # CJS.recordPropOptional @"exclude" (CJ.array CJ.Common.nonEmptyString)
   # CJS.recordPropOptional @"rules" (CJ.Common.strMap CJ.json)
 
 packagesCodec :: CJ.Codec (Map { package :: String } PackageSpec)
@@ -157,8 +181,10 @@ packagesCodec = dimap Map.toUnfoldable Map.fromFoldable $ CJ.array packageCodec
         # CJS.recordProp @"local" CJ.string
         # CJS.recordPropOptional @"module" CJ.string
 
-defaultConfig :: Config
+defaultConfig :: ConfigJson
 defaultConfig =
   { rulePackages: Map.singleton { package: "whine-core" } JustPackage
+  , include: Nothing
+  , exclude: Nothing
   , rules: Nothing
   }

src/Whine/Runner/Glob.js

@@ -1,4 +1,6 @@
 import mm from 'micromatch'
-export { globSync } from 'glob'
+import { globSync } from 'glob'
 
-export const test = patterns => file => mm.isMatch(file, patterns)
+export const test = ({ include, exclude }) => file => mm.isMatch(file, [...include, ...exclude.map(e => `!${e}`)])
+
+export const glob = ({ include, exclude }) => () => globSync(include, { ignore: exclude })

src/Whine/Runner/Glob.purs

@@ -1,11 +1,12 @@
-module Whine.Runner.Glob (glob, test) where
+module Whine.Runner.Glob where
 
 import Whine.Runner.Prelude
-import Effect.Uncurried (EffectFn1, runEffectFn1)
 
-glob :: String -> Effect (Array String)
-glob = runEffectFn1 globSync
+type Globs = { include :: Array NonEmptyString, exclude :: Array NonEmptyString }
 
-foreign import globSync :: EffectFn1 String (Array String)
+foreign import glob :: Globs -> Effect (Array FilePath)
 
-foreign import test :: Array String -> FilePath -> Boolean
+foreign import test :: Globs -> FilePath -> Boolean
+
+isEmptyGlobs :: Globs -> Boolean
+isEmptyGlobs { include, exclude } = null include && null exclude

src/Whine/Runner/LanguageServer.purs

@@ -7,64 +7,70 @@ import Data.String as String
 import Node.Path as NodePath
 import Record (merge)
 import Untagged.Castable (cast)
+import Vscode.Events (on)
 import Vscode.Server.Capabilities (textDocumentSyncKind)
 import Vscode.Server.Connection as Conn
 import Vscode.Server.Diagnostic (diagnosticSeverity)
-import Vscode.Events (on)
 import Vscode.Server.TextDocuments as Doc
 import Whine (checkModule)
+import Whine.Runner.Cli (CheckFileWhen(..))
 import Whine.Runner.Config (readConfig)
+import Whine.Runner.Glob as Glob
 import Whine.Types (RuleFactories, Violations, mapViolation)
 
 startLanguageServer ::
   { factories :: RuleFactories (WriterT (Violations ()) RunnerM)
   , configFile :: FilePath
+  , checkWhen :: CheckFileWhen
   }
   -> RunnerM Unit
-startLanguageServer { factories, configFile } = do
+startLanguageServer { factories, configFile, checkWhen } = do
   conn <- Conn.createConnection
 
   conn # on Conn.initialize \{} ->
     pure { capabilities: { textDocumentSync: textDocumentSyncKind.incremental } }
 
   -- TODO: report config errors
   -- TODO: reload config on change
-  ruleSet /\ _configErrors <-
+  config /\ _configErrors <-
     readConfig factories configFile
     # mapViolation (merge { muted: false })
     # runWriterT
 
-  onDidSave <- unliftRunnerM \document -> do
+  checkDocument <- unliftRunnerM \document -> do
     let uri = Doc.uri document
         path = uri # String.stripPrefix (Pattern "file://") <#> NodePath.relative (NodePath.dirname configFile) # fromMaybe ""
 
-    logDebug $ "Checking file: URI=" <> Doc.uri document <> ", path=" <> path
+    if Glob.test config.files path then do
+      logDebug $ "Checking file: URI=" <> Doc.uri document <> ", path=" <> path
 
-    text <- Doc.getText document
-    violations <- execWriterT $ checkModule ruleSet { path, text }
-    let liveViolations = violations # filter (not _.muted)
+      text <- Doc.getText document
+      violations <- execWriterT $ checkModule config.rules { path, text }
+      let liveViolations = violations # filter (not _.muted)
 
-    logDebug $ fold
-      [ "Found violations in ", path, ": "
-      , show (length liveViolations), " live, "
-      , show (length violations - length liveViolations), " muted"
-      ]
+      logDebug $ fold
+        [ "Found violations in ", path, ": "
+        , show (length liveViolations), " live, "
+        , show (length violations - length liveViolations), " muted"
+        ]
 
-    unless (null liveViolations) do
-      conn # Conn.sendDiagnostics
-        { uri
-        , diagnostics: liveViolations <#> \v -> cast
-            { range: fromMaybe firstLineRange $ v.source <#> \r -> { start: vsCodePos r.start, end: vsCodePos r.end }
-            , code: v.rule
-            , source: "purescript-whine"
-            , message: v.message
-            , severity: diagnosticSeverity.information
-            }
-        }
+      unless (null liveViolations) do
+        conn # Conn.sendDiagnostics
+          { uri
+          , diagnostics: liveViolations <#> \v -> cast
+              { range: fromMaybe firstLineRange $ v.source <#> \r -> { start: vsCodePos r.start, end: vsCodePos r.end }
+              , code: v.rule
+              , source: "purescript-whine"
+              , message: v.message
+              , severity: diagnosticSeverity.information
+              }
+          }
+    else
+      logDebug $ "Skipping " <> path <> " because it doesn't match globs in the config"
 
   docs <- Doc.create
-  docs # on Doc.didSave \{ document } -> launchAff_ $ onDidSave document
-  docs # on Doc.didOpen \{ document } -> launchAff_ $ onDidSave document
+  docs # on Doc.didOpen \{ document } -> launchAff_ $ checkDocument document
+  docs # on checkEvent \{ document } -> launchAff_ $ checkDocument document
 
   Doc.listen docs conn
   Conn.listen conn
@@ -74,3 +80,7 @@ startLanguageServer { factories, configFile } = do
   where
     firstLineRange = { start: { line: 0, character: 0 }, end: { line: 1, character: 0 } }
     vsCodePos p = { line: p.line, character: p.column }
+
+    checkEvent = case checkWhen of
+      CheckOnSave -> Doc.didSave
+      CheckOnChange -> Doc.didChangeContent