git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Use real errors rather than `error`
911af32Gary Burgess
psc-make/Main.hs+1−1
@@ -79,7 +79,7 @@ readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$>
79parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
79parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
80 => [(Either P.RebuildPolicy FilePath, String)]
80 => [(Either P.RebuildPolicy FilePath, String)]
81 -> [(FilePath, P.ForeignJS)]
81 -> [(FilePath, P.ForeignJS)]
82− -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName P.ForeignJS)
82+ -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName (FilePath, P.ForeignJS))
83parseInputs modules foreigns =
83parseInputs modules foreigns =
84 (,) <$> P.parseModulesFromFiles (either (const "") id) modules
84 (,) <$> P.parseModulesFromFiles (either (const "") id) modules
85 <*> P.parseForeignModulesFromFiles foreigns
85 <*> P.parseForeignModulesFromFiles foreigns
psc-make/Make.hs+11−7
@@ -64,7 +64,7 @@ traverseEither f (Right y) = Right <$> f y
64
64
65buildMakeActions :: FilePath
65buildMakeActions :: FilePath
66 -> M.Map P.ModuleName (Either P.RebuildPolicy String)
66 -> M.Map P.ModuleName (Either P.RebuildPolicy String)
67− -> M.Map P.ModuleName P.ForeignJS
67+ -> M.Map P.ModuleName (FilePath, P.ForeignJS)
68 -> Bool
68 -> Bool
69 -> P.MakeActions Make
69 -> P.MakeActions Make
70buildMakeActions outputDir filePathMap foreigns usePrefix =
70buildMakeActions outputDir filePathMap foreigns usePrefix =
@@ -90,20 +90,24 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
90
90
91 codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()
91 codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()
92 codegen m _ nextVar exts = do
92 codegen m _ nextVar exts = do
93+ let mn = CF.moduleName m
93− foreignInclude <- case CF.moduleName m `M.lookup` foreigns of
94+ foreignInclude <- case mn `M.lookup` foreigns of
95+ Just (path, _)
94− Just _ | not $ requiresForeign m -> error "Found unnecessary foreign module"
96+ | not $ requiresForeign m -> do
97+ tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
98+ return Nothing
95− | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
99+ | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
96− Nothing | requiresForeign m -> error "Foreign module missing"
100+ Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn
97 | otherwise -> return Nothing
101 | otherwise -> return Nothing
98 pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude
102 pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude
99− let filePath = P.runModuleName $ CF.moduleName m
103+ let filePath = P.runModuleName mn
100 jsFile = outputDir </> filePath </> "index.js"
104 jsFile = outputDir </> filePath </> "index.js"
101 externsFile = outputDir </> filePath </> "externs.purs"
105 externsFile = outputDir </> filePath </> "externs.purs"
102 foreignFile = outputDir </> filePath </> "foreign.js"
106 foreignFile = outputDir </> filePath </> "foreign.js"
103 prefix = ["Generated by psc-make version " ++ showVersion Paths.version | usePrefix]
107 prefix = ["Generated by psc-make version " ++ showVersion Paths.version | usePrefix]
104 js = unlines $ map ("// " ++) prefix ++ [pjs]
108 js = unlines $ map ("// " ++) prefix ++ [pjs]
105 writeTextFile jsFile js
109 writeTextFile jsFile js
106− maybe (return ()) (writeTextFile foreignFile) $ CF.moduleName m `M.lookup` foreigns
110+ maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns
107 writeTextFile externsFile exts
111 writeTextFile externsFile exts
108
112
109 requiresForeign :: CF.Module a -> Bool
113 requiresForeign :: CF.Module a -> Bool
psc/Main.hs+21−15
@@ -25,10 +25,10 @@ import Control.Monad
25import Control.Monad.Error.Class (MonadError(..))
25import Control.Monad.Error.Class (MonadError(..))
26import Control.Monad.Reader
26import Control.Monad.Reader
27import Control.Monad.Supply (evalSupplyT)
27import Control.Monad.Supply (evalSupplyT)
28+import Control.Monad.Supply.Class (MonadSupply())
28import Control.Monad.Writer
29import Control.Monad.Writer
29
30
30import Data.Maybe (fromMaybe)
31import Data.Maybe (fromMaybe)
31−import Data.Traversable (traverse)
32import Data.Version (showVersion)
32import Data.Version (showVersion)
33
33
34import Options.Applicative as Opts
34import Options.Applicative as Opts
@@ -83,7 +83,7 @@ compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
83 Right ((ms, foreigns), warnings) -> do
83 Right ((ms, foreigns), warnings) -> do
84 when (P.nonEmpty warnings) $
84 when (P.nonEmpty warnings) $
85 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
85 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
86− case runPSC opts (compileJS (map snd ms) foreigns prefix) of
86+ case runPSC opts (compileJS ms foreigns prefix) of
87 Left errs -> do
87 Left errs -> do
88 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
88 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
89 exitFailure
89 exitFailure
@@ -99,33 +99,39 @@ compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
99 exitSuccess
99 exitSuccess
100
100
101parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
101parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
102− => [(Maybe FilePath, String)] -> [(FilePath, P.ForeignJS)] -> m ([(Maybe FilePath, P.Module)], M.Map P.ModuleName String)
102+ => [(Maybe FilePath, String)] -> [(FilePath, P.ForeignJS)] -> m ([P.Module], M.Map P.ModuleName (FilePath, P.ForeignJS))
103parseInputs modules foreigns =
103parseInputs modules foreigns =
104− (,) <$> P.parseModulesFromFiles (fromMaybe "") modules
104+ (,) <$> (map snd <$> P.parseModulesFromFiles (fromMaybe "") modules)
105 <*> P.parseForeignModulesFromFiles foreigns
105 <*> P.parseForeignModulesFromFiles foreigns
106
106
107compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)
107compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)
108− => [P.Module] -> M.Map P.ModuleName P.ForeignJS -> [String] -> m (String, String)
108+ => [P.Module] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> [String] -> m (String, String)
109compileJS ms foreigns prefix = do
109compileJS ms foreigns prefix = do
110 (modulesToCodeGen, env, nextVar, exts) <- P.compile ms
110 (modulesToCodeGen, env, nextVar, exts) <- P.compile ms
111− js <- concat <$> evalSupplyT nextVar (traverse codegenModule modulesToCodeGen)
111+ js <- concat <$> evalSupplyT nextVar (P.parU modulesToCodeGen codegenModule)
112 js' <- generateMain env js
112 js' <- generateMain env js
113 let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
113 let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
114 return (pjs, exts)
114 return (pjs, exts)
115
115
116 where
116 where
117
117
118+ codegenModule :: (Functor n, Applicative n, MonadError P.MultipleErrors n, MonadWriter P.MultipleErrors n, MonadReader (P.Options P.Compile) n, MonadSupply n)
119+ => CF.Module CF.Ann -> n [J.JS]
118 codegenModule m =
120 codegenModule m =
119 let requiresForeign = not $ null (CF.moduleForeign m)
121 let requiresForeign = not $ null (CF.moduleForeign m)
122+ mn = CF.moduleName m
120− in case CF.moduleName m `M.lookup` foreigns of
123+ in case mn `M.lookup` foreigns of
124+ Just (path, js)
121− Just js | not requiresForeign -> error "Found unnecessary foreign module"
125+ | not requiresForeign -> do
126+ tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
127+ J.moduleToJs m Nothing
122− | otherwise -> J.moduleToJs m $ Just $
128+ | otherwise -> J.moduleToJs m $ Just $
123− J.JSApp (J.JSFunction Nothing [] $
129+ J.JSApp (J.JSFunction Nothing [] $
124− J.JSBlock [ J.JSVariableIntroduction "exports" (Just $ J.JSObjectLiteral [])
130+ J.JSBlock [ J.JSVariableIntroduction "exports" (Just $ J.JSObjectLiteral [])
125− , J.JSRaw js
131+ , J.JSRaw js
126− , J.JSReturn (J.JSVar "exports")
132+ , J.JSReturn (J.JSVar "exports")
127− ]) []
133+ ]) []
128− Nothing | requiresForeign -> error "Foreign module missing"
134+ Nothing | requiresForeign -> throwError . P.errorMessage $ P.MissingFFIModule mn
129 | otherwise -> J.moduleToJs m Nothing
135 | otherwise -> J.moduleToJs m Nothing
130
136
131 generateMain :: P.Environment -> [J.JS] -> m [J.JS]
137 generateMain :: P.Environment -> [J.JS] -> m [J.JS]
src/Language/PureScript/Errors.hs+295−193
@@ -54,6 +54,9 @@ data SimpleErrorMessage
54 | ErrorParsingFFIModule FilePath
54 | ErrorParsingFFIModule FilePath
55 | ErrorParsingPrelude P.ParseError
55 | ErrorParsingPrelude P.ParseError
56 | ErrorParsingModule P.ParseError
56 | ErrorParsingModule P.ParseError
57+ | MissingFFIModule ModuleName
58+ | MultipleFFIModules ModuleName FilePath FilePath
59+ | UnnecessaryFFIModule ModuleName FilePath
57 | InvalidExternsFile FilePath
60 | InvalidExternsFile FilePath
58 | CannotGetFileInfo FilePath
61 | CannotGetFileInfo FilePath
59 | CannotReadFile FilePath
62 | CannotReadFile FilePath
@@ -160,6 +163,9 @@ errorCode em = case unwrapErrorMessage em of
160 (ErrorParsingFFIModule _) -> "ErrorParsingFFIModule"
163 (ErrorParsingFFIModule _) -> "ErrorParsingFFIModule"
161 (ErrorParsingPrelude _) -> "ErrorParsingPrelude"
164 (ErrorParsingPrelude _) -> "ErrorParsingPrelude"
162 (ErrorParsingModule _) -> "ErrorParsingModule"
165 (ErrorParsingModule _) -> "ErrorParsingModule"
166+ MissingFFIModule{} -> "MissingFFIModule"
167+ MultipleFFIModules{} -> "MultipleFFIModules"
168+ UnnecessaryFFIModule{} -> "UnnecessaryFFIModule"
163 (InvalidExternsFile _) -> "InvalidExternsFile"
169 (InvalidExternsFile _) -> "InvalidExternsFile"
164 (CannotGetFileInfo _) -> "CannotGetFileInfo"
170 (CannotGetFileInfo _) -> "CannotGetFileInfo"
165 (CannotReadFile _) -> "CannotReadFile"
171 (CannotReadFile _) -> "CannotReadFile"
@@ -354,199 +360,295 @@ prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessag
354 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e
360 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e
355
361
356 go :: ErrorMessage -> Box.Box
362 go :: ErrorMessage -> Box.Box
357− goSimple (CannotGetFileInfo path) = paras [ line "Unable to read file info: "
363+ goSimple (CannotGetFileInfo path) =
364+ paras [ line "Unable to read file info: "
358− , indent . line $ path
365+ , indent . line $ path
359− ]
366+ ]
360− goSimple (CannotReadFile path) = paras [ line "Unable to read file: "
367+ goSimple (CannotReadFile path) =
368+ paras [ line "Unable to read file: "
361− , indent . line $ path
369+ , indent . line $ path
362− ]
370+ ]
363− goSimple (CannotWriteFile path) = paras [ line "Unable to write file: "
371+ goSimple (CannotWriteFile path) =
372+ paras [ line "Unable to write file: "
364− , indent . line $ path
373+ , indent . line $ path
365− ]
374+ ]
375+ goSimple (ErrorParsingExterns err) =
366− goSimple (ErrorParsingExterns err) = paras [ line "Error parsing externs files: "
376+ paras [ line "Error parsing externs files: "
367− , indent . line . show $ err
377+ , indent . line . show $ err
368− ]
378+ ]
379+ goSimple (ErrorParsingFFIModule path) =
369− goSimple (ErrorParsingFFIModule path) = paras [ line "Unable to parse module from FFI file: "
380+ paras [ line "Unable to parse module from FFI file: "
370− , indent . line $ path
381+ , indent . line $ path
371− ]
382+ ]
372− goSimple (ErrorParsingModule err) = paras [ line "Unable to parse module: "
383+ goSimple (ErrorParsingModule err) =
384+ paras [ line "Unable to parse module: "
373− , indent . line . show $ err
385+ , indent . line . show $ err
386+ ]
387+ goSimple (MissingFFIModule mn) =
388+ line $ "Missing FFI implementations for module " ++ show mn
389+ goSimple (UnnecessaryFFIModule mn path) =
390+ paras [ line $ "Unnecessary FFI implementations have been provided for module " ++ show mn ++ ": "
391+ , indent . line $ path
392+ ]
393+ goSimple (MultipleFFIModules mn path1 path2) =
394+ paras [ line $ "Multiple FFI implementations have been provided for module " ++ show mn ++ ": "
395+ , indent . line $ path1
396+ , indent . line $ path2
374− ]
397+ ]
375− goSimple (ErrorParsingPrelude err) = paras [ line "Error parsing prelude: "
398+ goSimple (ErrorParsingPrelude err) =
399+ paras [ line "Error parsing prelude: "
376− , indent . line . show $ err
400+ , indent . line . show $ err
377− ]
401+ ]
378− goSimple (InvalidExternsFile path) = paras [ line "Externs file is invalid: "
402+ goSimple (InvalidExternsFile path) =
403+ paras [ line "Externs file is invalid: "
379− , indent . line $ path
404+ , indent . line $ path
380− ]
405+ ]
406+ goSimple InvalidDoBind =
381− goSimple InvalidDoBind = line "Bind statement cannot be the last statement in a do block"
407+ line "Bind statement cannot be the last statement in a do block"
408+ goSimple InvalidDoLet =
382− goSimple InvalidDoLet = line "Let statement cannot be the last statement in a do block"
409+ line "Let statement cannot be the last statement in a do block"
383− goSimple CannotReorderOperators = line "Unable to reorder operators"
410+ goSimple CannotReorderOperators =
411+ line "Unable to reorder operators"
412+ goSimple UnspecifiedSkolemScope =
384− goSimple UnspecifiedSkolemScope = line "Skolem variable scope is unspecified"
413+ line "Skolem variable scope is unspecified"
414+ goSimple OverlappingNamesInLet =
385− goSimple OverlappingNamesInLet = line "Overlapping names in let binding."
415+ line "Overlapping names in let binding."
416+ goSimple (InfiniteType ty) =
386− goSimple (InfiniteType ty) = paras [ line "Infinite type detected: "
417+ paras [ line "Infinite type detected: "
387− , indent $ line $ prettyPrintType ty
418+ , indent $ line $ prettyPrintType ty
388− ]
419+ ]
420+ goSimple (InfiniteKind ki) =
389− goSimple (InfiniteKind ki) = paras [ line "Infinite kind detected: "
421+ paras [ line "Infinite kind detected: "
390− , indent $ line $ prettyPrintKind ki
422+ , indent $ line $ prettyPrintKind ki
391− ]
423+ ]
424+ goSimple (MultipleFixities name) =
392− goSimple (MultipleFixities name) = line $ "Multiple fixity declarations for " ++ show name
425+ line $ "Multiple fixity declarations for " ++ show name
426+ goSimple (OrphanTypeDeclaration nm) =
393− goSimple (OrphanTypeDeclaration nm) = line $ "Orphan type declaration for " ++ show nm
427+ line $ "Orphan type declaration for " ++ show nm
428+ goSimple (OrphanFixityDeclaration op) =
394− goSimple (OrphanFixityDeclaration op) = line $ "Orphan fixity declaration for " ++ show op
429+ line $ "Orphan fixity declaration for " ++ show op
430+ goSimple (RedefinedModule name) =
395− goSimple (RedefinedModule name) = line $ "Module " ++ show name ++ " has been defined multiple times"
431+ line $ "Module " ++ show name ++ " has been defined multiple times"
432+ goSimple (RedefinedIdent name) =
396− goSimple (RedefinedIdent name) = line $ "Name " ++ show name ++ " has been defined multiple times"
433+ line $ "Name " ++ show name ++ " has been defined multiple times"
397− goSimple (UnknownModule mn) = line $ "Unknown module " ++ show mn
434+ goSimple (UnknownModule mn) =
435+ line $ "Unknown module " ++ show mn
398− goSimple (UnknownType name) = line $ "Unknown type " ++ show name
436+ goSimple (UnknownType name) =
437+ line $ "Unknown type " ++ show name
399− goSimple (UnknownTypeClass name) = line $ "Unknown type class " ++ show name
438+ goSimple (UnknownTypeClass name) =
439+ line $ "Unknown type class " ++ show name
400− goSimple (UnknownValue name) = line $ "Unknown value " ++ show name
440+ goSimple (UnknownValue name) =
441+ line $ "Unknown value " ++ show name
401− goSimple (UnknownTypeConstructor name) = line $ "Unknown type constructor " ++ show name
442+ goSimple (UnknownTypeConstructor name) =
443+ line $ "Unknown type constructor " ++ show name
444+ goSimple (UnknownDataConstructor dc tc) =
402− goSimple (UnknownDataConstructor dc tc) = line $ "Unknown data constructor " ++ show dc ++ foldMap ((" for type constructor " ++) . show) tc
445+ line $ "Unknown data constructor " ++ show dc ++ foldMap ((" for type constructor " ++) . show) tc
446+ goSimple (ConflictingImport nm mn) =
403− goSimple (ConflictingImport nm mn) = line $ "Cannot declare `" ++ nm ++ "` since another declaration of that name was imported from `" ++ show mn ++ "`"
447+ line $ "Cannot declare `" ++ nm ++ "` since another declaration of that name was imported from `" ++ show mn ++ "`"
448+ goSimple (ConflictingImports nm m1 m2) =
404− goSimple (ConflictingImports nm m1 m2) = line $ "Conflicting imports for " ++ nm ++ " from modules " ++ show m1 ++ " and " ++ show m2
449+ line $ "Conflicting imports for " ++ nm ++ " from modules " ++ show m1 ++ " and " ++ show m2
450+ goSimple (ConflictingTypeDecls nm) =
405− goSimple (ConflictingTypeDecls nm) = line $ "Conflicting type declarations for " ++ show nm
451+ line $ "Conflicting type declarations for " ++ show nm
452+ goSimple (ConflictingCtorDecls nm) =
406− goSimple (ConflictingCtorDecls nm) = line $ "Conflicting data constructor declarations for " ++ show nm
453+ line $ "Conflicting data constructor declarations for " ++ show nm
454+ goSimple (TypeConflictsWithClass nm) =
407− goSimple (TypeConflictsWithClass nm) = line $ "Type " ++ show nm ++ " conflicts with type class declaration of the same name"
455+ line $ "Type " ++ show nm ++ " conflicts with type class declaration of the same name"
456+ goSimple (CtorConflictsWithClass nm) =
408− goSimple (CtorConflictsWithClass nm) = line $ "Data constructor " ++ show nm ++ " conflicts with type class declaration of the same name"
457+ line $ "Data constructor " ++ show nm ++ " conflicts with type class declaration of the same name"
458+ goSimple (ClassConflictsWithType nm) =
409− goSimple (ClassConflictsWithType nm) = line $ "Type class " ++ show nm ++ " conflicts with type declaration of the same name"
459+ line $ "Type class " ++ show nm ++ " conflicts with type declaration of the same name"
460+ goSimple (ClassConflictsWithCtor nm) =
410− goSimple (ClassConflictsWithCtor nm) = line $ "Type class " ++ show nm ++ " conflicts with data constructor declaration of the same name"
461+ line $ "Type class " ++ show nm ++ " conflicts with data constructor declaration of the same name"
462+ goSimple (DuplicateClassExport nm) =
411− goSimple (DuplicateClassExport nm) = line $ "Duplicate export declaration for type class " ++ show nm
463+ line $ "Duplicate export declaration for type class " ++ show nm
464+ goSimple (DuplicateValueExport nm) =
412− goSimple (DuplicateValueExport nm) = line $ "Duplicate export declaration for value " ++ show nm
465+ line $ "Duplicate export declaration for value " ++ show nm
466+ goSimple (CycleInDeclaration nm) =
413− goSimple (CycleInDeclaration nm) = line $ "Cycle in declaration of " ++ show nm
467+ line $ "Cycle in declaration of " ++ show nm
468+ goSimple (CycleInModules mns) =
414− goSimple (CycleInModules mns) = line $ "Cycle in module dependencies: " ++ intercalate ", " (map show mns)
469+ line $ "Cycle in module dependencies: " ++ intercalate ", " (map show mns)
470+ goSimple (CycleInTypeSynonym pn) =
415− goSimple (CycleInTypeSynonym pn) = line $ "Cycle in type synonym" ++ foldMap ((" " ++) . show) pn
471+ line $ "Cycle in type synonym" ++ foldMap ((" " ++) . show) pn
416− goSimple (NameIsUndefined ident) = line $ show ident ++ " is undefined"
472+ goSimple (NameIsUndefined ident) =
473+ line $ show ident ++ " is undefined"
474+ goSimple (NameNotInScope ident) =
417− goSimple (NameNotInScope ident) = line $ show ident ++ " may not be defined in the current scope"
475+ line $ show ident ++ " may not be defined in the current scope"
476+ goSimple (UndefinedTypeVariable name) =
418− goSimple (UndefinedTypeVariable name) = line $ "Type variable " ++ show name ++ " is undefined"
477+ line $ "Type variable " ++ show name ++ " is undefined"
478+ goSimple (PartiallyAppliedSynonym name) =
419− goSimple (PartiallyAppliedSynonym name) = line $ "Partially applied type synonym " ++ show name
479+ line $ "Partially applied type synonym " ++ show name
480+ goSimple (EscapedSkolem binding) =
420− goSimple (EscapedSkolem binding) = paras $ [ line "Rigid/skolem type variable has escaped." ]
481+ paras $ [ line "Rigid/skolem type variable has escaped." ]
421− <> foldMap (\expr -> [ line "Relevant expression: "
482+ <> foldMap (\expr -> [ line "Relevant expression: "
422− , indent $ line $ prettyPrintValue expr
483+ , indent $ line $ prettyPrintValue expr
423− ]) binding
484+ ]) binding
424− goSimple (TypesDoNotUnify t1 t2) = paras [ line "Cannot unify type"
485+ goSimple (TypesDoNotUnify t1 t2)
486+ = paras [ line "Cannot unify type"
425− , indent $ line $ prettyPrintType t1
487+ , indent $ line $ prettyPrintType t1
426− , line "with type"
488+ , line "with type"
427− , indent $ line $ prettyPrintType t2
489+ , indent $ line $ prettyPrintType t2
428− ]
490+ ]
429− goSimple (KindsDoNotUnify k1 k2) = paras [ line "Cannot unify kind"
491+ goSimple (KindsDoNotUnify k1 k2) =
492+ paras [ line "Cannot unify kind"
430− , indent $ line $ prettyPrintKind k1
493+ , indent $ line $ prettyPrintKind k1
431− , line "with kind"
494+ , line "with kind"
432− , indent $ line $ prettyPrintKind k2
495+ , indent $ line $ prettyPrintKind k2
433− ]
496+ ]
497+ goSimple (ConstrainedTypeUnified t1 t2) =
434− goSimple (ConstrainedTypeUnified t1 t2) = paras [ line "Cannot unify constrained type"
498+ paras [ line "Cannot unify constrained type"
435− , indent $ line $ prettyPrintType t1
499+ , indent $ line $ prettyPrintType t1
436− , line "with type"
500+ , line "with type"
437− , indent $ line $ prettyPrintType t2
501+ , indent $ line $ prettyPrintType t2
438− ]
502+ ]
503+ goSimple (OverlappingInstances nm ts ds) =
439− goSimple (OverlappingInstances nm ts ds) = paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
504+ paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
440− , paras $ map prettyPrintDictionaryValue ds
505+ , paras $ map prettyPrintDictionaryValue ds
441− ]
506+ ]
507+ goSimple (NoInstanceFound nm ts) =
442− goSimple (NoInstanceFound nm ts) = line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)
508+ line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)
509+ goSimple (DuplicateLabel l expr) =
443− goSimple (DuplicateLabel l expr) = paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]
510+ paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]
444− <> foldMap (\expr' -> [ line "Relevant expression: "
511+ <> foldMap (\expr' -> [ line "Relevant expression: "
445− , indent $ line $ prettyPrintValue expr'
512+ , indent $ line $ prettyPrintValue expr'
446− ]) expr
513+ ]) expr
447− goSimple (DuplicateTypeArgument name) = line $ "Duplicate type argument " ++ show name
514+ goSimple (DuplicateTypeArgument name) =
515+ line $ "Duplicate type argument " ++ show name
516+ goSimple (DuplicateValueDeclaration nm) =
448− goSimple (DuplicateValueDeclaration nm) = line $ "Duplicate value declaration for " ++ show nm
517+ line $ "Duplicate value declaration for " ++ show nm
518+ goSimple (ArgListLengthsDiffer ident) =
449− goSimple (ArgListLengthsDiffer ident) = line $ "Argument list lengths differ in declaration " ++ show ident
519+ line $ "Argument list lengths differ in declaration " ++ show ident
520+ goSimple (OverlappingArgNames ident) =
450− goSimple (OverlappingArgNames ident) = line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . show) ident
521+ line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . show) ident
522+ goSimple (MissingClassMember ident) =
451− goSimple (MissingClassMember ident) = line $ "Member " ++ show ident ++ " has not been implemented"
523+ line $ "Member " ++ show ident ++ " has not been implemented"
524+ goSimple (ExpectedType kind) =
452− goSimple (ExpectedType kind) = line $ "Expected type of kind *, was " ++ prettyPrintKind kind
525+ line $ "Expected type of kind *, was " ++ prettyPrintKind kind
526+ goSimple (IncorrectConstructorArity nm) =
453− goSimple (IncorrectConstructorArity nm) = line $ "Wrong number of arguments to constructor " ++ show nm
527+ line $ "Wrong number of arguments to constructor " ++ show nm
454− goSimple SubsumptionCheckFailed = line $ "Unable to check type subsumption"
528+ goSimple SubsumptionCheckFailed = line $ "Unable to check type subsumption"
455− goSimple (ExprDoesNotHaveType expr ty) = paras [ line "Expression"
529+ goSimple (ExprDoesNotHaveType expr ty) =
530+ paras [ line "Expression"
456− , indent $ line $ prettyPrintValue expr
531+ , indent $ line $ prettyPrintValue expr
457− , line "does not have type"
532+ , line "does not have type"
458− , indent $ line $ prettyPrintType ty
533+ , indent $ line $ prettyPrintType ty
459− ]
534+ ]
535+ goSimple (PropertyIsMissing prop row) =
460− goSimple (PropertyIsMissing prop row) = line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop
536+ line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop
537+ goSimple (CannotApplyFunction fn arg) =
461− goSimple (CannotApplyFunction fn arg) = paras [ line "Cannot apply function of type"
538+ paras [ line "Cannot apply function of type"
462− , indent $ line $ prettyPrintType fn
539+ , indent $ line $ prettyPrintType fn
463− , line "to argument"
540+ , line "to argument"
464− , indent $ line $ prettyPrintValue arg
541+ , indent $ line $ prettyPrintValue arg
465− ]
542+ ]
543+ goSimple TypeSynonymInstance =
466− goSimple TypeSynonymInstance = line "Type synonym instances are disallowed"
544+ line "Type synonym instances are disallowed"
545+ goSimple InvalidNewtype =
467− goSimple InvalidNewtype = line "Newtypes must define a single constructor with a single argument"
546+ line "Newtypes must define a single constructor with a single argument"
547+ goSimple (InvalidInstanceHead ty) =
468− goSimple (InvalidInstanceHead ty) = paras [ line "Invalid type in class instance head:"
548+ paras [ line "Invalid type in class instance head:"
469− , indent $ line $ prettyPrintType ty
549+ , indent $ line $ prettyPrintType ty
470− ]
550+ ]
551+ goSimple (TransitiveExportError x ys) =
471− goSimple (TransitiveExportError x ys) = paras $ (line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")
552+ paras $ (line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")
472− : map (line . prettyPrintExport) ys
553+ : map (line . prettyPrintExport) ys
554+ goSimple (ShadowedName nm) =
473− goSimple (ShadowedName nm) = line $ "Name '" ++ show nm ++ "' was shadowed."
555+ line $ "Name '" ++ show nm ++ "' was shadowed."
556+ goSimple (WildcardInferredType ty) =
474− goSimple (WildcardInferredType ty) = line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty
557+ line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty
558+ goSimple PreludeNotPresent =
475− goSimple PreludeNotPresent = paras [ line $ "There is no Prelude module loaded, and the --no-prelude option was not specified."
559+ paras [ line $ "There is no Prelude module loaded, and the --no-prelude option was not specified."
476− , line $ "You probably need to install the Prelude and other dependencies using Bower."
560+ , line $ "You probably need to install the Prelude and other dependencies using Bower."
477− ]
561+ ]
562+ go (NotYetDefined names err) =
478− go (NotYetDefined names err) = paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"
563+ paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"
479− , indent $ go err
564+ , indent $ go err
480− ]
565+ ]
481− go (ErrorUnifyingTypes t1 t2 err) = paras [ line "Error unifying type "
566+ go (ErrorUnifyingTypes t1 t2 err) =
567+ paras [ line "Error unifying type "
482− , indent $ line $ prettyPrintType t1
568+ , indent $ line $ prettyPrintType t1
483− , line "with type"
569+ , line "with type"
484− , indent $ line $ prettyPrintType t2
570+ , indent $ line $ prettyPrintType t2
485− , go err
571+ , go err
486− ]
572+ ]
487− go (ErrorInExpression expr err) = paras [ line "Error in expression:"
573+ go (ErrorInExpression expr err) =
574+ paras [ line "Error in expression:"
488− , indent $ line $ prettyPrintValue expr
575+ , indent $ line $ prettyPrintValue expr
489− , go err
576+ , go err
490− ]
577+ ]
578+ go (ErrorInModule mn err) =
491− go (ErrorInModule mn err) = paras [ line $ "Error in module " ++ show mn ++ ":"
579+ paras [ line $ "Error in module " ++ show mn ++ ":"
492− , go err
580+ , go err
493− ]
581+ ]
582+ go (ErrorInSubsumption t1 t2 err) =
494− go (ErrorInSubsumption t1 t2 err) = paras [ line "Error checking that type "
583+ paras [ line "Error checking that type "
495− , indent $ line $ prettyPrintType t1
584+ , indent $ line $ prettyPrintType t1
496− , line "subsumes type"
585+ , line "subsumes type"
497− , indent $ line $ prettyPrintType t2
586+ , indent $ line $ prettyPrintType t2
498− , go err
587+ , go err
499− ]
588+ ]
589+ go (ErrorInInstance name ts err) =
500− go (ErrorInInstance name ts err) = paras [ line $ "Error in type class instance " ++ show name ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
590+ paras [ line $ "Error in type class instance " ++ show name ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
501− , go err
591+ , go err
502− ]
592+ ]
593+ go (ErrorCheckingKind ty err) =
503− go (ErrorCheckingKind ty err) = paras [ line "Error checking kind of type "
594+ paras [ line "Error checking kind of type "
504− , indent $ line $ prettyPrintType ty
595+ , indent $ line $ prettyPrintType ty
505− , go err
596+ , go err
506− ]
597+ ]
598+ go (ErrorInferringType expr err) =
507− go (ErrorInferringType expr err) = paras [ line "Error inferring type of value "
599+ paras [ line "Error inferring type of value "
508− , indent $ line $ prettyPrintValue expr
600+ , indent $ line $ prettyPrintValue expr
509− , go err
601+ , go err
510− ]
602+ ]
603+ go (ErrorCheckingType expr ty err) =
511− go (ErrorCheckingType expr ty err) = paras [ line "Error checking that value "
604+ paras [ line "Error checking that value "
512− , indent $ line $ prettyPrintValue expr
605+ , indent $ line $ prettyPrintValue expr
513− , line "has type"
606+ , line "has type"
514− , indent $ line $ prettyPrintType ty
607+ , indent $ line $ prettyPrintType ty
515− , go err
608+ , go err
516− ]
609+ ]
610+ go (ErrorInApplication f t a err) =
517− go (ErrorInApplication f t a err) = paras [ line "Error applying function"
611+ paras [ line "Error applying function"
518− , indent $ line $ prettyPrintValue f
612+ , indent $ line $ prettyPrintValue f
519− , line "of type"
613+ , line "of type"
520− , indent $ line $ prettyPrintType t
614+ , indent $ line $ prettyPrintType t
521− , line "to argument"
615+ , line "to argument"
522− , indent $ line $ prettyPrintValue a
616+ , indent $ line $ prettyPrintValue a
523− , go err
617+ , go err
524− ]
618+ ]
619+ go (ErrorInDataConstructor nm err) =
525− go (ErrorInDataConstructor nm err) = paras [ line $ "Error in data constructor " ++ show nm ++ ":"
620+ paras [ line $ "Error in data constructor " ++ show nm ++ ":"
526− , go err
621+ , go err
527− ]
622+ ]
623+ go (ErrorInTypeConstructor nm err) =
528− go (ErrorInTypeConstructor nm err) = paras [ line $ "Error in type constructor " ++ show nm ++ ":"
624+ paras [ line $ "Error in type constructor " ++ show nm ++ ":"
529− , go err
625+ , go err
530− ]
626+ ]
627+ go (ErrorInBindingGroup nms err) =
531− go (ErrorInBindingGroup nms err) = paras [ line $ "Error in binding group " ++ intercalate ", " (map show nms) ++ ":"
628+ paras [ line $ "Error in binding group " ++ intercalate ", " (map show nms) ++ ":"
532− , go err
629+ , go err
533− ]
630+ ]
631+ go (ErrorInDataBindingGroup err) =
534− go (ErrorInDataBindingGroup err) = paras [ line $ "Error in data binding group:"
632+ paras [ line $ "Error in data binding group:"
535− , go err
633+ , go err
536− ]
634+ ]
635+ go (ErrorInTypeSynonym name err) =
537− go (ErrorInTypeSynonym name err) = paras [ line $ "Error in type synonym " ++ show name ++ ":"
636+ paras [ line $ "Error in type synonym " ++ show name ++ ":"
538− , go err
637+ , go err
539− ]
638+ ]
639+ go (ErrorInValueDeclaration n err) =
540− go (ErrorInValueDeclaration n err) = paras [ line $ "Error in value declaration " ++ show n ++ ":"
640+ paras [ line $ "Error in value declaration " ++ show n ++ ":"
541− , go err
641+ , go err
542− ]
642+ ]
643+ go (ErrorInForeignImport nm err) =
543− go (ErrorInForeignImport nm err) = paras [ line $ "Error in foreign import " ++ show nm ++ ":"
644+ paras [ line $ "Error in foreign import " ++ show nm ++ ":"
544− , go err
645+ , go err
545− ]
646+ ]
647+ go (PositionedError srcSpan err) =
546− go (PositionedError srcSpan err) = paras [ line $ "Error at " ++ displaySourceSpan srcSpan ++ ":"
648+ paras [ line $ "Error at " ++ displaySourceSpan srcSpan ++ ":"
547− , indent $ go err
649+ , indent $ go err
548− ]
650+ ]
549− go (SimpleErrorWrapper sem) = goSimple sem
651+ go (SimpleErrorWrapper sem) = goSimple sem
550
652
551 line :: String -> Box.Box
653 line :: String -> Box.Box
552 line = Box.text
654 line = Box.text
src/Language/PureScript/Parser/Declarations.hs+3
@@ -128,6 +128,9 @@ parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "imp
128 tys <- P.many (indented *> noWildcards parseTypeAtom)
128 tys <- P.many (indented *> noWildcards parseTypeAtom)
129 return $ ExternInstanceDeclaration name deps className tys)
129 return $ ExternInstanceDeclaration name deps className tys)
130 <|> (do ident <- parseIdent
130 <|> (do ident <- parseIdent
131+ -- TODO: add a wiki page link with migration info
132+ -- TODO: remove this deprecation warning in 0.8
133+ _ <- P.optional $ stringLiteral *> featureWasRemoved "Inline foreign string literals are no longer supported."
131 ty <- indented *> doubleColon *> noWildcards parsePolyType
134 ty <- indented *> doubleColon *> noWildcards parsePolyType
132 return $ ExternDeclaration ident ty))
135 return $ ExternDeclaration ident ty))
133
136
src/Language/PureScript/Parser/JS.hs+3−2
@@ -32,11 +32,12 @@ import qualified Text.Parsec as PS
32
32
33type ForeignJS = String
33type ForeignJS = String
34
34
35−parseForeignModulesFromFiles :: (MonadError MultipleErrors m, Functor m) => [(FilePath, ForeignJS)] -> m (M.Map ModuleName ForeignJS)
35+parseForeignModulesFromFiles :: (MonadError MultipleErrors m, Functor m) => [(FilePath, ForeignJS)] -> m (M.Map ModuleName (FilePath, ForeignJS))
36parseForeignModulesFromFiles files = do
36parseForeignModulesFromFiles files = do
37+ -- TODO: emit MultipleFFIModules error when duplicates are found
37 foreigns <- parU files $ \(path, file) ->
38 foreigns <- parU files $ \(path, file) ->
38 case findModuleName (lines file) of
39 case findModuleName (lines file) of
39− Just name -> return (name, file)
40+ Just name -> return (name, (path, file))
40 Nothing -> throwError (errorMessage $ ErrorParsingFFIModule path)
41 Nothing -> throwError (errorMessage $ ErrorParsingFFIModule path)
41 return $ M.fromList foreigns
42 return $ M.fromList foreigns
42
43