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

…ands (purescript#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