Make enum members and union tags to reserve top-level type namespace

CHANGES.md

@@ -11,6 +11,106 @@ To be released.
  -  Union tags became possible to have `default` keyword.  It's useful
     for migrating a record type to a union type.  [[#13], [#227]]
 
+ -  Enum members and union tags became disallowed to shadow an other type name
+    in a module.  It's because in some target languages we compile both types
+    and members/tags into objects that share the same namespace.  In Python,
+    both types and union tags are compiled into classes.
+
+    For example, the following definitions had been allowed, but now became
+    disallowed:
+
+    ~~~~~~~~ nirum
+    unboxed foo (text);
+    //      ^~~
+    enum bar = foo | baz;
+    //         ^~~
+    ~~~~~~~~
+
+    ~~~~~~~~ nirum
+    record foo (text a);
+    //     ^~~
+    union bar = foo (text b) | baz (text c);
+    //          ^~~
+    ~~~~~~~~
+
+    This rule is applied even between a member/tag and its belonging enum/union
+    type as well.  The following definitions are disallowed:
+
+    ~~~~~~~~ nirum
+    enum foo = foo | bar;
+         ^~~   ^~~
+    ~~~~~~~~
+
+    ~~~~~~~~ nirum
+    union bar = foo (text a) | bar (text b);
+          ^~~                  ^~~
+    ~~~~~~~~
+
+    If you already have used the same name for a type and a tag, you can avoid
+    breaking backward compatibility of serialization by specifying a different
+    behind name.  For example, if you've had a definition like:
+
+    ~~~~~~~~ nirum
+    enum foo = foo | bar;
+    //   ^~~   ^~~
+    ~~~~~~~~
+
+    It can be changed like the following:
+
+    ~~~~~~~~ nirum
+    enum foo = foo-renamed/foo | bar;
+    //         ^~~~~~~~~~~ ^~~
+    ~~~~~~~~
+
+ -  Enum members and union tags became disallowed to shadow other enum members
+    and union tags even if they belong to an other type.  It's because in some
+    target language we compile them into objects that share the same namespace,
+    regardless of their belonging type.
+
+    For example, the following definitions had been allowed, but now became
+    disallowed:
+
+    ~~~~~~~~ nirum
+    enum foo = bar | baz;
+    //         ^~~
+    enum qux = quux | bar;
+    //                ^~~
+    ~~~~~~~~
+
+    ~~~~~~~~ nirum
+    union foo = bar (text a) | baz (text b);
+    //          ^~~
+    enum qux = quux | bar;
+    //                ^~~
+    ~~~~~~~~
+
+    ~~~~~~~~ nirum
+    union foo = bar (text a) | baz (text b);
+    //                         ^~~
+    union qux = quux (text c) | baz (text d);
+    //                          ^~~
+    ~~~~~~~~
+
+    If you already have used the same name for members/tags of different
+    enum/union types, you can avoid breaking backward compatibility of
+    serialization by specifying a different behind name.
+    For example, if you've had a definition like:
+
+    ~~~~~~~~ nirum
+    enum foo = bar | baz;
+    //         ^~~
+    union qux = bar (text a) | quux (text b);
+    //          ^~~
+    ~~~~~~~~
+
+    It can be changed like the following:
+
+    ~~~~~~~~ nirum
+    enum foo = bar-renamed/bar | baz;
+    //         ^~~~~~~~~~~ ^~~
+    union qux = bar (text a) | quux (text b);
+    ~~~~~~~~
+
 ### Python target
 
  -  Generated Python packages became to have two [entry points] (a feature

src/Nirum/Constructs/Declaration.hs

@@ -1,12 +1,15 @@
 {-# LANGUAGE DefaultSignatures #-}
-module Nirum.Constructs.Declaration ( Declaration (annotations, name)
+module Nirum.Constructs.Declaration ( Declaration (..)
                                     , Documented (docs, docsBlock)
                                     ) where
 
+import Data.Set (Set, empty)
+
 import Nirum.Constructs (Construct)
 import Nirum.Constructs.Annotation (AnnotationSet, lookupDocs)
 import Nirum.Constructs.Docs (Docs, toBlock)
-import Nirum.Constructs.Name (Name)
+import Nirum.Constructs.Identifier (Identifier)
+import Nirum.Constructs.Name (Name (..))
 import Nirum.Docs (Block)
 
 class Documented a where
@@ -19,7 +22,17 @@ class Documented a where
     docsBlock :: a -> Maybe Block
     docsBlock = fmap toBlock . docs
 
--- Construct which has its own unique 'name' and can has its 'docs'.
+-- | Construct which has its own unique 'name' and can has its 'docs'.
 class (Construct a, Documented a) => Declaration a where
     name :: a -> Name
     annotations :: a -> AnnotationSet
+
+    -- | A set of facial name identifiers that are public (or "exported")
+    -- but not used for name resolution.  (If an identifier should be a key
+    -- for resolution 'name' should return it.)
+    --
+    -- The default implementation simply returns an empty set.
+    --
+    -- Intended to be used for 'Nirum.Constructs.DeclarationSet.DeclarationSet'.
+    extraPublicNames :: a -> Set Identifier
+    extraPublicNames _ = empty

src/Nirum/Constructs/DeclarationSet.hs

@@ -1,4 +1,7 @@
-{-# LANGUAGE OverloadedLists, TypeFamilies #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 module Nirum.Constructs.DeclarationSet ( DeclarationSet ()
                                        , NameDuplication ( BehindNameDuplication
                                                          , FacialNameDuplication
@@ -24,7 +27,7 @@ import Prelude hiding (lookup, null)
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 
-import Nirum.Constructs.Declaration (Declaration (name))
+import Nirum.Constructs.Declaration (Declaration (..))
 import Nirum.Constructs.Identifier (Identifier)
 import Nirum.Constructs.Name (Name (Name, behindName, facialName))
 
@@ -46,28 +49,52 @@ empty = DeclarationSet { declarations = M.empty
                        , index = []
                        }
 
-fromList :: Declaration a => [a] -> Either NameDuplication (DeclarationSet a)
-fromList declarations' =
-    case findDup names facialName S.empty of
-        Just dup -> Left $ FacialNameDuplication dup
-        _ -> case findDup names behindName S.empty of
-            Just dup -> Left $ BehindNameDuplication dup
-            _ -> Right DeclarationSet { declarations = M.fromList mapList
-                                      , index = index'
-                                      }
+fromList :: forall a . Declaration a
+         => [a]
+         -> Either NameDuplication (DeclarationSet a)
+fromList decls =
+    case ( List.find (\ d -> facialName (name d) `S.member` extraPublicNames d)
+                     decls
+         , findDup decls publicNames S.empty
+         , findDup decls (S.singleton . behindName . name) S.empty
+         ) of
+        (Nothing, Nothing, Nothing) ->
+            Right DeclarationSet
+                { declarations = M.fromList mapList
+                , index = index'
+                }
+        (Just dup, _, _) ->
+            Left $ FacialNameDuplication (name dup)
+        (Nothing, Just dup, _) ->
+            Left $ FacialNameDuplication dup
+        (Nothing, Nothing, Just dup) ->
+            Left $ BehindNameDuplication dup
   where
     names :: [Name]
-    names = map name declarations'
+    names = map name decls
     index' :: [Identifier]
     index' = map facialName names
-    mapList = [(facialName (name d), d) | d <- declarations']
-    findDup :: [Name] -> (Name -> Identifier) -> S.Set Identifier -> Maybe Name
-    findDup names' f dups =
-        case names' of
-            x : xs -> let name' = f x
-                      in if name' `S.member` dups
-                         then Just x
-                         else findDup xs f $ S.insert name' dups
+    mapList = [(facialName (name d), d) | d <- decls]
+    publicNames :: a -> S.Set Identifier
+    publicNames decl = facialName (name decl) `S.insert` extraPublicNames decl
+    findDup :: [a]
+            -> (a -> S.Set Identifier)
+            -> S.Set Identifier
+            -> Maybe Name
+    findDup decls' f dups =
+        case decls' of
+            x : xs ->
+                let publicNames' = f x
+                    xName = name x
+                    shadowings = publicNames' `S.intersection` dups
+                in
+                    case S.lookupMin shadowings of
+                        Nothing -> findDup xs f $ S.union publicNames' dups
+                        Just shadowing ->
+                            if facialName xName `S.member` shadowings ||
+                               behindName xName `S.member` shadowings
+                            then Just xName
+                            else Just (Name shadowing shadowing)
             _ -> Nothing
 
 toList :: Declaration a => DeclarationSet a -> [a]

src/Nirum/Constructs/TypeDeclaration.hs

@@ -61,17 +61,18 @@ import Data.Maybe (isJust, maybeToList)
 import Data.String (IsString (fromString))
 
 import qualified Data.Text as T
+import qualified Data.Set as S
 
 import Nirum.Constructs (Construct (toCode))
 import Nirum.Constructs.Annotation as A (AnnotationSet, empty, lookupDocs)
-import Nirum.Constructs.Declaration ( Declaration (annotations, name)
+import Nirum.Constructs.Declaration ( Declaration (..)
                                     , Documented (docs)
                                     )
 import Nirum.Constructs.Docs (Docs (Docs), toCodeWithPrefix)
 import Nirum.Constructs.DeclarationSet as DS
 import Nirum.Constructs.Identifier (Identifier)
 import Nirum.Constructs.ModulePath (ModulePath)
-import Nirum.Constructs.Name (Name (Name))
+import Nirum.Constructs.Name (Name (..))
 import Nirum.Constructs.Service ( Method
                                 , Service (Service)
                                 , methodDocs
@@ -298,6 +299,11 @@ instance Declaration TypeDeclaration where
     name TypeDeclaration { typename = name' } = name'
     name ServiceDeclaration { serviceName = name' } = name'
     name Import { importName = id' } = Name id' id'
+    extraPublicNames TypeDeclaration { type' = EnumType { members = ms } } =
+        S.fromList [facialName mName | EnumMember mName _ <- toList ms]
+    extraPublicNames TypeDeclaration { type' = unionType'@UnionType {} } =
+        S.fromList $ map (facialName . tagName) $ toList $ tags unionType'
+    extraPublicNames _ = S.empty
     annotations TypeDeclaration { typeAnnotations = anno' } = anno'
     annotations ServiceDeclaration { serviceAnnotations = anno' } = anno'
     annotations Import { importAnnotations = anno' } = anno'

test/Nirum/Constructs/DeclarationSetSpec.hs

@@ -2,8 +2,10 @@
 module Nirum.Constructs.DeclarationSetSpec (SampleDecl (..), spec) where
 
 import Control.Exception.Base (evaluate)
+import Data.List (sort)
 import Data.String (IsString (..))
 
+import qualified Data.Set as S
 import Test.Hspec.Meta
 
 import Nirum.Constructs (Construct (..))
@@ -22,6 +24,7 @@ import Nirum.Constructs.DeclarationSet ( DeclarationSet
                                        , union
                                        , (!)
                                        )
+import Nirum.Constructs.Identifier (Identifier)
 import Nirum.Constructs.Name (Name (Name))
 
 data SampleDecl = SampleDecl Name AnnotationSet deriving (Eq, Ord, Show)
@@ -40,6 +43,19 @@ instance IsString SampleDecl where
 
 type SampleDeclSet = DeclarationSet SampleDecl
 
+data SampleDecl2 =
+    SampleDecl2 Name (S.Set Identifier) AnnotationSet deriving (Eq, Ord, Show)
+
+instance Construct SampleDecl2 where
+    toCode _ = "(do not impl)"
+
+instance Documented SampleDecl2
+
+instance Declaration SampleDecl2 where
+    name (SampleDecl2 name' _ _) = name'
+    extraPublicNames (SampleDecl2 _ otherNames _) = otherNames
+    annotations (SampleDecl2 _ _ annotations') = annotations'
+
 spec :: Spec
 spec =
     describe "DeclarationSet" $ do
@@ -64,6 +80,22 @@ spec =
             it "returns Right DeclarationSet if there are no duplications" $ do
                 let Right dset = fl ["foo", "bar", "baz"]
                 toList dset `shouldBe` ["foo", "bar", "baz"]
+            it "checks extraPublicNames as well" $ do
+                let sampleDecl n on = SampleDecl2 n on A.empty
+                let decls =
+                        [ sampleDecl "foo" ["foo-a", "foo-b"]
+                        , sampleDecl (Name "bar" "bar2") ["bar-a", "bar-b"]
+                        ]
+                let Right a = fromList decls
+                sort (toList a) `shouldBe` sort decls
+                fromList (sampleDecl "baz" ["foo"] : decls) `shouldBe`
+                    Left (FacialNameDuplication "foo")
+                fromList (sampleDecl "baz" ["bar"] : decls) `shouldBe`
+                    Left (FacialNameDuplication $ Name "bar" "bar2")
+                fromList (sampleDecl "baz" ["foo-a"] : decls) `shouldBe`
+                    Left (FacialNameDuplication "foo-a")
+                fromList [sampleDecl "foo" ["foo"]] `shouldBe`
+                    Left (FacialNameDuplication "foo")
         let dset = ["foo", "bar", sd "baz" "asdf"] :: SampleDeclSet
         context "toList" $
             it "returns [Declaration]" $ do