a1168e3 · rowtype-yoga/purescript-native

examples/passing/2138.pursnew file+7

compare with golang

unifiedsplit

@@ -0,0 +1,7 @@

1+module Main where

2+

3+import Control.Monad.Eff.Console (log)

4+

5+import Lib (A(B,C))

6+

7+main = log "Done"

examples/passing/2138/Lib.pursnew file+3

@@ -0,0 +1,3 @@

1+module Lib (A(..), A) where

2+

3+data A = B | C

purescript.cabal+1

@@ -21,6 +21,7 @@ tested-with: GHC==7.10.3

21

22extra-source-files: examples/passing/*.purs

23 , examples/passing/2018/*.purs

24+ , examples/passing/2138/*.purs

24 , examples/passing/ClassRefSyntax/*.purs

25 , examples/passing/ClassRefSyntax/*.purs

25 , examples/passing/DctorOperatorAlias/*.purs

26 , examples/passing/DctorOperatorAlias/*.purs

26 , examples/passing/ExplicitImportReExport/*.purs

27 , examples/passing/ExplicitImportReExport/*.purs

src/Language/PureScript/Errors.hs+1−1

@@ -577,7 +577,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

577 paras [ line $ "Cannot import " ++ printName (Qualified Nothing name) ++ " from module " ++ runModuleName mn

578 , line "It either does not exist or the module does not export it."

579 ]

580− renderSimpleErrorMessage (UnknownImportDataConstructor mn dcon tcon) =

580+ renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =

581 line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon

582 renderSimpleErrorMessage (UnknownExport name) =

583 line $ "Cannot export unknown " ++ printName (Qualified Nothing name)

src/Language/PureScript/Sugar/Names/Env.hs+5−4

@@ -219,9 +219,8 @@ exportType

219exportType exps name dctors mn = do

220 let exTypes = exportedTypes exps

221 let exClasses = exportedTypeClasses exps

222− case name `M.lookup` exTypes of

222+ forM_ (name `M.lookup` exTypes) $ \(_, mn') ->

223− Just (_, mn') | mn /= mn' -> throwConflictError ConflictingTypeDecls name

223+ when (mn /= mn') $ throwConflictError ConflictingTypeDecls name

224− _ -> return ()

225 when (coerceProperName name `M.member` exClasses) $

224 when (coerceProperName name `M.member` exClasses) $

226 throwConflictError TypeConflictsWithClass name

225 throwConflictError TypeConflictsWithClass name

227 forM_ dctors $ \dctor -> do

226 forM_ dctors $ \dctor -> do

@@ -229,9 +228,11 @@ exportType exps name dctors mn = do

229 throwConflictError ConflictingCtorDecls dctor

228 throwConflictError ConflictingCtorDecls dctor

230 when (coerceProperName dctor `M.member` exClasses) $

229 when (coerceProperName dctor `M.member` exClasses) $

231 throwConflictError CtorConflictsWithClass dctor

230 throwConflictError CtorConflictsWithClass dctor

232− return $ exps { exportedTypes = M.insert name (dctors, mn) exTypes }

231+ return $ exps { exportedTypes = M.alter updateOrInsert name exTypes }

233 where

232 where

234 dctorExists dctor (dctors', mn') = mn /= mn' && elem dctor dctors'

233 dctorExists dctor (dctors', mn') = mn /= mn' && elem dctor dctors'

234+ updateOrInsert Nothing = Just (dctors, mn)

235+ updateOrInsert (Just (dctors', _)) = Just (dctors ++ dctors', mn)

235

236

236-- |

237-- |

237-- Safely adds a type operator to some exports, returning an error if a

238-- Safely adds a type operator to some exports, returning an error if a

src/Language/PureScript/Sugar/Names/Exports.hs+15−2

@@ -9,8 +9,9 @@ import Control.Monad

9import Control.Monad.Writer.Class (MonadWriter(..))

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

11

12+import Data.Function (on)

12import Data.Foldable (traverse_)

13import Data.Foldable (traverse_)

13−import Data.List (intersect)

14+import Data.List (intersect, groupBy, sortBy)

14import Data.Maybe (fromMaybe, mapMaybe)

15import Data.Maybe (fromMaybe, mapMaybe)

15import qualified Data.Map as M

16import qualified Data.Map as M

16

17

@@ -224,7 +225,7 @@ filterModule

224 -> [DeclarationRef]

225 -> [DeclarationRef]

225 -> m Exports

226 -> m Exports

226filterModule mn exps refs = do

227filterModule mn exps refs = do

227− types <- foldM filterTypes M.empty refs

228+ types <- foldM filterTypes M.empty (combineTypeRefs refs)

228 typeOps <- foldM (filterExport TyOpName getTypeOpRef exportedTypeOps) M.empty refs

229 typeOps <- foldM (filterExport TyOpName getTypeOpRef exportedTypeOps) M.empty refs

229 classes <- foldM (filterExport TyClassName getTypeClassRef exportedTypeClasses) M.empty refs

230 classes <- foldM (filterExport TyClassName getTypeClassRef exportedTypeClasses) M.empty refs

230 values <- foldM (filterExport IdentName getValueRef exportedValues) M.empty refs

231 values <- foldM (filterExport IdentName getValueRef exportedValues) M.empty refs

@@ -239,6 +240,18 @@ filterModule mn exps refs = do

239

240

240 where

241 where

241

242

243+ -- Takes the list of exported refs, filters out any non-TypeRefs, then

244+ -- combines any duplicate type exports to ensure that all constructors

245+ -- listed for the type are covered. Without this, only the data constructor

246+ -- listing for the last ref would be used.

247+ combineTypeRefs :: [DeclarationRef] -> [DeclarationRef]

248+ combineTypeRefs

249+ = fmap (uncurry TypeRef)

250+ . map (foldr1 $ \(tc, dcs1) (_, dcs2) -> (tc, liftM2 (++) dcs1 dcs2))

251+ . groupBy ((==) `on` fst)

252+ . sortBy (compare `on` fst)

253+ . mapMaybe getTypeRef

254+

242 filterTypes

255 filterTypes

243 :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName)

256 :: M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ModuleName)

244 -> DeclarationRef

257 -> DeclarationRef