From 917a21cd7a5a64c4b57dc0881087a26984bd41f1 Mon Sep 17 00:00:00 2001
From: nellaG <seirios0107@gmail.com>
Date: Sat, 10 Feb 2018 22:22:32 +0900
Subject: [PATCH 01/14] add delete function to DeclarationSet

---
 src/Nirum/Constructs/DeclarationSet.hs      | 15 +++++++++++++++
 test/Nirum/Constructs/DeclarationSetSpec.hs |  3 +++
 2 files changed, 18 insertions(+)

diff --git a/src/Nirum/Constructs/DeclarationSet.hs b/src/Nirum/Constructs/DeclarationSet.hs
index cfee515..96115e0 100644
--- a/src/Nirum/Constructs/DeclarationSet.hs
+++ b/src/Nirum/Constructs/DeclarationSet.hs
@@ -3,6 +3,7 @@ module Nirum.Constructs.DeclarationSet ( DeclarationSet ()
                                        , NameDuplication ( BehindNameDuplication
                                                          , FacialNameDuplication
                                                          )
+                                       , delete
                                        , empty
                                        , fromList
                                        , lookup
@@ -15,6 +16,7 @@ module Nirum.Constructs.DeclarationSet ( DeclarationSet ()
                                        , (!)
                                        ) where
 
+import qualified Data.List as List
 import Data.Maybe (fromJust)
 import qualified GHC.Exts as L
 import Prelude hiding (lookup, null)
@@ -97,6 +99,19 @@ union :: Declaration a
       -> Either NameDuplication (DeclarationSet a)
 union a b = fromList $ toList a ++ toList b
 
+delete :: Declaration a
+       => a
+       -> DeclarationSet a
+       -> DeclarationSet a
+delete d DeclarationSet { declarations = ds, index = ix } =
+    DeclarationSet
+        { declarations = M.delete identifier ds
+        , index = List.delete identifier ix
+        }
+  where
+    identifier :: Identifier
+    identifier = facialName $ name d
+
 instance (Declaration a) => L.IsList (DeclarationSet a) where
     type Item (DeclarationSet a) = a
     fromList declarations' =
diff --git a/test/Nirum/Constructs/DeclarationSetSpec.hs b/test/Nirum/Constructs/DeclarationSetSpec.hs
index e7a88c4..84eef7a 100644
--- a/test/Nirum/Constructs/DeclarationSetSpec.hs
+++ b/test/Nirum/Constructs/DeclarationSetSpec.hs
@@ -12,6 +12,7 @@ import Nirum.Constructs.Annotation (AnnotationSet)
 import Nirum.Constructs.Declaration (Declaration (..), Documented)
 import Nirum.Constructs.DeclarationSet ( DeclarationSet
                                        , NameDuplication (..)
+                                       , delete
                                        , empty
                                        , fromList
                                        , lookup'
@@ -102,3 +103,5 @@ spec =
             it "returns Left BehindNameDuplication if behind names are dup" $
                 union dset [sd "xyz" "foo"] `shouldBe`
                     Left (BehindNameDuplication $ Name "xyz" "foo")
+        specify "delete" $
+            delete "bar" dset `shouldBe` ["foo", sd "baz" "asdf"]

From 9f522be625be51d668fb13e1e6a73d8a76f3a3b0 Mon Sep 17 00:00:00 2001
From: nellaG <seirios0107@gmail.com>
Date: Sat, 10 Feb 2018 22:23:06 +0900
Subject: [PATCH 02/14] Optional default tag for union types

---
 examples/shapes.nrm                          |  2 +-
 src/Nirum/Constructs/TypeDeclaration.hs      | 16 ++++++---
 src/Nirum/Parser.hs                          | 22 +++++++++---
 src/Nirum/Targets/Docs.hs                    |  2 +-
 src/Nirum/Targets/Python.hs                  | 36 ++++++++++++--------
 test/Nirum/Constructs/TypeDeclarationSpec.hs |  2 +-
 test/Nirum/ParserSpec.hs                     | 19 ++++++++++-
 test/nirum_fixture/fixture/foo.nrm           |  2 +-
 test/python/primitive_test.py                |  9 +++++
 9 files changed, 82 insertions(+), 28 deletions(-)

diff --git a/examples/shapes.nrm b/examples/shapes.nrm
index dacbe52..9d4197f 100644
--- a/examples/shapes.nrm
+++ b/examples/shapes.nrm
@@ -32,7 +32,7 @@ record point (
 union shape
     # Type constructors in a sum type become translated to subtypes in OO
     # languages, and datatypes in functional languages.
-    = rectangle (
+    = default rectangle (
           # Each tag can have zero or more fields like record types.
           point upper-left,
           point lower-right
diff --git a/src/Nirum/Constructs/TypeDeclaration.hs b/src/Nirum/Constructs/TypeDeclaration.hs
index a610877..c45b4c7 100644
--- a/src/Nirum/Constructs/TypeDeclaration.hs
+++ b/src/Nirum/Constructs/TypeDeclaration.hs
@@ -34,6 +34,7 @@ module Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
                                                , UnboxedType
                                                , UnionType
                                                , canonicalType
+                                               , defaultTag
                                                , fields
                                                , innerType
                                                , jsonType
@@ -55,7 +56,7 @@ module Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
                                                           )
                                         ) where
 
-import Data.Maybe (isJust)
+import Data.Maybe (isJust, maybeToList)
 import Data.String (IsString (fromString))
 
 import qualified Data.Text as T
@@ -81,7 +82,9 @@ data Type
     | UnboxedType { innerType :: TypeExpression }
     | EnumType { members :: DeclarationSet EnumMember }
     | RecordType { fields :: DeclarationSet Field }
-    | UnionType { tags :: DeclarationSet Tag }
+    | UnionType { tags :: DeclarationSet Tag
+                , defaultTag :: Maybe Tag
+                }
     | PrimitiveType { primitiveTypeIdentifier :: PrimitiveTypeIdentifier
                     , jsonType :: JsonType
                     }
@@ -204,7 +207,7 @@ instance Construct TypeDeclaration where
       where
         fieldsCode = T.intercalate "\n" $ map toCode $ toList fields'
         docs' = A.lookupDocs annotationSet'
-    toCode (TypeDeclaration name' (UnionType tags') annotationSet') =
+    toCode (TypeDeclaration name' (UnionType tags' defaultTag') annotationSet') =
         T.concat [ toCode annotationSet'
                  , "union ", nameCode
                  , toCodeWithPrefix "\n    " (A.lookupDocs annotationSet')
@@ -216,8 +219,11 @@ instance Construct TypeDeclaration where
         nameCode = toCode name'
         tagsCode :: T.Text
         tagsCode = T.intercalate "\n    | "
-                                 [ T.replace "\n" "\n    " (toCode t)
-                                 | t <- toList tags'
+                                 [ T.replace "\n" "\n    " $
+                                             if defaultTag' == Just t
+                                             then T.append "default " (toCode t)
+                                             else toCode t
+                                 | t <- maybeToList defaultTag' ++ toList tags'
                                  ]
     toCode (TypeDeclaration name'
                             (PrimitiveType typename' jsonType')
diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs
index bc1378a..ee1340e 100644
--- a/src/Nirum/Parser.hs
+++ b/src/Nirum/Parser.hs
@@ -34,6 +34,7 @@ module Nirum.Parser ( Parser
 import Control.Monad (void)
 import qualified System.IO as SIO
 
+import qualified Data.List as L
 import Data.Map.Strict as Map hiding (foldl)
 import Data.Set hiding (empty, foldl, fromList, map)
 import qualified Data.Text as T
@@ -407,10 +408,12 @@ recordTypeDeclaration = do
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
     return $ TypeDeclaration typename (RecordType fields') annotationSet''
 
-tag :: Parser Tag
+tag :: Parser (Tag, Bool)
 tag = do
     annotationSet' <- annotationSet <?> "union tag annotations"
     spaces
+    default' <- optional (string "default" <?> "default tag")
+    spaces
     tagName <- name <?> "union tag name"
     spaces
     paren <- optional $ char '('
@@ -435,7 +438,11 @@ tag = do
             spaces
             return d
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
-    return $ Tag tagName fields' annotationSet''
+    return ( Tag tagName fields' annotationSet''
+           , case default' of
+                 Just _ -> True
+                 Nothing -> False
+           )
 
 unionTypeDeclaration :: Parser TypeDeclaration
 unionTypeDeclaration = do
@@ -452,11 +459,18 @@ unionTypeDeclaration = do
     spaces
     tags' <- (tag `sepBy1` try (spaces >> char '|' >> spaces))
              <?> "union tags"
+    let tags'' = [t | (t, _) <- tags']
+    let defaultTag = do
+            (t''', _) <- L.find snd tags'
+            return t'''
     spaces
     char ';'
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
-    handleNameDuplication "tag" tags' $ \ tagSet ->
-        return $ TypeDeclaration typename (UnionType tagSet) annotationSet''
+    handleNameDuplication "tag" tags'' $ \ tagSet -> do
+        let remainTagSet = case defaultTag of
+                               Just t -> DeclarationSet.delete t tagSet
+                               Nothing -> tagSet
+        return $ TypeDeclaration typename (UnionType remainTagSet defaultTag) annotationSet''
 
 typeDeclaration :: Parser TypeDeclaration
 typeDeclaration = do
diff --git a/src/Nirum/Targets/Docs.hs b/src/Nirum/Targets/Docs.hs
index 7e6b320..338d761 100644
--- a/src/Nirum/Targets/Docs.hs
+++ b/src/Nirum/Targets/Docs.hs
@@ -182,7 +182,7 @@ typeDecl mod' ident
                 <dd>#{blockToHtml d}
 |]
 typeDecl mod' ident
-         tc@TD.TypeDeclaration { TD.type' = TD.UnionType tags } = [shamlet|
+         tc@TD.TypeDeclaration { TD.type' = TD.UnionType tags _} = [shamlet|
     <h2>union <code>#{toNormalizedText ident}</code>
     $maybe d <- docsBlock tc
         #{blockToHtml d}
diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs
index c982e53..1fe00a0 100644
--- a/src/Nirum/Targets/Python.hs
+++ b/src/Nirum/Targets/Python.hs
@@ -49,7 +49,7 @@ module Nirum.Targets.Python ( Code
 import Control.Monad (forM)
 import qualified Control.Monad.State as ST
 import qualified Data.List as L
-import Data.Maybe (catMaybes, fromMaybe)
+import Data.Maybe (catMaybes, fromMaybe, maybeToList)
 import Data.Typeable (Typeable)
 import GHC.Exts (IsList (toList))
 import Text.Printf (printf)
@@ -95,7 +95,7 @@ import Nirum.Constructs.Service ( Method ( Method
 import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
                                         , Field (Field, fieldName)
                                         , PrimitiveTypeIdentifier (..)
-                                        , Tag (Tag)
+                                        , Tag (Tag, tagName)
                                         , Type ( Alias
                                                , EnumType
                                                , PrimitiveType
@@ -1009,14 +1009,13 @@ class $className(object):
         ]
 compileTypeDeclaration src
                        d@TypeDeclaration { typename = typename'
-                                         , type' = UnionType tags
+                                         , type' = UnionType tags defaultTag
                                          , typeAnnotations = annotations
                                          } = do
-    tagCodes <- mapM (compileUnionTag src typename') $ toList tags
-    let className = toClassName' typename'
-        tagCodes' = T.intercalate "\n\n" tagCodes
-        tagClasses = T.intercalate ", " [ toClassName' tagName
-                                        | Tag tagName _ _ <- toList tags
+    tagCodes <- mapM (compileUnionTag src typename') $ toList tags ++ maybeToList defaultTag
+    let tagCodes' = T.intercalate "\n\n" tagCodes
+        tagClasses = T.intercalate ", " [ toClassName' tagName'
+                                        | Tag tagName' _ _ <- toList tags ++ maybeToList defaultTag
                                         ]
         enumMembers = toIndentedCodes
             (\ (t, b) -> [qq|$t = '{b}'|]) enumMembers' "\n        "
@@ -1035,6 +1034,9 @@ compileTypeDeclaration src
     typeRepr <- typeReprCompiler
     ret <- returnCompiler
     arg <- parameterCompiler
+    let defaultTagBehindName = case defaultTag of
+            Just dt -> stringLiteral $ I.toSnakeCaseText $ N.behindName $ tagName dt
+            Nothing -> "None"
     return [qq|
 class $className({T.intercalate "," $ compileExtendClasses annotations}):
 {compileDocstring "    " d}
@@ -1042,6 +1044,7 @@ class $className({T.intercalate "," $ compileExtendClasses annotations}):
     __nirum_type__ = 'union'
     __nirum_union_behind_name__ = '{I.toSnakeCaseText $ N.behindName typename'}'
     __nirum_field_names__ = name_dict_type([$nameMaps])
+    __nirum_default_tag_behind_name__ = {defaultTagBehindName}
 
     class Tag(enum.Enum):
         $enumMembers
@@ -1064,6 +1067,10 @@ class $className({T.intercalate "," $ compileExtendClasses annotations}):
     def __nirum_deserialize__(
         {arg "cls" "type"}, value
     ){ ret className }:
+        if ($className.__nirum_default_tag_behind_name__ is not None and
+            isinstance(value, dict) and '_tag' not in value):
+            value = dict(value)
+            value['_tag'] = $className.__nirum_default_tag_behind_name__
         if '_type' not in value:
             raise ValueError('"_type" field is missing.')
         if '_tag' not in value:
@@ -1114,7 +1121,6 @@ class $className({T.intercalate "," $ compileExtendClasses annotations}):
             raise ValueError('\\n'.join(sorted(errors)))
         return cls(**args)
 
-
 $tagCodes'
 
 $className.__nirum_tag_classes__ = map_type(
@@ -1123,16 +1129,18 @@ $className.__nirum_tag_classes__ = map_type(
 )
             |]
   where
+    className :: T.Text
+    className = toClassName' typename'
     enumMembers' :: [(T.Text, T.Text)]
-    enumMembers' = [ ( toEnumMemberName tagName
-                     , I.toSnakeCaseText $ N.behindName tagName
+    enumMembers' = [ ( toEnumMemberName tagName'
+                     , I.toSnakeCaseText $ N.behindName tagName'
                      )
-                   | (Tag tagName _ _) <- toList tags
+                   | (Tag tagName' _ _) <- toList tags ++ maybeToList defaultTag
                    ]
     nameMaps :: T.Text
     nameMaps = toIndentedCodes
         toNamePair
-        [name' | Tag name' _ _ <- toList tags]
+        [name' | Tag name' _ _ <- toList tags ++ maybeToList defaultTag]
         ",\n        "
     compileExtendClasses :: A.AnnotationSet -> [Code]
     compileExtendClasses annotations' =
@@ -1185,7 +1193,7 @@ class $className(service_type):
         $methodNameMap
     ])
     __nirum_method_annotations__ = $methodAnnotations'
-
+    __valerie__ = True
     @staticmethod
     def __nirum_method_error_types__(k, d=None):
         return dict([
diff --git a/test/Nirum/Constructs/TypeDeclarationSpec.hs b/test/Nirum/Constructs/TypeDeclarationSpec.hs
index d3dbee8..a2fd913 100644
--- a/test/Nirum/Constructs/TypeDeclarationSpec.hs
+++ b/test/Nirum/Constructs/TypeDeclarationSpec.hs
@@ -127,7 +127,7 @@ record person (
                         , Tag "rectangle" rectangleFields empty
                         , Tag "none" [] empty
                         ]
-                union' = UnionType tags'
+                union' = UnionType tags' Nothing
                 a = TypeDeclaration { typename = "shape"
                                     , type' = union'
                                     , typeAnnotations = empty
diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs
index 83ca3ad..313a05d 100644
--- a/test/Nirum/ParserSpec.hs
+++ b/test/Nirum/ParserSpec.hs
@@ -656,6 +656,23 @@ record dup (
 
     descTypeDecl "unionTypeDeclaration" P.unionTypeDeclaration $ \ helpers -> do
         let (parse', expectError) = helpers
+        it "has defaultTag" $ do
+            let cOriginF = Field "origin" "point" empty
+                cRadiusF = Field "radius" "offset" empty
+                circleFields = [cOriginF, cRadiusF]
+                rUpperLeftF = Field "upper-left" "point" empty
+                rLowerRightF = Field "lower-right" "point" empty
+                rectangleFields = [rUpperLeftF, rLowerRightF]
+                circleTag = Tag "circle" circleFields empty
+                rectTag = Tag "rectangle" rectangleFields empty
+                tags' = [circleTag]
+                union' = UnionType tags' $ Just rectTag
+                a = TypeDeclaration "shape" union' empty
+            parse' [s|
+union shape
+    = circle (point origin, offset radius,)
+    | default rectangle (point upper-left, point lower-right,)
+    ;|] `shouldBeRight` a
         it "emits (TypeDeclaration (UnionType ...)) if succeeded to parse" $ do
             let cOriginF = Field "origin" "point" empty
                 cRadiusF = Field "radius" "offset" empty
@@ -667,7 +684,7 @@ record dup (
                 rectTag = Tag "rectangle" rectangleFields empty
                 noneTag = Tag "none" [] empty
                 tags' = [circleTag, rectTag, noneTag]
-                union' = UnionType tags'
+                union' = UnionType tags' Nothing
                 a = TypeDeclaration "shape" union' empty
                 b = a { typeAnnotations = singleDocs "shape type" }
             parse' [s|
diff --git a/test/nirum_fixture/fixture/foo.nrm b/test/nirum_fixture/fixture/foo.nrm
index a673869..b7bfbeb 100644
--- a/test/nirum_fixture/fixture/foo.nrm
+++ b/test/nirum_fixture/fixture/foo.nrm
@@ -59,7 +59,7 @@ union mixed-name = western-name ( text first-name
                  | east-asian-name ( text family-name
                                    , text given-name
                                    )
-                 | culture-agnostic-name (text fullname)
+                 | default culture-agnostic-name (text fullname)
                  ;
 union music
     # Union docs.
diff --git a/test/python/primitive_test.py b/test/python/primitive_test.py
index ac1cb8e..65aeda5 100644
--- a/test/python/primitive_test.py
+++ b/test/python/primitive_test.py
@@ -278,6 +278,15 @@ def test_union():
 '''
 
 
+def test_union_default_tag():
+    n = CultureAgnosticName(fullname=u'foobar')
+    serialized = n.__nirum_serialize__()
+    print(serialized)
+    del serialized['_tag']
+    n2 = MixedName.__nirum_deserialize__(serialized)
+    assert n2 == n
+
+
 def test_union_with_special_case():
     kr_pop = Pop(country=u'KR')
     assert kr_pop.country == u'KR'

From 156a307d3a69abdcfe24518d7843d9a6816edddb Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Sun, 11 Feb 2018 00:23:27 +0900
Subject: [PATCH 03/14] Gather all tags from Union using findTags

---
 src/Nirum/Targets/Python.hs | 26 +++++++++++++++++---------
 1 file changed, 17 insertions(+), 9 deletions(-)

diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs
index 1fe00a0..9c88b94 100644
--- a/src/Nirum/Targets/Python.hs
+++ b/src/Nirum/Targets/Python.hs
@@ -102,6 +102,7 @@ import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
                                                , RecordType
                                                , UnboxedType
                                                , UnionType
+                                               , defaultTag
                                                , primitiveTypeIdentifier
                                                )
                                         , TypeDeclaration (..)
@@ -178,6 +179,11 @@ data CodeGenContext
                      }
     deriving (Eq, Ord, Show)
 
+findTags :: Type -> [Tag]
+findTags t = case t of
+    (UnionType tags' d) -> toList tags' ++ maybeToList d
+    _ -> []
+
 localImportsMap :: CodeGenContext -> M.Map T.Text (M.Map T.Text T.Text)
 localImportsMap CodeGenContext { localImports = imports } =
     M.map (M.fromSet id) imports
@@ -1009,13 +1015,13 @@ class $className(object):
         ]
 compileTypeDeclaration src
                        d@TypeDeclaration { typename = typename'
-                                         , type' = UnionType tags defaultTag
+                                         , type' = u
                                          , typeAnnotations = annotations
                                          } = do
-    tagCodes <- mapM (compileUnionTag src typename') $ toList tags ++ maybeToList defaultTag
+    tagCodes <- mapM (compileUnionTag src typename') tags
     let tagCodes' = T.intercalate "\n\n" tagCodes
         tagClasses = T.intercalate ", " [ toClassName' tagName'
-                                        | Tag tagName' _ _ <- toList tags ++ maybeToList defaultTag
+                                        | Tag tagName' _ _ <- tags
                                         ]
         enumMembers = toIndentedCodes
             (\ (t, b) -> [qq|$t = '{b}'|]) enumMembers' "\n        "
@@ -1034,15 +1040,15 @@ compileTypeDeclaration src
     typeRepr <- typeReprCompiler
     ret <- returnCompiler
     arg <- parameterCompiler
-    let defaultTagBehindName = case defaultTag of
-            Just dt -> stringLiteral $ I.toSnakeCaseText $ N.behindName $ tagName dt
+    let defaultTagBehindName = case defaultTag u of
+            Just dt -> toBehindStringLiteral $ tagName dt
             Nothing -> "None"
     return [qq|
 class $className({T.intercalate "," $ compileExtendClasses annotations}):
 {compileDocstring "    " d}
 
     __nirum_type__ = 'union'
-    __nirum_union_behind_name__ = '{I.toSnakeCaseText $ N.behindName typename'}'
+    __nirum_union_behind_name__ = {toBehindStringLiteral typename'}
     __nirum_field_names__ = name_dict_type([$nameMaps])
     __nirum_default_tag_behind_name__ = {defaultTagBehindName}
 
@@ -1129,18 +1135,20 @@ $className.__nirum_tag_classes__ = map_type(
 )
             |]
   where
+    tags :: [Tag]
+    tags = findTags u
     className :: T.Text
     className = toClassName' typename'
     enumMembers' :: [(T.Text, T.Text)]
     enumMembers' = [ ( toEnumMemberName tagName'
                      , I.toSnakeCaseText $ N.behindName tagName'
                      )
-                   | (Tag tagName' _ _) <- toList tags ++ maybeToList defaultTag
+                   | (Tag tagName' _ _) <- tags
                    ]
     nameMaps :: T.Text
     nameMaps = toIndentedCodes
         toNamePair
-        [name' | Tag name' _ _ <- toList tags ++ maybeToList defaultTag]
+        [name' | Tag name' _ _ <- tags]
         ",\n        "
     compileExtendClasses :: A.AnnotationSet -> [Code]
     compileExtendClasses annotations' =
@@ -1193,7 +1201,7 @@ class $className(service_type):
         $methodNameMap
     ])
     __nirum_method_annotations__ = $methodAnnotations'
-    __valerie__ = True
+
     @staticmethod
     def __nirum_method_error_types__(k, d=None):
         return dict([

From 5deb9b9b0ac95ec91738a25c63ab7ba4af41a217 Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Sun, 11 Feb 2018 15:29:46 +0900
Subject: [PATCH 04/14] Remind default has to be added reservedKeywords

---
 src/Nirum/Parser.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs
index ee1340e..2d179a5 100644
--- a/src/Nirum/Parser.hs
+++ b/src/Nirum/Parser.hs
@@ -412,6 +412,9 @@ tag :: Parser (Tag, Bool)
 tag = do
     annotationSet' <- annotationSet <?> "union tag annotations"
     spaces
+    -- CHECK: If a new reserved keyword is introduced, it has to be also
+    -- added to `reservedKeywords` set in the `Nirum.Constructs.Identifier`
+    -- module.
     default' <- optional (string "default" <?> "default tag")
     spaces
     tagName <- name <?> "union tag name"

From 9948fa71ad3379d3b63add47263cc0fc0cd9125c Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Sun, 11 Feb 2018 16:57:17 +0900
Subject: [PATCH 05/14] Using heterocephalus on UnionType

---
 src/Nirum/Targets/Python.hs | 90 ++++++++++++++++++-------------------
 1 file changed, 45 insertions(+), 45 deletions(-)

diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs
index 9c88b94..5772824 100644
--- a/src/Nirum/Targets/Python.hs
+++ b/src/Nirum/Targets/Python.hs
@@ -63,6 +63,7 @@ import Data.Text.Lazy (toStrict)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Function (on)
 import System.FilePath (joinPath)
+import qualified Text.Blaze.Internal as BI
 import Text.Blaze.Renderer.Text
 import qualified Text.Email.Validate as E
 import Text.Heterocephalus (compileText)
@@ -206,6 +207,9 @@ runCodeGen :: CodeGen a
            -> (Either CompileError' a, CodeGenContext)
 runCodeGen = C.runCodeGen
 
+renderCompileText :: BI.Markup -> T.Text
+renderCompileText = toStrict . renderMarkup
+
 insertStandardImport :: T.Text -> CodeGen ()
 insertStandardImport module' = ST.modify insert'
   where
@@ -732,7 +736,7 @@ compileTypeDeclaration src d@TypeDeclaration { typename = typename'
                                              , type' = Alias ctype
                                              } = do
     ctypeExpr <- compileTypeExpression src (Just ctype)
-    return $ toStrict $ renderMarkup [compileText|
+    return $ renderCompileText $ [compileText|
 %{ case compileDocs d }
 %{ of Just rst }
 #: #{rst}
@@ -1019,12 +1023,6 @@ compileTypeDeclaration src
                                          , typeAnnotations = annotations
                                          } = do
     tagCodes <- mapM (compileUnionTag src typename') tags
-    let tagCodes' = T.intercalate "\n\n" tagCodes
-        tagClasses = T.intercalate ", " [ toClassName' tagName'
-                                        | Tag tagName' _ _ <- tags
-                                        ]
-        enumMembers = toIndentedCodes
-            (\ (t, b) -> [qq|$t = '{b}'|]) enumMembers' "\n        "
     importTypingForPython3
     insertStandardImport "enum"
     insertThirdPartyImports [ ("nirum.deserialize", ["deserialize_meta"])
@@ -1040,43 +1038,49 @@ compileTypeDeclaration src
     typeRepr <- typeReprCompiler
     ret <- returnCompiler
     arg <- parameterCompiler
-    let defaultTagBehindName = case defaultTag u of
-            Just dt -> toBehindStringLiteral $ tagName dt
-            Nothing -> "None"
-    return [qq|
-class $className({T.intercalate "," $ compileExtendClasses annotations}):
-{compileDocstring "    " d}
+    return $ renderCompileText $ [compileText|
+class #{className}(#{T.intercalate "," $ compileExtendClasses annotations}):
+#{compileDocstring "    " d}
 
     __nirum_type__ = 'union'
-    __nirum_union_behind_name__ = {toBehindStringLiteral typename'}
-    __nirum_field_names__ = name_dict_type([$nameMaps])
-    __nirum_default_tag_behind_name__ = {defaultTagBehindName}
+    __nirum_union_behind_name__ = '#{toBehindSnakeCaseText typename'}'
+    __nirum_field_names__ = name_dict_type([
+%{ forall (Tag (Name f b) _ _) <- tags }
+        ('#{toAttributeName f}', '#{I.toSnakeCaseText b}'),
+%{ endforall }
+    ])
 
     class Tag(enum.Enum):
-        $enumMembers
+%{ forall (Tag tn _ _) <- tags }
+        #{toEnumMemberName tn} = '#{toBehindSnakeCaseText tn}'
+%{ endforall }
 
     def __init__(self, *args, **kwargs):
         raise NotImplementedError(
-            "\{0\} cannot be instantiated "
+            "{0} cannot be instantiated "
             "since it is an abstract class.  Instantiate a concrete subtype "
-            "of it instead.".format({typeRepr "type(self)"})
+            "of it instead.".format(#{typeRepr "type(self)"})
         )
 
     def __nirum_serialize__(self):
         raise NotImplementedError(
-            "\{0\} cannot be instantiated "
+            "{0} cannot be instantiated "
             "since it is an abstract class.  Instantiate a concrete subtype "
-            "of it instead.".format({typeRepr "type(self)"})
+            "of it instead.".format(#{typeRepr "type(self)"})
         )
 
     @classmethod
     def __nirum_deserialize__(
-        {arg "cls" "type"}, value
-    ){ ret className }:
-        if ($className.__nirum_default_tag_behind_name__ is not None and
-            isinstance(value, dict) and '_tag' not in value):
+        #{arg "cls" "type"}, value
+    )#{ ret className }:
+%{ case defaultTag u }
+%{ of Just dt }
+        if isinstance(value, dict) and '_tag' not in value:
             value = dict(value)
-            value['_tag'] = $className.__nirum_default_tag_behind_name__
+            value['_tag'] = '#{toBehindSnakeCaseText $ tagName dt}'
+            value['_type'] = '#{toAttributeName' typename'}'
+%{ of Nothing }
+%{ endcase }
         if '_type' not in value:
             raise ValueError('"_type" field is missing.')
         if '_tag' not in value:
@@ -1124,32 +1128,25 @@ class $className({T.intercalate "," $ compileExtendClasses annotations}):
             except ValueError as e:
                 errors.add('%s: %s' % (attribute_name, str(e)))
         if errors:
-            raise ValueError('\\n'.join(sorted(errors)))
+            raise ValueError('\n'.join(sorted(errors)))
         return cls(**args)
 
-$tagCodes'
+%{ forall tagCode <- tagCodes }
+#{tagCode}
 
-$className.__nirum_tag_classes__ = map_type(
-    (tcls.__nirum_tag__, tcls)
-    for tcls in [$tagClasses]
-)
+%{ endforall }
+
+#{className}.__nirum_tag_classes__ = map_type({
+%{ forall (Tag tn _ _) <- tags }
+    #{className}.Tag.#{toEnumMemberName tn}: #{toClassName' tn},
+%{ endforall }
+})
             |]
   where
     tags :: [Tag]
     tags = findTags u
     className :: T.Text
     className = toClassName' typename'
-    enumMembers' :: [(T.Text, T.Text)]
-    enumMembers' = [ ( toEnumMemberName tagName'
-                     , I.toSnakeCaseText $ N.behindName tagName'
-                     )
-                   | (Tag tagName' _ _) <- tags
-                   ]
-    nameMaps :: T.Text
-    nameMaps = toIndentedCodes
-        toNamePair
-        [name' | Tag name' _ _ <- tags]
-        ",\n        "
     compileExtendClasses :: A.AnnotationSet -> [Code]
     compileExtendClasses annotations' =
         if null extendClasses
@@ -1163,6 +1160,9 @@ $className.__nirum_tag_classes__ = map_type(
             [ M.lookup annotationName extendsClassMap
             | (A.Annotation annotationName _) <- A.toList annotations'
             ]
+    toBehindSnakeCaseText :: Name -> T.Text
+    toBehindSnakeCaseText = I.toSnakeCaseText . N.behindName
+
 compileTypeDeclaration
     src@Source { sourcePackage = Package { metadata = metadata' } }
     d@ServiceDeclaration { serviceName = name'
@@ -1430,7 +1430,7 @@ compileModule pythonVersion' source = do
     let fromImports = M.assocs (localImportsMap context) ++
                       M.assocs (thirdPartyImports context)
     code <- result
-    return $ (,) installRequires $ toStrict $ renderMarkup $
+    return $ (,) installRequires $ renderCompileText $
         [compileText|# -*- coding: utf-8 -*-
 #{compileDocstring "" $ sourceModule source}
 %{ forall i <- S.elems (standardImports context) }
@@ -1475,7 +1475,7 @@ compilePackageMetadata Package
                            , modules = modules'
                            }
                        (InstallRequires deps optDeps) =
-    toStrict $ renderMarkup [compileText|# -*- coding: utf-8 -*-
+    renderCompileText [compileText|# -*- coding: utf-8 -*-
 import sys
 
 from setuptools import setup, __version__ as setuptools_version

From 1f671ee2ffb0f0709309be4e9f30f1823db1102e Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Sun, 11 Feb 2018 17:37:04 +0900
Subject: [PATCH 06/14] Add reserved keyword "default" to be used on tag

---
 src/Nirum/Constructs/Identifier.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Nirum/Constructs/Identifier.hs b/src/Nirum/Constructs/Identifier.hs
index b12fd6e..1a0b098 100644
--- a/src/Nirum/Constructs/Identifier.hs
+++ b/src/Nirum/Constructs/Identifier.hs
@@ -61,6 +61,7 @@ reservedKeywords = [ "enum"
                    , "type"
                    , "unboxed"
                    , "union"
+                   , "default"
                    ]
 
 identifierRule :: Parser Identifier

From cb2f43fba4649c9ff64358f2ec1a06fca92363a5 Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Sun, 11 Feb 2018 20:05:35 +0900
Subject: [PATCH 07/14] Test union has only 1 deafult tag

---
 src/Nirum/Parser.hs      |  5 ++++-
 test/Nirum/ParserSpec.hs | 18 ++++++++++++------
 2 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs
index 2d179a5..6f89ae8 100644
--- a/src/Nirum/Parser.hs
+++ b/src/Nirum/Parser.hs
@@ -473,7 +473,10 @@ unionTypeDeclaration = do
         let remainTagSet = case defaultTag of
                                Just t -> DeclarationSet.delete t tagSet
                                Nothing -> tagSet
-        return $ TypeDeclaration typename (UnionType remainTagSet defaultTag) annotationSet''
+
+        if length (L.filter snd tags') > 1
+            then fail "`union` have to has only 1 default tag."
+            else return $ TypeDeclaration typename (UnionType remainTagSet defaultTag) annotationSet''
 
 typeDeclaration :: Parser TypeDeclaration
 typeDeclaration = do
diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs
index 313a05d..d993ae4 100644
--- a/test/Nirum/ParserSpec.hs
+++ b/test/Nirum/ParserSpec.hs
@@ -823,7 +823,13 @@ union dup
             expectErr "unboxed a (text);\nunion b = x | y\nunboxed c (text);"
                       3 1
             expectErr "union a = x | y;\nunboxed b (text)\nunion c = x | y;" 3 1
-
+        it "failed to parse union with more than 1 default keyword." $ do
+            let (_, expectErr) = helperFuncs P.module'
+            expectErr [s|
+union shape
+    = default circle (point origin, offset radius,)
+    | default rectangle (point upper-left, point lower-right,)
+    ;|] 4 6
     describe "method" $ do
         let (parse', expectError) = helperFuncs P.method
             httpGetAnnotation = singleton $ Annotation "http"
@@ -836,14 +842,14 @@ union dup
             parse' "text get-name (person user)" `shouldBeRight`
                 Method "get-name" [Parameter "user" "person" empty]
                        (Just "text") Nothing empty
-            parse' "text get-name  ( person user,text default )" `shouldBeRight`
+            parse' "text get-name  ( person user,text `default` )" `shouldBeRight`
                 Method "get-name"
                        [ Parameter "user" "person" empty
                        , Parameter "default" "text" empty
                        ]
                        (Just "text") Nothing empty
             parse' "@http(method = \"GET\", path = \"/get-name/\") \
-                   \text get-name  ( person user,text default )" `shouldBeRight`
+                   \text get-name  ( person user,text `default` )" `shouldBeRight`
                 Method "get-name"
                        [ Parameter "user" "person" empty
                        , Parameter "default" "text" empty
@@ -852,7 +858,7 @@ union dup
             parse' "text get-name() throws name-error" `shouldBeRight`
                 Method "get-name" [] (Just "text") (Just "name-error") empty
             parse' [s|
-text get-name  ( person user,text default )
+text get-name  ( person user,text `default` )
                throws get-name-error|] `shouldBeRight`
                 Method "get-name"
                        [ Parameter "user" "person" empty
@@ -861,7 +867,7 @@ text get-name  ( person user,text default )
                        (Just "text") (Just "get-name-error") empty
             parse' [s|
 @http(method = "GET", path = "/get-name/")
-text get-name  ( person user,text default )
+text get-name  ( person user,text `default` )
                throws get-name-error|] `shouldBeRight`
                 Method "get-name"
                        [ Parameter "user" "person" empty
@@ -925,7 +931,7 @@ text get-name (
   # Gets the name of the user.
   person user,
   # The person to find their name.
-  text default
+  text `default`
   # The default name used when the user has no name.
 )|] `shouldBeRight` expectedMethod
         it "fails to parse if there are parameters of the same facial name" $ do

From dd8279cdb6aa81b83ebff9f8ab1a30008a502219 Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Sun, 11 Feb 2018 20:31:21 +0900
Subject: [PATCH 08/14] Lint

---
 src/Nirum/Constructs/TypeDeclaration.hs | 12 ++++++------
 src/Nirum/Parser.hs                     |  5 ++++-
 src/Nirum/Targets/Python.hs             |  1 -
 test/Nirum/ParserSpec.hs                |  4 ++--
 4 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/src/Nirum/Constructs/TypeDeclaration.hs b/src/Nirum/Constructs/TypeDeclaration.hs
index c45b4c7..799c634 100644
--- a/src/Nirum/Constructs/TypeDeclaration.hs
+++ b/src/Nirum/Constructs/TypeDeclaration.hs
@@ -207,10 +207,10 @@ instance Construct TypeDeclaration where
       where
         fieldsCode = T.intercalate "\n" $ map toCode $ toList fields'
         docs' = A.lookupDocs annotationSet'
-    toCode (TypeDeclaration name' (UnionType tags' defaultTag') annotationSet') =
-        T.concat [ toCode annotationSet'
+    toCode (TypeDeclaration name' (UnionType tags' defaultTag') as') =
+        T.concat [ toCode as'
                  , "union ", nameCode
-                 , toCodeWithPrefix "\n    " (A.lookupDocs annotationSet')
+                 , toCodeWithPrefix "\n    " (A.lookupDocs as')
                  , "\n    = " , tagsCode
                  , "\n    ;"
                  ]
@@ -227,12 +227,12 @@ instance Construct TypeDeclaration where
                                  ]
     toCode (TypeDeclaration name'
                             (PrimitiveType typename' jsonType')
-                            annotationSet') =
-        T.concat [ toCode annotationSet'
+                            as') =
+        T.concat [ toCode as'
                  , "// primitive type `", toCode name', "`\n"
                  , "//     internal type identifier: ", showT typename', "\n"
                  , "//     coded to json ", showT jsonType', " type\n"
-                 , docString (A.lookupDocs annotationSet')
+                 , docString (A.lookupDocs as')
                  ]
       where
         showT :: Show a => a -> T.Text
diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs
index 6f89ae8..1f5e35a 100644
--- a/src/Nirum/Parser.hs
+++ b/src/Nirum/Parser.hs
@@ -476,7 +476,10 @@ unionTypeDeclaration = do
 
         if length (L.filter snd tags') > 1
             then fail "`union` have to has only 1 default tag."
-            else return $ TypeDeclaration typename (UnionType remainTagSet defaultTag) annotationSet''
+            else return $ TypeDeclaration
+                              typename
+                              (UnionType remainTagSet defaultTag)
+                              annotationSet''
 
 typeDeclaration :: Parser TypeDeclaration
 typeDeclaration = do
diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs
index 5772824..e02282f 100644
--- a/src/Nirum/Targets/Python.hs
+++ b/src/Nirum/Targets/Python.hs
@@ -1078,7 +1078,6 @@ class #{className}(#{T.intercalate "," $ compileExtendClasses annotations}):
         if isinstance(value, dict) and '_tag' not in value:
             value = dict(value)
             value['_tag'] = '#{toBehindSnakeCaseText $ tagName dt}'
-            value['_type'] = '#{toAttributeName' typename'}'
 %{ of Nothing }
 %{ endcase }
         if '_type' not in value:
diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs
index d993ae4..09c0cec 100644
--- a/test/Nirum/ParserSpec.hs
+++ b/test/Nirum/ParserSpec.hs
@@ -842,14 +842,14 @@ union shape
             parse' "text get-name (person user)" `shouldBeRight`
                 Method "get-name" [Parameter "user" "person" empty]
                        (Just "text") Nothing empty
-            parse' "text get-name  ( person user,text `default` )" `shouldBeRight`
+            parse' "text get-name (person user,text `default`)" `shouldBeRight`
                 Method "get-name"
                        [ Parameter "user" "person" empty
                        , Parameter "default" "text" empty
                        ]
                        (Just "text") Nothing empty
             parse' "@http(method = \"GET\", path = \"/get-name/\") \
-                   \text get-name  ( person user,text `default` )" `shouldBeRight`
+                   \text get-name (person user,text `default`)" `shouldBeRight`
                 Method "get-name"
                        [ Parameter "user" "person" empty
                        , Parameter "default" "text" empty

From ae66d60d7b1bab3cc7a111cf86d1615e87a3ec61 Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Sun, 11 Feb 2018 22:36:28 +0900
Subject: [PATCH 09/14] Add refactoring guide

---
 docs/refactoring.md | 70 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)

diff --git a/docs/refactoring.md b/docs/refactoring.md
index 7ab6e23..2bec351 100644
--- a/docs/refactoring.md
+++ b/docs/refactoring.md
@@ -203,3 +203,73 @@ its lack of order if necessary.
 When a JSON array serialized from a list field is deserialized to a set,
 the same values shown more than once are collapsed to unique values.
 Also, its order is not preserved.
+
+
+Interchangeability of union type and record type
+------------------------------------------------
+
+Sometimes we need to evolve an existing record type to be extended.
+
+But when we change a record type to a union type, it breaks backward
+compatibility.  Suppose we have a record type named `name` that looks like:
+
+~~~~~~~~ nirum
+record name (text fullname);
+~~~~~~~~
+
+An example of JSON serialized one would look like:
+
+~~~~~~~~ json
+{
+    "_type": "name",
+    "fullname": "John Doe"
+}
+~~~~~~~~
+
+What if we need to be more sensible to culture-specific names?  Now we decide
+to change it to a union:
+
+~~~~~~~~ nirum
+union name
+    = wastern-name (text first-name, text? middle-name, text last-name)
+    | east-asian-name (text family-name, text given-name)
+    | culture-agnostice-name (text fullname)
+    ;
+~~~~~~~~
+
+Since union types requires `"_tag"` field besides `"_type"` field when
+they are deserialized, data sent from the older programs becomes to break
+compatibility.
+
+In order to make union types possible to deserialize existing record data
+(which lacks `"_tag"` field), we need to choose `default` tag for data lacking
+`"_tag"` field:
+
+~~~~~~~~ nirum
+union name
+    = wastern-name (text first-name, text? middle-name, text last-name)
+    | east-asian-name (text family-name, text given-name)
+    | default culture-agnostice-name (text fullname)
+    ;
+~~~~~~~~
+
+With a `default` tag, union types become possible to deserialize data lacking
+`"_tag"` field, and they are treated as an instance of the `default` tag.
+For example, where we have a payload data like:
+
+~~~~~~~~ json
+{
+    "_type": "name",
+    "fullname": "John Doe"
+}
+~~~~~~~~
+
+It's treated as equivalent to the following one:
+
+~~~~~~~~ json
+{
+    "_type": "name",
+    "_tag": "culture_agnostic_name",
+    "fullname": "John Doe"
+}
+~~~~~~~~

From bd17d5e38de9d913c523abe7e7d195fa3419c2ab Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Tue, 20 Feb 2018 20:01:57 +0900
Subject: [PATCH 10/14] Checklist has to show when Parser.hs is changed

---
 src/Nirum/Parser.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs
index 1f5e35a..e18f085 100644
--- a/src/Nirum/Parser.hs
+++ b/src/Nirum/Parser.hs
@@ -93,6 +93,10 @@ import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier
 
 type ParseError = E.ParseError (Token T.Text) E.Dec
 
+-- CHECK: If a new reserved keyword is introduced, it has to be also
+-- added to `reservedKeywords` set in the `Nirum.Constructs.Identifier`
+-- module.
+
 comment :: Parser ()
 comment = string "//" >> void (many $ noneOf ("\n" :: String)) <?> "comment"
 
@@ -412,9 +416,6 @@ tag :: Parser (Tag, Bool)
 tag = do
     annotationSet' <- annotationSet <?> "union tag annotations"
     spaces
-    -- CHECK: If a new reserved keyword is introduced, it has to be also
-    -- added to `reservedKeywords` set in the `Nirum.Constructs.Identifier`
-    -- module.
     default' <- optional (string "default" <?> "default tag")
     spaces
     tagName <- name <?> "union tag name"

From 9695195610ddd0c6ac616129548dc3c6a22b7d00 Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Tue, 20 Feb 2018 20:13:27 +0900
Subject: [PATCH 11/14] __nirum_field_types__ is always callable

---
 src/Nirum/Targets/Python.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs
index e02282f..adb6417 100644
--- a/src/Nirum/Targets/Python.hs
+++ b/src/Nirum/Targets/Python.hs
@@ -963,10 +963,7 @@ class $className(object):
             )
         args = dict()
         behind_names = cls.__nirum_field_names__.behind_names
-        field_types = cls.__nirum_field_types__
-        if callable(field_types):
-            field_types = field_types()
-            # old compiler could generate non-callable dictionary
+        field_types = cls.__nirum_field_types__()
         errors = set()
         for attribute_name, item in value.items():
             if attribute_name == '_type':

From f9bc8d550052f35efa3bb54bb79018a8ab555f33 Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Tue, 20 Feb 2018 20:26:26 +0900
Subject: [PATCH 12/14] toStrinct $ renderMarkup intend to be removed

---
 src/Nirum/Targets/Python.hs | 12 ++++--------
 1 file changed, 4 insertions(+), 8 deletions(-)

diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs
index adb6417..b53a420 100644
--- a/src/Nirum/Targets/Python.hs
+++ b/src/Nirum/Targets/Python.hs
@@ -63,7 +63,6 @@ import Data.Text.Lazy (toStrict)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Function (on)
 import System.FilePath (joinPath)
-import qualified Text.Blaze.Internal as BI
 import Text.Blaze.Renderer.Text
 import qualified Text.Email.Validate as E
 import Text.Heterocephalus (compileText)
@@ -207,9 +206,6 @@ runCodeGen :: CodeGen a
            -> (Either CompileError' a, CodeGenContext)
 runCodeGen = C.runCodeGen
 
-renderCompileText :: BI.Markup -> T.Text
-renderCompileText = toStrict . renderMarkup
-
 insertStandardImport :: T.Text -> CodeGen ()
 insertStandardImport module' = ST.modify insert'
   where
@@ -736,7 +732,7 @@ compileTypeDeclaration src d@TypeDeclaration { typename = typename'
                                              , type' = Alias ctype
                                              } = do
     ctypeExpr <- compileTypeExpression src (Just ctype)
-    return $ renderCompileText $ [compileText|
+    return $ toStrict $ renderMarkup $ [compileText|
 %{ case compileDocs d }
 %{ of Just rst }
 #: #{rst}
@@ -1035,7 +1031,7 @@ compileTypeDeclaration src
     typeRepr <- typeReprCompiler
     ret <- returnCompiler
     arg <- parameterCompiler
-    return $ renderCompileText $ [compileText|
+    return $ toStrict $ renderMarkup $ [compileText|
 class #{className}(#{T.intercalate "," $ compileExtendClasses annotations}):
 #{compileDocstring "    " d}
 
@@ -1426,7 +1422,7 @@ compileModule pythonVersion' source = do
     let fromImports = M.assocs (localImportsMap context) ++
                       M.assocs (thirdPartyImports context)
     code <- result
-    return $ (,) installRequires $ renderCompileText $
+    return $ (,) installRequires $ toStrict $ renderMarkup $
         [compileText|# -*- coding: utf-8 -*-
 #{compileDocstring "" $ sourceModule source}
 %{ forall i <- S.elems (standardImports context) }
@@ -1471,7 +1467,7 @@ compilePackageMetadata Package
                            , modules = modules'
                            }
                        (InstallRequires deps optDeps) =
-    renderCompileText [compileText|# -*- coding: utf-8 -*-
+    toStrict $ renderMarkup [compileText|# -*- coding: utf-8 -*-
 import sys
 
 from setuptools import setup, __version__ as setuptools_version

From 87d7f5ee205b01f1eda99baaaf1fc5fa93931af9 Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Wed, 28 Feb 2018 22:41:47 +0900
Subject: [PATCH 13/14] Not to import functions seperately

---
 src/Nirum/Constructs/TypeDeclaration.hs      |  28 ++++-
 src/Nirum/Parser.hs                          | 112 +++++++++----------
 src/Nirum/Targets/Python.hs                  |  98 +++++++---------
 test/Nirum/Constructs/TypeDeclarationSpec.hs |   3 +-
 test/Nirum/ParserSpec.hs                     |  97 +++++++---------
 5 files changed, 155 insertions(+), 183 deletions(-)

diff --git a/src/Nirum/Constructs/TypeDeclaration.hs b/src/Nirum/Constructs/TypeDeclaration.hs
index 799c634..3b6e120 100644
--- a/src/Nirum/Constructs/TypeDeclaration.hs
+++ b/src/Nirum/Constructs/TypeDeclaration.hs
@@ -40,7 +40,6 @@ module Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
                                                , jsonType
                                                , members
                                                , primitiveTypeIdentifier
-                                               , tags
                                                )
                                         , TypeDeclaration ( Import
                                                           , ServiceDeclaration
@@ -54,6 +53,8 @@ module Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
                                                           , typeAnnotations
                                                           , typename
                                                           )
+                                        , unionType
+                                        , tags
                                         ) where
 
 import Data.Maybe (isJust, maybeToList)
@@ -67,7 +68,7 @@ import Nirum.Constructs.Declaration ( Declaration (annotations, name)
                                     , Documented (docs)
                                     )
 import Nirum.Constructs.Docs (Docs (Docs), toCodeWithPrefix)
-import Nirum.Constructs.DeclarationSet (DeclarationSet, null', toList)
+import Nirum.Constructs.DeclarationSet as DS
 import Nirum.Constructs.Identifier (Identifier)
 import Nirum.Constructs.ModulePath (ModulePath)
 import Nirum.Constructs.Name (Name (Name))
@@ -82,14 +83,22 @@ data Type
     | UnboxedType { innerType :: TypeExpression }
     | EnumType { members :: DeclarationSet EnumMember }
     | RecordType { fields :: DeclarationSet Field }
-    | UnionType { tags :: DeclarationSet Tag
-                , defaultTag :: Maybe Tag
-                }
+    | UnionType -- | Use 'unionType' instaed.
+        { nondefaultTags :: DeclarationSet Tag -- This should not be exported.
+        , defaultTag :: Maybe Tag
+        }
     | PrimitiveType { primitiveTypeIdentifier :: PrimitiveTypeIdentifier
                     , jsonType :: JsonType
                     }
     deriving (Eq, Ord, Show)
 
+tags :: Type -> DeclarationSet Tag
+tags UnionType { nondefaultTags = tags', defaultTag = defTag } =
+    case fromList $ toList tags' ++ maybeToList defTag of
+        Right ts -> ts
+        Left _ -> DS.empty -- must never happen!
+tags _ = DS.empty
+
 -- | Member of 'EnumType'.
 data EnumMember = EnumMember Name AnnotationSet deriving (Eq, Ord, Show)
 
@@ -134,6 +143,15 @@ data Tag = Tag { tagName :: Name
                , tagAnnotations :: AnnotationSet
                } deriving (Eq, Ord, Show)
 
+-- | Create a 'UnionType'.
+unionType :: [Tag] -> Maybe Tag -> Either NameDuplication Type
+unionType t dt = case fromList t of
+                     Right ts -> Right $
+                         case dt of
+                             Nothing -> UnionType ts Nothing
+                             Just dt' -> UnionType (delete dt' ts) dt
+                     Left a -> Left a
+
 instance Construct Tag where
     toCode tag@(Tag name' fields' _) =
         if null' fields'
diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs
index e18f085..cdc4a04 100644
--- a/src/Nirum/Parser.hs
+++ b/src/Nirum/Parser.hs
@@ -9,6 +9,7 @@ module Nirum.Parser ( Parser
                     , enumTypeDeclaration
                     , file
                     , handleNameDuplication
+                    , handleNameDuplicationError
                     , identifier
                     , imports
                     , listModifier
@@ -67,22 +68,10 @@ import Nirum.Constructs.Service ( Method (Method)
                                 , Parameter (Parameter)
                                 , Service (Service)
                                 )
-import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
-                                        , Field (Field)
-                                        , Tag (Tag)
-                                        , Type ( Alias
-                                               , EnumType
-                                               , RecordType
-                                               , UnboxedType
-                                               , UnionType
-                                               )
-                                        , TypeDeclaration ( Import
-                                                          , ServiceDeclaration
-                                                          , TypeDeclaration
-                                                          , serviceAnnotations
-                                                          , typeAnnotations
-                                                          )
-                                        )
+import Nirum.Constructs.TypeDeclaration as TD hiding ( fields
+                                                     , modulePath
+                                                     , importName
+                                                     )
 import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier
                                                         , MapModifier
                                                         , OptionModifier
@@ -254,17 +243,17 @@ aliasTypeDeclaration = do
     annotationSet' <- annotationSet <?> "type alias annotations"
     string' "type" <?> "type alias keyword"
     spaces
-    typename <- identifier <?> "alias type name"
-    let name' = Name typename typename
+    typeName <- identifier <?> "alias type name"
+    let name' = Name typeName typeName
     spaces
     char '='
     spaces
-    canonicalType <- typeExpression <?> "canonical type of alias"
+    canonicalType' <- typeExpression <?> "canonical type of alias"
     spaces
     char ';'
     docs' <- optional $ try $ spaces >> (docs <?> "type alias docs")
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
-    return $ TypeDeclaration name' (Alias canonicalType) annotationSet''
+    return $ TypeDeclaration name' (Alias canonicalType') annotationSet''
 
 
 unboxedTypeDeclaration :: Parser TypeDeclaration
@@ -272,19 +261,19 @@ unboxedTypeDeclaration = do
     annotationSet' <- annotationSet <?> "unboxed type annotations"
     string' "unboxed" <?> "unboxed type keyword"
     spaces
-    typename <- identifier <?> "unboxed type name"
-    let name' = Name typename typename
+    typeName <- identifier <?> "unboxed type name"
+    let name' = Name typeName typeName
     spaces
     char '('
     spaces
-    innerType <- typeExpression <?> "inner type of unboxed type"
+    innerType' <- typeExpression <?> "inner type of unboxed type"
     spaces
     char ')'
     spaces
     char ';'
     docs' <- optional $ try $ spaces >> (docs <?> "unboxed type docs")
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
-    return $ TypeDeclaration name' (UnboxedType innerType) annotationSet''
+    return $ TypeDeclaration name' (UnboxedType innerType') annotationSet''
 
 enumMember :: Parser EnumMember
 enumMember = do
@@ -300,25 +289,31 @@ enumMember = do
     return $ EnumMember memberName annotationSet''
 
 handleNameDuplication :: Declaration a
-                      => String -> [a]
+                      => String
+                      -> [a]
                       -> (DeclarationSet a -> Parser b)
                       -> Parser b
-handleNameDuplication label' declarations cont =
-    case DeclarationSet.fromList declarations of
-        Left (BehindNameDuplication (Name _ bname)) ->
-            fail ("the behind " ++ label' ++ " name `" ++ toString bname ++
-                  "` is duplicated")
-        Left (FacialNameDuplication (Name fname _)) ->
-            fail ("the facial " ++ label' ++ " name `" ++ toString fname ++
-                  "` is duplicated")
-        Right set -> cont set
+handleNameDuplication label' declarations cont = do
+    set <- handleNameDuplicationError label' $
+        DeclarationSet.fromList declarations
+    cont set
+
+handleNameDuplicationError :: String -> Either NameDuplication a -> Parser a
+handleNameDuplicationError _ (Right v) = return v
+handleNameDuplicationError label' (Left dup) =
+    fail ("the " ++ nameType ++ " " ++ label' ++ " name `" ++
+          toString name' ++ "` is duplicated")
+  where
+    (nameType, name') = case dup of
+        BehindNameDuplication (Name _ bname) -> ("behind", bname)
+        FacialNameDuplication (Name fname _) -> ("facial", fname)
 
 enumTypeDeclaration :: Parser TypeDeclaration
 enumTypeDeclaration = do
     annotationSet' <- annotationSet <?> "enum type annotations"
     string "enum" <?> "enum keyword"
     spaces
-    typename <- name <?> "enum type name"
+    typeName <- name <?> "enum type name"
     spaces
     frontDocs <- optional $ do
         d <- docs <?> "enum type docs"
@@ -333,9 +328,9 @@ enumTypeDeclaration = do
             spaces
             return d
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
-    members <- (enumMember `sepBy1` (spaces >> char '|' >> spaces))
-                   <?> "enum members"
-    case DeclarationSet.fromList members of
+    members' <- (enumMember `sepBy1` (spaces >> char '|' >> spaces))
+        <?> "enum members"
+    case DeclarationSet.fromList members' of
         Left (BehindNameDuplication (Name _ bname)) ->
             fail ("the behind member name `" ++ toString bname ++
                   "` is duplicated")
@@ -345,7 +340,7 @@ enumTypeDeclaration = do
         Right memberSet -> do
             spaces
             char ';'
-            return $ TypeDeclaration typename (EnumType memberSet)
+            return $ TypeDeclaration typeName (EnumType memberSet)
                                      annotationSet''
 
 fieldsOrParameters :: forall a . (String, String)
@@ -354,12 +349,12 @@ fieldsOrParameters :: forall a . (String, String)
 fieldsOrParameters (label', pluralLabel) make = do
     annotationSet' <- annotationSet <?> (label' ++ " annotations")
     spaces
-    type' <- typeExpression <?> (label' ++ " type")
+    typeExpr <- typeExpression <?> (label' ++ " type")
     spaces1
     name' <- name <?> (label' ++ " name")
     spaces
-    let makeWithDocs = make name' type' . A.union annotationSet'
-                                        . annotationsFromDocs
+    let makeWithDocs = make name' typeExpr . A.union annotationSet'
+                                           . annotationsFromDocs
     followedByComma makeWithDocs <|> do
         d <- optional docs' <?> (label' ++ " docs")
         return [makeWithDocs d]
@@ -396,7 +391,7 @@ recordTypeDeclaration = do
     annotationSet' <- annotationSet <?> "record type annotations"
     string "record" <?> "record keyword"
     spaces
-    typename <- name <?> "record type name"
+    typeName <- name <?> "record type name"
     spaces
     char '('
     spaces
@@ -410,7 +405,7 @@ recordTypeDeclaration = do
     spaces
     char ';'
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
-    return $ TypeDeclaration typename (RecordType fields') annotationSet''
+    return $ TypeDeclaration typeName (RecordType fields') annotationSet''
 
 tag :: Parser (Tag, Bool)
 tag = do
@@ -418,7 +413,7 @@ tag = do
     spaces
     default' <- optional (string "default" <?> "default tag")
     spaces
-    tagName <- name <?> "union tag name"
+    tagName' <- name <?> "union tag name"
     spaces
     paren <- optional $ char '('
     spaces
@@ -442,7 +437,7 @@ tag = do
             spaces
             return d
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
-    return ( Tag tagName fields' annotationSet''
+    return ( Tag tagName' fields' annotationSet''
            , case default' of
                  Just _ -> True
                  Nothing -> False
@@ -453,7 +448,7 @@ unionTypeDeclaration = do
     annotationSet' <- annotationSet <?> "union type annotations"
     string "union" <?> "union keyword"
     spaces
-    typename <- name <?> "union type name"
+    typeName <- name <?> "union type name"
     spaces
     docs' <- optional $ do
         d <- docs <?> "union type docs"
@@ -464,23 +459,18 @@ unionTypeDeclaration = do
     tags' <- (tag `sepBy1` try (spaces >> char '|' >> spaces))
              <?> "union tags"
     let tags'' = [t | (t, _) <- tags']
-    let defaultTag = do
+    let defaultTag' = do
             (t''', _) <- L.find snd tags'
             return t'''
     spaces
     char ';'
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
-    handleNameDuplication "tag" tags'' $ \ tagSet -> do
-        let remainTagSet = case defaultTag of
-                               Just t -> DeclarationSet.delete t tagSet
-                               Nothing -> tagSet
-
-        if length (L.filter snd tags') > 1
-            then fail "`union` have to has only 1 default tag."
-            else return $ TypeDeclaration
-                              typename
-                              (UnionType remainTagSet defaultTag)
-                              annotationSet''
+    if length (L.filter snd tags') > 1
+        then fail "A union type cannot have more than a default tag."
+        else do
+            ut <- handleNameDuplicationError "tag" $
+                unionType tags'' defaultTag'
+            return $ TypeDeclaration typeName ut annotationSet''
 
 typeDeclaration :: Parser TypeDeclaration
 typeDeclaration = do
@@ -561,7 +551,7 @@ serviceDeclaration = do
     annotationSet' <- annotationSet <?> "service annotation"
     string "service" <?> "service keyword"
     spaces
-    serviceName <- name <?> "service name"
+    serviceName' <- name <?> "service name"
     spaces
     char '('
     spaces
@@ -575,7 +565,7 @@ serviceDeclaration = do
     spaces
     char ';'
     annotationSet'' <- annotationsWithDocs annotationSet' docs'
-    return $ ServiceDeclaration serviceName (Service methods') annotationSet''
+    return $ ServiceDeclaration serviceName' (Service methods') annotationSet''
 
 modulePath :: Parser ModulePath
 modulePath = do
diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs
index b53a420..0a97689 100644
--- a/src/Nirum/Targets/Python.hs
+++ b/src/Nirum/Targets/Python.hs
@@ -49,7 +49,7 @@ module Nirum.Targets.Python ( Code
 import Control.Monad (forM)
 import qualified Control.Monad.State as ST
 import qualified Data.List as L
-import Data.Maybe (catMaybes, fromMaybe, maybeToList)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Typeable (Typeable)
 import GHC.Exts (IsList (toList))
 import Text.Printf (printf)
@@ -92,21 +92,7 @@ import Nirum.Constructs.Service ( Method ( Method
                                 , Parameter (Parameter)
                                 , Service (Service)
                                 )
-import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
-                                        , Field (Field, fieldName)
-                                        , PrimitiveTypeIdentifier (..)
-                                        , Tag (Tag, tagName)
-                                        , Type ( Alias
-                                               , EnumType
-                                               , PrimitiveType
-                                               , RecordType
-                                               , UnboxedType
-                                               , UnionType
-                                               , defaultTag
-                                               , primitiveTypeIdentifier
-                                               )
-                                        , TypeDeclaration (..)
-                                        )
+import Nirum.Constructs.TypeDeclaration as TD
 import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier
                                                         , MapModifier
                                                         , OptionModifier
@@ -117,8 +103,7 @@ import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier
 import Nirum.Docs.ReStructuredText (ReStructuredText, render)
 import Nirum.Package hiding (target)
 import Nirum.Package.Metadata ( Author (Author, name, email)
-                              , Metadata ( Metadata
-                                         , authors
+                              , Metadata ( authors
                                          , target
                                          , version
                                          , description
@@ -137,7 +122,6 @@ import Nirum.Package.Metadata ( Author (Author, name, email)
                                        , targetName
                                        , toByteString
                                        )
-                              , fieldType
                               , stringField
                               , tableField
                               , versionField
@@ -179,11 +163,6 @@ data CodeGenContext
                      }
     deriving (Eq, Ord, Show)
 
-findTags :: Type -> [Tag]
-findTags t = case t of
-    (UnionType tags' d) -> toList tags' ++ maybeToList d
-    _ -> []
-
 localImportsMap :: CodeGenContext -> M.Map T.Text (M.Map T.Text T.Text)
 localImportsMap CodeGenContext { localImports = imports } =
     M.map (M.fromSet id) imports
@@ -362,8 +341,8 @@ compileParameters gen nameTypeTriples =
         nameTypeTriples ", "
 
 compileFieldInitializers :: DS.DeclarationSet Field -> Int -> CodeGen Code
-compileFieldInitializers fields depth = do
-    initializers <- forM (toList fields) compileFieldInitializer
+compileFieldInitializers fields' depth = do
+    initializers <- forM (toList fields') compileFieldInitializer
     return $ T.intercalate indentSpaces initializers
   where
     indentSpaces :: T.Text
@@ -403,7 +382,7 @@ compileDocstring indentSpace d = compileDocstring' indentSpace d []
 
 compileDocstringWithFields :: Documented a
                            => Code -> a -> DS.DeclarationSet Field -> Code
-compileDocstringWithFields indentSpace decl fields =
+compileDocstringWithFields indentSpace decl fields' =
     compileDocstring' indentSpace decl extra
   where
     extra :: [ReStructuredText]
@@ -418,7 +397,7 @@ compileDocstringWithFields indentSpace decl fields =
                                      , "\n\n"
                                      , indent "   " docs'
                                      ]
-        | f@(Field n _ _) <- toList fields
+        | f@(Field n _ _) <- toList fields'
         ]
 
 compileDocsComment :: Documented a => Code -> a -> Code
@@ -467,9 +446,9 @@ returnCompiler = do
 
 
 compileUnionTag :: Source -> Name -> Tag -> CodeGen Code
-compileUnionTag source parentname d@(Tag typename' fields _) = do
+compileUnionTag source parentname d@(Tag typename' fields' _) = do
     typeExprCodes <- mapM (compileTypeExpression source)
-        [Just typeExpr | (Field _ typeExpr _) <- toList fields]
+        [Just typeExpr | (Field _ typeExpr _) <- toList fields']
     let nameTypeTriples = L.sortBy (compare `on` thd3)
                                    (zip3 tagNames typeExprCodes optionFlags)
         slotTypes = toIndentedCodes
@@ -481,7 +460,7 @@ compileUnionTag source parentname d@(Tag typename' fields _) = do
     arg <- parameterCompiler
     ret <- returnCompiler
     pyVer <- getPythonVersion
-    initializers <- compileFieldInitializers fields $ case pyVer of
+    initializers <- compileFieldInitializers fields' $ case pyVer of
         Python3 -> 2
         Python2 -> 3
     let initParams = compileParameters arg nameTypeTriples
@@ -503,7 +482,7 @@ compileUnionTag source parentname d@(Tag typename' fields _) = do
             |]
     return [qq|
 class $className($parentClass):
-{compileDocstringWithFields "    " d fields}
+{compileDocstringWithFields "    " d fields'}
     __slots__ = (
         $slots
     )
@@ -556,14 +535,14 @@ if hasattr($parentClass, '__qualname__'):
     optionFlags = [ case typeExpr of
                         OptionModifier _ -> True
                         _ -> False
-                  | (Field _ typeExpr _) <- toList fields
+                  | (Field _ typeExpr _) <- toList fields'
                   ]
     className :: T.Text
     className = toClassName' typename'
     behindParentTypename :: T.Text
     behindParentTypename = I.toSnakeCaseText $ N.behindName parentname
     tagNames :: [T.Text]
-    tagNames = map (toAttributeName' . fieldName) (toList fields)
+    tagNames = map (toAttributeName' . fieldName) (toList fields')
     behindTagName :: T.Text
     behindTagName = I.toSnakeCaseText $ N.behindName typename'
     slots :: Code
@@ -575,7 +554,7 @@ if hasattr($parentClass, '__qualname__'):
         then "self.__nirum_tag__"
         else [qq|({toIndentedCodes (T.append "self.") tagNames ", "},)|]
     fieldList :: [Field]
-    fieldList = toList fields
+    fieldList = toList fields'
     nameMaps :: Code
     nameMaps = toIndentedCodes toNamePair
                                (map fieldName fieldList)
@@ -828,7 +807,7 @@ class #{className}(object):
         return hash(self.value)
 |]
 compileTypeDeclaration _ d@TypeDeclaration { typename = typename'
-                                           , type' = EnumType members
+                                           , type' = EnumType members'
                                            } = do
     let className = toClassName' typename'
     insertStandardImport "enum"
@@ -837,7 +816,7 @@ compileTypeDeclaration _ d@TypeDeclaration { typename = typename'
 class #{className}(enum.Enum):
 #{compileDocstring "    " d}
 
-%{ forall member@(EnumMember memberName@(Name _ behind) _) <- toList members }
+%{ forall member@(EnumMember memberName@(Name _ behind) _) <- toList members' }
 #{compileDocsComment "    " member}
     #{toEnumMemberName memberName} = '#{I.toSnakeCaseText behind}'
 %{ endforall }
@@ -865,7 +844,7 @@ class #{className}(enum.Enum):
 #{className}.__nirum_type__ = 'enum'
 |]
 compileTypeDeclaration src d@TypeDeclaration { typename = typename'
-                                             , type' = RecordType fields
+                                             , type' = RecordType fields'
                                              } = do
     typeExprCodes <- mapM (compileTypeExpression src)
         [Just typeExpr | (Field _ typeExpr _) <- fieldList]
@@ -885,7 +864,7 @@ compileTypeDeclaration src d@TypeDeclaration { typename = typename'
     ret <- returnCompiler
     typeRepr <- typeReprCompiler
     pyVer <- getPythonVersion
-    initializers <- compileFieldInitializers fields $ case pyVer of
+    initializers <- compileFieldInitializers fields' $ case pyVer of
         Python3 -> 2
         Python2 -> 3
     let initParams = compileParameters arg nameTypeTriples
@@ -908,7 +887,7 @@ compileTypeDeclaration src d@TypeDeclaration { typename = typename'
     let clsType = arg "cls" "type"
     return [qq|
 class $className(object):
-{compileDocstringWithFields "    " d fields}
+{compileDocstringWithFields "    " d fields'}
     __slots__ = (
         $slots,
     )
@@ -983,7 +962,7 @@ class $className(object):
     className :: T.Text
     className = toClassName' typename'
     fieldList :: [Field]
-    fieldList = toList fields
+    fieldList = toList fields'
     behindTypename :: T.Text
     behindTypename = I.toSnakeCaseText $ N.behindName typename'
     optionFlags :: [Bool]
@@ -999,7 +978,7 @@ class $className(object):
     nameMaps :: Code
     nameMaps = toIndentedCodes
         toNamePair
-        (map fieldName $ toList fields)
+        (map fieldName $ toList fields')
         ",\n        "
     hashText :: Code
     hashText = toIndentedCodes (\ n -> [qq|self.{n}|]) fieldNames ", "
@@ -1012,10 +991,10 @@ class $className(object):
         ]
 compileTypeDeclaration src
                        d@TypeDeclaration { typename = typename'
-                                         , type' = u
+                                         , type' = union
                                          , typeAnnotations = annotations
                                          } = do
-    tagCodes <- mapM (compileUnionTag src typename') tags
+    tagCodes <- mapM (compileUnionTag src typename') tags'
     importTypingForPython3
     insertStandardImport "enum"
     insertThirdPartyImports [ ("nirum.deserialize", ["deserialize_meta"])
@@ -1029,8 +1008,7 @@ compileTypeDeclaration src
                                )
                              ]
     typeRepr <- typeReprCompiler
-    ret <- returnCompiler
-    arg <- parameterCompiler
+    pyVer <- getPythonVersion
     return $ toStrict $ renderMarkup $ [compileText|
 class #{className}(#{T.intercalate "," $ compileExtendClasses annotations}):
 #{compileDocstring "    " d}
@@ -1038,13 +1016,13 @@ class #{className}(#{T.intercalate "," $ compileExtendClasses annotations}):
     __nirum_type__ = 'union'
     __nirum_union_behind_name__ = '#{toBehindSnakeCaseText typename'}'
     __nirum_field_names__ = name_dict_type([
-%{ forall (Tag (Name f b) _ _) <- tags }
+%{ forall (Tag (Name f b) _ _) <- tags' }
         ('#{toAttributeName f}', '#{I.toSnakeCaseText b}'),
 %{ endforall }
     ])
 
     class Tag(enum.Enum):
-%{ forall (Tag tn _ _) <- tags }
+%{ forall (Tag tn _ _) <- tags' }
         #{toEnumMemberName tn} = '#{toBehindSnakeCaseText tn}'
 %{ endforall }
 
@@ -1063,10 +1041,13 @@ class #{className}(#{T.intercalate "," $ compileExtendClasses annotations}):
         )
 
     @classmethod
-    def __nirum_deserialize__(
-        #{arg "cls" "type"}, value
-    )#{ ret className }:
-%{ case defaultTag u }
+%{ case pyVer }
+%{ of Python2 }
+    def __nirum_deserialize__(cls, value):
+%{ of Python3 }
+    def __nirum_deserialize__(cls: '#{className}', value) -> '#{className}':
+%{ endcase }
+%{ case defaultTag union }
 %{ of Just dt }
         if isinstance(value, dict) and '_tag' not in value:
             value = dict(value)
@@ -1129,14 +1110,14 @@ class #{className}(#{T.intercalate "," $ compileExtendClasses annotations}):
 %{ endforall }
 
 #{className}.__nirum_tag_classes__ = map_type({
-%{ forall (Tag tn _ _) <- tags }
+%{ forall (Tag tn _ _) <- tags' }
     #{className}.Tag.#{toEnumMemberName tn}: #{toClassName' tn},
 %{ endforall }
 })
             |]
   where
-    tags :: [Tag]
-    tags = findTags u
+    tags' :: [Tag]
+    tags' = DS.toList $ tags union
     className :: T.Text
     className = toClassName' typename'
     compileExtendClasses :: A.AnnotationSet -> [Code]
@@ -1453,7 +1434,7 @@ from #{from} import (
 
 compilePackageMetadata :: Package' -> InstallRequires -> Code
 compilePackageMetadata Package
-                           { metadata = Metadata
+                           { metadata = MD.Metadata
                                  { authors = authors'
                                  , version = version'
                                  , description = description'
@@ -1571,7 +1552,8 @@ recursive-include src-py2 *.py
 
 compilePackage' :: Package'
                 -> M.Map FilePath (Either CompileError' Code)
-compilePackage' package@Package { metadata = Metadata { target = target' } } =
+compilePackage' package@Package { metadata = MD.Metadata { target = target' }
+                                } =
     M.fromList $
         initFiles ++
         [ ( f
@@ -1643,7 +1625,7 @@ instance Target Python where
                   (Nothing, _) -> Left $ FieldValueError [qq|renams.$k|]
                       [qq|expected a module path as a key, not "$k"|]
                   _ -> Left $ FieldTypeError [qq|renames.$k|] "string" $
-                                             fieldType v
+                                             MD.fieldType v
             | (k, v) <- HM.toList renameTable
             ]
         return Python { packageName = name'
diff --git a/test/Nirum/Constructs/TypeDeclarationSpec.hs b/test/Nirum/Constructs/TypeDeclarationSpec.hs
index a2fd913..544b289 100644
--- a/test/Nirum/Constructs/TypeDeclarationSpec.hs
+++ b/test/Nirum/Constructs/TypeDeclarationSpec.hs
@@ -18,6 +18,7 @@ import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
                                         , Tag (Tag)
                                         , Type (..)
                                         , TypeDeclaration (..)
+                                        , unionType
                                         )
 import Util (singleDocs)
 
@@ -127,7 +128,7 @@ record person (
                         , Tag "rectangle" rectangleFields empty
                         , Tag "none" [] empty
                         ]
-                union' = UnionType tags' Nothing
+            let Right union' = unionType tags' Nothing
                 a = TypeDeclaration { typename = "shape"
                                     , type' = union'
                                     , typeAnnotations = empty
diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs
index 09c0cec..3bfa8e6 100644
--- a/test/Nirum/ParserSpec.hs
+++ b/test/Nirum/ParserSpec.hs
@@ -32,12 +32,7 @@ import Nirum.Constructs.Service ( Method (Method)
                                 , Parameter (Parameter)
                                 , Service (Service)
                                 )
-import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember)
-                                        , Field (Field, fieldAnnotations)
-                                        , Tag (Tag, tagAnnotations, tagFields)
-                                        , Type (..)
-                                        , TypeDeclaration (..)
-                                        )
+import Nirum.Constructs.TypeDeclaration as TD hiding (tags)
 import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier
                                                         , MapModifier
                                                         , OptionModifier
@@ -666,7 +661,7 @@ record dup (
                 circleTag = Tag "circle" circleFields empty
                 rectTag = Tag "rectangle" rectangleFields empty
                 tags' = [circleTag]
-                union' = UnionType tags' $ Just rectTag
+                Right union' = unionType tags' $ Just rectTag
                 a = TypeDeclaration "shape" union' empty
             parse' [s|
 union shape
@@ -684,7 +679,7 @@ union shape
                 rectTag = Tag "rectangle" rectangleFields empty
                 noneTag = Tag "none" [] empty
                 tags' = [circleTag, rectTag, noneTag]
-                union' = UnionType tags' Nothing
+                Right union' = unionType tags' Nothing
                 a = TypeDeclaration "shape" union' empty
                 b = a { typeAnnotations = singleDocs "shape type" }
             parse' [s|
@@ -719,18 +714,21 @@ union shape
     | rectangle (point upper-left, point lower-right,)
     | none
     ;|] `shouldBeRight` b
+            let Right union3 = unionType
+                    [circleTag, rectTag, Tag "none" [] fooAnnotationSet]
+                    Nothing
             parse' [s|
 union shape
     = circle (point origin, offset radius,)
     | rectangle (point upper-left, point lower-right,)
     | @foo (v = "bar") none
-    ;|] `shouldBeRight`
-                    a { type' = union' { tags = [ circleTag
-                                                , rectTag
-                                                , Tag "none" [] fooAnnotationSet
-                                                ]
-                                       }
-                      }
+    ;|] `shouldBeRight` a { type' = union3 }
+            let Right union4 = unionType
+                    [ circleTag { tagAnnotations = singleDocs "tag docs" }
+                    , rectTag { tagAnnotations = singleDocs "front docs" }
+                    , noneTag
+                    ]
+                    Nothing
             parse' [s|
 union shape
     = circle (point origin, offset radius,)
@@ -740,59 +738,42 @@ union shape
           point upper-left, point lower-right,
       )
     | none
-    ;|] `shouldBeRight`
-                    a { type' = union'
-                            { tags = [ circleTag
-                                        { tagAnnotations = singleDocs "tag docs"
-                                        }
-                                     , rectTag
-                                        { tagAnnotations =
-                                              singleDocs "front docs"
-                                        }
-                                     , noneTag
-                                     ]
-                            }
-                      }
+    ;|] `shouldBeRight` a { type' = union4 }
+            let Right union5 = unionType
+                    [ circleTag, rectTag
+                    , noneTag { tagAnnotations = singleDocs "tag docs" }
+                    ]
+                    Nothing
             parse' [s|
 union shape
     = circle (point origin, offset radius,)
     | rectangle (point upper-left, point lower-right,)
     | none  # tag docs
-    ;|] `shouldBeRight`
-                    a { type' = union'
-                            { tags = [ circleTag, rectTag
-                                     , noneTag
-                                        { tagAnnotations = singleDocs "tag docs"
-                                        }
-                                     ]
-                            }
-                      }
+    ;|] `shouldBeRight` a { type' = union5 }
+            let Right union6 = unionType
+                    [ circleTag
+                          { tagFields =
+                                 [ cOriginF
+                                 , cRadiusF
+                                       { fieldAnnotations = bazAnnotationSet }
+                                 ]
+                          }
+                    , rectTag
+                          { tagFields =
+                                [ rUpperLeftF
+                                , rLowerRightF
+                                      { fieldAnnotations = fooAnnotationSet }
+                                ]
+                          }
+                    , noneTag
+                    ]
+                    Nothing
             parse' [s|
 union shape
     = circle (point origin, @baz offset radius,)
     | rectangle (point upper-left, @foo (v = "bar") point lower-right,)
     | none
-    ;|] `shouldBeRight`
-                    a { type' = union'
-                            { tags = [ circleTag
-                                           { tagFields =
-                                                 [ cOriginF
-                                                 , cRadiusF { fieldAnnotations =
-                                                              bazAnnotationSet }
-                                                 ]
-                                           }
-                                     , rectTag
-                                           { tagFields =
-                                                 [ rUpperLeftF
-                                                 , rLowerRightF
-                                                       { fieldAnnotations =
-                                                         fooAnnotationSet }
-                                                 ]
-                                           }
-                                     , noneTag
-                                     ]
-                             }
-                      }
+    ;|] `shouldBeRight` a { type' = union6 }
         it "fails to parse if there are duplicated facial names" $ do
             expectError [s|
 union dup

From d1df601e3b23c5de44f1bac8ad152568cf5b6d3f Mon Sep 17 00:00:00 2001
From: Kang Hyojun <iam.kanghyojun@gmail.com>
Date: Wed, 28 Feb 2018 23:44:55 +0900
Subject: [PATCH 14/14] Write changelog

---
 CHANGES.md | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index cd6d696..8dc2017 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -6,6 +6,14 @@ Version 0.4.0
 
 To be released.
 
+### Language
+
+ -  Union tags became possible to have `default` keyword.  It's useful
+    for migrating a record type to a union type.  [[#13], [#227]]
+
+[#13]: https://github.com/spoqa/nirum/issues/13
+[#227]: https://github.com/spoqa/nirum/pull/227
+
 
 Version 0.3.0
 -------------
@@ -102,7 +110,7 @@ Released on February 18, 2018.
 
 ### Et cetera
 
- -  The officialy distributed executable binaries for Linux became
+ -  The officially distributed executable binaries for Linux became
     independent from [glibc]; instead statically linked to [musl].  [#216]
  -  The Docker image now has `nirum` command in `PATH`.  [[#155]]
  -  The Docker image became based and built on [Alpine Linux][] so that