Merge pull request purescript#1155 from purescript/glob

paf31 · paf31 · commit c4b2e41ecfa8 · 2015-06-11T08:27:05.000-07:00
Fix purescript#1152, support globs in file paths
diff --git a/hierarchy/Main.hs b/hierarchy/Main.hs
@@ -13,6 +13,8 @@
 --
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE TupleSections #-}
+
 module Main where
 
 import Control.Monad (unless)
@@ -24,6 +26,7 @@ import Data.Version (showVersion)
 import Options.Applicative
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath ((</>))
+import System.FilePath.Glob (glob)
 import System.Exit (exitFailure, exitSuccess)
 import System.IO (hPutStr, stderr)
 
@@ -50,13 +53,14 @@ instance Ord SuperMap where
 runModuleName :: P.ModuleName -> String
 runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
 
-readInput :: FilePath -> IO (Either P.MultipleErrors [P.Module])
-readInput filename = do
-  content <- readFile filename
-  return $ map snd <$> P.parseModulesFromFiles id [(filename, content)]
+readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])
+readInput paths = do
+  content <- mapM (\path -> (path, ) <$> readFile path) paths
+  return $ map snd <$> P.parseModulesFromFiles id content
 
 compile :: HierarchyOptions -> IO ()
-compile (HierarchyOptions input mOutput) = do
+compile (HierarchyOptions inputGlob mOutput) = do
+  input <- glob inputGlob
   modules <- readInput input
   case modules of
     Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors False errs) >> exitFailure
diff --git a/psc-docs/Main.hs b/psc-docs/Main.hs
@@ -34,6 +34,7 @@ import System.Exit (exitFailure)
 import System.IO (hPutStrLn, stderr)
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath (takeDirectory)
+import System.FilePath.Glob (glob)
 
 import Etags
 import Ctags
@@ -61,7 +62,8 @@ data PSCDocsOptions = PSCDocsOptions
   deriving (Show)
 
 docgen :: PSCDocsOptions -> IO ()
-docgen (PSCDocsOptions fmt input output) =
+docgen (PSCDocsOptions fmt inputGlob output) = do
+  input <- concat <$> mapM glob inputGlob
   case fmt of
     Etags -> dumpTags input dumpEtags
     Ctags -> dumpTags input dumpCtags
diff --git a/psc-make/Main.hs b/psc-make/Main.hs
@@ -31,6 +31,7 @@ import Options.Applicative as Opts
 
 import System.Exit (exitSuccess, exitFailure)
 import System.IO (hPutStrLn, stderr)
+import System.FilePath.Glob (glob)
 
 import qualified Language.PureScript as P
 import qualified Paths_purescript as Paths
@@ -50,8 +51,10 @@ data InputOptions = InputOptions
   }
 
 compile :: PSCMakeOptions -> IO ()
-compile (PSCMakeOptions input inputForeign outputDir opts usePrefix) = do
+compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do
+  input <- concat <$> mapM glob inputGlob
   moduleFiles <- readInput (InputOptions input)
+  inputForeign <- concat <$> mapM glob inputForeignGlob
   foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
   case runWriterT (parseInputs moduleFiles foreignFiles) of
     Left errs -> do
diff --git a/psc/Main.hs b/psc/Main.hs
@@ -34,6 +34,7 @@ import Options.Applicative as Opts
 import System.Directory (createDirectoryIfMissing)
 import System.Exit (exitSuccess, exitFailure)
 import System.FilePath (takeDirectory)
+import System.FilePath.Glob (glob)
 import System.IO (hPutStrLn, stderr)
 
 import qualified Data.Map as M
@@ -66,9 +67,11 @@ runPSC :: P.Options P.Compile -> PSC a -> Either P.MultipleErrors (a, P.Multiple
 runPSC opts rwe = runWriterT (runReaderT rwe opts)
 
 compile :: PSCOptions -> IO ()
-compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
+compile (PSCOptions inputGlob inputForeignGlob opts stdin output externs usePrefix) = do
   let prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]
+  input <- concat <$> mapM glob inputGlob
   moduleFiles <- readInput (InputOptions stdin input)
+  inputForeign <- concat <$> mapM glob inputForeignGlob
   foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
   case runWriterT (parseInputs moduleFiles foreignFiles) of
     Left errs -> do
diff --git a/psci/PSCi.hs b/psci/PSCi.hs
@@ -43,6 +43,7 @@ import System.Console.Haskeline
 import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)
 import System.Exit
 import System.FilePath (pathSeparator, (</>), isPathSeparator)
+import System.FilePath.Glob (glob)
 import System.Process (readProcessWithExitCode)
 
 import qualified Language.PureScript as P
@@ -490,19 +491,21 @@ consoleIsDefined = any ((== P.ModuleName (map P.ProperName [ "Control", "Monad",
 loop :: PSCiOptions -> IO ()
 loop PSCiOptions{..} = do
   config <- loadUserConfig
-  modulesOrFirstError <- loadAllModules psciInputFile
+  inputFiles <- concat <$> mapM glob psciInputFile
+  foreignFiles <- concat <$> mapM glob psciForeignInputFiles
+  modulesOrFirstError <- loadAllModules inputFiles
   case modulesOrFirstError of
     Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
     Right modules -> do
       historyFilename <- getHistoryFilename
       let settings = defaultSettings { historyFile = Just historyFilename }
       foreignsOrError <- runMake $ do
-        foreignFiles <- forM psciForeignInputFiles (\inFile -> (inFile,) <$> makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile inFile)) (readFile inFile))
-        P.parseForeignModulesFromFiles foreignFiles
+        foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile inFile)) (readFile inFile))
+        P.parseForeignModulesFromFiles foreignFilesContent
       case foreignsOrError of
         Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
         Right foreigns ->
-          flip evalStateT (PSCiState psciInputFile [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
+          flip evalStateT (PSCiState inputFiles [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
             outputStrLn prologueMessage
             traverse_ (mapM_ (runPSCI . handleCommand)) config
             modules' <- lift $ gets psciLoadedModules
diff --git a/purescript.cabal b/purescript.cabal
@@ -147,7 +147,7 @@ library
 executable psc
     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
                    mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
-                   transformers -any
+                   transformers -any, Glob >= 0.7 && < 0.8
     main-is: Main.hs
     buildable: True
     hs-source-dirs: psc
@@ -157,7 +157,7 @@ executable psc
 executable psc-make
     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
                    mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
-                   time -any, transformers -any, transformers-compat -any
+                   time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8
     main-is: Main.hs
     buildable: True
     hs-source-dirs: psc-make
@@ -168,7 +168,7 @@ executable psci
     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
                    mtl -any, optparse-applicative >= 0.10.0, parsec -any,
                    haskeline >= 0.7.0.0, purescript -any, transformers -any,
-                   transformers-compat -any, process -any, time -any
+                   transformers-compat -any, process -any, time -any, Glob -any
 
     main-is: Main.hs
     buildable: True
@@ -185,8 +185,8 @@ executable psci
 executable psc-docs
     build-depends: base >=4 && <5, purescript -any,
                    optparse-applicative >= 0.10.0, process -any, mtl -any,
-                   split -any, ansi-wl-pprint -any, directory -any, filepath
-                   -any
+                   split -any, ansi-wl-pprint -any, directory -any, 
+                   filepath -any, Glob -any
     main-is: Main.hs
     buildable: True
     hs-source-dirs: psc-docs
@@ -213,7 +213,8 @@ executable psc-publish
 
 executable psc-hierarchy
     build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,
-                   process -any, mtl -any, parsec -any, filepath -any, directory -any
+                   process -any, mtl -any, parsec -any, filepath -any, directory -any, 
+                   Glob -any
     main-is: Main.hs
     buildable: True
     hs-source-dirs: hierarchy
@@ -233,7 +234,8 @@ test-suite psci-tests
     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
                    mtl -any, optparse-applicative >= 0.10.0, parsec -any,
                    haskeline >= 0.7.0.0, purescript -any, transformers -any,
-                   transformers-compat -any, process -any, HUnit -any, time -any
+                   transformers-compat -any, process -any, HUnit -any, time -any, 
+                   Glob -any
     type: exitcode-stdio-1.0
     main-is: Main.hs
     buildable: True
