4852b5d · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Find foreign modules by name rather than comment-search (#2118)

* Find foreign modules by name rather than comment-search, see #2012 * Fix tests * Use inferForeignModules in psc-ide * Always specify filepath when inferring foreign modules

commit4852b5d408b7176aeb3fce210e2cc1337af244b9 authorPhil Freeman <paf31@cantab.net> dateSun 15 May 2016, 18:36 (10 years ago) parent2da4825

11 files changed+127−209

compare with golang

unifiedsplit

psc/Main.hs+21−44 psci/Main.hs+4−16 purescript.cabal−1 src/Language/PureScript/Ide/Rebuild.hs+14−13 src/Language/PureScript/Interactive.hs+24−29 src/Language/PureScript/Interactive/Types.hs−2 src/Language/PureScript/Make.hs+31−21 src/Language/PureScript/Parser.hs−1 src/Language/PureScript/Parser/JS.hs−46 tests/Language/PureScript/Ide/Integration.hs−1 tests/TestCompiler.hs+33−35

psc/Main.hs+21−44

@@ -1,48 +1,42 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE FlexibleContexts #-}

33{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

45{-# LANGUAGE TupleSections #-}

67module Main where

8−import Control.Applicative

9−import Control.Monad

10−import Control.Monad.Error.Class (MonadError(..))

11−import Control.Monad.Writer.Strict

9+import Control.Applicative

10+import Control.Monad

11+import Control.Monad.Writer.Strict

1212

13−import Data.List (isSuffixOf, partition)

14−import Data.Version (showVersion)

15−import qualified Data.Map as M

1613import qualified Data.Aeson as A

1714import qualified Data.ByteString.Lazy as B

1815import qualified Data.ByteString.UTF8 as BU8

16+import qualified Data.Map as M

17+import Data.Version (showVersion)

1918

20−import Options.Applicative as Opts

19+import qualified Language.PureScript as P

20+import Language.PureScript.Errors.JSON

21+import Language.PureScript.Make

2122

22−import System.Exit (exitSuccess, exitFailure)

23−import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)

24−import System.IO.UTF8

25−import System.FilePath.Glob (glob)

23+import Options.Applicative as Opts

2624

27−import qualified Language.PureScript as P

2825import qualified Paths_purescript as Paths

2926

30−import Language.PureScript.Make

31−import Language.PureScript.Errors.JSON

27+import System.Exit (exitSuccess, exitFailure)

28+import System.FilePath.Glob (glob)

29+import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)

30+import System.IO.UTF8

3231

3332data PSCMakeOptions = PSCMakeOptions

3433 { pscmInput :: [FilePath]

35− , pscmForeignInput :: [FilePath]

3634 , pscmOutputDir :: FilePath

3735 , pscmOpts :: P.Options

3836 , pscmUsePrefix :: Bool

3937 , pscmJSONErrors :: Bool

4038 }

4139

42−data InputOptions = InputOptions

43− { ioInputFiles :: [FilePath]

44− }

45−

4640-- | Argumnets: verbose, use JSON, warnings, errors

4741printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO ()

4842printWarningsAndErrors verbose False warnings errors = do

@@ -65,14 +59,12 @@ compile PSCMakeOptions{..} = do

6559 when (null input && not pscmJSONErrors) $ do

6660 hPutStrLn stderr "psc: No input files."

6761 exitFailure

68− let (jsFiles, pursFiles) = partition (isSuffixOf ".js") input

69− moduleFiles <- readInput (InputOptions pursFiles)

70− inputForeign <- globWarningOnMisses (unless pscmJSONErrors . warnFileTypeNotFound) pscmForeignInput

71− foreignFiles <- forM (inputForeign ++ jsFiles) (\inFile -> (inFile,) <$> readUTF8File inFile)

62+ moduleFiles <- readInput input

7263 (makeErrors, makeWarnings) <- runMake pscmOpts $ do

73− (ms, foreigns) <- parseInputs moduleFiles foreignFiles

74− let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms

75− makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix

64+ ms <- P.parseModulesFromFiles id moduleFiles

65+ let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, Right fp)) ms

66+ foreigns <- inferForeignModules filePathMap

67+ let makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix

7668 P.make makeActions (map snd ms)

7769 printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors makeWarnings makeErrors

7870 exitSuccess

@@ -89,28 +81,14 @@ globWarningOnMisses warn = concatMapM globWithWarning

8981 return paths

9082 concatMapM f = liftM concat . mapM f

9183

92−readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]

93−readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile

94−

95−parseInputs :: (MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)

96− => [(Either P.RebuildPolicy FilePath, String)]

97− -> [(FilePath, P.ForeignJS)]

98− -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)

99−parseInputs modules foreigns =

100− (,) <$> P.parseModulesFromFiles (either (const "") id) modules

101− <*> P.parseForeignModulesFromFiles foreigns

84+readInput :: [FilePath] -> IO [(FilePath, String)]

85+readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile

10286

10387inputFile :: Parser FilePath

10488inputFile = strArgument $

10589 metavar "FILE"

10690 <> help "The input .purs file(s)"

10791

108−inputForeignFile :: Parser FilePath

109−inputForeignFile = strOption $

110− short 'f'

111− <> long "ffi"

112− <> help "The input .js file(s) providing foreign import implementations"

113−

11492outputDirectory :: Parser FilePath

11593outputDirectory = strOption $

11694 short 'o'

@@ -173,7 +151,6 @@ options = P.Options <$> noTco

173151

174152pscMakeOptions :: Parser PSCMakeOptions

175153pscMakeOptions = PSCMakeOptions <$> many inputFile

176− <*> many inputForeignFile

177154 <*> outputDirectory

178155 <*> options

179156 <*> (not <$> noPrefix)

psci/Main.hs+4−16

@@ -37,7 +37,6 @@ import System.FilePath.Glob (glob)

3737data PSCiOptions = PSCiOptions

3838 { psciMultiLineMode :: Bool

3939 , psciInputFile :: [FilePath]

40− , psciForeignInputFiles :: [FilePath]

4140 , psciInputNodeFlags :: [String]

4241 }

4342

@@ -52,12 +51,6 @@ inputFile = Opts.strArgument $

5251 Opts.metavar "FILE"

5352 <> Opts.help "Optional .purs files to load on start"

5453

55−inputForeignFile :: Opts.Parser FilePath

56−inputForeignFile = Opts.strOption $

57− Opts.short 'f'

58− <> Opts.long "ffi"

59− <> Opts.help "The input .js file(s) providing foreign import implementations"

60−

6154nodeFlagsFlag :: Opts.Parser [String]

6255nodeFlagsFlag = Opts.option parser $

6356 Opts.long "node-opts"

@@ -70,7 +63,6 @@ nodeFlagsFlag = Opts.option parser $

7063psciOptions :: Opts.Parser PSCiOptions

7164psciOptions = PSCiOptions <$> multiLineMode

7265 <*> many inputFile

73− <*> many inputForeignFile

7466 <*> nodeFlagsFlag

7567

7668version :: Opts.Parser (a -> a)

@@ -107,24 +99,20 @@ main = getOpt >>= loop

10799 loop :: PSCiOptions -> IO ()

108100 loop PSCiOptions{..} = do

109101 inputFiles <- concat <$> traverse glob psciInputFile

110− foreignFiles <- concat <$> traverse glob psciForeignInputFiles

111102 e <- runExceptT $ do

112103 modules <- ExceptT (loadAllModules inputFiles)

113104 unless (supportModuleIsDefined (map snd modules)) . liftIO $ do

114105 putStrLn supportModuleMessage

115106 exitFailure

116− foreigns <- ExceptT . runMake $ do

117− foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> P.readTextFile inFile)

118− P.parseForeignModulesFromFiles foreignFilesContent

119− (externs, env) <- ExceptT . runMake . make foreigns . map snd $ modules

120− return (modules, foreigns, externs, env)

107+ (externs, env) <- ExceptT . runMake . make $ modules

108+ return (modules, externs, env)

121109 case e of

122110 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure

123− Right (modules, foreigns, externs, env) -> do

111+ Right (modules, externs, env) -> do

124112 historyFilename <- getHistoryFilename

125113 let settings = defaultSettings { historyFile = Just historyFilename }

126114 initialState = PSCiState [] [] (zip (map snd modules) externs)

127− config = PSCiConfig inputFiles foreigns psciInputNodeFlags env

115+ config = PSCiConfig inputFiles psciInputNodeFlags env

128116 runner = flip runReaderT config

129117 . flip evalStateT initialState

130118 . runInputT (setComplete completion settings)

purescript.cabal−1

@@ -179,7 +179,6 @@ library

179179 Language.PureScript.Parser.Lexer

180180 Language.PureScript.Parser.Common

181181 Language.PureScript.Parser.Declarations

182− Language.PureScript.Parser.JS

183182 Language.PureScript.Parser.Kinds

184183 Language.PureScript.Parser.State

185184 Language.PureScript.Parser.Types

src/Language/PureScript/Ide/Rebuild.hs+14−13

@@ -19,8 +19,6 @@ import Data.Maybe (fromJust, mapMaybe)

1919import qualified Data.Set as S

2020import qualified Language.PureScript as P

2121import Language.PureScript.Errors.JSON

22−import System.FilePath (replaceExtension)

23−import System.Directory (doesFileExist)

2422import System.IO.UTF8 (readUTF8File)

2523

2624rebuildFile

@@ -37,23 +35,26 @@ rebuildFile path = do

3735 Right [m] -> pure m

3836 Right _ -> throwError . GeneralError $ "Please define exactly one module."

3937

38+ -- Externs files must be sorted ahead of time, so that they get applied

39+ -- correctly to the 'Environment'.

4040 externs <- sortExterns m . M.delete (P.getModuleName m) =<< getExternFiles

4141

4242 outputDirectory <- confOutputPath . envConfiguration <$> ask

4343

44− let foreignModule = replaceExtension path "js"

45− foreignExists <- liftIO (doesFileExist foreignModule)

44+ -- For rebuilding, we want to 'RebuildAlways', but for inferring foreign

45+ -- modules using their file paths, we need to specify the path in the 'Map'.

46+ let filePathMap = M.singleton (P.getModuleName m) (Left P.RebuildAlways)

47+ foreigns <- P.inferForeignModules (M.singleton (P.getModuleName m) (Right path))

4648

47− let ma = P.buildMakeActions outputDirectory

48− (M.singleton (P.getModuleName m) (Left P.RebuildAlways))

49− (if foreignExists

50− then M.singleton (P.getModuleName m) foreignModule

51− else M.empty)

52− False

49+ -- Silence progress update messages during the build

50+ let actions = (P.buildMakeActions outputDirectory filePathMap foreigns False)

51+ { P.progress = const (pure ()) }

52+

53+ -- Rebuild the single module using the cached externs

5354 (result, warnings) <- liftIO

54− . P.runMake P.defaultOptions

55− . P.rebuildModule (ma { P.progress = const (pure ()) }) externs

56− $ m

55+ . P.runMake P.defaultOptions

56+ . P.rebuildModule actions externs

57+ $ m

5758 case result of

5859 Left errors -> throwError . RebuildError $ toJSONErrors False P.Error errors

5960 Right _ -> pure . RebuildSuccess $ toJSONErrors False P.Warning warnings

src/Language/PureScript/Interactive.hs+24−29

@@ -53,40 +53,41 @@ runMake mk = fst <$> P.runMake P.defaultOptions mk

5353

5454-- | Rebuild a module, using the cached externs data for dependencies.

5555rebuild

56− :: M.Map P.ModuleName FilePath

57− -> [P.ExternsFile]

56+ :: [P.ExternsFile]

5857 -> P.Module

5958 -> P.Make (P.ExternsFile, P.Environment)

60−rebuild foreignFiles loadedExterns m = do

59+rebuild loadedExterns m = do

6160 externs <- P.rebuildModule buildActions loadedExterns m

6261 return (externs, foldl' (flip P.applyExternsFileToEnvironment) P.initEnvironment (loadedExterns ++ [externs]))

6362 where

6463 buildActions :: P.MakeActions P.Make

65− buildActions = (P.buildMakeActions modulesDir

66− filePathMap

67− foreignFiles

68− False) { P.progress = const (return ()) }

64+ buildActions =

65+ (P.buildMakeActions modulesDir

66+ filePathMap

67+ M.empty

68+ False) { P.progress = const (return ()) }

6969

7070 filePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)

7171 filePathMap = M.singleton (P.getModuleName m) (Left P.RebuildAlways)

7272

7373-- | Build the collection of modules from scratch. This is usually done on startup.

7474make

75− :: M.Map P.ModuleName FilePath

76− -> [P.Module]

75+ :: [(FilePath, P.Module)]

7776 -> P.Make ([P.ExternsFile], P.Environment)

78−make foreignFiles ms = do

79− externs <- P.make buildActions ms

77+make ms = do

78+ foreignFiles <- P.inferForeignModules filePathMap

79+ externs <- P.make (buildActions foreignFiles) (map snd ms)

8080 return (externs, foldl' (flip P.applyExternsFileToEnvironment) P.initEnvironment externs)

8181 where

82− buildActions :: P.MakeActions P.Make

83− buildActions = (P.buildMakeActions modulesDir

84− filePathMap

85− foreignFiles

86− False)

82+ buildActions :: M.Map P.ModuleName FilePath -> P.MakeActions P.Make

83+ buildActions foreignFiles =

84+ P.buildMakeActions modulesDir

85+ filePathMap

86+ foreignFiles

87+ False

8788

8889 filePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)

89− filePathMap = M.fromList $ map (\m -> (P.getModuleName m, Left P.RebuildAlways)) ms

90+ filePathMap = M.fromList $ map (\(fp, m) -> (P.getModuleName m, Right fp)) ms

9091

9192-- | Performs a PSCi command

9293handleCommand

@@ -115,8 +116,7 @@ handleResetState = do

115116 files <- asks psciLoadedFiles

116117 e <- runExceptT $ do

117118 modules <- ExceptT . liftIO $ loadAllModules files

118− foreignFiles <- asks psciForeignFiles

119− (externs, _) <- ExceptT . liftIO . runMake . make foreignFiles . map snd $ modules

119+ (externs, _) <- ExceptT . liftIO . runMake . make $ modules

120120 return (map snd modules, externs)

121121 case e of

122122 Left errs -> printErrors errs

@@ -132,9 +132,8 @@ handleExpression

132132handleExpression val = do

133133 st <- get

134134 let m = createTemporaryModule True st val

135− foreignFiles <- asks psciForeignFiles

136135 nodeArgs <- asks ((++ [indexFile]) . psciNodeFlags)

137− e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m

136+ e <- liftIO . runMake $ rebuild (map snd (psciLoadedExterns st)) m

138137 case e of

139138 Left errs -> printErrors errs

140139 Right _ -> do

@@ -157,8 +156,7 @@ handleDecls

157156handleDecls ds = do

158157 st <- gets (updateLets (++ ds))

159158 let m = createTemporaryModule False st (P.Literal (P.ObjectLiteral []))

160− foreignFiles <- asks psciForeignFiles

161− e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m

159+ e <- liftIO . runMake $ rebuild (map snd (psciLoadedExterns st)) m

162160 case e of

163161 Left err -> printErrors err

164162 Right _ -> put st

@@ -212,9 +210,8 @@ handleImport

212210 -> m ()

213211handleImport im = do

214212 st <- gets (updateImportedModules (im :))

215− foreignFiles <- asks psciForeignFiles

216213 let m = createTemporaryModuleForImports st

217− e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m

214+ e <- liftIO . runMake $ rebuild (map snd (psciLoadedExterns st)) m

218215 case e of

219216 Left errs -> printErrors errs

220217 Right _ -> put st

@@ -226,9 +223,8 @@ handleTypeOf

226223 -> m ()

227224handleTypeOf val = do

228225 st <- get

229− foreignFiles <- asks psciForeignFiles

230226 let m = createTemporaryModule False st val

231− e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m

227+ e <- liftIO . runMake $ rebuild (map snd (psciLoadedExterns st)) m

232228 case e of

233229 Left errs -> printErrors errs

234230 Right (_, env') ->

@@ -243,10 +239,9 @@ handleKindOf

243239 -> m ()

244240handleKindOf typ = do

245241 st <- get

246− foreignFiles <- asks psciForeignFiles

247242 let m = createTemporaryModuleForKind st typ

248243 mName = P.ModuleName [P.ProperName "$PSCI"]

249− e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m

244+ e <- liftIO . runMake $ rebuild (map snd (psciLoadedExterns st)) m

250245 case e of

251246 Left errs -> printErrors errs

252247 Right (_, env') ->

src/Language/PureScript/Interactive/Types.hs−2

@@ -5,7 +5,6 @@ module Language.PureScript.Interactive.Types where

66import Prelude.Compat

8−import Data.Map (Map)

98import qualified Language.PureScript as P

109

1110-- | The PSCI configuration.

@@ -14,7 +13,6 @@ import qualified Language.PureScript as P

1413--

1514data PSCiConfig = PSCiConfig

1615 { psciLoadedFiles :: [FilePath]

17− , psciForeignFiles :: Map P.ModuleName FilePath

1816 , psciNodeFlags :: [String]

1917 , psciEnvironment :: P.Environment

2018 } deriving Show

src/Language/PureScript/Make.hs+31−21

@@ -17,6 +17,7 @@ module Language.PureScript.Make

1717 , makeIO

1818 , readTextFile

1919 , buildMakeActions

20+ , inferForeignModules

2021 ) where

2122

2223import Prelude.Compat

@@ -75,7 +76,7 @@ import SourceMap

7576import SourceMap.Types

7677

7778import System.Directory (doesFileExist, getModificationTime, createDirectoryIfMissing, getCurrentDirectory)

78−import System.FilePath ((</>), takeDirectory, makeRelative, splitPath, normalise)

79+import System.FilePath ((</>), takeDirectory, makeRelative, splitPath, normalise, replaceExtension)

7980import System.IO.Error (tryIOError)

8081import System.IO.UTF8 (readUTF8File, writeUTF8File)

8182

@@ -98,31 +99,22 @@ renderProgressMessage (CompilingModule mn) = "Compiling " ++ runModuleName mn

9899--

99100-- * The details of how files are read/written etc.

100101--

101−data MakeActions m = MakeActions {

102− -- |

103− -- Get the timestamp for the input file(s) for a module. If there are multiple

104− -- files (.purs and foreign files, for example) the timestamp should be for

102+data MakeActions m = MakeActions

103+ { getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))

104+ -- ^ Get the timestamp for the input file(s) for a module. If there are multiple

105+ -- files (@.purs@ and foreign files, for example) the timestamp should be for

105106 -- the most recently modified file.

106− --

107− getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))

108− -- |

109− -- Get the timestamp for the output files for a module. This should be the

110− -- timestamp for the oldest modified file, or Nothing if any of the required

111− -- output files are missing.

112− --

113107 , getOutputTimestamp :: ModuleName -> m (Maybe UTCTime)

114− -- |

115− -- Read the externs file for a module as a string and also return the actual

116− -- path for the file.

108+ -- ^ Get the timestamp for the output files for a module. This should be the

109+ -- timestamp for the oldest modified file, or 'Nothing' if any of the required

110+ -- output files are missing.

117111 , readExterns :: ModuleName -> m (FilePath, Externs)

118− -- |

119− -- Run the code generator for the module and write any required output files.

120− --

112+ -- ^ Read the externs file for a module as a string and also return the actual

113+ -- path for the file.

121114 , codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT m ()

122− -- |

123− -- Respond to a progress update.

124− --

115+ -- ^ Run the code generator for the module and write any required output files.

125116 , progress :: ProgressMessage -> m ()

117+ -- ^ Respond to a progress update.

126118 }

127119

128120-- |

@@ -297,6 +289,24 @@ makeIO f io = do

297289readTextFile :: FilePath -> Make String

298290readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ readUTF8File path

299291

292+-- | Infer the module name for a module by looking for the same filename with

293+-- a .js extension.

294+inferForeignModules

295+ :: forall m

296+ . MonadIO m

297+ => M.Map ModuleName (Either RebuildPolicy FilePath)

298+ -> m (M.Map ModuleName FilePath)

299+inferForeignModules = fmap (M.mapMaybe id) . traverse inferForeignModule

300+ where

301+ inferForeignModule :: Either RebuildPolicy FilePath -> m (Maybe FilePath)

302+ inferForeignModule (Left _) = return Nothing

303+ inferForeignModule (Right path) = do

304+ let jsFile = replaceExtension path "js"

305+ exists <- liftIO $ doesFileExist jsFile

306+ if exists

307+ then return (Just jsFile)

308+ else return Nothing

309+

300310-- |

301311-- A set of make actions that read and write modules from the given directory.

302312--

src/Language/PureScript/Parser.hs−1

@@ -17,7 +17,6 @@ module Language.PureScript.Parser (module P) where

1717

1818import Language.PureScript.Parser.Common as P

1919import Language.PureScript.Parser.Declarations as P

20−import Language.PureScript.Parser.JS as P

2120import Language.PureScript.Parser.Kinds as P

2221import Language.PureScript.Parser.Lexer as P

2322import Language.PureScript.Parser.State as P

src/Language/PureScript/Parser/JS.hsdeleted−46

@@ -1,46 +0,0 @@

1−module Language.PureScript.Parser.JS

2− ( ForeignJS()

3− , parseForeignModulesFromFiles

4− ) where

5−

6−import Prelude.Compat hiding (lex)

7−

8−import Control.Monad (forM_, when, msum)

9−import Control.Monad.Error.Class (MonadError(..))

10−import Control.Monad.Writer.Class (MonadWriter(..))

11−

12−import Data.Function (on)

13−import Data.List (sortBy, groupBy)

14−import qualified Data.Map as M

15−

16−import Language.PureScript.Errors

17−import Language.PureScript.Names

18−import Language.PureScript.Parser.Common

19−import Language.PureScript.Parser.Lexer

20−

21−import qualified Text.Parsec as PS

22−

23−type ForeignJS = String

24−

25−parseForeignModulesFromFiles :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

26− => [(FilePath, ForeignJS)]

27− -> m (M.Map ModuleName FilePath)

28−parseForeignModulesFromFiles files = do

29− foreigns <- parU files $ \(path, file) ->

30− case findModuleName (lines file) of

31− Just name -> return (name, path)

32− Nothing -> throwError (errorMessage $ ErrorParsingFFIModule path Nothing)

33− let grouped = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) foreigns

34− forM_ grouped $ \grp ->

35− when (length grp > 1) $ do

36− let mn = fst (head grp)

37− paths = map snd grp

38− tell $ errorMessage $ MultipleFFIModules mn paths

39− return $ M.fromList foreigns

40−

41−findModuleName :: [String] -> Maybe ModuleName

42−findModuleName = msum . map parseComment

43− where

44− parseComment :: String -> Maybe ModuleName

45− parseComment s = either (const Nothing) Just $

46− lex "" s >>= runTokenParser "" (symbol' "//" *> reserved "module" *> moduleName <* PS.eof)

tests/Language/PureScript/Ide/Integration.hs−1

@@ -131,7 +131,6 @@ isSuccess (ExitFailure _) = False

131131fileGlob :: String

132132fileGlob = unwords

133133 [ "\"src/**/*.purs\""

134− , "\"src/**/*.js\""

135134 ]

136135

137136-- Integration Testing API

tests/TestCompiler.hs+33−35

@@ -27,14 +27,15 @@ import qualified Language.PureScript as P

2727

2828import Data.Char (isSpace)

2929import Data.Function (on)

30−import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy, partition)

30+import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy)

3131import Data.Maybe (mapMaybe)

3232import Data.Time.Clock (UTCTime())

33+import Data.Tuple (swap)

3334

3435import qualified Data.Map as M

3536

3637import Control.Monad

37−import Control.Arrow ((>>>))

38+import Control.Arrow ((***), (>>>))

3839

3940import Control.Monad.Reader

4041import Control.Monad.Writer.Strict

@@ -57,7 +58,7 @@ main = hspec spec

5758spec :: Spec

5859spec = do

5960

60− (supportExterns, supportForeigns, passingTestCases, failingTestCases) <- runIO $ do

61+ (supportExterns, passingTestCases, failingTestCases) <- runIO $ do

6162 cwd <- getCurrentDirectory

6263 let passing = cwd </> "examples" </> "passing"

6364 let failing = cwd </> "examples" </> "failing"

@@ -66,49 +67,40 @@ spec = do

6667 passingFiles <- getTestFiles passing <$> testGlob passing

6768 failingFiles <- getTestFiles failing <$> testGlob failing

6869 supportPurs <- supportFiles "purs"

69− supportForeigns <- loadForeigns =<< supportFiles "js"

7070 supportPursFiles <- readInput supportPurs

7171 supportExterns <- runExceptT $ do

7272 modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles

73− externs <- ExceptT . runTest $ P.make (makeActions supportForeigns) (map snd modules)

73+ foreigns <- inferForeignModules modules

74+ externs <- ExceptT . runTest $ P.make (makeActions foreigns) (map snd modules)

7475 return (zip (map snd modules) externs)

7576 case supportExterns of

7677 Left errs -> fail (P.prettyPrintMultipleErrors False errs)

77− Right externs -> return (externs, supportForeigns, passingFiles, failingFiles)

78+ Right externs -> return (externs, passingFiles, failingFiles)

7879

7980 context ("Passing examples") $ do

80− forM_ passingTestCases $ \(testPurs, testJS) ->

81− it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $ do

82− testForeigns <- loadForeigns testJS

83− assertCompiles supportExterns testPurs (supportForeigns <> testForeigns)

81+ forM_ passingTestCases $ \testPurs ->

82+ it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $

83+ assertCompiles supportExterns testPurs

8484

8585 context ("Failing examples") $ do

86− forM_ failingTestCases $ \(testPurs, testJS) -> do

86+ forM_ failingTestCases $ \testPurs -> do

8787 let mainPath = getTestMain testPurs

8888 expectedFailures <- runIO $ getShouldFailWith mainPath

89− it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $ do

90− testForeigns <- loadForeigns testJS

91− assertDoesNotCompile supportExterns testPurs (supportForeigns <> testForeigns) expectedFailures

89+ it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $

90+ assertDoesNotCompile supportExterns testPurs expectedFailures

9291

9392 where

9493

9594 -- A glob for all purs and js files within a test directory

9695 testGlob :: FilePath -> IO [FilePath]

97− testGlob dir = join . fst <$> Glob.globDir (map Glob.compile ["**/*.purs", "**/*.js"]) dir

98−

99− -- Loads foreign modules from source files

100− loadForeigns :: [FilePath] -> IO (M.Map P.ModuleName FilePath)

101− loadForeigns paths = do

102− files <- forM paths (\f -> (f,) <$> readUTF8File f)

103− Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles files

104− return foreigns

96+ testGlob = Glob.globDir1 (Glob.compile "**/*.purs")

10597

10698 -- Groups the test files so that a top-level file can have dependencies in a

10799 -- subdirectory of the same name. The inner tuple contains a list of the

108100 -- .purs files and the .js files for the test case.

109− getTestFiles :: FilePath -> [FilePath] -> [([FilePath], [FilePath])]

101+ getTestFiles :: FilePath -> [FilePath] -> [[FilePath]]

110102 getTestFiles baseDir

111− = map (partition ((== ".purs") . takeExtensions))

103+ = map (filter ((== ".purs") . takeExtensions))

112104 . map (map (baseDir </>))

113105 . groupBy ((==) `on` extractPrefix)

114106 . sortBy (compare `on` extractPrefix)

@@ -137,6 +129,15 @@ spec = do

137129 where

138130 extractFailWiths = lines >>> mapMaybe (stripPrefix "-- @shouldFailWith ") >>> map trim

139131

132+inferForeignModules

133+ :: MonadIO m

134+ => [(FilePath, P.Module)]

135+ -> m (M.Map P.ModuleName FilePath)

136+inferForeignModules = P.inferForeignModules . fromList

137+ where

138+ fromList :: [(FilePath, P.Module)] -> M.Map P.ModuleName (Either P.RebuildPolicy FilePath)

139+ fromList = M.fromList . map ((P.getModuleName *** Right) . swap)

140+

140141trim :: String -> String

141142trim = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse

142143

@@ -175,12 +176,12 @@ runTest = fmap fst . P.runMake P.defaultOptions

175176compile

176177 :: [(P.Module, P.ExternsFile)]

177178 -> [FilePath]

178− -> M.Map P.ModuleName FilePath

179179 -> ([P.Module] -> IO ())

180180 -> IO (Either P.MultipleErrors [P.ExternsFile])

181−compile supportExterns inputFiles foreigns check = silence $ runTest $ do

181+compile supportExterns inputFiles check = silence $ runTest $ do

182182 fs <- liftIO $ readInput inputFiles

183183 ms <- P.parseModulesFromFiles id fs

184+ foreigns <- inferForeignModules ms

184185 liftIO (check (map snd ms))

185186 let actions = makeActions foreigns

186187 case ms of

@@ -190,22 +191,20 @@ compile supportExterns inputFiles foreigns check = silence $ runTest $ do

190191assert

191192 :: [(P.Module, P.ExternsFile)]

192193 -> [FilePath]

193− -> M.Map P.ModuleName FilePath

194194 -> ([P.Module] -> IO ())

195195 -> (Either P.MultipleErrors [P.ExternsFile] -> IO (Maybe String))

196196 -> Expectation

197−assert supportExterns inputFiles foreigns check f = do

198− e <- compile supportExterns inputFiles foreigns check

197+assert supportExterns inputFiles check f = do

198+ e <- compile supportExterns inputFiles check

199199 maybeErr <- f e

200200 maybe (return ()) expectationFailure maybeErr

201201

202202assertCompiles

203203 :: [(P.Module, P.ExternsFile)]

204204 -> [FilePath]

205− -> M.Map P.ModuleName FilePath

206205 -> Expectation

207−assertCompiles supportExterns inputFiles foreigns =

208− assert supportExterns inputFiles foreigns checkMain $ \e ->

206+assertCompiles supportExterns inputFiles = do

207+ assert supportExterns inputFiles checkMain $ \e ->

209208 case e of

210209 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs

211210 Right _ -> do

@@ -228,11 +227,10 @@ assertCompiles supportExterns inputFiles foreigns =

228227assertDoesNotCompile

229228 :: [(P.Module, P.ExternsFile)]

230229 -> [FilePath]

231− -> M.Map P.ModuleName FilePath

232230 -> [String]

233231 -> Expectation

234−assertDoesNotCompile supportExterns inputFiles foreigns shouldFailWith =

235− assert supportExterns inputFiles foreigns noPreCheck $ \e ->

232+assertDoesNotCompile supportExterns inputFiles shouldFailWith = do

233+ assert supportExterns inputFiles noPreCheck $ \e ->

236234 case e of

237235 Left errs ->

238236 return $ if null shouldFailWith