diff --git a/CHANGES.md b/CHANGES.md index df268d9..a7c0553 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -126,6 +126,14 @@ To be released. import types (country); ~~~~~~~~ + - Added support for integer type annotation argument. [[#178], [#267]] + + ~~~~~~~~ nirum + service foo-service ( + @bar(baz=1) + int32 qux (int32 quux), + ); + ~~~~~~~~ ### Docs target @@ -187,6 +195,7 @@ To be released. [#13]: https://github.com/spoqa/nirum/issues/13 [#100]: https://github.com/spoqa/nirum/issues/100 +[#178]: https://github.com/spoqa/nirum/issues/178 [#217]: https://github.com/spoqa/nirum/issues/217 [#220]: https://github.com/spoqa/nirum/issues/220 [#227]: https://github.com/spoqa/nirum/pull/227 @@ -196,6 +205,7 @@ To be released. [#257]: https://github.com/spoqa/nirum/pull/257 [#258]: https://github.com/spoqa/nirum/pull/258 [#259]: https://github.com/spoqa/nirum/pull/259 +[#267]: https://github.com/spoqa/nirum/pull/267 [#269]: https://github.com/spoqa/nirum/pull/269 [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/src/Nirum/Constructs/Annotation.hs b/src/Nirum/Constructs/Annotation.hs index 85849b5..5a087b1 100644 --- a/src/Nirum/Constructs/Annotation.hs +++ b/src/Nirum/Constructs/Annotation.hs @@ -27,10 +27,10 @@ import Nirum.Constructs.Annotation.Internal import Nirum.Constructs.Docs import Nirum.Constructs.Identifier (Identifier) - docs :: Docs -> Annotation docs (Docs d) = Annotation { name = docsAnnotationName - , arguments = M.singleton docsAnnotationParameter d + , arguments = + M.singleton docsAnnotationParameter $ Text d } newtype NameDuplication = AnnotationNameDuplication Identifier @@ -79,7 +79,9 @@ lookupDocs :: AnnotationSet -> Maybe Docs lookupDocs annotationSet = do Annotation _ args <- lookup docsAnnotationName annotationSet d <- M.lookup docsAnnotationParameter args - return $ Docs d + case d of + Text d' -> Just $ Docs d' + _ -> Nothing insertDocs :: (Monad m) => Docs -> AnnotationSet -> m AnnotationSet insertDocs docs' (AnnotationSet anno) = @@ -90,4 +92,4 @@ insertDocs docs' (AnnotationSet anno) = insertLookup :: Ord k => k -> a -> M.Map k a -> (Maybe a, M.Map k a) insertLookup = M.insertLookupWithKey $ \ _ a _ -> a args :: AnnotationArgumentSet - args = M.singleton docsAnnotationParameter $ toText docs' + args = M.singleton docsAnnotationParameter $ Text $ toText docs' diff --git a/src/Nirum/Constructs/Annotation/Internal.hs b/src/Nirum/Constructs/Annotation/Internal.hs index 4a8b0c4..f710b48 100644 --- a/src/Nirum/Constructs/Annotation/Internal.hs +++ b/src/Nirum/Constructs/Annotation/Internal.hs @@ -4,6 +4,9 @@ module Nirum.Constructs.Annotation.Internal , arguments , name ) + , AnnotationArgument ( Text + , Integer + ) , AnnotationArgumentSet , AnnotationSet ( AnnotationSet , annotations @@ -20,7 +23,11 @@ import Nirum.Constructs (Construct (toCode)) import Nirum.Constructs.Docs import Nirum.Constructs.Identifier (Identifier) -type AnnotationArgumentSet = M.Map Identifier T.Text +data AnnotationArgument = Text T.Text + | Integer Integer + deriving (Eq, Ord, Show) + +type AnnotationArgumentSet = M.Map Identifier AnnotationArgument -- | Annotation for 'Declaration'. data Annotation = Annotation { name :: Identifier @@ -32,10 +39,13 @@ instance Construct Annotation where | M.null args = '@' `T.cons` toCode n | otherwise = [qq|@{toCode n}({showArgs $ M.toList args})|] where - showArgs :: [(Identifier, T.Text)] -> T.Text + showArgs :: [(Identifier, AnnotationArgument)] -> T.Text showArgs args' = T.intercalate ", " $ map showArg args' - showArg :: (Identifier, T.Text) -> T.Text - showArg (key, value) = [qq|{toCode key} = {literal value}|] + showArg :: (Identifier, AnnotationArgument) -> T.Text + showArg (key, value) = [qq|{toCode key} = {argToText value}|] + argToText :: AnnotationArgument -> T.Text + argToText (Text t) = literal t + argToText (Integer i) = T.pack $ show i literal :: T.Text -> T.Text literal s = [qq|"{(showLitString $ T.unpack s) ""}"|] showLitString :: String -> ShowS diff --git a/src/Nirum/Constructs/Docs.hs b/src/Nirum/Constructs/Docs.hs index 0d9ad93..f2f93ba 100644 --- a/src/Nirum/Constructs/Docs.hs +++ b/src/Nirum/Constructs/Docs.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Nirum.Constructs.Docs ( Docs (Docs) - , docsAnnotationName , docsAnnotationParameter + , docsAnnotationName , title , toBlock , toCode @@ -17,12 +17,12 @@ import Nirum.Constructs (Construct (toCode)) import Nirum.Constructs.Identifier (Identifier) import Nirum.Docs (Block (Document, Heading), parse) -docsAnnotationName :: Identifier -docsAnnotationName = "docs" - docsAnnotationParameter :: Identifier docsAnnotationParameter = "docs" +docsAnnotationName :: Identifier +docsAnnotationName = "docs" + -- | Docstring for constructs. newtype Docs = Docs T.Text deriving (Eq, Ord, Show) diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs index 9fb93db..d6e73e8 100644 --- a/src/Nirum/Parser.hs +++ b/src/Nirum/Parser.hs @@ -44,6 +44,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as TIO import Text.Megaparsec hiding (ParseError, parse) import Text.Megaparsec.Char ( char + , digitChar , eol , noneOf , spaceChar @@ -52,8 +53,14 @@ import Text.Megaparsec.Char ( char ) import qualified Text.Megaparsec.Error as E import Text.Megaparsec.Char.Lexer (charLiteral) +import Text.Read hiding (choice) import qualified Nirum.Constructs.Annotation as A +import Nirum.Constructs.Annotation.Internal hiding ( Text + , annotations + , name + ) +import qualified Nirum.Constructs.Annotation.Internal as AI import Nirum.Constructs.Declaration (Declaration) import qualified Nirum.Constructs.Declaration as D import Nirum.Constructs.Docs (Docs (Docs)) @@ -162,13 +169,26 @@ uniqueName forwardNames label' = try $ do nameP :: Parser Name nameP = name label' -annotationArgumentValue :: Parser T.Text +integer :: Parser Integer +integer = do + v <- many digitChar + case readMaybe v of + Just i -> return i + Nothing -> fail "digit expected." -- never happened + + +annotationArgumentValue :: Parser AnnotationArgument annotationArgumentValue = do - char '"' - value <- manyTill charLiteral (char '"') - return $ T.pack value + startQuote <- optional $ try $ char '"' + case startQuote of + Just _ -> do + v <- manyTill charLiteral (char '"') + return $ AI.Text $ T.pack v + Nothing -> do + v <- integer + return $ Integer v -annotationArgument :: Parser (Identifier, T.Text) +annotationArgument :: Parser (Identifier, AnnotationArgument) annotationArgument = do arg <- identifier "annotation parameter" spaces diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs index e9af30c..fb910d0 100644 --- a/src/Nirum/Targets/Python.hs +++ b/src/Nirum/Targets/Python.hs @@ -40,6 +40,8 @@ import Text.Heterocephalus (compileText) import Text.InterpolatedString.Perl6 (q, qq) import qualified Nirum.Constructs.Annotation as A +import Nirum.Constructs.Annotation.Internal hiding (Text, annotations, name) +import qualified Nirum.Constructs.Annotation.Internal as AI import qualified Nirum.Constructs.DeclarationSet as DS import qualified Nirum.Constructs.Identifier as I import Nirum.Constructs.Declaration (Documented (docsBlock)) @@ -1198,15 +1200,15 @@ if hasattr({className}.Client, '__qualname__'): compileAnnotation ident annoArgument = toKeyItem ident $ wrapMap $ T.intercalate "," - [ toKeyStr ident' value :: T.Text + [ [qq|'{toAttributeName ident'}': {annoArgToText value}|] | (ident', value) <- M.toList annoArgument ] where escapeSingle :: T.Text -> T.Text escapeSingle = T.strip . T.replace "'" "\\'" - toKeyStr :: I.Identifier -> T.Text -> T.Text - toKeyStr k v = - [qq|'{toAttributeName k}': u'''{escapeSingle v}'''|] + annoArgToText :: AnnotationArgument -> T.Text + annoArgToText (AI.Text t) = [qq|u'''{escapeSingle t}'''|] + annoArgToText (Integer i) = T.pack $ show i compileMethodAnnotation :: Method -> T.Text compileMethodAnnotation Method { methodName = mName , methodAnnotations = annoSet diff --git a/test/Nirum/Constructs/AnnotationSpec.hs b/test/Nirum/Constructs/AnnotationSpec.hs index 2ea2eed..91b53b2 100644 --- a/test/Nirum/Constructs/AnnotationSpec.hs +++ b/test/Nirum/Constructs/AnnotationSpec.hs @@ -7,14 +7,15 @@ import Test.Hspec.Meta import qualified Data.Map.Strict as M import Nirum.Constructs.Annotation as A -import Nirum.Constructs.Annotation.Internal ( AnnotationSet (AnnotationSet) ) +import Nirum.Constructs.Annotation.Internal spec :: Spec spec = do let annotation = Annotation "foo" M.empty - loremAnno = Annotation "lorem" [("arg", "ipsum")] - escapeCharAnno = Annotation "quote" [("arg", "\"")] - longNameAnno = Annotation "long-cat-is-long" [("long", "nyancat")] + loremAnno = Annotation "lorem" [("arg", Text "ipsum")] + escapeCharAnno = Annotation "quote" [("arg", Text "\"")] + longNameAnno = + Annotation "long-cat-is-long" [("long", Text "nyancat")] docsAnno = docs "Description" describe "Annotation" $ do describe "toCode Annotation" $ @@ -24,15 +25,15 @@ spec = do toCode escapeCharAnno `shouldBe` "@quote(arg = \"\\\"\")" specify "docs" $ docsAnno `shouldBe` - Annotation "docs" [("docs", "Description\n")] + Annotation "docs" [("docs", Text "Description\n")] describe "AnnotationSet" $ do specify "empty" $ empty `shouldSatisfy` null specify "singleton" $ do singleton (Annotation "foo" []) `shouldBe` AnnotationSet [("foo", [])] - singleton (Annotation "bar" [("arg", "baz")]) `shouldBe` - AnnotationSet [("bar", [("arg", "baz")])] + singleton (Annotation "bar" [("arg", Text "baz")]) `shouldBe` + AnnotationSet [("bar", [("arg", Text "baz")])] describe "fromList" $ do it "success" $ do let Right empty' = fromList [] @@ -49,12 +50,12 @@ spec = do specify "union" $ do let Right a = fromList [annotation, loremAnno] let Right b = fromList [docsAnno, escapeCharAnno] - let c = AnnotationSet [("foo", [("arg", "bar")])] + let c = AnnotationSet [("foo", [("arg", Text "bar")])] A.union a b `shouldBe` AnnotationSet [ ("foo", []) - , ("lorem", [("arg", "ipsum")]) - , ("quote", [("arg", "\"")]) - , ("docs", [("docs", "Description\n")]) + , ("lorem", [("arg", Text "ipsum")]) + , ("quote", [("arg", Text "\"")]) + , ("docs", [("docs", Text "Description\n")]) ] A.union a c `shouldBe` a let Right annotationSet = fromList [ annotation @@ -85,6 +86,6 @@ spec = do describe "insertDocs" $ do it "should insert the doc comment as an annotation" $ A.insertDocs "yay" empty `shouldReturn` - AnnotationSet [("docs", [("docs", "yay\n")])] + AnnotationSet [("docs", [("docs", Text "yay\n")])] it "should fail on the annotation that already have a doc" $ A.insertDocs "yay" annotationSet `shouldThrow` anyException diff --git a/test/Nirum/Constructs/ServiceSpec.hs b/test/Nirum/Constructs/ServiceSpec.hs index d55728f..82342a3 100644 --- a/test/Nirum/Constructs/ServiceSpec.hs +++ b/test/Nirum/Constructs/ServiceSpec.hs @@ -6,6 +6,7 @@ import Data.Map.Strict as Map (fromList) import Test.Hspec.Meta import Nirum.Constructs.Annotation +import Nirum.Constructs.Annotation.Internal import Nirum.Constructs.Docs (toCode) import Nirum.Constructs.Service (Method (Method), Parameter (Parameter)) import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier @@ -18,8 +19,8 @@ import Util (singleDocs) spec :: Spec spec = do let methodAnno = singleton $ Annotation "http" $ Map.fromList - [ ("method", "GET") - , ("path", "/ping/") + [ ("method", Text "GET") + , ("path", Text "/ping/") ] let docsAnno = singleDocs "docs..." describe "Parameter" $ diff --git a/test/Nirum/Constructs/TypeDeclarationSpec.hs b/test/Nirum/Constructs/TypeDeclarationSpec.hs index bcd92ac..2477d9e 100644 --- a/test/Nirum/Constructs/TypeDeclarationSpec.hs +++ b/test/Nirum/Constructs/TypeDeclarationSpec.hs @@ -8,6 +8,7 @@ import Test.Hspec.Meta import Nirum.Constructs (Construct (toCode)) import Nirum.Constructs.Annotation hiding (docs, fromList, name) +import qualified Nirum.Constructs.Annotation.Internal as AI import Nirum.Constructs.Declaration (Declaration (name), docs) import Nirum.Constructs.DeclarationSet hiding (empty) import Nirum.Constructs.Service (Method (Method), Service (Service)) @@ -23,7 +24,7 @@ import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember) import Util (singleDocs) barAnnotationSet :: AnnotationSet -barAnnotationSet = singleton $ Annotation "bar" [("val", "baz")] +barAnnotationSet = singleton $ Annotation "bar" [("val", AI.Text "baz")] spec :: Spec spec = do diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs index a95870e..c689fe1 100644 --- a/test/Nirum/ParserSpec.hs +++ b/test/Nirum/ParserSpec.hs @@ -25,6 +25,8 @@ import qualified Nirum.Parser as P import Nirum.Parser (Parser, ParseError) import Nirum.Constructs (Construct (toCode)) import Nirum.Constructs.Annotation as A +import Nirum.Constructs.Annotation.Internal hiding (Text) +import qualified Nirum.Constructs.Annotation.Internal as AI import Nirum.Constructs.Docs (Docs (Docs)) import Nirum.Constructs.DeclarationSet (DeclarationSet) import Nirum.Constructs.DeclarationSetSpec (SampleDecl (..)) @@ -80,7 +82,7 @@ helperFuncs parser = fooAnnotationSet :: AnnotationSet -fooAnnotationSet = A.singleton $ Annotation "foo" [("v", "bar")] +fooAnnotationSet = A.singleton $ Annotation "foo" [("v", AI.Text "bar")] bazAnnotationSet :: AnnotationSet bazAnnotationSet = A.singleton $ Annotation "baz" [] @@ -177,7 +179,10 @@ spec = do describe "annotation" $ do let (parse', expectError) = helperFuncs P.annotation context "with single argument" $ do - let rightAnnotaiton = Annotation "name-abc" [("foo", "wo\"rld")] + let rightAnnotaiton = + Annotation "name-abc" [("foo", AI.Text "wo\"rld")] + let rightIntAnnotation = + Annotation "name-abc" [("foo", Integer 1)] it "success" $ do parse' "@name-abc(foo=\"wo\\\"rld\")" `shouldBeRight` rightAnnotaiton @@ -192,7 +197,11 @@ spec = do parse' "@name-abc ( foo=\"wo\\\"rld\")" `shouldBeRight` rightAnnotaiton parse' "@name-abc(foo=\"wo\\\"rld\\n\")" `shouldBeRight` - Annotation "name-abc" [("foo", "wo\"rld\n")] + Annotation "name-abc" [("foo", AI.Text "wo\"rld\n")] + parse' "@name-abc(foo=1)" `shouldBeRight` rightIntAnnotation + parse' "@name-abc( foo=1)" `shouldBeRight` rightIntAnnotation + parse' "@name-abc(foo=1 )" `shouldBeRight` rightIntAnnotation + parse' "@name-abc( foo=1 )" `shouldBeRight` rightIntAnnotation it "fails to parse if annotation name start with hyphen" $ do expectError "@-abc(v=\"helloworld\")" 1 2 expectError "@-abc-d(v = \"helloworld\")" 1 2 @@ -218,7 +227,7 @@ spec = do describe "annotationSet" $ do let (parse', expectError) = helperFuncs P.annotationSet Right annotationSet = fromList - [ Annotation "a" [("arg", "b")] + [ Annotation "a" [("arg", AI.Text "b")] , Annotation "c" [] ] it "success" $ do @@ -822,8 +831,8 @@ union shape describe "method" $ do let (parse', expectError) = helperFuncs P.method httpGetAnnotation = singleton $ Annotation "http" - [ ("method", "GET") - , ("path", "/get-name/") + [ ("method", AI.Text "GET") + , ("path", AI.Text "/get-name/") ] it "emits Method if succeeded to parse" $ do parse' "text get-name()" `shouldBeRight` diff --git a/test/nirum_fixture/fixture/datetime.nrm b/test/nirum_fixture/fixture/datetime.nrm new file mode 100644 index 0000000..25234c8 --- /dev/null +++ b/test/nirum_fixture/fixture/datetime.nrm @@ -0,0 +1,4 @@ +service datetime-service ( + @num-constraints(min=1, max=12) + int32 delta_month(int32 month), +); diff --git a/test/python/annotation_test.py b/test/python/annotation_test.py index de50bab..6b63698 100644 --- a/test/python/annotation_test.py +++ b/test/python/annotation_test.py @@ -1,3 +1,4 @@ +from fixture.datetime import DatetimeService from fixture.foo import PingService, RpcError from nirum.datastructures import Map @@ -11,6 +12,12 @@ def test_service_method_annotation_metadata(): 'docs': Map({'docs': u'Method docs.'}), 'http_resource': Map({'method': u'GET', 'path': u'/ping'}), 'quote': Map({'single': u"'", 'triple': u"'''"}), - 'unicode': Map({'unicode': u'\uc720\ub2c8\ucf54\ub4dc'}), - }) + 'unicode': Map({'unicode': u'\uc720\ub2c8\ucf54\ub4dc'}), }) assert PingService.__nirum_method_annotations__['ping'] == expect + + +def test_annotation_int(): + exp = Map({ + 'num_constraints': Map({'max': 12, 'min': 1}), + }) + assert DatetimeService.__nirum_method_annotations__['delta_month'] == exp diff --git a/test/python/setup_test.py b/test/python/setup_test.py index f09c07f..6657109 100644 --- a/test/python/setup_test.py +++ b/test/python/setup_test.py @@ -24,6 +24,7 @@ def test_setup_metadata(): 'fixture.reserved_keyword_enum', 'fixture.reserved_keyword_union', 'fixture.types', 'fixture.alias', 'renamed', 'renamed.foo', 'renamed.foo.bar', + 'fixture.datetime', } assert ['0.3.0'] == pkg['Version'] assert ['Package description'] == pkg['Summary'] @@ -44,6 +45,7 @@ def test_module_entry_points(): 'fixture.types', 'fixture.alias', 'renames.test.foo', 'renames.test.foo.bar', + 'fixture.datetime', } import fixture.foo assert map_['fixture.foo'].resolve() is fixture.foo