diff --git a/CHANGES.md b/CHANGES.md index 446c542..df87bf8 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -118,6 +118,15 @@ To be released. - Fixed a compiler bug that an error message on name duplicates had referred to a wrong line/column number. [[#255]] + - Added aliased import. It's handy to avoid a name shadowing. + [[#217], [#258]] + + ~~~~~~~~ nirum + import iso (country as iso-country); + import types (country); + ~~~~~~~~ + + ### Docs target - A new required configuration `targets.docs.title` was added. @@ -175,12 +184,14 @@ To be released. March 2018. [#13]: https://github.com/spoqa/nirum/issues/13 +[#217]: https://github.com/spoqa/nirum/issues/217 [#220]: https://github.com/spoqa/nirum/issues/220 [#227]: https://github.com/spoqa/nirum/pull/227 [#253]: https://github.com/spoqa/nirum/pull/253 [#254]: https://github.com/spoqa/nirum/pull/254 [#255]: https://github.com/spoqa/nirum/pull/255 [#257]: https://github.com/spoqa/nirum/pull/257 +[#258]: https://github.com/spoqa/nirum/pull/258 [#259]: https://github.com/spoqa/nirum/pull/259 [entry points]: https://setuptools.readthedocs.io/en/latest/pkg_resources.html#entry-points [python2-numbers-integral]: https://docs.python.org/2/library/numbers.html#numbers.Integral diff --git a/examples/address.nrm b/examples/address.nrm index 3a118b4..10b0baa 100644 --- a/examples/address.nrm +++ b/examples/address.nrm @@ -1,4 +1,5 @@ import countries (country); +import geo (geo as geo-point); record address ( float32 lat, @@ -8,3 +9,8 @@ record address ( country country, text postal-code, ); + + +record pin ( + geo-point geo, +); diff --git a/examples/countries.nrm b/examples/countries.nrm index a262b47..946cd91 100644 --- a/examples/countries.nrm +++ b/examples/countries.nrm @@ -6,7 +6,7 @@ enum country | ax # Ă…land Islands | al # Albania | dz # Algeria - | as # American Samoa + | `as` # American Samoa | ad # Andorra | ao # Angola | ai # Anguilla diff --git a/examples/geo.nrm b/examples/geo.nrm new file mode 100644 index 0000000..3d7042e --- /dev/null +++ b/examples/geo.nrm @@ -0,0 +1,4 @@ +record geo ( + float32 latitude, + float32 longitude, +); diff --git a/src/Nirum/Constructs/Identifier.hs b/src/Nirum/Constructs/Identifier.hs index 336eb40..97a1034 100644 --- a/src/Nirum/Constructs/Identifier.hs +++ b/src/Nirum/Constructs/Identifier.hs @@ -62,6 +62,7 @@ reservedKeywords = [ "enum" , "unboxed" , "union" , "default" + , "as" ] identifierRule :: P.Parsec Void T.Text Identifier diff --git a/src/Nirum/Constructs/Module.hs b/src/Nirum/Constructs/Module.hs index 8482d5c..b228a66 100644 --- a/src/Nirum/Constructs/Module.hs +++ b/src/Nirum/Constructs/Module.hs @@ -57,10 +57,18 @@ instance Construct Module where where typeList :: [TypeDeclaration] typeList = DS.toList types' + importIdentifiersToCode :: (Identifier, Identifier) -> T.Text + importIdentifiersToCode (i, s) = if i == s + then toCode i + else T.concat [ toCode s + , " as " + , toCode i + ] importCodes :: [T.Text] importCodes = [ T.concat [ "import ", toCode p, " (" - , T.intercalate ", " $ map toCode $ S.toAscList i + , T.intercalate ", " $ + map importIdentifiersToCode $ S.toAscList i , ");" ] | (p, i) <- M.toAscList (imports m) @@ -76,9 +84,9 @@ instance Construct Module where instance Documented Module where docs (Module _ docs') = docs' -imports :: Module -> M.Map ModulePath (S.Set Identifier) +imports :: Module -> M.Map ModulePath (S.Set (Identifier, Identifier)) imports (Module decls _) = - M.fromListWith S.union [(p, [i]) | Import p i _ <- DS.toList decls] + M.fromListWith S.union [(p, [(i, s)]) | Import p i s _ <- DS.toList decls] coreModulePath :: ModulePath coreModulePath = ["core"] diff --git a/src/Nirum/Constructs/TypeDeclaration.hs b/src/Nirum/Constructs/TypeDeclaration.hs index 16cd966..493da98 100644 --- a/src/Nirum/Constructs/TypeDeclaration.hs +++ b/src/Nirum/Constructs/TypeDeclaration.hs @@ -49,6 +49,7 @@ module Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember) , service , serviceAnnotations , serviceName + , sourceName , type' , typeAnnotations , typename @@ -191,6 +192,7 @@ data TypeDeclaration } | Import { modulePath :: ModulePath , importName :: Identifier + , sourceName :: Identifier , importAnnotations :: AnnotationSet } deriving (Eq, Ord, Show) @@ -285,13 +287,16 @@ instance Construct TypeDeclaration where methodsText = T.intercalate "\n" $ map toCode methods' docs' :: Maybe Docs docs' = A.lookupDocs annotations' - toCode (Import path ident aSet) = T.concat [ "import " - , toCode path - , " (" - , toCode aSet - , toCode ident - , ");\n" - ] + toCode (Import path iName sName aSet) = T.concat + [ "import " + , toCode path + , " (" + , toCode aSet + , if iName == sName + then toCode iName + else T.concat [ toCode sName, " as ", toCode iName ] + , ");\n" + ] instance Documented TypeDeclaration diff --git a/src/Nirum/Package/ModuleSet.hs b/src/Nirum/Package/ModuleSet.hs index 29b67a8..ae1b675 100644 --- a/src/Nirum/Package/ModuleSet.hs +++ b/src/Nirum/Package/ModuleSet.hs @@ -90,12 +90,12 @@ detectMissingImports moduleSet = Nothing -> [MissingModulePathError path path'] Just (Module decls _) -> [ e - | i <- S.toList idents - , e <- case DS.lookup i decls of + | (_, s) <- S.toList idents + , e <- case DS.lookup s decls of Just TypeDeclaration {} -> [] Just ServiceDeclaration {} -> [] - Just Import {} -> [MissingImportError path path' i] - Nothing -> [MissingImportError path path' i] + Just Import {} -> [MissingImportError path path' s] + Nothing -> [MissingImportError path path' s] ] ] diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs index ec440b4..9fb93db 100644 --- a/src/Nirum/Parser.hs +++ b/src/Nirum/Parser.hs @@ -11,6 +11,7 @@ module Nirum.Parser ( Parser , handleNameDuplication , handleNameDuplicationError , identifier + , importName , imports , listModifier , mapModifier @@ -32,7 +33,7 @@ module Nirum.Parser ( Parser , unionTypeDeclaration ) where -import Control.Monad (void, when) +import Control.Monad (unless, void, when) import Data.Void import qualified System.IO as SIO @@ -627,28 +628,49 @@ modulePath = do f Nothing i = Just $ ModuleName i f (Just p) i = Just $ ModulePath p i -importName :: Parser (Identifier, A.AnnotationSet) -importName = do +importName :: [Identifier] + -> Parser (Identifier, Identifier, A.AnnotationSet) +importName forwardNames = do aSet <- annotationSet "import annotations" spaces iName <- identifier "name to import" - return (iName, aSet) + hasAlias <- optional $ try $ do + spaces + string' "as" + aName <- case hasAlias of + Just _ -> do + spaces + uniqueIdentifier forwardNames "alias name to import" + Nothing -> + return iName + return (aName, iName, aSet) -imports :: Parser [TypeDeclaration] -imports = do +imports :: [Identifier] -> Parser [TypeDeclaration] +imports forwardNames = do string' "import" "import keyword" spaces path <- modulePath "module path" spaces char '(' spaces - idents <- (importName >>= \ i -> spaces >> return i) - `sepEndBy1` (char ',' >> spaces) - "names to import" + idents <- many' [] $ \ importNames' -> do + notFollowedBy $ choice [char ')', char ',' >> spaces >> char ')'] + let forwardNames' = [i | (i, _, _) <- importNames'] ++ forwardNames + unless (L.null importNames') $ do + string' "," + spaces + n <- importName forwardNames' + spaces + return n + when (L.null idents) $ fail "parentheses cannot be empty" + void $ optional $ string' "," + spaces char ')' spaces char ';' - return [Import path ident aSet | (ident, aSet) <- idents] + return [ Import path imp source aSet + | (imp, source, aSet) <- idents + ] module' :: Parser Module @@ -660,7 +682,7 @@ module' = do return d spaces importLists <- many $ do - importList <- imports + importList <- imports [] spaces return importList let imports' = [i | l <- importLists, i <- l] diff --git a/src/Nirum/Targets/Python/Serializers.hs b/src/Nirum/Targets/Python/Serializers.hs index 8d204b0..338ff04 100644 --- a/src/Nirum/Targets/Python/Serializers.hs +++ b/src/Nirum/Targets/Python/Serializers.hs @@ -39,22 +39,22 @@ compileSerializer mod' (TypeIdentifier typeId) pythonVar = case lookupType typeId mod' of Missing -> "None" -- must never happen Local (Alias t) -> compileSerializer mod' t pythonVar - Imported modulePath' (Alias t) -> + Imported modulePath' _ (Alias t) -> case resolveBoundModule modulePath' (boundPackage mod') of Nothing -> "None" -- must never happen Just foundMod -> compileSerializer foundMod t pythonVar Local PrimitiveType { primitiveTypeIdentifier = p } -> compilePrimitiveTypeSerializer p pythonVar - Imported _ PrimitiveType { primitiveTypeIdentifier = p } -> + Imported _ _ PrimitiveType { primitiveTypeIdentifier = p } -> compilePrimitiveTypeSerializer p pythonVar Local EnumType {} -> serializerCall - Imported _ EnumType {} -> serializerCall + Imported _ _ EnumType {} -> serializerCall Local RecordType {} -> serializerCall - Imported _ RecordType {} -> serializerCall + Imported _ _ RecordType {} -> serializerCall Local UnboxedType {} -> serializerCall - Imported _ UnboxedType {} -> serializerCall + Imported _ _ UnboxedType {} -> serializerCall Local UnionType {} -> serializerCall - Imported _ UnionType {} -> serializerCall + Imported _ _ UnionType {} -> serializerCall where serializerCall :: Code serializerCall = [qq|$pythonVar.__nirum_serialize__()|] diff --git a/src/Nirum/Targets/Python/TypeExpression.hs b/src/Nirum/Targets/Python/TypeExpression.hs index dd14ba9..8f540fe 100644 --- a/src/Nirum/Targets/Python/TypeExpression.hs +++ b/src/Nirum/Targets/Python/TypeExpression.hs @@ -22,9 +22,12 @@ compileTypeExpression :: BoundModule Python compileTypeExpression mod' (Just (TypeIdentifier i)) = case lookupType i mod' of Missing -> fail $ "undefined identifier: " ++ toString i - Imported _ (PrimitiveType p _) -> compilePrimitiveType p - Imported m _ -> do - insertThirdPartyImports [(toImportPath target' m, [toClassName i])] + Imported _ _ (PrimitiveType p _) -> compilePrimitiveType p + Imported m in' _ -> do + insertThirdPartyImportsA [ ( toImportPath target' m + , [(toClassName i, toClassName in')] + ) + ] return $ toClassName i Local _ -> return $ toClassName i where diff --git a/src/Nirum/Targets/Python/Validators.hs b/src/Nirum/Targets/Python/Validators.hs index 33ad54b..8b33134 100644 --- a/src/Nirum/Targets/Python/Validators.hs +++ b/src/Nirum/Targets/Python/Validators.hs @@ -65,13 +65,13 @@ compileValidator mod' (TypeIdentifier typeId) pythonVar = case lookupType typeId mod' of Missing -> return $ Validator "False" [] -- must never happen Local (Alias typeExpr') -> compileValidator mod' typeExpr' pythonVar - Imported modulePath' (Alias typeExpr') -> + Imported modulePath' _ (Alias typeExpr') -> case resolveBoundModule modulePath' (boundPackage mod') of Nothing -> return $ Validator "False" [] -- must never happen Just foundMod -> compileValidator foundMod typeExpr' pythonVar Local PrimitiveType { primitiveTypeIdentifier = pId } -> compilePrimitiveTypeValidator pId pythonVar - Imported _ PrimitiveType { primitiveTypeIdentifier = pId } -> + Imported _ _ PrimitiveType { primitiveTypeIdentifier = pId } -> compilePrimitiveTypeValidator pId pythonVar _ -> compileInstanceValidator mod' typeId pythonVar diff --git a/src/Nirum/TypeInstance/BoundModule.hs b/src/Nirum/TypeInstance/BoundModule.hs index ac92c61..4ed1424 100644 --- a/src/Nirum/TypeInstance/BoundModule.hs +++ b/src/Nirum/TypeInstance/BoundModule.hs @@ -47,25 +47,28 @@ boundTypes = findInBoundModule types DS.empty data TypeLookup = Missing | Local Type - | Imported ModulePath Type + | Imported ModulePath Identifier Type deriving (Eq, Ord, Show) lookupType :: Target t => Identifier -> BoundModule t -> TypeLookup lookupType identifier boundModule = case DS.lookup identifier (boundTypes boundModule) of - Nothing -> toType coreModulePath - (DS.lookup identifier $ types coreModule) + Nothing -> + toType + coreModulePath + identifier + (DS.lookup identifier $ types coreModule) Just TypeDeclaration { type' = t } -> Local t - Just (Import path' _ _) -> + Just (Import path' _ s _) -> case resolveModule path' (boundPackage boundModule) of Nothing -> Missing Just (Module decls _) -> - toType path' (DS.lookup identifier decls) + toType path' s (DS.lookup s decls) Just ServiceDeclaration {} -> Missing where - toType :: ModulePath -> Maybe TypeDeclaration -> TypeLookup - toType mp (Just TypeDeclaration { type' = t }) = Imported mp t - toType _ _ = Missing + toType :: ModulePath -> Identifier -> Maybe TypeDeclaration -> TypeLookup + toType mp i (Just TypeDeclaration { type' = t }) = Imported mp i t + toType _ _ _ = Missing instance Target t => Documented (BoundModule t) where docs = findInBoundModule Nirum.Constructs.Module.docs Nothing diff --git a/test/Nirum/CodeBuilderSpec.hs b/test/Nirum/CodeBuilderSpec.hs index a9c47b4..a9c1aa5 100644 --- a/test/Nirum/CodeBuilderSpec.hs +++ b/test/Nirum/CodeBuilderSpec.hs @@ -79,9 +79,9 @@ spec = do let run' = fst . runBuilder package ["fruits"] () let core = ModuleName "core" run' (lookupType "text") `shouldBe` - Imported core (TD.PrimitiveType TD.Text TD.String) + Imported core "text" (TD.PrimitiveType TD.Text TD.String) run' (lookupType "int32") `shouldBe` - Imported core (TD.PrimitiveType TD.Int32 TD.Number) + Imported core "int32" (TD.PrimitiveType TD.Int32 TD.Number) data DummyTarget = DummyTarget deriving (Eq, Ord, Show) diff --git a/test/Nirum/Constructs/ModuleSpec.hs b/test/Nirum/Constructs/ModuleSpec.hs index d3c0dcf..7514d3f 100644 --- a/test/Nirum/Constructs/ModuleSpec.hs +++ b/test/Nirum/Constructs/ModuleSpec.hs @@ -21,20 +21,27 @@ spec = pathT = TypeDeclaration "path" (Alias "text") (singleton docsAnno) offsetT = TypeDeclaration "offset" (UnboxedType "float64") empty - decls = [ Import ["foo", "bar"] "baz" empty - , Import ["foo", "bar"] "qux" empty - , Import ["zzz"] "qqq" empty - , Import ["zzz"] "ppp" empty - , Import ["xyz"] "asdf" empty + decls = [ Import ["foo", "bar"] "baz" "baz" empty + , Import ["foo", "bar"] "qux" "qux" empty + , Import ["zzz"] "qqq" "qqq" empty + , Import ["zzz"] "ppp" "ppp" empty + , Import ["xyz"] "asdf" "asdf" empty , pathT , offsetT ] :: DeclarationSet TypeDeclaration + decls2 = [ Import ["foo", "bar"] "qux" "baz" empty + ] :: DeclarationSet TypeDeclaration mod1 = Module decls Nothing mod2 = Module decls $ Just "module level docs...\nblahblah" + mod3 = Module decls2 Nothing specify "imports" $ do - imports mod1 `shouldBe` [ (["foo", "bar"], ["baz", "qux"]) - , (["xyz"], ["asdf"]) - , (["zzz"], ["qqq", "ppp"]) + imports mod1 `shouldBe` [ ( ["foo", "bar"] + , [("baz", "baz"), ("qux", "qux")] + ) + , (["xyz"], [("asdf", "asdf")]) + , ( ["zzz"] + , [("qqq", "qqq"), ("ppp", "ppp")] + ) ] imports mod2 `shouldBe` imports mod1 specify "toCode" $ do @@ -57,4 +64,8 @@ type path = text; # path string unboxed offset (float64); +|] + toCode mod3 `shouldBe` [q|import foo.bar (baz as qux); + + |] diff --git a/test/Nirum/Constructs/TypeDeclarationSpec.hs b/test/Nirum/Constructs/TypeDeclarationSpec.hs index dd5cf5c..bcd92ac 100644 --- a/test/Nirum/Constructs/TypeDeclarationSpec.hs +++ b/test/Nirum/Constructs/TypeDeclarationSpec.hs @@ -185,13 +185,21 @@ service ping-service ( "@bar(val = \"baz\")\nservice anno-service (bool ping ());" -- TODO: more tests context "Import" $ do - let import' = Import ["foo", "bar"] "baz" empty + let import' = Import ["foo", "bar"] "baz" "baz" empty + let importAliasing = Import ["foo", "bar"] "qux" "baz" empty specify "name" $ name import' `shouldBe` "baz" specify "docs" $ docs import' `shouldBe` Nothing specify "toCode" $ toCode import' `shouldBe` "import foo.bar (baz);\n" + specify "name" $ + name importAliasing `shouldBe` "qux" + specify "docs" $ + docs importAliasing `shouldBe` Nothing + specify "toCode" $ + toCode importAliasing `shouldBe` + "import foo.bar (baz as qux);\n" context "member/tag name shadowing" $ do let fromRight either' = head [v | Right v <- [either']] diff --git a/test/Nirum/Package/ModuleSetSpec.hs b/test/Nirum/Package/ModuleSetSpec.hs index 051acb8..27ac58f 100644 --- a/test/Nirum/Package/ModuleSetSpec.hs +++ b/test/Nirum/Package/ModuleSetSpec.hs @@ -47,45 +47,67 @@ validModules = , (["foo", "baz"], Module [] $ Just "foo.baz") , (["qux"], Module [] $ Just "qux") , ( ["xyz"] - , Module [ Import ["abc"] "a" empty + , Module [ Import ["abc"] "a" "a" empty , TypeDeclaration "x" (Alias "text") empty - ] Nothing + ] + Nothing + ) + , ( ["zar"] + , Module [ Import ["abc"] "aliased" "a" empty + , TypeDeclaration "quuz" (Alias "text") empty + ] + Nothing ) ] missingImportsModules :: [(ModulePath, Module)] missingImportsModules = [ ( ["foo"] - , Module [ Import ["foo", "bar"] "xyz" empty -- MissingModulePathError - , Import ["foo", "bar"] "zzz" empty -- MissingModulePathError - , Import ["baz"] "qux" empty - ] Nothing + , Module + [ Import ["foo", "bar"] "xyz" "xyz" empty -- MissingModulePathError + , Import ["foo", "bar"] "zzz" "zzz" empty -- MissingModulePathError + , Import ["baz"] "qux" "qux" empty + ] + Nothing ) , ( ["baz"] , Module [ TypeDeclaration "qux" (Alias "text") empty ] Nothing ) - , (["qux"], Module [ Import ["foo"] "abc" empty -- MissingImportError - , Import ["foo"] "def" empty -- MissingImportError - ] Nothing) + , ( ["qux"] + , Module [ Import ["foo"] "abc" "abc" empty -- MissingImportError + , Import ["foo"] "def" "def" empty -- MissingImportError + ] + Nothing + ) ] circularImportsModules :: [(ModulePath, Module)] circularImportsModules = - [ (["asdf"], Module [ Import ["asdf"] "foo" empty - , TypeDeclaration "bar" (Alias "text") empty - ] Nothing) - , (["abc", "def"], Module [ Import ["abc", "ghi"] "bar" empty - , TypeDeclaration - "foo" (Alias "text") empty - ] Nothing) - , (["abc", "ghi"], Module [ Import ["abc", "xyz"] "baz" empty - , TypeDeclaration - "bar" (Alias "text") empty - ] Nothing) - , (["abc", "xyz"], Module [ Import ["abc", "def"] "foo" empty - , TypeDeclaration - "baz" (Alias "text") empty - ] Nothing) + [ ( ["asdf"] + , Module [ Import ["asdf"] "foo" "foo" empty + , TypeDeclaration "bar" (Alias "text") empty + ] + Nothing + ) + , ( ["abc", "def"] + , Module [ Import ["abc", "ghi"] "bar" "bar" empty + , TypeDeclaration + "foo" (Alias "text") empty + ] + Nothing + ) + , ( ["abc", "ghi"] + , Module [ Import ["abc", "xyz"] "baz" "baz" empty + , TypeDeclaration "bar" (Alias "text") empty + ] + Nothing + ) + , ( ["abc", "xyz"] + , Module [ Import ["abc", "def"] "foo" "foo" empty + , TypeDeclaration "baz" (Alias "text") empty + ] + Nothing + ) ] spec :: Spec @@ -119,7 +141,7 @@ spec = mod' `shouldBe` fooBarModule lookup ["wrong", "path"] validModuleSet `shouldSatisfy` isNothing specify "length" $ - length validModuleSet `shouldBe` 6 + length validModuleSet `shouldBe` 7 specify "null" $ validModuleSet `shouldNotSatisfy` null where diff --git a/test/Nirum/PackageSpec.hs b/test/Nirum/PackageSpec.hs index 46fc341..50539e6 100644 --- a/test/Nirum/PackageSpec.hs +++ b/test/Nirum/PackageSpec.hs @@ -82,8 +82,10 @@ testPackage target' = do Right countriesM <- parseFile (path "countries.nrm") Right addressM <- parseFile (path "address.nrm") Right pdfServiceM <- parseFile (path "pdf-service.nrm") + Right geoM <- parseFile (path "geo.nrm") let modules = [ (["blockchain"], blockchainM) , (["builtins"], builtinsM) + , (["geo"], geoM) , (["product"], productM) , (["shapes"], shapesM) , (["countries"], countriesM) @@ -122,6 +124,7 @@ testPackage target' = do mods' <- scanModules path mods' `shouldBe` [ (["blockchain"], path "blockchain.nrm") , (["builtins"], path "builtins.nrm") + , (["geo"], path "geo.nrm") , (["product"], path "product.nrm") , (["shapes"], path "shapes.nrm") , (["countries"], path "countries.nrm") diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs index a971f8a..a95870e 100644 --- a/test/Nirum/ParserSpec.hs +++ b/test/Nirum/ParserSpec.hs @@ -1145,70 +1145,123 @@ service method-dups ( expectError "foo.bar.baz." 1 13 describe "imports" $ do - let (parse', expectError) = helperFuncs P.imports - it "emits Import values if succeeded to parse" $ + let (parse', expectError) = helperFuncs $ P.imports [] + it "can single import name w/o trailing comma" $ do + parse' "import foo.bar (a);" `shouldBeRight` + [Import ["foo", "bar"] "a" "a" empty] + parse' "import foo.bar (a as qux);" `shouldBeRight` + [Import ["foo", "bar"] "qux" "a" empty] + it "can single import name w/ trailing comma" $ do + parse' "import foo.bar (a,);" `shouldBeRight` + [Import ["foo", "bar"] "a" "a" empty] + parse' "import foo.bar (a as qux,);" `shouldBeRight` + [Import ["foo", "bar"] "qux" "a" empty] + it "emits Import values if succeeded to parse" $ do parse' "import foo.bar (a, b);" `shouldBeRight` - [ Import ["foo", "bar"] "a" empty - , Import ["foo", "bar"] "b" empty + [ Import ["foo", "bar"] "a" "a" empty + , Import ["foo", "bar"] "b" "b" empty + ] + parse' "import foo.bar (a as foo, b as bar);" `shouldBeRight` + [ Import ["foo", "bar"] "foo" "a" empty + , Import ["foo", "bar"] "bar" "b" empty ] it "can be annotated" $ do parse' "import foo.bar (@foo (v = \"bar\") a, @baz b);" `shouldBeRight` - [ Import ["foo", "bar"] "a" fooAnnotationSet - , Import ["foo", "bar"] "b" bazAnnotationSet + [ Import ["foo", "bar"] "a" "a" fooAnnotationSet + , Import ["foo", "bar"] "b" "b" bazAnnotationSet ] parse' "import foo.bar (@foo (v = \"bar\") @baz a, b);" `shouldBeRight` - [ Import ["foo", "bar"] "a" $ + [ Import ["foo", "bar"] "a" "a" $ union fooAnnotationSet bazAnnotationSet - , Import ["foo", "bar"] "b" empty + , Import ["foo", "bar"] "b" "b" empty + ] + parse' + "import foo.bar (@foo (v = \"bar\") a as foo, @baz b as bar);" + `shouldBeRight` + [ Import ["foo", "bar"] "foo" "a" fooAnnotationSet + , Import ["foo", "bar"] "bar" "b" bazAnnotationSet ] - specify "import names can have a trailing comma" $ + parse' + "import foo.bar (@foo (v = \"bar\") @baz a as foo, b as bar);" + `shouldBeRight` + [ Import ["foo", "bar"] "foo" "a" $ + union fooAnnotationSet bazAnnotationSet + , Import ["foo", "bar"] "bar" "b" empty + ] + specify "import names can have a trailing comma" $ do parse' "import foo.bar (a, b,);" `shouldBeRight` - [ Import ["foo", "bar"] "a" empty - , Import ["foo", "bar"] "b" empty + [ Import ["foo", "bar"] "a" "a" empty + , Import ["foo", "bar"] "b" "b" empty + ] + parse' "import foo.bar (a as foo, b as bar,);" `shouldBeRight` + [ Import ["foo", "bar"] "foo" "a" empty + , Import ["foo", "bar"] "bar" "b" empty ] specify "import names in parentheses can be multiline" $ do -- without a trailing comma parse' "import foo.bar (\n a,\n b\n);" `shouldBeRight` - [ Import ["foo", "bar"] "a" empty - , Import ["foo", "bar"] "b" empty + [ Import ["foo", "bar"] "a" "a" empty + , Import ["foo", "bar"] "b" "b" empty ] + parse' "import foo.bar (\n a as foo,\n b as bar\n);" + `shouldBeRight` + [ Import ["foo", "bar"] "foo" "a" empty + , Import ["foo", "bar"] "bar" "b" empty + ] -- with a trailing comma - parse' "import foo.bar (\n c,\n d,\n);" `shouldBeRight` - [ Import ["foo", "bar"] "c" empty - , Import ["foo", "bar"] "d" empty - ] + parse' "import foo.bar (\n c,\n d,\n);" + `shouldBeRight` + [ Import ["foo", "bar"] "c" "c" empty + , Import ["foo", "bar"] "d" "d" empty + ] + parse' "import foo.bar (\n c as foo,\n d as bar,\n);" + `shouldBeRight` + [ Import ["foo", "bar"] "foo" "c" empty + , Import ["foo", "bar"] "bar" "d" empty + ] + it "errors if parentheses have nothing" $ expectError "import foo.bar ();" 1 17 + it "disallows when there are duplicated alias names" $ + expectError "import foo.bar (lorem as yolo, ipsum as yolo);" 1 41 - describe "module'" $ context "handling name duplications" $ do - let (_, expectError) = helperFuncs P.module' - let examples = - -- Vertical alignment of `dup` is an intention; it purposes - -- to generate the same error offsets. - [ "type dup = text;" - , "unboxed dup (text);" - , "record dup (text a);" - , "enum dup = m1 | m2;" - , "enum e1 = dup | foo;" - , "union dup = t1 | t2;" - , "union u1 = dup | foo;" - , "service dup (text ping ());" - ] - let importExample = "import foo (dup);" - let shiftDigit = \ case - '1' -> '3' - '2' -> '4' - c -> c - let inputs = [ (a, if a == b then T.map shiftDigit b else b) - | a <- importExample : examples - , b <- examples - ] - forM_ inputs $ \ (forward, shadowing) -> - let input = T.concat [forward, "\n", shadowing] - in - specify (T.unpack input) $ expectError input 2 12 + describe "module'" $ do + context "handling name duplications" $ do + let (_, expectError) = helperFuncs P.module' + let examples = + -- Vertical alignment of `dup` is an intention; it purposes + -- to generate the same error offsets. + [ "type dup = text;" + , "unboxed dup (text);" + , "record dup (text a);" + , "enum dup = m1 | m2;" + , "enum e1 = dup | foo;" + , "union dup = t1 | t2;" + , "union u1 = dup | foo;" + , "service dup (text ping ());" + ] + let importExample = "import foo (dup);" + let shiftDigit = \ case + '1' -> '3' + '2' -> '4' + c -> c + let inputs = [ (a, if a == b then T.map shiftDigit b else b) + | a <- importExample : examples + , b <- examples + ] + forM_ inputs $ \ (forward, shadowing) -> + let input = T.concat [forward, "\n", shadowing] + in + specify (T.unpack input) $ expectError input 2 12 + specify "allows import duplicated source name when it use alias" $ do + let (parse', _) = helperFuncs P.module' + parse' "import foo.bar (a);\n import lorem.ipsum (a as dolor);" + `shouldBeRight` + Module [ Import ["foo", "bar"] "a" "a" empty + , Import ["lorem", "ipsum"] "dolor" "a" empty + ] Nothing specify "parse & parseFile" $ do files <- getDirectoryContents "examples" diff --git a/test/Nirum/Targets/DocsSpec.hs b/test/Nirum/Targets/DocsSpec.hs index 1310b36..597cff3 100644 --- a/test/Nirum/Targets/DocsSpec.hs +++ b/test/Nirum/Targets/DocsSpec.hs @@ -23,7 +23,8 @@ import Nirum.TestFixtures spec :: Spec spec = describe "Docs" $ do - let decls = [Import ["zzz"] "qqq" empty] :: DeclarationSet TypeDeclaration + let decls = [ Import ["zzz"] "qqq" "qqq" empty + ] :: DeclarationSet TypeDeclaration mod1 = Module decls Nothing mod2 = Module decls $ Just "module level docs...\nblahblah" mod3 = Module decls $ Just "# One Spoqa Trinity Studio\nblahblah" diff --git a/test/Nirum/Targets/Python/CodeGenSpec.hs b/test/Nirum/Targets/Python/CodeGenSpec.hs index e9e5ff9..cd4ee55 100644 --- a/test/Nirum/Targets/Python/CodeGenSpec.hs +++ b/test/Nirum/Targets/Python/CodeGenSpec.hs @@ -55,7 +55,7 @@ makeDummySource' pathPrefix m renames = metadata' [ (mp ["foo"], m) , ( mp ["foo", "bar"] - , Module [ Import (mp ["qux"]) "path" empty + , Module [ Import (mp ["qux"]) "path" "path" empty , TypeDeclaration "path-unbox" (UnboxedType "path") empty , TypeDeclaration "int-unbox" (UnboxedType "bigint") empty diff --git a/test/Nirum/TargetsSpec.hs b/test/Nirum/TargetsSpec.hs index ae28b8d..e1acd6e 100644 --- a/test/Nirum/TargetsSpec.hs +++ b/test/Nirum/TargetsSpec.hs @@ -56,6 +56,7 @@ spec = , "src-py2" "blockchain" "__init__.py" , "src-py2" "builtins" "__init__.py" , "src-py2" "countries" "__init__.py" + , "src-py2" "geo" "__init__.py" , "src-py2" "pdf_service" "__init__.py" , "src-py2" "product" "__init__.py" , "src-py2" "shapes" "__init__.py" @@ -63,6 +64,7 @@ spec = , "src" "blockchain" "__init__.py" , "src" "builtins" "__init__.py" , "src" "countries" "__init__.py" + , "src" "geo" "__init__.py" , "src" "pdf_service" "__init__.py" , "src" "product" "__init__.py" , "src" "shapes" "__init__.py" diff --git a/test/Nirum/TypeInstance/BoundModuleSpec.hs b/test/Nirum/TypeInstance/BoundModuleSpec.hs index 893013a..a604163 100644 --- a/test/Nirum/TypeInstance/BoundModuleSpec.hs +++ b/test/Nirum/TypeInstance/BoundModuleSpec.hs @@ -37,25 +37,31 @@ testPackage target' = do let Just bm = resolveBoundModule ["foo", "bar"] validPackage Just abc = resolveBoundModule ["abc"] validPackage Just xyz = resolveBoundModule ["xyz"] validPackage + Just zar = resolveBoundModule ["zar"] validPackage specify "docs" $ do docs bm `shouldBe` Just "foo.bar" let Just bm' = resolveBoundModule ["foo"] validPackage docs bm' `shouldBe` Just "foo" specify "boundTypes" $ do boundTypes bm `shouldBe` [] - boundTypes abc `shouldBe` [TypeDeclaration "a" (Alias "text") empty] + boundTypes abc `shouldBe` + [TypeDeclaration "a" (Alias "text") empty] boundTypes xyz `shouldBe` - [ Import ["abc"] "a" empty + [ Import ["abc"] "a" "a" empty , TypeDeclaration "x" (Alias "text") empty ] specify "lookupType" $ do lookupType "a" bm `shouldBe` Missing lookupType "a" abc `shouldBe` Local (Alias "text") - lookupType "a" xyz `shouldBe` Imported ["abc"] (Alias "text") + lookupType "a" xyz `shouldBe` Imported ["abc"] "a" (Alias "text") + lookupType "aliased" zar `shouldBe` + Imported ["abc"] "a" (Alias "text") lookupType "x" bm `shouldBe` Missing lookupType "x" abc `shouldBe` Missing lookupType "x" xyz `shouldBe` Local (Alias "text") + lookupType "quuz" zar `shouldBe` Local (Alias "text") lookupType "text" bm `shouldBe` - Imported coreModulePath (PrimitiveType Text String) + Imported coreModulePath "text" (PrimitiveType Text String) lookupType "text" abc `shouldBe` lookupType "text" bm lookupType "text" xyz `shouldBe` lookupType "text" bm + lookupType "text" zar `shouldBe` lookupType "text" bm diff --git a/test/nirum_fixture/fixture/alias.nrm b/test/nirum_fixture/fixture/alias.nrm new file mode 100644 index 0000000..fc25119 --- /dev/null +++ b/test/nirum_fixture/fixture/alias.nrm @@ -0,0 +1,7 @@ +import fixture.types (float-unbox as float64-unbox); +import fixture.foo (float-unbox as float32-unbox); + +record float-unbox ( + float64-unbox f64, + float32-unbox f32, +); diff --git a/test/nirum_fixture/fixture/types.nrm b/test/nirum_fixture/fixture/types.nrm index 980f0bb..272fe48 100644 --- a/test/nirum_fixture/fixture/types.nrm +++ b/test/nirum_fixture/fixture/types.nrm @@ -3,3 +3,5 @@ unboxed uuid-list ([uuid]); unboxed int32-unboxed (int32); unboxed datetime-unboxed (datetime); + +unboxed float-unbox (float32); diff --git a/test/python/alias_test.py b/test/python/alias_test.py new file mode 100644 index 0000000..0145836 --- /dev/null +++ b/test/python/alias_test.py @@ -0,0 +1,16 @@ +from fixture.types import FloatUnbox as OriginFloat64 +from fixture.foo import FloatUnbox as OriginFloat32 +from fixture.alias import FloatUnbox as FloatUnboxRecord + + +def test_aliasing_import(): + record = FloatUnboxRecord( + f64=OriginFloat64(3.14), + f32=OriginFloat32(1.59), + ) + assert record + alias_mod = __import__('fixture').alias + assert hasattr(alias_mod, 'Float32Unbox') + assert alias_mod.Float32Unbox is OriginFloat32 + assert hasattr(alias_mod, 'Float64Unbox') + assert alias_mod.Float64Unbox is OriginFloat64 diff --git a/test/python/setup_test.py b/test/python/setup_test.py index 2c4adfc..f03a597 100644 --- a/test/python/setup_test.py +++ b/test/python/setup_test.py @@ -22,7 +22,7 @@ def test_setup_metadata(): assert set(pkg['Provides']) == { 'fixture', 'fixture.foo', 'fixture.foo.bar', 'fixture.qux', 'fixture.reserved_keyword_enum', 'fixture.reserved_keyword_union', - 'fixture.types', + 'fixture.types', 'fixture.alias', 'renamed', 'renamed.foo', 'renamed.foo.bar', } assert ['0.3.0'] == pkg['Version'] @@ -36,6 +36,7 @@ def test_module_entry_points(): 'fixture.foo', 'fixture.foo.bar', 'fixture.qux', 'fixture.reserved-keyword-enum', 'fixture.reserved-keyword-union', 'fixture.types', + 'fixture.alias', 'renames.test.foo', 'renames.test.foo.bar', } import fixture.foo