4852b5d · rowtype-yoga/purescript-native

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

on golang help sign in

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

4852b5dPhil Freeman10 years ago

psc/Main.hs+21−44

compare with golang

unifiedsplit

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

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE TupleSections #-}

5{-# LANGUAGE TupleSections #-}

6module Main where

7module Main where

8−import Control.Applicative

9+import Control.Applicative

9−import Control.Monad

10+import Control.Monad

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

11−import Control.Monad.Writer.Strict

11+import Control.Monad.Writer.Strict

13−import Data.List (isSuffixOf, partition)

14−import Data.Version (showVersion)

15−import qualified Data.Map as M

16import qualified Data.Aeson as A

13import qualified Data.Aeson as A

17import qualified Data.ByteString.Lazy as B

14import qualified Data.ByteString.Lazy as B

18import qualified Data.ByteString.UTF8 as BU8

15import qualified Data.ByteString.UTF8 as BU8

16+import qualified Data.Map as M

17+import Data.Version (showVersion)

20−import Options.Applicative as Opts

19+import qualified Language.PureScript as P

20+import Language.PureScript.Errors.JSON

21+import Language.PureScript.Make

22−import System.Exit (exitSuccess, exitFailure)

23+import Options.Applicative as Opts

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

24−import System.IO.UTF8

25−import System.FilePath.Glob (glob)

27−import qualified Language.PureScript as P

28import qualified Paths_purescript as Paths

25import qualified Paths_purescript as Paths

30−import Language.PureScript.Make

27+import System.Exit (exitSuccess, exitFailure)

31−import Language.PureScript.Errors.JSON

28+import System.FilePath.Glob (glob)

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

30+import System.IO.UTF8

33data PSCMakeOptions = PSCMakeOptions

32data PSCMakeOptions = PSCMakeOptions

34 { pscmInput :: [FilePath]

33 { pscmInput :: [FilePath]

35− , pscmForeignInput :: [FilePath]

36 , pscmOutputDir :: FilePath

34 , pscmOutputDir :: FilePath

37 , pscmOpts :: P.Options

35 , pscmOpts :: P.Options

38 , pscmUsePrefix :: Bool

36 , pscmUsePrefix :: Bool

39 , pscmJSONErrors :: Bool

37 , pscmJSONErrors :: Bool

40 }

38 }

42−data InputOptions = InputOptions

43− { ioInputFiles :: [FilePath]

44− }

45−

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

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

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

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

48printWarningsAndErrors verbose False warnings errors = do

42printWarningsAndErrors verbose False warnings errors = do

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

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

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

66 hPutStrLn stderr "psc: No input files."

60 hPutStrLn stderr "psc: No input files."

67 exitFailure

61 exitFailure

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

69− moduleFiles <- readInput (InputOptions pursFiles)

62+ moduleFiles <- readInput input

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

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

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

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

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

64+ ms <- P.parseModulesFromFiles id moduleFiles

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

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

66+ foreigns <- inferForeignModules filePathMap

75− makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix

67+ let makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix

76 P.make makeActions (map snd ms)

68 P.make makeActions (map snd ms)

77 printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors makeWarnings makeErrors

69 printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors makeWarnings makeErrors

78 exitSuccess

70 exitSuccess

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

89 return paths

81 return paths

90 concatMapM f = liftM concat . mapM f

82 concatMapM f = liftM concat . mapM f

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

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

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

85+readInput inputFiles = forM inputFiles $ \inFile -> (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

102

103inputFile :: Parser FilePath

87inputFile :: Parser FilePath

104inputFile = strArgument $

88inputFile = strArgument $

105 metavar "FILE"

89 metavar "FILE"

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

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

107

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−

114outputDirectory :: Parser FilePath

92outputDirectory :: Parser FilePath

115outputDirectory = strOption $

93outputDirectory = strOption $

116 short 'o'

94 short 'o'

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

173

151

174pscMakeOptions :: Parser PSCMakeOptions

152pscMakeOptions :: Parser PSCMakeOptions

175pscMakeOptions = PSCMakeOptions <$> many inputFile

153pscMakeOptions = PSCMakeOptions <$> many inputFile

176− <*> many inputForeignFile

177 <*> outputDirectory

154 <*> outputDirectory

178 <*> options

155 <*> options

179 <*> (not <$> noPrefix)

156 <*> (not <$> noPrefix)

psci/Main.hs+4−16

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

37data PSCiOptions = PSCiOptions

38 { psciMultiLineMode :: Bool

39 , psciInputFile :: [FilePath]

40− , psciForeignInputFiles :: [FilePath]

41 , psciInputNodeFlags :: [String]

40 , psciInputNodeFlags :: [String]

42 }

41 }

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

52 Opts.metavar "FILE"

51 Opts.metavar "FILE"

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

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

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−

61nodeFlagsFlag :: Opts.Parser [String]

54nodeFlagsFlag :: Opts.Parser [String]

62nodeFlagsFlag = Opts.option parser $

55nodeFlagsFlag = Opts.option parser $

63 Opts.long "node-opts"

56 Opts.long "node-opts"

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

70psciOptions :: Opts.Parser PSCiOptions

63psciOptions :: Opts.Parser PSCiOptions

71psciOptions = PSCiOptions <$> multiLineMode

64psciOptions = PSCiOptions <$> multiLineMode

72 <*> many inputFile

65 <*> many inputFile

73− <*> many inputForeignFile

74 <*> nodeFlagsFlag

66 <*> nodeFlagsFlag

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

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

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

107 loop :: PSCiOptions -> IO ()

99 loop :: PSCiOptions -> IO ()

108 loop PSCiOptions{..} = do

100 loop PSCiOptions{..} = do

109 inputFiles <- concat <$> traverse glob psciInputFile

101 inputFiles <- concat <$> traverse glob psciInputFile

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

111 e <- runExceptT $ do

102 e <- runExceptT $ do

112 modules <- ExceptT (loadAllModules inputFiles)

103 modules <- ExceptT (loadAllModules inputFiles)

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

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

114 putStrLn supportModuleMessage

105 putStrLn supportModuleMessage

115 exitFailure

106 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

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

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

108+ return (modules, externs, env)

121 case e of

109 case e of

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

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

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

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

124 historyFilename <- getHistoryFilename

112 historyFilename <- getHistoryFilename

125 let settings = defaultSettings { historyFile = Just historyFilename }

113 let settings = defaultSettings { historyFile = Just historyFilename }

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

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

127− config = PSCiConfig inputFiles foreigns psciInputNodeFlags env

115+ config = PSCiConfig inputFiles psciInputNodeFlags env

128 runner = flip runReaderT config

116 runner = flip runReaderT config

129 . flip evalStateT initialState

117 . flip evalStateT initialState

130 . runInputT (setComplete completion settings)

118 . runInputT (setComplete completion settings)

purescript.cabal−1

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

179 Language.PureScript.Parser.Lexer

180 Language.PureScript.Parser.Common

181 Language.PureScript.Parser.Declarations

182− Language.PureScript.Parser.JS

183 Language.PureScript.Parser.Kinds

182 Language.PureScript.Parser.Kinds

184 Language.PureScript.Parser.State

183 Language.PureScript.Parser.State

185 Language.PureScript.Parser.Types

184 Language.PureScript.Parser.Types

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

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

19import qualified Data.Set as S

20import qualified Language.PureScript as P

21import Language.PureScript.Errors.JSON

22−import System.FilePath (replaceExtension)

23−import System.Directory (doesFileExist)

24import System.IO.UTF8 (readUTF8File)

22import System.IO.UTF8 (readUTF8File)

26rebuildFile

24rebuildFile

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

37 Right [m] -> pure m

35 Right [m] -> pure m

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

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

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

39+ -- correctly to the 'Environment'.

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

42 outputDirectory <- confOutputPath . envConfiguration <$> ask

44− let foreignModule = replaceExtension path "js"

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

45− foreignExists <- liftIO (doesFileExist foreignModule)

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))

49+ -- Silence progress update messages during the build

47− let ma = P.buildMakeActions outputDirectory

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

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

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

49− (if foreignExists

52+

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

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

51− else M.empty)

52− False

53 (result, warnings) <- liftIO

54 (result, warnings) <- liftIO

54− . P.runMake P.defaultOptions

55+ . P.runMake P.defaultOptions

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

56+ . P.rebuildModule actions externs

56− $ m

57+ $ m

57 case result of

58 case result of

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

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

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

60 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

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

55rebuild

56− :: M.Map P.ModuleName FilePath

57− -> [P.ExternsFile]

56+ :: [P.ExternsFile]

58 -> P.Module

57 -> P.Module

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

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

60−rebuild foreignFiles loadedExterns m = do

59+rebuild loadedExterns m = do

61 externs <- P.rebuildModule buildActions loadedExterns m

60 externs <- P.rebuildModule buildActions loadedExterns m

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

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

63 where

62 where

64 buildActions :: P.MakeActions P.Make

63 buildActions :: P.MakeActions P.Make

64+ buildActions =

65− buildActions = (P.buildMakeActions modulesDir

65+ (P.buildMakeActions modulesDir

66− filePathMap

66+ filePathMap

67− foreignFiles

67+ M.empty

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

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

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

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

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

74make

75− :: M.Map P.ModuleName FilePath

76− -> [P.Module]

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

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

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

78−make foreignFiles ms = do

77+make ms = do

78+ foreignFiles <- P.inferForeignModules filePathMap

79− externs <- P.make buildActions ms

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

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

81 where

82− buildActions :: P.MakeActions P.Make

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

83+ buildActions foreignFiles =

83− buildActions = (P.buildMakeActions modulesDir

84+ P.buildMakeActions modulesDir

84− filePathMap

85+ filePathMap

85− foreignFiles

86+ foreignFiles

86− False)

87+ False

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

89 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

91-- | Performs a PSCi command

92-- | Performs a PSCi command

92handleCommand

93handleCommand

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

115 files <- asks psciLoadedFiles

116 files <- asks psciLoadedFiles

116 e <- runExceptT $ do

117 e <- runExceptT $ do

117 modules <- ExceptT . liftIO $ loadAllModules files

118 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

120 return (map snd modules, externs)

121 case e of

122 Left errs -> printErrors errs

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

132handleExpression val = do

133 st <- get

134 let m = createTemporaryModule True st val

135− foreignFiles <- asks psciForeignFiles

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

135 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

138 case e of

137 case e of

139 Left errs -> printErrors errs

138 Left errs -> printErrors errs

140 Right _ -> do

139 Right _ -> do

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

157handleDecls ds = do

156handleDecls ds = do

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

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

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

158 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

162 case e of

160 case e of

163 Left err -> printErrors err

161 Left err -> printErrors err

164 Right _ -> put st

162 Right _ -> put st

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

212 -> m ()

210 -> m ()

213handleImport im = do

211handleImport im = do

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

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

215− foreignFiles <- asks psciForeignFiles

216 let m = createTemporaryModuleForImports st

213 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

218 case e of

215 case e of

219 Left errs -> printErrors errs

216 Left errs -> printErrors errs

220 Right _ -> put st

217 Right _ -> put st

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

226 -> m ()

223 -> m ()

227handleTypeOf val = do

224handleTypeOf val = do

228 st <- get

225 st <- get

229− foreignFiles <- asks psciForeignFiles

230 let m = createTemporaryModule False st val

226 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

232 case e of

228 case e of

233 Left errs -> printErrors errs

229 Left errs -> printErrors errs

234 Right (_, env') ->

230 Right (_, env') ->

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

243 -> m ()

239 -> m ()

244handleKindOf typ = do

240handleKindOf typ = do

245 st <- get

241 st <- get

246− foreignFiles <- asks psciForeignFiles

247 let m = createTemporaryModuleForKind st typ

242 let m = createTemporaryModuleForKind st typ

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

243 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

250 case e of

245 case e of

251 Left errs -> printErrors errs

246 Left errs -> printErrors errs

252 Right (_, env') ->

247 Right (_, env') ->

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

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

6import Prelude.Compat

8−import Data.Map (Map)

9import qualified Language.PureScript as P

8import qualified Language.PureScript as P

11-- | The PSCI configuration.

10-- | The PSCI configuration.

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

14--

13--

15data PSCiConfig = PSCiConfig

14data PSCiConfig = PSCiConfig

16 { psciLoadedFiles :: [FilePath]

15 { psciLoadedFiles :: [FilePath]

17− , psciForeignFiles :: Map P.ModuleName FilePath

18 , psciNodeFlags :: [String]

16 , psciNodeFlags :: [String]

19 , psciEnvironment :: P.Environment

17 , psciEnvironment :: P.Environment

20 } deriving Show

18 } deriving Show

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

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

17 , makeIO

18 , readTextFile

19 , buildMakeActions

20+ , inferForeignModules

20 ) where

21 ) where

22import Prelude.Compat

23import Prelude.Compat

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

75import SourceMap.Types

76import SourceMap.Types

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

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

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

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

79import System.IO.Error (tryIOError)

80import System.IO.Error (tryIOError)

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

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

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

98--

99--

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

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

100--

101--

101−data MakeActions m = MakeActions {

102+data MakeActions m = MakeActions

102− -- |

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

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

104+ -- ^ 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

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

105 -- the most recently modified file.

106 -- 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− --

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

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

114− -- |

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

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

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

116− -- path for the file.

110+ -- output files are missing.

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

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

118− -- |

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

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

113+ -- path for the file.

120− --

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

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

122− -- |

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

123− -- Respond to a progress update.

124− --

125 , progress :: ProgressMessage -> m ()

116 , progress :: ProgressMessage -> m ()

117+ -- ^ Respond to a progress update.

126 }

118 }

127

119

128-- |

120-- |

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

297readTextFile :: FilePath -> Make String

289readTextFile :: FilePath -> Make String

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

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

299

291

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+

300-- |

310-- |

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

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

302--

312--

src/Language/PureScript/Parser.hs−1

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

18import Language.PureScript.Parser.Common as P

19import Language.PureScript.Parser.Declarations as P

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

21import Language.PureScript.Parser.Kinds as P

20import Language.PureScript.Parser.Kinds as P

22import Language.PureScript.Parser.Lexer as P

21import Language.PureScript.Parser.Lexer as P

23import Language.PureScript.Parser.State as P

22import 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

131fileGlob :: String

132fileGlob = unwords

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

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

135 ]

134 ]

136

135

137-- Integration Testing API

136-- Integration Testing API

tests/TestCompiler.hs+33−35

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

28import Data.Char (isSpace)

29import Data.Function (on)

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

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

31import Data.Maybe (mapMaybe)

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

33+import Data.Tuple (swap)

34import qualified Data.Map as M

35import qualified Data.Map as M

36import Control.Monad

37import Control.Monad

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

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

39import Control.Monad.Reader

40import Control.Monad.Reader

40import Control.Monad.Writer.Strict

41import Control.Monad.Writer.Strict

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

57spec :: Spec

58spec :: Spec

58spec = do

59spec = do

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

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

61 cwd <- getCurrentDirectory

62 cwd <- getCurrentDirectory

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

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

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

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

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

66 passingFiles <- getTestFiles passing <$> testGlob passing

67 passingFiles <- getTestFiles passing <$> testGlob passing

67 failingFiles <- getTestFiles failing <$> testGlob failing

68 failingFiles <- getTestFiles failing <$> testGlob failing

68 supportPurs <- supportFiles "purs"

69 supportPurs <- supportFiles "purs"

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

70 supportPursFiles <- readInput supportPurs

71 supportExterns <- runExceptT $ do

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

73+ foreigns <- inferForeignModules modules

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

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

74 return (zip (map snd modules) externs)

75 return (zip (map snd modules) externs)

75 case supportExterns of

76 case supportExterns of

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

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

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

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

79 context ("Passing examples") $ do

80 context ("Passing examples") $ do

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

81+ forM_ passingTestCases $ \testPurs ->

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

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

82− testForeigns <- loadForeigns testJS

83− assertCompiles supportExterns testPurs (supportForeigns <> testForeigns)

83+ assertCompiles supportExterns testPurs

85 context ("Failing examples") $ do

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

86+ forM_ failingTestCases $ \testPurs -> do

87 let mainPath = getTestMain testPurs

88 expectedFailures <- runIO $ getShouldFailWith mainPath

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

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

90− testForeigns <- loadForeigns testJS

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

90+ assertDoesNotCompile supportExterns testPurs expectedFailures

93 where

92 where

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

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

96 testGlob :: FilePath -> IO [FilePath]

95 testGlob :: FilePath -> IO [FilePath]

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

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

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

105

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

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

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

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

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

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

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

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

110 getTestFiles baseDir

102 getTestFiles baseDir

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

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

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

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

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

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

114 . sortBy (compare `on` extractPrefix)

106 . sortBy (compare `on` extractPrefix)

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

137 where

129 where

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

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

139

131

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+

140trim :: String -> String

141trim :: String -> String

141trim = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse

142trim = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse

142

143

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

175compile

176compile

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

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

177 -> [FilePath]

178 -> [FilePath]

178− -> M.Map P.ModuleName FilePath

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

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

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

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

182 fs <- liftIO $ readInput inputFiles

183 ms <- P.parseModulesFromFiles id fs

184+ foreigns <- inferForeignModules ms

184 liftIO (check (map snd ms))

185 liftIO (check (map snd ms))

185 let actions = makeActions foreigns

186 let actions = makeActions foreigns

186 case ms of

187 case ms of

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

190assert

191assert

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

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

192 -> [FilePath]

193 -> [FilePath]

193− -> M.Map P.ModuleName FilePath

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

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

196 -> Expectation

197−assert supportExterns inputFiles foreigns check f = do

197+assert supportExterns inputFiles check f = do

198− e <- compile supportExterns inputFiles foreigns check

198+ e <- compile supportExterns inputFiles check

199 maybeErr <- f e

200 maybe (return ()) expectationFailure maybeErr

201

202assertCompiles

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

204 -> [FilePath]

205− -> M.Map P.ModuleName FilePath

206 -> Expectation

205 -> Expectation

207−assertCompiles supportExterns inputFiles foreigns =

206+assertCompiles supportExterns inputFiles = do

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

207+ assert supportExterns inputFiles checkMain $ \e ->

209 case e of

208 case e of

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

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

211 Right _ -> do

210 Right _ -> do

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

228assertDoesNotCompile

227assertDoesNotCompile

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

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

230 -> [FilePath]

229 -> [FilePath]

231− -> M.Map P.ModuleName FilePath

232 -> [String]

230 -> [String]

233 -> Expectation

231 -> Expectation

234−assertDoesNotCompile supportExterns inputFiles foreigns shouldFailWith =

232+assertDoesNotCompile supportExterns inputFiles shouldFailWith = do

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

233+ assert supportExterns inputFiles noPreCheck $ \e ->

236 case e of

234 case e of

237 Left errs ->

235 Left errs ->

238 return $ if null shouldFailWith

236 return $ if null shouldFailWith