f5aa076 · rowtype-yoga/purescript-native

examples/failing/DuplicateModule.pursnew file+2

compare with golang

unifiedsplit

@@ -0,0 +1,2 @@

1+-- @shouldFailWith DuplicateModule

2+module M1 where

examples/failing/DuplicateModule/M1.pursnew file+1

@@ -0,0 +1 @@

1+module M1 where

purescript.cabal+1

@@ -60,6 +60,7 @@ extra-source-files: examples/passing/*.purs

60 , examples/failing/ConflictingImports2/*.purs

61 , examples/failing/ConflictingQualifiedImports/*.purs

62 , examples/failing/ConflictingQualifiedImports2/*.purs

63+ , examples/failing/DuplicateModule/*.purs

63 , examples/failing/ExportConflictClass/*.purs

64 , examples/failing/ExportConflictClass/*.purs

64 , examples/failing/ExportConflictCtor/*.purs

65 , examples/failing/ExportConflictCtor/*.purs

65 , examples/failing/ExportConflictType/*.purs

66 , examples/failing/ExportConflictType/*.purs

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

@@ -47,7 +47,6 @@ data SimpleErrorMessage

47 | MultipleValueOpFixities (OpName 'ValueOpName)

48 | MultipleTypeOpFixities (OpName 'TypeOpName)

49 | OrphanTypeDeclaration Ident

50− | RedefinedModule ModuleName [SourceSpan]

51 | RedefinedIdent Ident

50 | RedefinedIdent Ident

52 | OverlappingNamesInLet

51 | OverlappingNamesInLet

53 | UnknownName (Qualified Name)

52 | UnknownName (Qualified Name)

@@ -59,7 +58,7 @@ data SimpleErrorMessage

59 | ScopeShadowing Name (Maybe ModuleName) [ModuleName]

58 | ScopeShadowing Name (Maybe ModuleName) [ModuleName]

60 | DeclConflict Name Name

59 | DeclConflict Name Name

61 | ExportConflict (Qualified Name) (Qualified Name)

60 | ExportConflict (Qualified Name) (Qualified Name)

62− | DuplicateModuleName ModuleName

61+ | DuplicateModule ModuleName [SourceSpan]

63 | DuplicateTypeArgument String

62 | DuplicateTypeArgument String

64 | InvalidDoBind

63 | InvalidDoBind

65 | InvalidDoLet

64 | InvalidDoLet

@@ -179,6 +178,10 @@ data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [Decla

179getModuleName :: Module -> ModuleName

178getModuleName :: Module -> ModuleName

180getModuleName (Module _ _ name _ _) = name

179getModuleName (Module _ _ name _ _) = name

181

180

181+-- | Return a module's source span.

182+getModuleSourceSpan :: Module -> SourceSpan

183+getModuleSourceSpan (Module ss _ _ _ _) = ss

184+

182-- |

185-- |

183-- Add an import declaration for a module if it does not already explicitly import it.

186-- Add an import declaration for a module if it does not already explicitly import it.

184--

187--

src/Language/PureScript/Errors.hs+5−8

@@ -90,7 +90,6 @@ errorCode em = case unwrapErrorMessage em of

90 MultipleValueOpFixities{} -> "MultipleValueOpFixities"

91 MultipleTypeOpFixities{} -> "MultipleTypeOpFixities"

92 OrphanTypeDeclaration{} -> "OrphanTypeDeclaration"

93− RedefinedModule{} -> "RedefinedModule"

94 RedefinedIdent{} -> "RedefinedIdent"

93 RedefinedIdent{} -> "RedefinedIdent"

95 OverlappingNamesInLet -> "OverlappingNamesInLet"

94 OverlappingNamesInLet -> "OverlappingNamesInLet"

96 UnknownName{} -> "UnknownName"

95 UnknownName{} -> "UnknownName"

@@ -102,7 +101,7 @@ errorCode em = case unwrapErrorMessage em of

102 ScopeShadowing{} -> "ScopeShadowing"

101 ScopeShadowing{} -> "ScopeShadowing"

103 DeclConflict{} -> "DeclConflict"

102 DeclConflict{} -> "DeclConflict"

104 ExportConflict{} -> "ExportConflict"

103 ExportConflict{} -> "ExportConflict"

105− DuplicateModuleName{} -> "DuplicateModuleName"

104+ DuplicateModule{} -> "DuplicateModule"

106 DuplicateTypeArgument{} -> "DuplicateTypeArgument"

105 DuplicateTypeArgument{} -> "DuplicateTypeArgument"

107 InvalidDoBind -> "InvalidDoBind"

106 InvalidDoBind -> "InvalidDoBind"

108 InvalidDoLet -> "InvalidDoLet"

107 InvalidDoLet -> "InvalidDoLet"

@@ -488,10 +487,6 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

488 line $ "There are multiple fixity/precedence declarations for type operator " ++ markCode (showOp op)

487 line $ "There are multiple fixity/precedence declarations for type operator " ++ markCode (showOp op)

489 renderSimpleErrorMessage (OrphanTypeDeclaration nm) =

488 renderSimpleErrorMessage (OrphanTypeDeclaration nm) =

490 line $ "The type declaration for " ++ markCode (showIdent nm) ++ " should be followed by its definition."

489 line $ "The type declaration for " ++ markCode (showIdent nm) ++ " should be followed by its definition."

491− renderSimpleErrorMessage (RedefinedModule name filenames) =

492− paras [ line ("The module " ++ markCode (runModuleName name) ++ " has been defined multiple times:")

493− , indent . paras $ map (line . displaySourceSpan) filenames

494− ]

495 renderSimpleErrorMessage (RedefinedIdent name) =

490 renderSimpleErrorMessage (RedefinedIdent name) =

496 line $ "The value " ++ markCode (showIdent name) ++ " has been defined multiple times"

491 line $ "The value " ++ markCode (showIdent name) ++ " has been defined multiple times"

497 renderSimpleErrorMessage (UnknownName name) =

492 renderSimpleErrorMessage (UnknownName name) =

@@ -521,8 +516,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

521 line $ "Declaration for " ++ printName (Qualified Nothing new) ++ " conflicts with an existing " ++ nameType existing ++ " of the same name."

516 line $ "Declaration for " ++ printName (Qualified Nothing new) ++ " conflicts with an existing " ++ nameType existing ++ " of the same name."

522 renderSimpleErrorMessage (ExportConflict new existing) =

517 renderSimpleErrorMessage (ExportConflict new existing) =

523 line $ "Export for " ++ printName new ++ " conflicts with " ++ runName existing

518 line $ "Export for " ++ printName new ++ " conflicts with " ++ runName existing

524− renderSimpleErrorMessage (DuplicateModuleName mn) =

519+ renderSimpleErrorMessage (DuplicateModule mn ss) =

525− line $ "Module " ++ markCode (runModuleName mn) ++ " has been defined multiple times."

520+ paras [ line ("Module " ++ markCode (runModuleName mn) ++ " has been defined multiple times:")

521+ , indent . paras $ map (line . displaySourceSpan) ss

522+ ]

526 renderSimpleErrorMessage (CycleInDeclaration nm) =

523 renderSimpleErrorMessage (CycleInDeclaration nm) =

527 line $ "The value of " ++ markCode (showIdent nm) ++ " is undefined here, so this reference is not allowed."

524 line $ "The value of " ++ markCode (showIdent nm) ++ " is undefined here, so this reference is not allowed."

528 renderSimpleErrorMessage (CycleInModules mns) =

525 renderSimpleErrorMessage (CycleInModules mns) =

src/Language/PureScript/Make.hs+13−13

@@ -40,8 +40,9 @@ import Data.Aeson (encode, decode)

40import qualified Data.Aeson as Aeson

41import Data.ByteString.Builder (toLazyByteString, stringUtf8)

42import Data.Either (partitionEithers)

43+import Data.Function (on)

43import Data.Foldable (for_)

44import Data.Foldable (for_)

44−import Data.List (foldl', sort)

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

45import Data.Maybe (fromMaybe, catMaybes)

46import Data.Maybe (fromMaybe, catMaybes)

46import Data.String (fromString)

47import Data.String (fromString)

47import Data.Time.Clock

48import Data.Time.Clock

@@ -191,18 +192,17 @@ make ma@MakeActions{..} ms = do

191 where

192 where

192 checkModuleNamesAreUnique :: m ()

193 checkModuleNamesAreUnique :: m ()

193 checkModuleNamesAreUnique =

194 checkModuleNamesAreUnique =

194− case findDuplicate (map getModuleName ms) of

195+ for_ (findDuplicates getModuleName ms) $ \mss ->

195− Nothing -> return ()

196+ throwError . flip foldMap mss $ \ms' ->

196− Just mn -> throwError . errorMessage $ DuplicateModuleName mn

197+ let mn = getModuleName (head ms')

197−

198+ in errorMessage $ DuplicateModule mn (map getModuleSourceSpan ms')

198− -- Verify that a list of values has unique keys

199+

199− findDuplicate :: (Ord a) => [a] -> Maybe a

200+ -- Find all groups of duplicate values in a list based on a projection.

200− findDuplicate = go . sort

201+ findDuplicates :: Ord b => (a -> b) -> [a] -> Maybe [[a]]

201− where

202+ findDuplicates f xs =

202− go (x : y : xs)

203+ case filter ((> 1) . length) . groupBy ((==) `on` f) . sortBy (compare `on` f) $ xs of

203− | x == y = Just x

204− | otherwise = go (y : xs)

205− go _ = Nothing

204+ [] -> Nothing

205+ xss -> Just xss

206

207 -- Sort a list so its elements appear in the same order as in another list.

208 inOrderOf :: (Ord a) => [a] -> [a] -> [a]

src/Language/PureScript/Sugar/Names.hs+6−9

@@ -99,15 +99,12 @@ desugarImportsWithEnv externs modules = do

99 exportedRefs f = M.fromList $ (, efModuleName) <$> mapMaybe f efExports

100

101 updateEnv :: ([Module], Env) -> Module -> m ([Module], Env)

102− updateEnv (ms, env) m@(Module ss _ mn _ refs) =

102+ updateEnv (ms, env) m@(Module ss _ mn _ refs) = do

103− case mn `M.lookup` env of

104− Just m' -> throwError . errorMessage $ RedefinedModule mn [envModuleSourceSpan m', ss]

105− Nothing -> do

106− members <- findExportable m

103+ members <- findExportable m

107− let env' = M.insert mn (ss, primImports, members) env

104+ let env' = M.insert mn (ss, primImports, members) env

108− (m', imps) <- resolveImports env' m

105+ (m', imps) <- resolveImports env' m

109− exps <- maybe (return members) (resolveExports env' ss mn imps members) refs

106+ exps <- maybe (return members) (resolveExports env' ss mn imps members) refs

110− return (m' : ms, M.insert mn (ss, imps, exps) env)

107+ return (m' : ms, M.insert mn (ss, imps, exps) env)

111

108

112 renameInModule' :: Env -> Module -> m Module

109 renameInModule' :: Env -> Module -> m Module

113 renameInModule' env m@(Module _ _ mn _ _) =

110 renameInModule' env m@(Module _ _ mn _ _) =