Add support for --source-globs-file CLI arg in relevant purs comm…

…ands (#4530)

* Enable passing source input globs via `--source-globs-file path/to/file`

  `--source-globs-file` support has been added to the following commands:
  `compile`, `docs`, `graph`, `ide`, and `publish`.

  Due to a [shell character limitation on Windows](https://learn.microsoft.com/en-us/troubleshoot/windows-client/shell-experience/command-line-string-limitation) where a large list of 
  source globs cannot be passed (e.g. `purs compile ... glob1000/src/**/*.purs`),
  source globs can be stored in a file according to the format below
  and the file is passed in instead via `purs compile ---source-globs-file path/to/file`.
  
  ```
  # Lines starting with '#' are comments.
  # Blank lines are ignored.
  # Otherwise, every line is a glob.

  .spago/foo-1.2.3/src/**/*.purs
  .spago/bar-2.3.3/src/**/*.purs
  my-package/src/**/*.purs
  my-package/tests/**/*.purs
  ```

  `--source-globs-file` is an optional argument. Mixing it with the normal source globs is fine.
  Assuming `.spago/source-globs` contains `src/**/*.purs`, each command below will use
  the same input globs:
  ```sh
  purs compile src/**/*.purs
  purs compile --source-globs .spago/source-globs
  purs compile --source-globs .spago/source-globs src/**/*.purs 
  ```

  In the command...
  ```
  purs compile inputGlob1 inputGlob2 --source-globs-file fileWithMoreGlobs --exclude-files excludeGlob1
  ```
  the files passed to the compiler are: all the files found by 
  `inputGlob1`, `inputGlob2`, and all the globs listed in `fileWithMoreGlobs`
  minus the files found by `excludeGlob1`.

* Add `--exclude-file` to more commands

  While implementing the fix above, I discovered that the `--exclude-file` CLI arg 
  wasn't included in other `purs` commands where such a usage would be 
  relevant (e.g. `docs`, `repl`, `graph`, and `ide`). This PR also rectifies that problem.

.github/workflows/ci.yml

@@ -130,6 +130,15 @@ jobs:
  - id: "build"
  run: "ci/fix-home ci/build.sh"
 
+ - name: "(Linux only) Glob tests"
+ if: "contains(matrix.os, 'ubuntu-latest')"
+ working-directory: "sdist-test"
+ # We build in this directory in build.sh, so this is where we need to
+ # launch `stack exec`. The actual glob checks happen in a temporary directory.
+ run: |
+ apt-get install tree
+ ../ci/fix-home stack exec bash ../glob-test.sh
+
  - name: "(Linux only) Build the entire package set"
  if: "contains(matrix.os, 'ubuntu-latest')"
  # We build in this directory in build.sh, so this is where we need to

CHANGELOG.d/feature_add-exclude-file-to-more-commands.md

@@ -0,0 +1,5 @@
+* Add `--exclude-file` to more commands
+
+ This CLI arg was added to the `compile` command, but not to other commands
+ where such a usage would be relevant (e.g. `docs`, `repl`, `graph`, and `ide`).
+

CHANGELOG.d/feature_glob-input-files.md

@@ -0,0 +1,38 @@
+* Enable passing source input globs via `--source-globs-file path/to/file`
+
+ `--source-globs-file` support has been added to the following commands:
+ `compile`, `docs`, `graph`, `ide`, and `publish`.
+
+ Due to a [shell character limitation on Windows](https://learn.microsoft.com/en-us/troubleshoot/windows-client/shell-experience/command-line-string-limitation) where a large list of 
+ source globs cannot be passed (e.g. `purs compile ... glob1000/src/**/*.purs`),
+ source globs can be stored in a file according to the format below
+ and the file is passed in instead via `purs compile ---source-globs-file path/to/file`.
+
+ ```
+ # Lines starting with '#' are comments.
+ # Blank lines are ignored.
+ # Otherwise, every line is a glob.
+
+ .spago/foo-1.2.3/src/**/*.purs
+ .spago/bar-2.3.3/src/**/*.purs
+ my-package/src/**/*.purs
+ my-package/tests/**/*.purs
+ ```
+
+ `--source-globs-file` is an optional argument. Mixing it with the normal source globs is fine.
+ Assuming `.spago/source-globs` contains `src/**/*.purs`, each command below will use
+ the same input globs:
+ ```sh
+ purs compile src/**/*.purs
+ purs compile --source-globs .spago/source-globs
+ purs compile --source-globs .spago/source-globs src/**/*.purs 
+ ```
+
+ In the command...
+ ```
+ purs compile inputGlob1 inputGlob2 --source-globs-file fileWithMoreGlobs --exclude-files excludeGlob1
+ ```
+ the files passed to the compiler are: all the files found by 
+ `inputGlob1`, `inputGlob2`, and all the globs listed in `fileWithMoreGlobs`
+ minus the files found by `excludeGlob1`.
+

app/Command/Compile.hs

@@ -7,25 +7,27 @@ import Control.Monad (when)
 import Data.Aeson qualified as A
 import Data.Bool (bool)
 import Data.ByteString.Lazy.UTF8 qualified as LBU8
-import Data.List (intercalate, (\\))
+import Data.List (intercalate)
 import Data.Map qualified as M
 import Data.Set qualified as S
 import Data.Text qualified as T
 import Data.Traversable (for)
 import Language.PureScript qualified as P
 import Language.PureScript.CST qualified as CST
 import Language.PureScript.Errors.JSON (JSONResult(..), toJSONErrors)
+import Language.PureScript.Glob (toInputGlobs, PSCGlobs(..), warnFileTypeNotFound)
 import Language.PureScript.Make (buildMakeActions, inferForeignModules, runMake)
 import Options.Applicative qualified as Opts
+import SharedCLI qualified
 import System.Console.ANSI qualified as ANSI
 import System.Exit (exitSuccess, exitFailure)
 import System.Directory (getCurrentDirectory)
-import System.FilePath.Glob (glob)
-import System.IO (hPutStr, hPutStrLn, stderr, stdout)
+import System.IO (hPutStr, stderr, stdout)
 import System.IO.UTF8 (readUTF8FilesT)
 
 data PSCMakeOptions = PSCMakeOptions
  { pscmInput :: [FilePath]
+ , pscmInputFromFile :: Maybe FilePath
  , pscmExclude :: [FilePath]
  , pscmOutputDir :: FilePath
  , pscmOpts :: P.Options
@@ -54,9 +56,12 @@ printWarningsAndErrors verbose True files warnings errors = do
 
 compile :: PSCMakeOptions -> IO ()
 compile PSCMakeOptions{..} = do
- included <- globWarningOnMisses warnFileTypeNotFound pscmInput
- excluded <- globWarningOnMisses warnFileTypeNotFound pscmExclude
- let input = included \\ excluded
+ input <- toInputGlobs $ PSCGlobs
+ { pscInputGlobs = pscmInput
+ , pscInputGlobsFromFile = pscmInputFromFile
+ , pscExcludeGlobs = pscmExclude
+ , pscWarnFileTypeNotFound = warnFileTypeNotFound "compile"
+ }
  when (null input) $ do
  hPutStr stderr $ unlines [ "purs compile: No input files."
  , "Usage: For basic information, try the `--help' option."
@@ -72,29 +77,6 @@ compile PSCMakeOptions{..} = do
  printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors moduleFiles makeWarnings makeErrors
  exitSuccess
 
-warnFileTypeNotFound :: String -> IO ()
-warnFileTypeNotFound = hPutStrLn stderr . ("purs compile: No files found using pattern: " ++)
-
-globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]
-globWarningOnMisses warn = concatMapM globWithWarning
- where
- globWithWarning pattern' = do
- paths <- glob pattern'
- when (null paths) $ warn pattern'
- return paths
- concatMapM f = fmap concat . mapM f
-
-inputFile :: Opts.Parser FilePath
-inputFile = Opts.strArgument $
- Opts.metavar "FILE"
- <> Opts.help "The input .purs file(s)."
-
-excludedFiles :: Opts.Parser FilePath
-excludedFiles = Opts.strOption $
- Opts.short 'x'
- <> Opts.long "exclude-files"
- <> Opts.help "Glob of .purs files to exclude from the supplied files."
-
 outputDirectory :: Opts.Parser FilePath
 outputDirectory = Opts.strOption $
  Opts.short 'o'
@@ -161,8 +143,9 @@ options =
  handleTargets ts = S.fromList (if P.JSSourceMap `elem` ts then P.JS : ts else ts)
 
 pscMakeOptions :: Opts.Parser PSCMakeOptions
-pscMakeOptions = PSCMakeOptions <$> many inputFile
- <*> many excludedFiles
+pscMakeOptions = PSCMakeOptions <$> many SharedCLI.inputFile
+ <*> SharedCLI.globInputFile
+ <*> many SharedCLI.excludeFiles
  <*> outputDirectory
  <*> options
  <*> (not <$> noPrefix)

app/Command/Docs.hs

@@ -13,12 +13,14 @@ import Data.Text qualified as T
 import Language.PureScript qualified as P
 import Language.PureScript.Docs qualified as D
 import Language.PureScript.Docs.Tags (dumpCtags, dumpEtags)
+import Language.PureScript.Glob (PSCGlobs(..), toInputGlobs, warnFileTypeNotFound)
 import Options.Applicative qualified as Opts
 import Text.PrettyPrint.ANSI.Leijen qualified as PP
+import SharedCLI qualified
 import System.Directory (getCurrentDirectory, createDirectoryIfMissing, removeFile)
 import System.Exit (exitFailure)
 import System.FilePath ((</>))
-import System.FilePath.Glob (compile, glob, globDir1)
+import System.FilePath.Glob (compile, globDir1)
 import System.IO (hPutStrLn, stderr)
 import System.IO.UTF8 (writeUTF8FileT)
 
@@ -35,12 +37,19 @@ data PSCDocsOptions = PSCDocsOptions
  , _pscdOutput :: Maybe FilePath
  , _pscdCompileOutputDir :: FilePath
  , _pscdInputFiles :: [FilePath]
+ , _pscdInputFromFile :: Maybe FilePath
+ , _pscdExcludeFiles :: [FilePath]
  }
  deriving (Show)
 
 docgen :: PSCDocsOptions -> IO ()
-docgen (PSCDocsOptions fmt moutput compileOutput inputGlob) = do
- input <- concat <$> mapM glob inputGlob
+docgen (PSCDocsOptions fmt moutput compileOutput inputGlob inputGlobFromFile excludeGlob) = do
+ input <- toInputGlobs $ PSCGlobs
+ { pscInputGlobs = inputGlob
+ , pscInputGlobsFromFile = inputGlobFromFile
+ , pscExcludeGlobs = excludeGlob
+ , pscWarnFileTypeNotFound = warnFileTypeNotFound "docs"
+ }
  when (null input) $ do
  hPutStrLn stderr "purs docs: no input files."
  exitFailure
@@ -104,7 +113,13 @@ defaultOutputForFormat fmt =
  Ctags -> "tags"
 
 pscDocsOptions :: Opts.Parser PSCDocsOptions
-pscDocsOptions = PSCDocsOptions <$> format <*> output <*> compileOutputDir <*> many inputFile
+pscDocsOptions = 
+ PSCDocsOptions <$> format 
+ <*> output 
+ <*> compileOutputDir 
+ <*> many SharedCLI.inputFile
+ <*> SharedCLI.globInputFile
+ <*> many SharedCLI.excludeFiles
  where
  format :: Opts.Parser Format
  format = Opts.option Opts.auto $
@@ -128,11 +143,6 @@ pscDocsOptions = PSCDocsOptions <$> format <*> output <*> compileOutputDir <*> m
  <> Opts.metavar "DIR"
  <> Opts.help "Compiler output directory"
 
- inputFile :: Opts.Parser FilePath
- inputFile = Opts.strArgument $
- Opts.metavar "FILE"
- <> Opts.help "The input .purs file(s)"
-
 command :: Opts.Parser (IO ())
 command = docgen <$> (Opts.helper <*> pscDocsOptions)
 

app/Command/Graph.hs

@@ -10,21 +10,30 @@ import Data.ByteString.Lazy qualified as LB
 import Data.ByteString.Lazy.UTF8 qualified as LBU8
 import Language.PureScript qualified as P
 import Language.PureScript.Errors.JSON (JSONResult(..), toJSONErrors)
+import Language.PureScript.Glob (PSCGlobs(..), toInputGlobs, warnFileTypeNotFound)
 import Options.Applicative qualified as Opts
+import SharedCLI qualified
 import System.Console.ANSI qualified as ANSI
 import System.Exit (exitFailure)
 import System.Directory (getCurrentDirectory)
-import System.FilePath.Glob (glob)
 import System.IO (hPutStr, hPutStrLn, stderr)
 
 data GraphOptions = GraphOptions
  { graphInput :: [FilePath]
+ , graphInputFromFile :: Maybe FilePath
+ , graphExclude :: [FilePath]
  , graphJSONErrors :: Bool
  }
 
 graph :: GraphOptions -> IO ()
 graph GraphOptions{..} = do
- input <- globWarningOnMisses (unless graphJSONErrors . warnFileTypeNotFound) graphInput
+ input <- toInputGlobs $ PSCGlobs
+ { pscInputGlobs = graphInput
+ , pscInputGlobsFromFile = graphInputFromFile
+ , pscExcludeGlobs = graphExclude
+ , pscWarnFileTypeNotFound = unless graphJSONErrors . warnFileTypeNotFound "graph"
+ }
+
  when (null input && not graphJSONErrors) $ do
  hPutStr stderr $ unlines
  [ "purs graph: No input files."
@@ -37,26 +46,16 @@ graph GraphOptions{..} = do
  printWarningsAndErrors graphJSONErrors makeWarnings makeResult
  >>= (LB.putStr . Json.encode)
 
- where
- warnFileTypeNotFound :: String -> IO ()
- warnFileTypeNotFound =
- hPutStrLn stderr . ("purs graph: No files found using pattern: " <>)
-
-
 command :: Opts.Parser (IO ())
 command = graph <$> (Opts.helper <*> graphOptions)
  where
  graphOptions :: Opts.Parser GraphOptions
  graphOptions =
- GraphOptions <$> many inputFile
+ GraphOptions <$> many SharedCLI.inputFile
+ <*> SharedCLI.globInputFile
+ <*> many SharedCLI.excludeFiles
  <*> jsonErrors
 
- inputFile :: Opts.Parser FilePath
- inputFile =
- Opts.strArgument $
- Opts.metavar "FILE" <>
- Opts.help "The input .purs file(s)."
-
  jsonErrors :: Opts.Parser Bool
  jsonErrors =
  Opts.switch $
@@ -84,16 +83,3 @@ printWarningsAndErrors True warnings errors = do
  case errors of
  Left _errs -> exitFailure
  Right res -> pure res
-
-
-globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]
-globWarningOnMisses warn = concatMapM globWithWarning
- where
- globWithWarning :: String -> IO [FilePath]
- globWithWarning pattern' = do
- paths <- glob pattern'
- when (null paths) $ warn pattern'
- return paths
-
- concatMapM :: (a -> IO [b]) -> [a] -> IO [b]
- concatMapM f = fmap concat . mapM f

app/Command/Ide.hs

@@ -35,6 +35,7 @@ import Language.PureScript.Ide.State (updateCacheTimestamp)
 import Language.PureScript.Ide.Types (Ide, IdeConfiguration(..), IdeEnvironment(..), IdeLogLevel(..), emptyIdeState)
 import Network.Socket qualified as Network
 import Options.Applicative qualified as Opts
+import SharedCLI qualified
 import System.Directory (doesDirectoryExist, getCurrentDirectory, setCurrentDirectory)
 import System.FilePath ((</>))
 import System.IO (BufferMode(..), hClose, hFlush, hSetBuffering, hSetEncoding, utf8)
@@ -59,6 +60,8 @@ listenOnLocalhost port = do
 data ServerOptions = ServerOptions
  { _serverDirectory :: Maybe FilePath
  , _serverGlobs :: [FilePath]
+ , _serverGlobsFromFile :: Maybe FilePath
+ , _serverGlobsExcluded :: [FilePath]
  , _serverOutputPath :: FilePath
  , _serverPort :: Network.PortNumber
  , _serverLoglevel :: IdeLogLevel
@@ -110,7 +113,7 @@ command = Opts.helper <*> subcommands where
  Opts.option Opts.auto (Opts.long "port" `mappend` Opts.short 'p' `mappend` Opts.value (4242 :: Integer))
 
  server :: ServerOptions -> IO ()
- server opts'@(ServerOptions dir globs outputPath port logLevel editorMode polling noWatch) = do
+ server opts'@(ServerOptions dir globs globsFromFile globsExcluded outputPath port logLevel editorMode polling noWatch) = do
  when (logLevel == LogDebug || logLevel == LogAll)
  (putText "Parsed Options:" *> print opts')
  maybe (pure ()) setCurrentDirectory dir
@@ -136,6 +139,8 @@ command = Opts.helper <*> subcommands where
  { confLogLevel = logLevel
  , confOutputPath = outputPath
  , confGlobs = globs
+ , confGlobsFromFile = globsFromFile
+ , confGlobsExclude = globsExcluded
  }
  ts <- newIORef Nothing
  let
@@ -150,7 +155,9 @@ command = Opts.helper <*> subcommands where
  serverOptions =
  ServerOptions
  <$> optional (Opts.strOption (Opts.long "directory" `mappend` Opts.short 'd'))
- <*> many (Opts.argument Opts.str (Opts.metavar "Source GLOBS..."))
+ <*> many SharedCLI.inputFile
+ <*> SharedCLI.globInputFile
+ <*> many SharedCLI.excludeFiles
  <*> Opts.strOption (Opts.long "output-directory" `mappend` Opts.value "output/")
  <*> (fromIntegral <$>
  Opts.option Opts.auto (Opts.long "port" `mappend` Opts.short 'p' `mappend` Opts.value (4242 :: Integer)))

app/Command/REPL.hs

@@ -15,27 +15,25 @@ import Control.Monad.Trans.Reader (ReaderT, runReaderT)
 import Data.Foldable (for_)
 import Language.PureScript qualified as P
 import Language.PureScript.CST qualified as CST
+import Language.PureScript.Glob (PSCGlobs(..), toInputGlobs, warnFileTypeNotFound)
 import Language.PureScript.Interactive
 import Options.Applicative qualified as Opts
+import SharedCLI qualified
 import System.Console.Haskeline (InputT, Settings(..), defaultSettings, getInputLine, handleInterrupt, outputStrLn, runInputT, setComplete, withInterrupt)
 import System.IO.UTF8 (readUTF8File)
 import System.Exit (ExitCode(..), exitFailure)
 import System.Directory (doesFileExist, getCurrentDirectory)
 import System.FilePath ((</>))
-import System.FilePath.Glob qualified as Glob
 import System.IO (hPutStrLn, stderr)
 
 -- | Command line options
 data PSCiOptions = PSCiOptions
  { psciInputGlob :: [String]
+ , psciInputFromFile :: Maybe String
+ , psciExclude :: [String]
  , psciBackend :: Backend
  }
 
-inputFile :: Opts.Parser FilePath
-inputFile = Opts.strArgument $
- Opts.metavar "FILES"
- <> Opts.help "Optional .purs files to load on start"
-
 nodePathOption :: Opts.Parser (Maybe FilePath)
 nodePathOption = Opts.optional . Opts.strOption $
  Opts.metavar "FILE"
@@ -63,7 +61,9 @@ backend =
  <|> (nodeBackend <$> nodePathOption <*> nodeFlagsOption)
 
 psciOptions :: Opts.Parser PSCiOptions
-psciOptions = PSCiOptions <$> many inputFile
+psciOptions = PSCiOptions <$> many SharedCLI.inputFile
+ <*> SharedCLI.globInputFile
+ <*> many SharedCLI.excludeFiles
  <*> backend
 
 -- | Parses the input and returns either a command, or an error as a 'String'.
@@ -132,7 +132,12 @@ command = loop <$> options
  where
  loop :: PSCiOptions -> IO ()
  loop PSCiOptions{..} = do
- inputFiles <- concat <$> traverse Glob.glob psciInputGlob
+ inputFiles <- toInputGlobs $ PSCGlobs
+ { pscInputGlobs = psciInputGlob
+ , pscInputGlobsFromFile = psciInputFromFile
+ , pscExcludeGlobs = psciExclude
+ , pscWarnFileTypeNotFound = warnFileTypeNotFound "repl"
+ }
  e <- runExceptT $ do
  modules <- ExceptT (loadAllModules inputFiles)
  when (null modules) . liftIO $ do