94710ed · rowtype-yoga/purescript-native

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

on golang help sign in

Require dependencies to exist during sorting phase (#2570)

94710edPhil Freeman10 years ago

examples/failing/ImportModule.purs+1−1

compare with golang

unifiedsplit

@@ -1,4 +1,4 @@

1−-- @shouldFailWith UnknownName

1+-- @shouldFailWith ModuleNotFound

2module Main where

4import M1

src/Language/PureScript/AST/Declarations.hs+2−1

@@ -44,7 +44,8 @@ data TypeSearch

45-- | A type of error messages

46data SimpleErrorMessage

47+ = ModuleNotFound ModuleName

47− = ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)

48+ | ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)

48 | ErrorParsingModule P.ParseError

49 | ErrorParsingModule P.ParseError

49 | MissingFFIModule ModuleName

50 | MissingFFIModule ModuleName

50 | MultipleFFIModules ModuleName [FilePath]

51 | MultipleFFIModules ModuleName [FilePath]

src/Language/PureScript/Errors.hs+63−82

@@ -6,44 +6,40 @@ module Language.PureScript.Errors

6 , module Language.PureScript.Errors

7 ) where

9−import Prelude.Compat

9+import Prelude.Compat

10−

10+

11−import Control.Arrow ((&&&))

11+import Control.Arrow ((&&&))

12−import Control.Monad

12+import Control.Monad

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

13+import Control.Monad.Error.Class (MonadError(..))

14−import Control.Monad.Trans.State.Lazy

14+import Control.Monad.Trans.State.Lazy

15−import Control.Monad.Writer

15+import Control.Monad.Writer

16−

17−import Data.Char (isSpace)

16+import Data.Char (isSpace)

18−import Data.Either (lefts, rights)

17+import Data.Either (lefts, rights)

19−import Data.Foldable (fold)

18+import Data.Foldable (fold)

20−import Data.Functor.Identity (Identity(..))

19+import Data.Functor.Identity (Identity(..))

21−import Data.List (transpose, nub, nubBy, sortBy, partition)

20+import Data.List (transpose, nub, nubBy, sortBy, partition)

22−import Data.Maybe (maybeToList, fromMaybe, mapMaybe)

21+import Data.Maybe (maybeToList, fromMaybe, mapMaybe)

23−import Data.Ord (comparing)

22+import Data.Ord (comparing)

24import qualified Data.Map as M

23import qualified Data.Map as M

25import qualified Data.Text as T

24import qualified Data.Text as T

26−import Data.Text (Text)

25+import Data.Text (Text)

27−

28−import Language.PureScript.AST

26+import Language.PureScript.AST

29−import Language.PureScript.Crash

30−import Language.PureScript.Environment

31−import Language.PureScript.Names

32−import Language.PureScript.Pretty

33−import Language.PureScript.Traversals

34−import Language.PureScript.Types

35−import Language.PureScript.Label (Label(..))

36−import Language.PureScript.Pretty.Common (before, endWith)

37import qualified Language.PureScript.Bundle as Bundle

27import qualified Language.PureScript.Bundle as Bundle

38import qualified Language.PureScript.Constants as C

28import qualified Language.PureScript.Constants as C

39−

29+import Language.PureScript.Crash

30+import Language.PureScript.Environment

31+import Language.PureScript.Label (Label(..))

32+import Language.PureScript.Names

33+import Language.PureScript.Pretty

34+import Language.PureScript.Pretty.Common (before, endWith)

35+import Language.PureScript.Traversals

36+import Language.PureScript.Types

37+import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers

40import qualified System.Console.ANSI as ANSI

38import qualified System.Console.ANSI as ANSI

41−

42import qualified Text.Parsec as P

39import qualified Text.Parsec as P

43import qualified Text.Parsec.Error as PE

40import qualified Text.Parsec.Error as PE

41+import Text.Parsec.Error (Message(..))

44import qualified Text.PrettyPrint.Boxes as Box

42import qualified Text.PrettyPrint.Boxes as Box

45−import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers

46−import Text.Parsec.Error (Message(..))

48newtype ErrorSuggestion = ErrorSuggestion Text

44newtype ErrorSuggestion = ErrorSuggestion Text

@@ -72,11 +68,10 @@ stripModuleAndSpan (ErrorMessage hints e) = ErrorMessage (filter (not . shouldSt

72 shouldStrip (PositionedError _) = True

68 shouldStrip (PositionedError _) = True

73 shouldStrip _ = False

69 shouldStrip _ = False

75−-- |

76−-- Get the error code for a particular error type

71+-- | Get the error code for a particular error type

77−--

78errorCode :: ErrorMessage -> Text

72errorCode :: ErrorMessage -> Text

79errorCode em = case unwrapErrorMessage em of

73errorCode em = case unwrapErrorMessage em of

74+ ModuleNotFound{} -> "ModuleNotFound"

80 ErrorParsingFFIModule{} -> "ErrorParsingFFIModule"

75 ErrorParsingFFIModule{} -> "ErrorParsingFFIModule"

81 ErrorParsingModule{} -> "ErrorParsingModule"

76 ErrorParsingModule{} -> "ErrorParsingModule"

82 MissingFFIModule{} -> "MissingFFIModule"

77 MissingFFIModule{} -> "MissingFFIModule"

@@ -175,25 +170,20 @@ errorCode em = case unwrapErrorMessage em of

175 ClassInstanceArityMismatch{} -> "ClassInstanceArityMismatch"

170 ClassInstanceArityMismatch{} -> "ClassInstanceArityMismatch"

176 UserDefinedWarning{} -> "UserDefinedWarning"

171 UserDefinedWarning{} -> "UserDefinedWarning"

177

172

178−-- |

179−-- A stack trace for an error

173+-- | A stack trace for an error

180−--

181newtype MultipleErrors = MultipleErrors

174newtype MultipleErrors = MultipleErrors

182− { runMultipleErrors :: [ErrorMessage] } deriving (Show, Monoid)

175+ { runMultipleErrors :: [ErrorMessage]

176+ } deriving (Show, Monoid)

183

177

184-- | Check whether a collection of errors is empty or not.

178-- | Check whether a collection of errors is empty or not.

185nonEmpty :: MultipleErrors -> Bool

179nonEmpty :: MultipleErrors -> Bool

186nonEmpty = not . null . runMultipleErrors

180nonEmpty = not . null . runMultipleErrors

187

181

188−-- |

189−-- Create an error set from a single simple error message

182+-- | Create an error set from a single simple error message

190−--

191errorMessage :: SimpleErrorMessage -> MultipleErrors

183errorMessage :: SimpleErrorMessage -> MultipleErrors

192errorMessage err = MultipleErrors [ErrorMessage [] err]

184errorMessage err = MultipleErrors [ErrorMessage [] err]

193

185

194−-- |

195−-- Create an error set from a single error message

186+-- | Create an error set from a single error message

196−--

197singleError :: ErrorMessage -> MultipleErrors

187singleError :: ErrorMessage -> MultipleErrors

198singleError = MultipleErrors . pure

188singleError = MultipleErrors . pure

199

189

@@ -226,15 +216,12 @@ defaultUnknownMap = TypeMap M.empty M.empty 0

226-- | How critical the issue is

216-- | How critical the issue is

227data Level = Error | Warning deriving Show

217data Level = Error | Warning deriving Show

228

218

229−-- |

230−-- Extract nested error messages from wrapper errors

219+-- | Extract nested error messages from wrapper errors

231−--

232unwrapErrorMessage :: ErrorMessage -> SimpleErrorMessage

220unwrapErrorMessage :: ErrorMessage -> SimpleErrorMessage

233unwrapErrorMessage (ErrorMessage _ se) = se

221unwrapErrorMessage (ErrorMessage _ se) = se

234

222

235replaceUnknowns :: Type -> State TypeMap Type

223replaceUnknowns :: Type -> State TypeMap Type

236−replaceUnknowns = everywhereOnTypesM replaceTypes

224+replaceUnknowns = everywhereOnTypesM replaceTypes where

237− where

238 replaceTypes :: Type -> State TypeMap Type

225 replaceTypes :: Type -> State TypeMap Type

239 replaceTypes (TUnknown u) = do

226 replaceTypes (TUnknown u) = do

240 m <- get

227 m <- get

@@ -387,10 +374,7 @@ defaultPPEOptions = PPEOptions

387 , ppeShowDocs = True

374 , ppeShowDocs = True

388 }

375 }

389

376

390−

391−-- |

392−-- Pretty print a single error, simplifying if necessary

377+-- | Pretty print a single error, simplifying if necessary

393−--

394prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box

378prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box

395prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalState defaultUnknownMap $ do

379prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalState defaultUnknownMap $ do

396 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)

380 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)

@@ -431,6 +415,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalS

431 unknownInfo u = line $ markCode ("t" <> T.pack (show u)) <> " is an unknown type"

415 unknownInfo u = line $ markCode ("t" <> T.pack (show u)) <> " is an unknown type"

432

416

433 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box

417 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box

418+ renderSimpleErrorMessage (ModuleNotFound mn) =

419+ paras [ line $ "Module " <> markCode (runModuleName mn) <> " was not found."

420+ , line "Make sure the source file exists, and that it has been provided as an input to psc."

421+ ]

434 renderSimpleErrorMessage (CannotGetFileInfo path) =

422 renderSimpleErrorMessage (CannotGetFileInfo path) =

435 paras [ line "Unable to read file info: "

423 paras [ line "Unable to read file info: "

436 , indent . lineS $ path

424 , indent . lineS $ path

@@ -1176,15 +1164,11 @@ prettyPrintRef (ReExportRef _ _) =

1176prettyPrintRef (PositionedDeclarationRef _ _ ref) =

1164prettyPrintRef (PositionedDeclarationRef _ _ ref) =

1177 prettyPrintRef ref

1165 prettyPrintRef ref

1178

1166

1179−-- |

1180−-- Pretty print multiple errors

1167+-- | Pretty print multiple errors

1181−--

1182prettyPrintMultipleErrors :: PPEOptions -> MultipleErrors -> String

1168prettyPrintMultipleErrors :: PPEOptions -> MultipleErrors -> String

1183prettyPrintMultipleErrors ppeOptions = unlines . map renderBox . prettyPrintMultipleErrorsBox ppeOptions

1169prettyPrintMultipleErrors ppeOptions = unlines . map renderBox . prettyPrintMultipleErrorsBox ppeOptions

1184

1170

1185−-- |

1186−-- Pretty print multiple warnings

1171+-- | Pretty print multiple warnings

1187−--

1188prettyPrintMultipleWarnings :: PPEOptions -> MultipleErrors -> String

1172prettyPrintMultipleWarnings :: PPEOptions -> MultipleErrors -> String

1189prettyPrintMultipleWarnings ppeOptions = unlines . map renderBox . prettyPrintMultipleWarningsBox ppeOptions

1173prettyPrintMultipleWarnings ppeOptions = unlines . map renderBox . prettyPrintMultipleWarningsBox ppeOptions

1190

1174

@@ -1215,11 +1199,10 @@ prettyPrintMultipleErrorsWith ppeOptions _ intro (MultipleErrors es) =

1215prettyPrintParseError :: P.ParseError -> Box.Box

1199prettyPrintParseError :: P.ParseError -> Box.Box

1216prettyPrintParseError = prettyPrintParseErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" . PE.errorMessages

1200prettyPrintParseError = prettyPrintParseErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" . PE.errorMessages

1217

1201

1218−-- |

1219−-- Pretty print ParseError detail messages.

1202+-- | Pretty print 'ParseError' detail messages.

1220−--

1221−-- Adapted from 'Text.Parsec.Error.showErrorMessages', see <https://github.com/aslatter/parsec/blob/v3.1.9/Text/Parsec/Error.hs#L173>.

1222--

1203--

1204+-- Adapted from 'Text.Parsec.Error.showErrorMessages'.

1205+-- See <https://github.com/aslatter/parsec/blob/v3.1.9/Text/Parsec/Error.hs#L173>.

1223prettyPrintParseErrorMessages :: String -> String -> String -> String -> String -> [Message] -> Box.Box

1206prettyPrintParseErrorMessages :: String -> String -> String -> String -> String -> [Message] -> Box.Box

1224prettyPrintParseErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs

1207prettyPrintParseErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs

1225 | null msgs = Box.text msgUnknown

1208 | null msgs = Box.text msgUnknown

@@ -1288,9 +1271,7 @@ toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)

1288 | f == primName "TypeConcat" = before <$> (toTypelevelString x) <*> (toTypelevelString ret)

1271 | f == primName "TypeConcat" = before <$> (toTypelevelString x) <*> (toTypelevelString ret)

1289toTypelevelString _ = Nothing

1272toTypelevelString _ = Nothing

1290

1273

1291−-- |

1292−-- Rethrow an error with a more detailed error message in the case of failure

1274+-- | Rethrow an error with a more detailed error message in the case of failure

1293−--

1294rethrow :: (MonadError e m) => (e -> e) -> m a -> m a

1275rethrow :: (MonadError e m) => (e -> e) -> m a -> m a

1295rethrow f = flip catchError $ \e -> throwError (f e)

1276rethrow f = flip catchError $ \e -> throwError (f e)

1296

1277

@@ -1303,9 +1284,7 @@ reflectErrors ma = ma >>= either throwError return

1303warnAndRethrow :: (MonadError e m, MonadWriter e m) => (e -> e) -> m a -> m a

1284warnAndRethrow :: (MonadError e m, MonadWriter e m) => (e -> e) -> m a -> m a

1304warnAndRethrow f = rethrow f . censor f

1285warnAndRethrow f = rethrow f . censor f

1305

1286

1306−-- |

1307−-- Rethrow an error with source position information

1287+-- | Rethrow an error with source position information

1308−--

1309rethrowWithPosition :: (MonadError MultipleErrors m) => SourceSpan -> m a -> m a

1288rethrowWithPosition :: (MonadError MultipleErrors m) => SourceSpan -> m a -> m a

1310rethrowWithPosition pos = rethrow (onErrorMessages (withPosition pos))

1289rethrowWithPosition pos = rethrow (onErrorMessages (withPosition pos))

1311

1290

@@ -1318,10 +1297,8 @@ warnAndRethrowWithPosition pos = rethrowWithPosition pos . warnWithPosition pos

1318withPosition :: SourceSpan -> ErrorMessage -> ErrorMessage

1297withPosition :: SourceSpan -> ErrorMessage -> ErrorMessage

1319withPosition pos (ErrorMessage hints se) = ErrorMessage (PositionedError pos : hints) se

1298withPosition pos (ErrorMessage hints se) = ErrorMessage (PositionedError pos : hints) se

1320

1299

1321−-- |

1322−-- Runs a computation listening for warnings and then escalating any warnings

1300+-- | Runs a computation listening for warnings and then escalating any warnings

1323-- that match the predicate to error status.

1301-- that match the predicate to error status.

1324−--

1325escalateWarningWhen

1302escalateWarningWhen

1326 :: (MonadWriter MultipleErrors m, MonadError MultipleErrors m)

1303 :: (MonadWriter MultipleErrors m, MonadError MultipleErrors m)

1327 => (ErrorMessage -> Bool)

1304 => (ErrorMessage -> Bool)

@@ -1334,16 +1311,20 @@ escalateWarningWhen isError ma = do

1334 unless (null errors) $ throwError $ MultipleErrors errors

1311 unless (null errors) $ throwError $ MultipleErrors errors

1335 return a

1312 return a

1336

1313

1337−-- |

1338−-- Collect errors in in parallel

1314+-- | Collect errors in in parallel

1339−--

1315+parU

1316+ :: forall m a b

1340−parU :: (MonadError MultipleErrors m) => [a] -> (a -> m b) -> m [b]

1317+ . MonadError MultipleErrors m

1318+ => [a]

1319+ -> (a -> m b)

1320+ -> m [b]

1321+parU xs f =

1341−parU xs f = forM xs (withError . f) >>= collectErrors

1322+ forM xs (withError . f) >>= collectErrors

1342 where

1323 where

1343− withError :: (MonadError MultipleErrors m) => m a -> m (Either MultipleErrors a)

1324+ withError :: m b -> m (Either MultipleErrors b)

1344− withError u = catchError (Right <$> u) (return . Left)

1325+ withError u = catchError (Right <$> u) (return . Left)

1345

1326

1346− collectErrors :: (MonadError MultipleErrors m) => [Either MultipleErrors a] -> m [a]

1327+ collectErrors :: [Either MultipleErrors b] -> m [b]

1347− collectErrors es = case lefts es of

1328+ collectErrors es = case lefts es of

1348− [] -> return $ rights es

1329+ [] -> return $ rights es

1349− errs -> throwError $ fold errs

1330+ errs -> throwError $ fold errs

src/Language/PureScript/Make.hs+80−87

@@ -20,53 +20,51 @@ module Language.PureScript.Make

20 , inferForeignModules

21 ) where

23−import Prelude.Compat

23+import Prelude.Compat

24−

24+

25−import Control.Concurrent.Lifted as C

25+import Control.Concurrent.Lifted as C

26−import Control.Monad hiding (sequence)

26+import Control.Monad hiding (sequence)

27−import Control.Monad.Base (MonadBase(..))

27+import Control.Monad.Base (MonadBase(..))

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

28+import Control.Monad.Error.Class (MonadError(..))

29−import Control.Monad.IO.Class

29+import Control.Monad.IO.Class

30−import Control.Monad.Logger

30+import Control.Monad.Logger

31−import Control.Monad.Reader (MonadReader(..), ReaderT(..), asks)

31+import Control.Monad.Reader (MonadReader(..), ReaderT(..), asks)

32−import Control.Monad.Supply

32+import Control.Monad.Supply

33−import Control.Monad.Trans.Class (MonadTrans(..))

33+import Control.Monad.Trans.Class (MonadTrans(..))

34−import Control.Monad.Trans.Control (MonadBaseControl(..))

34+import Control.Monad.Trans.Control (MonadBaseControl(..))

35−import Control.Monad.Trans.Except

35+import Control.Monad.Trans.Except

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

36+import Control.Monad.Writer.Class (MonadWriter(..))

37−

38−import Data.Aeson (encode, decode)

37+import Data.Aeson (encode, decode)

39import qualified Data.Aeson as Aeson

38import qualified Data.Aeson as Aeson

40−import Data.Either (partitionEithers)

39+import Data.Either (partitionEithers)

41−import Data.Function (on)

40+import Data.Function (on)

42−import Data.Foldable (for_)

41+import Data.Foldable (for_)

43−import Data.List (foldl', sortBy, groupBy)

42+import Data.List (foldl', sortBy, groupBy)

44−import Data.Maybe (fromMaybe, catMaybes)

43+import Data.Maybe (fromMaybe, catMaybes)

45−import Data.Monoid ((<>))

44+import Data.Monoid ((<>))

46−import Data.Time.Clock

45+import Data.Time.Clock

47−import Data.Traversable (for)

46+import Data.Traversable (for)

48−import Data.Version (showVersion)

47+import Data.Version (showVersion)

49import qualified Data.ByteString.Lazy as B

48import qualified Data.ByteString.Lazy as B

50import qualified Data.ByteString.UTF8 as BU8

49import qualified Data.ByteString.UTF8 as BU8

51import qualified Data.Map as M

50import qualified Data.Map as M

52import qualified Data.Set as S

51import qualified Data.Set as S

53import qualified Data.Text as T

52import qualified Data.Text as T

54import qualified Data.Text.Encoding as TE

53import qualified Data.Text.Encoding as TE

55−

56−import Language.PureScript.AST

54+import Language.PureScript.AST

57−import Language.PureScript.Crash

55+import Language.PureScript.Crash

58−import Language.PureScript.Environment

56+import Language.PureScript.Environment

59−import Language.PureScript.Errors

57+import Language.PureScript.Errors

60−import Language.PureScript.Externs

58+import Language.PureScript.Externs

61−import Language.PureScript.Linter

59+import Language.PureScript.Linter

62−import Language.PureScript.ModuleDependencies

60+import Language.PureScript.ModuleDependencies

63−import Language.PureScript.Names

61+import Language.PureScript.Names

64−import Language.PureScript.Options

62+import Language.PureScript.Options

65−import Language.PureScript.Pretty

63+import Language.PureScript.Pretty

66−import Language.PureScript.Pretty.Common(SMap(..))

64+import Language.PureScript.Pretty.Common(SMap(..))

67−import Language.PureScript.Renamer

65+import Language.PureScript.Renamer

68−import Language.PureScript.Sugar

66+import Language.PureScript.Sugar

69−import Language.PureScript.TypeChecker

67+import Language.PureScript.TypeChecker

70import qualified Language.JavaScript.Parser as JS

68import qualified Language.JavaScript.Parser as JS

71import qualified Language.PureScript.Bundle as Bundle

69import qualified Language.PureScript.Bundle as Bundle

72import qualified Language.PureScript.CodeGen.JS as J

70import qualified Language.PureScript.CodeGen.JS as J

@@ -74,21 +72,18 @@ import qualified Language.PureScript.Constants as C

74import qualified Language.PureScript.CoreFn as CF

72import qualified Language.PureScript.CoreFn as CF

75import qualified Language.PureScript.CoreFn.ToJSON as CFJ

73import qualified Language.PureScript.CoreFn.ToJSON as CFJ

76import qualified Language.PureScript.Parser as PSParser

74import qualified Language.PureScript.Parser as PSParser

77−

78import qualified Paths_purescript as Paths

75import qualified Paths_purescript as Paths

79−

80−import SourceMap

76+import SourceMap

81−import SourceMap.Types

77+import SourceMap.Types

82−

83−import System.Directory (doesFileExist, getModificationTime, createDirectoryIfMissing, getCurrentDirectory)

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

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

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

85−import System.IO.Error (tryIOError)

80+import System.IO.Error (tryIOError)

86−

87import qualified Text.Parsec as Parsec

81import qualified Text.Parsec as Parsec

89-- | Progress messages from the make process

83-- | Progress messages from the make process

90data ProgressMessage

84data ProgressMessage

91 = CompilingModule ModuleName

85 = CompilingModule ModuleName

86+ -- ^ Compilation started for the specified module

92 deriving (Show, Eq, Ord)

87 deriving (Show, Eq, Ord)

94-- | Render a progress message

89-- | Render a progress message

@@ -102,7 +97,6 @@ renderProgressMessage (CompilingModule mn) = "Compiling " ++ T.unpack (runModule

102-- * The particular backend being used (Javascript, C++11, etc.)

97-- * The particular backend being used (Javascript, C++11, etc.)

103--

98--

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

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

105−--

106data MakeActions m = MakeActions

100data MakeActions m = MakeActions

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

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

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

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

@@ -121,26 +115,26 @@ data MakeActions m = MakeActions

121 -- ^ Respond to a progress update.

115 -- ^ Respond to a progress update.

122 }

116 }

123

117

124−-- |

125−-- Generated code for an externs file.

118+-- | Generated code for an externs file.

126−--

127type Externs = B.ByteString

119type Externs = B.ByteString

128

120

129−-- |

130−-- Determines when to rebuild a module

121+-- | Determines when to rebuild a module

131−--

132data RebuildPolicy

122data RebuildPolicy

133 -- | Never rebuild this module

123 -- | Never rebuild this module

134 = RebuildNever

124 = RebuildNever

135 -- | Always rebuild this module

125 -- | Always rebuild this module

136 | RebuildAlways deriving (Show, Eq, Ord)

126 | RebuildAlways deriving (Show, Eq, Ord)

137

127

138−-- | Rebuild a single module

128+-- | Rebuild a single module.

129+--

130+-- This function is used for fast-rebuild workflows (PSCi and psc-ide are examples).

131+rebuildModule

132+ :: forall m

139−rebuildModule :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

133+ . (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

140− => MakeActions m

134+ => MakeActions m

141− -> [ExternsFile]

135+ -> [ExternsFile]

142− -> Module

136+ -> Module

143− -> m ExternsFile

137+ -> m ExternsFile

144rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do

138rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do

145 progress $ CompilingModule moduleName

139 progress $ CompilingModule moduleName

146 let env = foldl' (flip applyExternsFileToEnvironment) initEnvironment externs

140 let env = foldl' (flip applyExternsFileToEnvironment) initEnvironment externs

@@ -157,12 +151,10 @@ rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do

157 evalSupplyT nextVar . codegen renamed env' . encode $ exts

151 evalSupplyT nextVar . codegen renamed env' . encode $ exts

158 return exts

152 return exts

159

153

160−-- |

161−-- Compiles in "make" mode, compiling each module separately to a js files and an externs file

154+-- | Compiles in "make" mode, compiling each module separately to a @.js@ file and an @externs.json@ file.

162--

155--

163-- If timestamps have not changed, the externs file can be used to provide the module's types without

156-- If timestamps have not changed, the externs file can be used to provide the module's types without

164-- having to typecheck the module again.

157-- having to typecheck the module again.

165−--

166make :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

158make :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

167 => MakeActions m

159 => MakeActions m

168 -> [Module]

160 -> [Module]

@@ -244,7 +236,7 @@ make ma@MakeActions{..} ms = do

244 putMVar (fst $ fromMaybe (internalError "make: no barrier") $ lookup moduleName barriers) externs

236 putMVar (fst $ fromMaybe (internalError "make: no barrier") $ lookup moduleName barriers) externs

245 putMVar (snd $ fromMaybe (internalError "make: no barrier") $ lookup moduleName barriers) errors

237 putMVar (snd $ fromMaybe (internalError "make: no barrier") $ lookup moduleName barriers) errors

246

238

247− maximumMaybe :: (Ord a) => [a] -> Maybe a

239+ maximumMaybe :: Ord a => [a] -> Maybe a

248 maximumMaybe [] = Nothing

240 maximumMaybe [] = Nothing

249 maximumMaybe xs = Just $ maximum xs

241 maximumMaybe xs = Just $ maximum xs

250

242

@@ -262,11 +254,10 @@ make ma@MakeActions{..} ms = do

262importPrim :: Module -> Module

254importPrim :: Module -> Module

263importPrim = addDefaultImport (ModuleName [ProperName C.prim])

255importPrim = addDefaultImport (ModuleName [ProperName C.prim])

264

256

265−-- |

266−-- A monad for running make actions

257+-- | A monad for running make actions

267−--

258+newtype Make a = Make

268−newtype Make a = Make { unMake :: ReaderT Options (ExceptT MultipleErrors (Logger MultipleErrors)) a }

259+ { unMake :: ReaderT Options (ExceptT MultipleErrors (Logger MultipleErrors)) a

269− deriving (Functor, Applicative, Monad, MonadIO, MonadError MultipleErrors, MonadWriter MultipleErrors, MonadReader Options)

260+ } deriving (Functor, Applicative, Monad, MonadIO, MonadError MultipleErrors, MonadWriter MultipleErrors, MonadReader Options)

270

261

271instance MonadBase IO Make where

262instance MonadBase IO Make where

272 liftBase = liftIO

263 liftBase = liftIO

@@ -276,12 +267,12 @@ instance MonadBaseControl IO Make where

276 liftBaseWith f = Make $ liftBaseWith $ \q -> f (q . unMake)

267 liftBaseWith f = Make $ liftBaseWith $ \q -> f (q . unMake)

277 restoreM = Make . restoreM

268 restoreM = Make . restoreM

278

269

279−-- |

280−-- Execute a 'Make' monad, returning either errors, or the result of the compile plus any warnings.

270+-- | Execute a 'Make' monad, returning either errors, or the result of the compile plus any warnings.

281−--

282runMake :: Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)

271runMake :: Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)

283runMake opts = runLogger' . runExceptT . flip runReaderT opts . unMake

272runMake opts = runLogger' . runExceptT . flip runReaderT opts . unMake

284

273

274+-- | Run an 'IO' action in the 'Make' monad, by specifying how IO errors should

275+-- be rendered as 'ErrorMessage' values.

285makeIO :: (IOError -> ErrorMessage) -> IO a -> Make a

276makeIO :: (IOError -> ErrorMessage) -> IO a -> Make a

286makeIO f io = do

277makeIO f io = do

287 e <- liftIO $ tryIOError io

278 e <- liftIO $ tryIOError io

@@ -299,7 +290,8 @@ inferForeignModules

299 . MonadIO m

290 . MonadIO m

300 => M.Map ModuleName (Either RebuildPolicy FilePath)

291 => M.Map ModuleName (Either RebuildPolicy FilePath)

301 -> m (M.Map ModuleName FilePath)

292 -> m (M.Map ModuleName FilePath)

293+inferForeignModules =

302−inferForeignModules = fmap (M.mapMaybe id) . traverse inferForeignModule

294+ fmap (M.mapMaybe id) . traverse inferForeignModule

303 where

295 where

304 inferForeignModule :: Either RebuildPolicy FilePath -> m (Maybe FilePath)

296 inferForeignModule :: Either RebuildPolicy FilePath -> m (Maybe FilePath)

305 inferForeignModule (Left _) = return Nothing

297 inferForeignModule (Left _) = return Nothing

@@ -310,16 +302,19 @@ inferForeignModules = fmap (M.mapMaybe id) . traverse inferForeignModule

310 then return (Just jsFile)

302 then return (Just jsFile)

311 else return Nothing

303 else return Nothing

312

304

313−-- |

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

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

315−--

306+buildMakeActions

307+ :: FilePath

316−buildMakeActions :: FilePath -- ^ the output directory

308+ -- ^ the output directory

309+ -> M.Map ModuleName (Either RebuildPolicy FilePath)

317− -> M.Map ModuleName (Either RebuildPolicy FilePath) -- ^ a map between module names and paths to the file containing the PureScript module

310+ -- ^ a map between module names and paths to the file containing the PureScript module

311+ -> M.Map ModuleName FilePath

318− -> M.Map ModuleName FilePath -- ^ a map between module name and the file containing the foreign javascript for the module

312+ -- ^ a map between module name and the file containing the foreign javascript for the module

313+ -> Bool

319− -> Bool -- ^ Generate a prefix comment?

314+ -- ^ Generate a prefix comment?

320− -> MakeActions Make

315+ -> MakeActions Make

321buildMakeActions outputDir filePathMap foreigns usePrefix =

316buildMakeActions outputDir filePathMap foreigns usePrefix =

322− MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress

317+ MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress

323 where

318 where

324

319

325 getInputTimestamp :: ModuleName -> Make (Either RebuildPolicy (Maybe UTCTime))

320 getInputTimestamp :: ModuleName -> Make (Either RebuildPolicy (Maybe UTCTime))

@@ -421,10 +416,8 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

421 progress :: ProgressMessage -> Make ()

416 progress :: ProgressMessage -> Make ()

422 progress = liftIO . putStrLn . renderProgressMessage

417 progress = liftIO . putStrLn . renderProgressMessage

423

418

424−-- |

425−-- Check that the declarations in a given PureScript module match with those

419+-- | Check that the declarations in a given PureScript module match with those

426-- in its corresponding foreign module.

420-- in its corresponding foreign module.

427−--

428checkForeignDecls :: CF.Module ann -> FilePath -> SupplyT Make ()

421checkForeignDecls :: CF.Module ann -> FilePath -> SupplyT Make ()

429checkForeignDecls m path = do

422checkForeignDecls m path = do

430 jsStr <- lift $ readTextFile path

423 jsStr <- lift $ readTextFile path

src/Language/PureScript/ModuleDependencies.hs+41−77

@@ -1,24 +1,18 @@

1−-- |

2−-- Provides the ability to sort modules based on module dependencies

1+-- | Provides the ability to sort modules based on module dependencies

3−--

4module Language.PureScript.ModuleDependencies

2module Language.PureScript.ModuleDependencies

5 ( sortModules

3 ( sortModules

6 , ModuleGraph

4 , ModuleGraph

7 ) where

5 ) where

9−import Prelude.Compat

7+import Protolude

10−

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

12−

13−import Data.Graph

14−import Data.List (nub)

15−import Data.Maybe (fromMaybe)

9+import Data.Graph

10+import qualified Data.Set as S

17−import Language.PureScript.AST

11+import Language.PureScript.AST

12+import qualified Language.PureScript.Constants as C

18−import Language.PureScript.Crash

13+import Language.PureScript.Crash

19−import Language.PureScript.Errors

14+import Language.PureScript.Errors

20−import Language.PureScript.Names

15+import Language.PureScript.Names

21−import Language.PureScript.Types

23-- | A list of modules with their transitive dependencies

17-- | A list of modules with their transitive dependencies

24type ModuleGraph = [(ModuleName, [ModuleName])]

18type ModuleGraph = [(ModuleName, [ModuleName])]

@@ -26,75 +20,45 @@ type ModuleGraph = [(ModuleName, [ModuleName])]

26-- | Sort a collection of modules based on module dependencies.

20-- | Sort a collection of modules based on module dependencies.

27--

21--

28-- Reports an error if the module graph contains a cycle.

22-- Reports an error if the module graph contains a cycle.

29−--

23+sortModules

24+ :: forall m

30−sortModules :: (MonadError MultipleErrors m) => [Module] -> m ([Module], ModuleGraph)

25+ . MonadError MultipleErrors m

26+ => [Module]

27+ -> m ([Module], ModuleGraph)

31sortModules ms = do

28sortModules ms = do

32− let verts = map goModule ms

29+ let mns = S.fromList $ map getModuleName ms

30+ verts <- mapM (toGraphNode mns) ms

33− ms' <- mapM toModule $ stronglyConnComp verts

31+ ms' <- mapM toModule $ stronglyConnComp verts

34− let (graph, fromVertex, toVertex) = graphFromEdges verts

32+ let (graph, fromVertex, toVertex) = graphFromEdges verts

35− moduleGraph = do (_, mn, _) <- verts

33+ moduleGraph = do (_, mn, _) <- verts

36− let v = fromMaybe (internalError "sortModules: vertex not found") (toVertex mn)

34+ let v = fromMaybe (internalError "sortModules: vertex not found") (toVertex mn)

37− deps = reachable graph v

35+ deps = reachable graph v

38− toKey i = case fromVertex i of (_, key, _) -> key

36+ toKey i = case fromVertex i of (_, key, _) -> key

39− return (mn, filter (/= mn) (map toKey deps))

37+ return (mn, filter (/= mn) (map toKey deps))

40− return (ms', moduleGraph)

38+ return (ms', moduleGraph)

41 where

39 where

42− goModule :: Module -> (Module, ModuleName, [ModuleName])

40+ toGraphNode :: S.Set ModuleName -> Module -> m (Module, ModuleName, [ModuleName])

43− goModule m@(Module _ _ _ ds _) =

41+ toGraphNode mns m@(Module _ _ mn ds _) = do

44− let ams = concatMap extractQualAs ds

42+ let deps = ordNub (concatMap usedModules ds)

43+ forM_ deps $ \dep ->

44+ when (dep /= C.Prim && S.notMember dep mns) $

45+ throwError . addHint (ErrorInModule mn) . errorMessage $ ModuleNotFound dep

45− in (m, getModuleName m, nub (concatMap (usedModules ams) ds))

46+ pure (m, getModuleName m, deps)

47− -- Extract module names that have been brought into scope by an `as` import.

48− extractQualAs :: Declaration -> [ModuleName]

49− extractQualAs (PositionedDeclaration _ _ d) = extractQualAs d

50− extractQualAs (ImportDeclaration _ _ (Just am)) = [am]

51− extractQualAs _ = []

52−

53−-- |

54−-- Calculate a list of used modules based on explicit imports and qualified

48+-- | Calculate a list of used modules based on explicit imports and qualified names.

55−-- names. `ams` is a list of `ModuleNames` that refer to names brought into

49+usedModules :: Declaration -> [ModuleName]

56−-- scope by importing with `as` - this ensures that when building the list we

50+usedModules d = f d where

57−-- don't inadvertantly assume a dependency on an actual module, if there is a

58−-- module that has the same name as the qualified import.

59−--

60−usedModules :: [ModuleName] -> Declaration -> [ModuleName]

51+ f :: Declaration -> [ModuleName]

61−usedModules ams d =

62− let (f, _, _, _, _) = everythingOnValues (++) forDecls forValues (const []) (const []) (const [])

52+ (f, _, _, _, _) = everythingOnValues (++) forDecls (const []) (const []) (const []) (const [])

63− (g, _, _, _, _) = accumTypes (everythingOnTypes (++) forTypes)

64− in nub (f d ++ g d)

65− where

67 forDecls :: Declaration -> [ModuleName]

54 forDecls :: Declaration -> [ModuleName]

68− forDecls (ImportDeclaration mn _ _) =

69− -- Regardless of whether an imported module is qualified we still need to

55+ -- Regardless of whether an imported module is qualified we still need to

70− -- take into account its import to build an accurate list of dependencies.

56+ -- take into account its import to build an accurate list of dependencies.

71− [mn]

57+ forDecls (ImportDeclaration mn _ _) = [mn]

72− forDecls (FixityDeclaration fd)

73− | Just mn <- extractQualFixity fd, mn `notElem` ams = [mn]

74− forDecls (TypeInstanceDeclaration _ _ (Qualified (Just mn) _) _ _)

75− | mn `notElem` ams = [mn]

76 forDecls _ = []

58 forDecls _ = []

78− forValues :: Expr -> [ModuleName]

79− forValues (Var (Qualified (Just mn) _))

80− | mn `notElem` ams = [mn]

81− forValues (Constructor (Qualified (Just mn) _))

82− | mn `notElem` ams = [mn]

83− forValues _ = []

84−

85− forTypes :: Type -> [ModuleName]

86− forTypes (TypeConstructor (Qualified (Just mn) _))

87− | mn `notElem` ams = [mn]

88− forTypes _ = []

89−

90− extractQualFixity :: Either ValueFixity TypeFixity -> Maybe ModuleName

91− extractQualFixity (Left (ValueFixity _ (Qualified mn _) _)) = mn

92− extractQualFixity (Right (TypeFixity _ (Qualified mn _) _)) = mn

93−

94−-- |

95−-- Convert a strongly connected component of the module graph to a module

60+-- | Convert a strongly connected component of the module graph to a module

96−--

97−toModule :: (MonadError MultipleErrors m) => SCC Module -> m Module

61+toModule :: MonadError MultipleErrors m => SCC Module -> m Module

98toModule (AcyclicSCC m) = return m

62toModule (AcyclicSCC m) = return m

99toModule (CyclicSCC [m]) = return m

63toModule (CyclicSCC [m]) = return m

100toModule (CyclicSCC ms) = throwError . errorMessage $ CycleInModules (map getModuleName ms)

64toModule (CyclicSCC ms) = throwError . errorMessage $ CycleInModules (map getModuleName ms)

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

@@ -243,7 +243,7 @@ unwrapResult = withObject "result" $ \o -> do

243 case rt of

244 "error" -> do

245 res <- o .: "result"

246− pure (Left res)

246+ withArray "errors" (fmap (Left . fold) . traverse (withObject "error" (.: "message"))) res

247 "success" -> do

248 res <- o .: "result"

249 pure (Right res)