6fd459e · rowtype-yoga/purescript-native

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

Fix the duplicate/redefined module error

commit6fd459e61665e004f56b14403b8c5be516649f6d authorGary Burgess <gary.burgess@gmail.com> dateSat 24 Sep 2016, 11:45 (10 years ago) parenta84f7f3

7 files changed+33−32

compare with golang

unifiedsplit

examples/failing/DuplicateModule.purs+2 examples/failing/DuplicateModule/M1.purs+1 purescript.cabal+1 src/Language/PureScript/AST/Declarations.hs+5−2 src/Language/PureScript/Errors.hs+5−8 src/Language/PureScript/Make.hs+13−13 src/Language/PureScript/Sugar/Names.hs+6−9

examples/failing/DuplicateModule.pursnew file+2

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

6060 , examples/failing/ConflictingImports2/*.purs

6161 , examples/failing/ConflictingQualifiedImports/*.purs

6262 , examples/failing/ConflictingQualifiedImports2/*.purs

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

6364 , examples/failing/ExportConflictClass/*.purs

6465 , examples/failing/ExportConflictCtor/*.purs

6566 , examples/failing/ExportConflictType/*.purs

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

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

4747 | MultipleValueOpFixities (OpName 'ValueOpName)

4848 | MultipleTypeOpFixities (OpName 'TypeOpName)

4949 | OrphanTypeDeclaration Ident

50− | RedefinedModule ModuleName [SourceSpan]

5150 | RedefinedIdent Ident

5251 | OverlappingNamesInLet

5352 | UnknownName (Qualified Name)

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

5958 | ScopeShadowing Name (Maybe ModuleName) [ModuleName]

6059 | DeclConflict Name Name

6160 | ExportConflict (Qualified Name) (Qualified Name)

62− | DuplicateModuleName ModuleName

61+ | DuplicateModule ModuleName [SourceSpan]

6362 | DuplicateTypeArgument String

6463 | InvalidDoBind

6564 | InvalidDoLet

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

177176getModuleName :: Module -> ModuleName

178177getModuleName (Module _ _ name _ _) = name

179178

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

180+getModuleSourceSpan :: Module -> SourceSpan

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

182+

180183-- |

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

182185--

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

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

9090 MultipleValueOpFixities{} -> "MultipleValueOpFixities"

9191 MultipleTypeOpFixities{} -> "MultipleTypeOpFixities"

9292 OrphanTypeDeclaration{} -> "OrphanTypeDeclaration"

93− RedefinedModule{} -> "RedefinedModule"

9493 RedefinedIdent{} -> "RedefinedIdent"

9594 OverlappingNamesInLet -> "OverlappingNamesInLet"

9695 UnknownName{} -> "UnknownName"

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

102101 ScopeShadowing{} -> "ScopeShadowing"

103102 DeclConflict{} -> "DeclConflict"

104103 ExportConflict{} -> "ExportConflict"

105− DuplicateModuleName{} -> "DuplicateModuleName"

104+ DuplicateModule{} -> "DuplicateModule"

106105 DuplicateTypeArgument{} -> "DuplicateTypeArgument"

107106 InvalidDoBind -> "InvalidDoBind"

108107 InvalidDoLet -> "InvalidDoLet"

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

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

487486 renderSimpleErrorMessage (OrphanTypeDeclaration nm) =

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

489− renderSimpleErrorMessage (RedefinedModule name filenames) =

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

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

492− ]

493488 renderSimpleErrorMessage (RedefinedIdent name) =

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

495490 renderSimpleErrorMessage (UnknownName name) =

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

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

520515 renderSimpleErrorMessage (ExportConflict new existing) =

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

522− renderSimpleErrorMessage (DuplicateModuleName mn) =

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

517+ renderSimpleErrorMessage (DuplicateModule mn ss) =

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

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

520+ ]

524521 renderSimpleErrorMessage (CycleInDeclaration nm) =

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

526523 renderSimpleErrorMessage (CycleInModules mns) =

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

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

4040import qualified Data.Aeson as Aeson

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

4242import Data.Either (partitionEithers)

43+import Data.Function (on)

4344import Data.Foldable (for_)

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

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

4546import Data.Maybe (fromMaybe, catMaybes)

4647import Data.String (fromString)

4748import Data.Time.Clock

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

191192 where

192193 checkModuleNamesAreUnique :: m ()

193194 checkModuleNamesAreUnique =

194− case findDuplicate (map getModuleName ms) of

195− Nothing -> return ()

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

197−

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

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

200− findDuplicate = go . sort

201− where

202− go (x : y : xs)

203− | x == y = Just x

204− | otherwise = go (y : xs)

205− go _ = Nothing

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

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

197+ let mn = getModuleName (head ms')

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

199+

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

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

202+ findDuplicates f xs =

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

204+ [] -> Nothing

205+ xss -> Just xss

206206

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

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

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

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

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

100100

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

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

103− case mn `M.lookup` env of

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

105− Nothing -> do

106− members <- findExportable m

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

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

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

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

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

103+ members <- findExportable m

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

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

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

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

111108

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

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