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 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" +} +~~~~~~~~ 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/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/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 diff --git a/src/Nirum/Constructs/TypeDeclaration.hs b/src/Nirum/Constructs/TypeDeclaration.hs index a610877..3b6e120 100644 --- a/src/Nirum/Constructs/TypeDeclaration.hs +++ b/src/Nirum/Constructs/TypeDeclaration.hs @@ -34,12 +34,12 @@ module Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember) , UnboxedType , UnionType , canonicalType + , defaultTag , fields , innerType , jsonType , members , primitiveTypeIdentifier - , tags ) , TypeDeclaration ( Import , ServiceDeclaration @@ -53,9 +53,11 @@ module Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember) , typeAnnotations , typename ) + , unionType + , tags ) where -import Data.Maybe (isJust) +import Data.Maybe (isJust, maybeToList) import Data.String (IsString (fromString)) import qualified Data.Text as T @@ -66,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)) @@ -81,12 +83,22 @@ data Type | UnboxedType { innerType :: TypeExpression } | EnumType { members :: DeclarationSet EnumMember } | RecordType { fields :: DeclarationSet Field } - | UnionType { tags :: DeclarationSet 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) @@ -131,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' @@ -204,10 +225,10 @@ instance Construct TypeDeclaration where where fieldsCode = T.intercalate "\n" $ map toCode $ toList fields' docs' = A.lookupDocs annotationSet' - toCode (TypeDeclaration name' (UnionType tags') 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 ;" ] @@ -216,17 +237,20 @@ 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') - 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 bc1378a..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 @@ -34,6 +35,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 @@ -66,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 @@ -92,6 +82,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" @@ -249,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 @@ -267,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 @@ -295,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" @@ -328,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") @@ -340,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) @@ -349,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] @@ -391,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 @@ -405,13 +405,15 @@ recordTypeDeclaration = do spaces char ';' annotationSet'' <- annotationsWithDocs annotationSet' docs' - return $ TypeDeclaration typename (RecordType fields') annotationSet'' + return $ TypeDeclaration typeName (RecordType fields') annotationSet'' -tag :: Parser Tag +tag :: Parser (Tag, Bool) tag = do annotationSet' <- annotationSet "union tag annotations" spaces - tagName <- name "union tag name" + default' <- optional (string "default" "default tag") + spaces + tagName' <- name "union tag name" spaces paren <- optional $ char '(' spaces @@ -435,14 +437,18 @@ 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 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" @@ -452,11 +458,19 @@ 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'' + 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 @@ -537,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 @@ -551,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/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
#{blockToHtml d} |] typeDecl mod' ident - tc@TD.TypeDeclaration { TD.type' = TD.UnionType tags } = [shamlet| + tc@TD.TypeDeclaration { TD.type' = TD.UnionType tags _} = [shamlet|

union #{toNormalizedText ident} $maybe d <- docsBlock tc #{blockToHtml d} diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs index c982e53..0a97689 100644 --- a/src/Nirum/Targets/Python.hs +++ b/src/Nirum/Targets/Python.hs @@ -92,20 +92,7 @@ import Nirum.Constructs.Service ( Method ( Method , Parameter (Parameter) , Service (Service) ) -import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember) - , Field (Field, fieldName) - , PrimitiveTypeIdentifier (..) - , Tag (Tag) - , Type ( Alias - , EnumType - , PrimitiveType - , RecordType - , UnboxedType - , UnionType - , primitiveTypeIdentifier - ) - , TypeDeclaration (..) - ) +import Nirum.Constructs.TypeDeclaration as TD import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier , MapModifier , OptionModifier @@ -116,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 @@ -136,7 +122,6 @@ import Nirum.Package.Metadata ( Author (Author, name, email) , targetName , toByteString ) - , fieldType , stringField , tableField , versionField @@ -356,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 @@ -397,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] @@ -412,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 @@ -461,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 @@ -475,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 @@ -497,7 +482,7 @@ compileUnionTag source parentname d@(Tag typename' fields _) = do |] return [qq| class $className($parentClass): -{compileDocstringWithFields " " d fields} +{compileDocstringWithFields " " d fields'} __slots__ = ( $slots ) @@ -550,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 @@ -569,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) @@ -726,7 +711,7 @@ compileTypeDeclaration src d@TypeDeclaration { typename = typename' , type' = Alias ctype } = do ctypeExpr <- compileTypeExpression src (Just ctype) - return $ toStrict $ renderMarkup [compileText| + return $ toStrict $ renderMarkup $ [compileText| %{ case compileDocs d } %{ of Just rst } #: #{rst} @@ -822,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" @@ -831,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 } @@ -859,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] @@ -879,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 @@ -902,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, ) @@ -953,10 +938,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': @@ -980,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] @@ -996,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 ", " @@ -1009,17 +991,10 @@ class $className(object): ] compileTypeDeclaration src d@TypeDeclaration { typename = typename' - , type' = UnionType tags + , type' = union , 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 - ] - enumMembers = toIndentedCodes - (\ (t, b) -> [qq|$t = '{b}'|]) enumMembers' "\n " + tagCodes <- mapM (compileUnionTag src typename') tags' importTypingForPython3 insertStandardImport "enum" insertThirdPartyImports [ ("nirum.deserialize", ["deserialize_meta"]) @@ -1033,37 +1008,52 @@ compileTypeDeclaration src ) ] typeRepr <- typeReprCompiler - ret <- returnCompiler - arg <- parameterCompiler - return [qq| -class $className({T.intercalate "," $ compileExtendClasses annotations}): -{compileDocstring " " d} + pyVer <- getPythonVersion + return $ toStrict $ renderMarkup $ [compileText| +class #{className}(#{T.intercalate "," $ compileExtendClasses annotations}): +#{compileDocstring " " d} __nirum_type__ = 'union' - __nirum_union_behind_name__ = '{I.toSnakeCaseText $ N.behindName typename'}' - __nirum_field_names__ = name_dict_type([$nameMaps]) + __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 }: +%{ 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) + value['_tag'] = '#{toBehindSnakeCaseText $ tagName dt}' +%{ of Nothing } +%{ endcase } if '_type' not in value: raise ValueError('"_type" field is missing.') if '_tag' not in value: @@ -1111,29 +1101,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) +%{ forall tagCode <- tagCodes } +#{tagCode} -$tagCodes' +%{ endforall } -$className.__nirum_tag_classes__ = map_type( - (tcls.__nirum_tag__, tcls) - for tcls in [$tagClasses] -) +#{className}.__nirum_tag_classes__ = map_type({ +%{ forall (Tag tn _ _) <- tags' } + #{className}.Tag.#{toEnumMemberName tn}: #{toClassName' tn}, +%{ endforall } +}) |] where - enumMembers' :: [(T.Text, T.Text)] - enumMembers' = [ ( toEnumMemberName tagName - , I.toSnakeCaseText $ N.behindName tagName - ) - | (Tag tagName _ _) <- toList tags - ] - nameMaps :: T.Text - nameMaps = toIndentedCodes - toNamePair - [name' | Tag name' _ _ <- toList tags] - ",\n " + tags' :: [Tag] + tags' = DS.toList $ tags union + className :: T.Text + className = toClassName' typename' compileExtendClasses :: A.AnnotationSet -> [Code] compileExtendClasses annotations' = if null extendClasses @@ -1147,6 +1133,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' @@ -1445,7 +1434,7 @@ from #{from} import ( compilePackageMetadata :: Package' -> InstallRequires -> Code compilePackageMetadata Package - { metadata = Metadata + { metadata = MD.Metadata { authors = authors' , version = version' , description = description' @@ -1563,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 @@ -1635,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/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"] diff --git a/test/Nirum/Constructs/TypeDeclarationSpec.hs b/test/Nirum/Constructs/TypeDeclarationSpec.hs index d3dbee8..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' + 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 83ca3ad..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 @@ -656,6 +651,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] + Right 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 +679,7 @@ record dup ( rectTag = Tag "rectangle" rectangleFields empty noneTag = Tag "none" [] empty tags' = [circleTag, rectTag, noneTag] - union' = UnionType tags' + Right union' = unionType tags' Nothing a = TypeDeclaration "shape" union' empty b = a { typeAnnotations = singleDocs "shape type" } parse' [s| @@ -702,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,) @@ -723,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 @@ -806,7 +804,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" @@ -819,14 +823,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 @@ -835,7 +839,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 @@ -844,7 +848,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 @@ -908,7 +912,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 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'