From 274ba963e09ab02bbd53f47c0fc8cc1f0329e131 Mon Sep 17 00:00:00 2001 From: Hyojun Kang Date: Sat, 6 Aug 2016 18:43:09 +0900 Subject: [PATCH 1/6] Annoation --- nirum.cabal | 2 ++ src/Nirum/Constructs/Annotation.hs | 21 +++++++++++++++++++++ src/Nirum/Constructs/Declaration.hs | 2 +- test/Nirum/Constructs/AnnotationSpec.hs | 15 +++++++++++++++ 4 files changed, 39 insertions(+), 1 deletion(-) create mode 100644 src/Nirum/Constructs/Annotation.hs create mode 100644 test/Nirum/Constructs/AnnotationSpec.hs diff --git a/nirum.cabal b/nirum.cabal index 3b67308..3632888 100644 --- a/nirum.cabal +++ b/nirum.cabal @@ -20,6 +20,7 @@ cabal-version: >=1.10 library exposed-modules: Nirum.Cli , Nirum.Constructs + , Nirum.Constructs.Annotation , Nirum.Constructs.Declaration , Nirum.Constructs.DeclarationSet , Nirum.Constructs.Identifier @@ -68,6 +69,7 @@ test-suite spec hs-source-dirs: test main-is: Spec.hs other-modules: Nirum.CliSpec + , Nirum.Constructs.AnnotationSpec , Nirum.Constructs.DeclarationSpec , Nirum.Constructs.DeclarationSetSpec , Nirum.Constructs.IdentifierSpec diff --git a/src/Nirum/Constructs/Annotation.hs b/src/Nirum/Constructs/Annotation.hs new file mode 100644 index 0000000..daf0f9f --- /dev/null +++ b/src/Nirum/Constructs/Annotation.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} +module Nirum.Constructs.Annotation ( Annotation(Annotation) + , Metadata + , toCode + ) where + +import Text.InterpolatedString.Perl6 (qq) +import qualified Data.Text as T + +import Nirum.Constructs (Construct(toCode)) + + +type Metadata = T.Text + +-- | Annotation for names. +data Annotation = Annotation { name :: T.Text + , metadata :: Metadata + } deriving (Eq, Ord, Show) + +instance Construct Annotation where + toCode Annotation {name = n, metadata = m} = [qq|[$n: "$m"]|] diff --git a/src/Nirum/Constructs/Declaration.hs b/src/Nirum/Constructs/Declaration.hs index 1263ad2..00595a5 100644 --- a/src/Nirum/Constructs/Declaration.hs +++ b/src/Nirum/Constructs/Declaration.hs @@ -4,7 +4,7 @@ module Nirum.Constructs.Declaration ( Declaration , docs , name , toCode - , toCodeWithPrefix + , toCodeWithPrefix , toText ) where diff --git a/test/Nirum/Constructs/AnnotationSpec.hs b/test/Nirum/Constructs/AnnotationSpec.hs new file mode 100644 index 0000000..22311ff --- /dev/null +++ b/test/Nirum/Constructs/AnnotationSpec.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE OverloadedStrings #-} +module Nirum.Constructs.AnnotationSpec where + +import Test.Hspec.Meta + +import Nirum.Constructs.Annotation ( Annotation(Annotation) + , toCode + ) + +spec :: Spec +spec = + describe "Annotation" $ + describe "toCode Annotation" $ + it "prints annotation properly" $ + toCode (Annotation "foo" "bar") `shouldBe` "[foo: \"bar\"]" From f59fc2d799f79282bd1564280e1ed2553c12db85 Mon Sep 17 00:00:00 2001 From: Hyojun Kang Date: Sat, 6 Aug 2016 21:52:07 +0900 Subject: [PATCH 2/6] Parse Annoation --- src/Nirum/Constructs/Annotation.hs | 5 +++-- src/Nirum/Parser.hs | 31 +++++++++++++++++++++++++++--- test/Nirum/ParserSpec.hs | 19 ++++++++++++++++++ 3 files changed, 50 insertions(+), 5 deletions(-) diff --git a/src/Nirum/Constructs/Annotation.hs b/src/Nirum/Constructs/Annotation.hs index daf0f9f..6dbcf47 100644 --- a/src/Nirum/Constructs/Annotation.hs +++ b/src/Nirum/Constructs/Annotation.hs @@ -8,14 +8,15 @@ import Text.InterpolatedString.Perl6 (qq) import qualified Data.Text as T import Nirum.Constructs (Construct(toCode)) +import qualified Nirum.Constructs.Identifier as CI type Metadata = T.Text -- | Annotation for names. -data Annotation = Annotation { name :: T.Text +data Annotation = Annotation { name :: CI.Identifier , metadata :: Metadata } deriving (Eq, Ord, Show) instance Construct Annotation where - toCode Annotation {name = n, metadata = m} = [qq|[$n: "$m"]|] + toCode Annotation {name = n, metadata = m} = [qq|[{CI.toCode n}: "$m"]|] diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs index 14f064e..56f2d39 100644 --- a/src/Nirum/Parser.hs +++ b/src/Nirum/Parser.hs @@ -2,8 +2,9 @@ {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} module Nirum.Parser ( Parser , ParseError - , aliasTypeDeclaration - , boxedTypeDeclaration + , aliasTypeDeclaration + , annotation + , boxedTypeDeclaration , docs , enumTypeDeclaration , file @@ -39,6 +40,7 @@ import Data.Text.IO (readFile) import Text.Megaparsec ( Token , eof , many + , manyTill , notFollowedBy , option , optional @@ -52,10 +54,18 @@ import Text.Megaparsec ( Token , (<|>) , () ) -import Text.Megaparsec.Char (char, eol, noneOf, spaceChar, string, string') +import Text.Megaparsec.Char (char + , eol + , noneOf + , spaceChar + , string + , string' + ) import qualified Text.Megaparsec.Error as E import Text.Megaparsec.Text (Parser) +import Text.Megaparsec.Lexer (charLiteral) +import Nirum.Constructs.Annotation (Annotation(Annotation)) import Nirum.Constructs.Declaration (Declaration, Docs(Docs)) import Nirum.Constructs.DeclarationSet ( DeclarationSet , NameDuplication( BehindNameDuplication @@ -136,6 +146,21 @@ name = do identifier "behind name" return $ Name facialName behindName +annotation :: Parser Annotation +annotation = do + char '[' + spaces + name' <- identifier + spaces + char ':' + spaces + metadata <- (char '"' >> manyTill charLiteral (char '"')) + "annotation metadata" + spaces + char ']' + return $ Annotation name' $ T.pack metadata + + typeExpression :: Parser TypeExpression typeExpression = try optionModifier <|> typeExpressionWithoutOptionModifier diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs index 0df5438..63e0d11 100644 --- a/test/Nirum/ParserSpec.hs +++ b/test/Nirum/ParserSpec.hs @@ -20,6 +20,7 @@ import Text.Megaparsec.Text (Parser) import qualified Nirum.Parser as P import Nirum.Constructs (Construct(toCode)) +import Nirum.Constructs.Annotation (Annotation(Annotation)) import Nirum.Constructs.Declaration (Docs(Docs)) import Nirum.Constructs.DeclarationSet (DeclarationSet) import Nirum.Constructs.DeclarationSetSpec (SampleDecl(..)) @@ -153,6 +154,24 @@ spec = do parse' "`enum`/`boxed`" `shouldBeRight` Name "enum" "boxed" parse' "`enum` / `boxed`" `shouldBeRight` Name "enum" "boxed" + describe "annoation" $ do + let (parse', expectError) = helperFuncs P.annotation + rightAnnotaiton = Right (Annotation "name-abc" "wo\"rld") + it "success" $ do + parse' "[name-abc: \"wo\\\"rld\"]" `shouldBe` rightAnnotaiton + parse' "[name-abc:\"wo\\\"rld\"]" `shouldBe` rightAnnotaiton + parse' "[name-abc:\"wo\\\"rld\" ]" `shouldBe` rightAnnotaiton + parse' "[name-abc: \"wo\\\"rld\" ]" `shouldBe` rightAnnotaiton + parse' "[ name-abc : \"wo\\\"rld\"]" `shouldBe` rightAnnotaiton + parse' "[name-abc : \"wo\\\"rld\"]" `shouldBe` rightAnnotaiton + it "fails to parse if annotation name start with hyphen" $ do + expectError "[-abc: \"helloworld\"]" 1 2 + expectError "[-abc-d: \"helloworld\"]" 1 2 + it "fails to parse without colon " $ do + expectError "[foobar \"helloworld\"]" 1 9 + it "fails to parse without double quotes" $ do + expectError "[foobar: helloworld]" 1 10 + describe "typeIdentifier" $ do let (parse', expectError) = helperFuncs P.typeIdentifier it "fails to parse if the input is not a valid identifier" $ From 5a4eb20dbe10ed009778e2a792596ff27eb8592d Mon Sep 17 00:00:00 2001 From: Hyojun Kang Date: Sat, 6 Aug 2016 23:51:24 +0900 Subject: [PATCH 3/6] AnnotationSet --- src/Nirum/Constructs/Annotation.hs | 42 +++++++++++++++++++++++++ test/Nirum/Constructs/AnnotationSpec.hs | 35 +++++++++++++++++++-- test/Nirum/ParserSpec.hs | 4 +-- 3 files changed, 76 insertions(+), 5 deletions(-) diff --git a/src/Nirum/Constructs/Annotation.hs b/src/Nirum/Constructs/Annotation.hs index 6dbcf47..fddb9cd 100644 --- a/src/Nirum/Constructs/Annotation.hs +++ b/src/Nirum/Constructs/Annotation.hs @@ -1,11 +1,19 @@ {-# LANGUAGE OverloadedStrings, QuasiQuotes #-} module Nirum.Constructs.Annotation ( Annotation(Annotation) + , AnnotationSet(AnnotationSet) , Metadata + , NameDuplication(AnnotationNameDuplication) + , annotations + , empty + , fromList , toCode + , toList ) where import Text.InterpolatedString.Perl6 (qq) import qualified Data.Text as T +import qualified Data.Map.Strict as M +import qualified Data.Set as S import Nirum.Constructs (Construct(toCode)) import qualified Nirum.Constructs.Identifier as CI @@ -20,3 +28,37 @@ data Annotation = Annotation { name :: CI.Identifier instance Construct Annotation where toCode Annotation {name = n, metadata = m} = [qq|[{CI.toCode n}: "$m"]|] + +data AnnotationSet + -- | The set of 'Annotation' values. + -- Evenry annotaiton name has to be unique in the set. + = AnnotationSet { annotations :: M.Map CI.Identifier Annotation } + deriving (Eq, Ord, Show) + +data NameDuplication = AnnotationNameDuplication CI.Identifier + deriving (Eq, Show) + +empty :: AnnotationSet +empty = AnnotationSet { annotations = M.empty } + +fromList :: [Annotation] -> Either NameDuplication AnnotationSet +fromList annotations' = + case findDup names S.empty of + Just duplication -> Left (AnnotationNameDuplication duplication) + _ -> Right AnnotationSet { annotations = M.fromList [ (name a, a) + | a <- annotations' + ] + } + where + names :: [CI.Identifier] + names = [name a | a <- annotations'] + findDup :: [CI.Identifier] -> S.Set CI.Identifier -> Maybe CI.Identifier + findDup identifiers dups = + case identifiers of + x:xs -> if x `S.member` dups + then Just x + else findDup xs $ S.insert x dups + _ -> Nothing + +toList :: AnnotationSet -> [Annotation] +toList AnnotationSet { annotations = annotations' } = M.elems annotations' diff --git a/test/Nirum/Constructs/AnnotationSpec.hs b/test/Nirum/Constructs/AnnotationSpec.hs index 22311ff..a22f37f 100644 --- a/test/Nirum/Constructs/AnnotationSpec.hs +++ b/test/Nirum/Constructs/AnnotationSpec.hs @@ -2,14 +2,43 @@ module Nirum.Constructs.AnnotationSpec where import Test.Hspec.Meta +import qualified Data.Map.Strict as M -import Nirum.Constructs.Annotation ( Annotation(Annotation) +import Nirum.Constructs.Annotation ( Annotation (Annotation) + , AnnotationSet (AnnotationSet) + , NameDuplication ( + AnnotationNameDuplication + ) + , empty + , fromList , toCode + , toList ) spec :: Spec -spec = +spec = do + let annotation = Annotation "foo" "bar" + loremAnno = Annotation "lorem" "ipsum" describe "Annotation" $ describe "toCode Annotation" $ it "prints annotation properly" $ - toCode (Annotation "foo" "bar") `shouldBe` "[foo: \"bar\"]" + toCode annotation `shouldBe` "[foo: \"bar\"]" + describe "AnnotationSet" $ do + it "empty" $ empty `shouldBe` AnnotationSet M.empty + describe "fromList" $ do + it "success" $ do + fromList [] `shouldBe` Right (AnnotationSet M.empty) + fromList [annotation] `shouldBe` Right + (AnnotationSet $ M.fromList [("foo", annotation)]) + it "name duplication" $ do + let duplicationAnnotations = fromList [ annotation + , loremAnno + , annotation + ] + duplicationAnnotations `shouldBe` + Left (AnnotationNameDuplication "foo") + let annotationSet = case fromList [annotation, loremAnno] of + Right set -> set + Left _ -> empty + it "toList" $ + (fromList $ toList annotationSet) `shouldBe` Right annotationSet diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs index 63e0d11..b9a3c09 100644 --- a/test/Nirum/ParserSpec.hs +++ b/test/Nirum/ParserSpec.hs @@ -167,9 +167,9 @@ spec = do it "fails to parse if annotation name start with hyphen" $ do expectError "[-abc: \"helloworld\"]" 1 2 expectError "[-abc-d: \"helloworld\"]" 1 2 - it "fails to parse without colon " $ do + it "fails to parse without colon " $ expectError "[foobar \"helloworld\"]" 1 9 - it "fails to parse without double quotes" $ do + it "fails to parse without double quotes" $ expectError "[foobar: helloworld]" 1 10 describe "typeIdentifier" $ do From f1ef1c4dc326d51c176f6f89ea9172f903434f55 Mon Sep 17 00:00:00 2001 From: Hyojun Kang Date: Thu, 11 Aug 2016 02:49:43 +0900 Subject: [PATCH 4/6] Annotations on TypeDeclarations --- src/Nirum/Constructs/Annotation.hs | 24 +++-- src/Nirum/Constructs/Module.hs | 29 ++--- src/Nirum/Constructs/TypeDeclaration.hs | 44 +++++--- src/Nirum/Parser.hs | 44 +++++--- src/Nirum/Targets/Python.hs | 12 +-- test/Nirum/Constructs/AnnotationSpec.hs | 21 ++-- test/Nirum/Constructs/ModuleSpec.hs | 7 +- test/Nirum/Constructs/TypeDeclarationSpec.hs | 8 +- test/Nirum/PackageSpec.hs | 32 +++--- test/Nirum/ParserSpec.hs | 107 ++++++++++++++----- test/Nirum/Targets/PythonSpec.hs | 29 +++-- 11 files changed, 238 insertions(+), 119 deletions(-) diff --git a/src/Nirum/Constructs/Annotation.hs b/src/Nirum/Constructs/Annotation.hs index fddb9cd..7e75546 100644 --- a/src/Nirum/Constructs/Annotation.hs +++ b/src/Nirum/Constructs/Annotation.hs @@ -15,28 +15,32 @@ import qualified Data.Text as T import qualified Data.Map.Strict as M import qualified Data.Set as S -import Nirum.Constructs (Construct(toCode)) -import qualified Nirum.Constructs.Identifier as CI +import Nirum.Constructs (Construct (toCode)) +import Nirum.Constructs.Identifier (Identifier) type Metadata = T.Text --- | Annotation for names. -data Annotation = Annotation { name :: CI.Identifier +-- | Annotation for 'Declaration'. +data Annotation = Annotation { name :: Identifier , metadata :: Metadata } deriving (Eq, Ord, Show) instance Construct Annotation where - toCode Annotation {name = n, metadata = m} = [qq|[{CI.toCode n}: "$m"]|] + toCode Annotation {name = n, metadata = m} = [qq|[{toCode n}: "$m"]|] data AnnotationSet -- | The set of 'Annotation' values. -- Evenry annotaiton name has to be unique in the set. - = AnnotationSet { annotations :: M.Map CI.Identifier Annotation } + = AnnotationSet { annotations :: M.Map Identifier Annotation } deriving (Eq, Ord, Show) -data NameDuplication = AnnotationNameDuplication CI.Identifier - deriving (Eq, Show) +instance Construct AnnotationSet where + toCode AnnotationSet {annotations = annotations'} = + T.intercalate "\n" $ map toCode (M.elems annotations') + +data NameDuplication = AnnotationNameDuplication Identifier + deriving (Eq, Ord, Show) empty :: AnnotationSet empty = AnnotationSet { annotations = M.empty } @@ -50,9 +54,9 @@ fromList annotations' = ] } where - names :: [CI.Identifier] + names :: [Identifier] names = [name a | a <- annotations'] - findDup :: [CI.Identifier] -> S.Set CI.Identifier -> Maybe CI.Identifier + findDup :: [Identifier] -> S.Set Identifier -> Maybe Identifier findDup identifiers dups = case identifiers of x:xs -> if x `S.member` dups diff --git a/src/Nirum/Constructs/Module.hs b/src/Nirum/Constructs/Module.hs index a63f308..8f8204e 100644 --- a/src/Nirum/Constructs/Module.hs +++ b/src/Nirum/Constructs/Module.hs @@ -12,6 +12,7 @@ import qualified Data.Text as T import Text.InterpolatedString.Perl6 (q) import Nirum.Constructs (Construct(toCode)) +import Nirum.Constructs.Annotation (empty) import Nirum.Constructs.Declaration (Docs) import qualified Nirum.Constructs.DeclarationSet as DS import Nirum.Constructs.Identifier (Identifier) @@ -66,22 +67,24 @@ coreModule = Module coreTypes $ Just coreDocs coreTypes :: DS.DeclarationSet TypeDeclaration coreTypes = -- number types - [ TypeDeclaration "bigint" (PrimitiveType Bigint String) Nothing - , TypeDeclaration "decimal" (PrimitiveType Decimal String) Nothing - , TypeDeclaration "int32" (PrimitiveType Int32 Number) Nothing - , TypeDeclaration "int64" (PrimitiveType Int64 Number) Nothing - , TypeDeclaration "float32" (PrimitiveType Float32 Number) Nothing - , TypeDeclaration "float64" (PrimitiveType Float64 Number) Nothing + [ TypeDeclaration "bigint" (PrimitiveType Bigint String) Nothing empty + , TypeDeclaration "decimal" (PrimitiveType Decimal String) Nothing empty + , TypeDeclaration "int32" (PrimitiveType Int32 Number) Nothing empty + , TypeDeclaration "int64" (PrimitiveType Int64 Number) Nothing empty + , TypeDeclaration "float32" (PrimitiveType Float32 Number) Nothing empty + , TypeDeclaration "float64" (PrimitiveType Float64 Number) Nothing empty -- string types - , TypeDeclaration "text" (PrimitiveType Text String) Nothing - , TypeDeclaration "binary" (PrimitiveType Binary String) Nothing + , TypeDeclaration "text" (PrimitiveType Text String) Nothing empty + , TypeDeclaration "binary" (PrimitiveType Binary String) Nothing empty -- time types - , TypeDeclaration "date" (PrimitiveType Date String) Nothing - , TypeDeclaration "datetime" (PrimitiveType Datetime String) Nothing + , TypeDeclaration + "date" (PrimitiveType Date String) Nothing empty + , TypeDeclaration + "datetime" (PrimitiveType Datetime String) Nothing empty -- et cetera - , TypeDeclaration "bool" (PrimitiveType Bool Boolean) Nothing - , TypeDeclaration "uuid" (PrimitiveType Uuid String) Nothing - , TypeDeclaration "uri" (PrimitiveType Uri String) Nothing + , TypeDeclaration "bool" (PrimitiveType Bool Boolean) Nothing empty + , TypeDeclaration "uuid" (PrimitiveType Uuid String) Nothing empty + , TypeDeclaration "uri" (PrimitiveType Uri String) Nothing empty ] coreDocs :: Docs diff --git a/src/Nirum/Constructs/TypeDeclaration.hs b/src/Nirum/Constructs/TypeDeclaration.hs index b12e9f9..64aac5d 100644 --- a/src/Nirum/Constructs/TypeDeclaration.hs +++ b/src/Nirum/Constructs/TypeDeclaration.hs @@ -14,6 +14,7 @@ module Nirum.Constructs.TypeDeclaration ( EnumMember(EnumMember) , serviceDocs , serviceName , type' + , typeAnnotations , typeDocs , typename ) @@ -25,8 +26,9 @@ import Data.String (IsString(fromString)) import qualified Data.Text as T import Nirum.Constructs (Construct(toCode)) -import Nirum.Constructs.Declaration ( Declaration(..) - , Docs(..) +import Nirum.Constructs.Annotation (AnnotationSet) +import Nirum.Constructs.Declaration ( Declaration (..) + , Docs (..) , toCodeWithPrefix ) import Nirum.Constructs.DeclarationSet (DeclarationSet, null', toList) @@ -111,6 +113,7 @@ data TypeDeclaration = TypeDeclaration { typename :: Name , type' :: Type , typeDocs :: Maybe Docs + , typeAnnotations :: AnnotationSet } | ServiceDeclaration { serviceName :: Name , service :: Service @@ -122,24 +125,28 @@ data TypeDeclaration deriving (Eq, Ord, Show) instance Construct TypeDeclaration where - toCode (TypeDeclaration name' (Alias cname) docs') = - T.concat [ "type ", toCode name' + toCode (TypeDeclaration name' (Alias cname) docs' annotationSet') = + T.concat [ toCode annotationSet' + , "type ", toCode name' , " = ", toCode cname, ";" , toCodeWithPrefix "\n" docs' ] - toCode (TypeDeclaration name' (BoxedType itype) docs') = - T.concat [ "boxed ", toCode name' + toCode (TypeDeclaration name' (BoxedType itype) docs' annotationSet') = + T.concat [ toCode annotationSet' + , "boxed ", toCode name' , " (", toCode itype, ");" , toCodeWithPrefix "\n" docs'] - toCode (TypeDeclaration name' (EnumType members') docs') = - T.concat [ "enum ", toCode name' + toCode (TypeDeclaration name' (EnumType members') docs' annotationSet') = + T.concat [ toCode annotationSet' + , "enum ", toCode name' , toCodeWithPrefix "\n " docs' , "\n = ", T.replace "\n" "\n " membersCode, "\n ;" ] where membersCode = T.intercalate "\n| " $ map toCode $ toList members' - toCode (TypeDeclaration name' (RecordType fields') docs') = - T.concat [ "record ", toCode name', " (" + toCode (TypeDeclaration name' (RecordType fields') docs' annotationSet') = + T.concat [ toCode annotationSet' + , "record ", toCode name', " (" , toCodeWithPrefix "\n " docs' , if isJust docs' then "\n" else "" , T.replace "\n" "\n " $ T.cons '\n' fieldsCode @@ -147,8 +154,9 @@ instance Construct TypeDeclaration where ] where fieldsCode = T.intercalate "\n" $ map toCode $ toList fields' - toCode (TypeDeclaration name' (UnionType tags') docs') = - T.concat [ "union ", nameCode + toCode (TypeDeclaration name' (UnionType tags') docs' annotationSet') = + T.concat [ toCode annotationSet' + , "union ", nameCode , toCodeWithPrefix "\n " docs' , "\n = " , tagsCode , "\n ;" @@ -161,8 +169,12 @@ instance Construct TypeDeclaration where [ T.replace "\n" "\n " (toCode t) | t <- toList tags' ] - toCode (TypeDeclaration name' (PrimitiveType typename' jsonType') docs') = - T.concat [ "// primitive type `", toCode name', "`\n" + toCode (TypeDeclaration name' + (PrimitiveType typename' jsonType') + docs' + annotationSet') = + T.concat [ toCode annotationSet' + , "// primitive type `", toCode name', "`\n" , "// internal type identifier: ", showT typename', "\n" , "// coded to json ", showT jsonType', " type\n" , docString docs' @@ -204,9 +216,9 @@ instance Construct TypeDeclaration where ] instance Declaration TypeDeclaration where - name (TypeDeclaration name' _ _) = name' + name (TypeDeclaration name' _ _ _) = name' name (ServiceDeclaration name' _ _) = name' name (Import _ identifier) = Name identifier identifier - docs (TypeDeclaration _ _ docs') = docs' + docs (TypeDeclaration _ _ docs' _) = docs' docs (ServiceDeclaration _ _ docs') = docs' docs (Import _ _) = Nothing diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs index 56f2d39..f59ed10 100644 --- a/src/Nirum/Parser.hs +++ b/src/Nirum/Parser.hs @@ -4,6 +4,7 @@ module Nirum.Parser ( Parser , ParseError , aliasTypeDeclaration , annotation + , annotationSet , boxedTypeDeclaration , docs , enumTypeDeclaration @@ -65,7 +66,7 @@ import qualified Text.Megaparsec.Error as E import Text.Megaparsec.Text (Parser) import Text.Megaparsec.Lexer (charLiteral) -import Nirum.Constructs.Annotation (Annotation(Annotation)) +import qualified Nirum.Constructs.Annotation as A import Nirum.Constructs.Declaration (Declaration, Docs(Docs)) import Nirum.Constructs.DeclarationSet ( DeclarationSet , NameDuplication( BehindNameDuplication @@ -146,7 +147,7 @@ name = do identifier "behind name" return $ Name facialName behindName -annotation :: Parser Annotation +annotation :: Parser A.Annotation annotation = do char '[' spaces @@ -158,8 +159,18 @@ annotation = do "annotation metadata" spaces char ']' - return $ Annotation name' $ T.pack metadata + return $ A.Annotation name' $ T.pack metadata +annotationSet :: Parser A.AnnotationSet +annotationSet = do + annotations <- many $ do + spaces + a <- annotation + spaces + return a + case A.fromList annotations of + Right annotations' -> return annotations' + Left (A.AnnotationNameDuplication _) -> fail "annotation name duplicate" typeExpression :: Parser TypeExpression typeExpression = @@ -224,6 +235,7 @@ docs = do aliasTypeDeclaration :: Parser TypeDeclaration aliasTypeDeclaration = do + annotationSet' <- annotationSet "type alias annotations" string' "type" "type alias keyword" spaces typename <- identifier "alias type name" @@ -235,10 +247,12 @@ aliasTypeDeclaration = do spaces char ';' docs' <- optional $ try $ spaces >> (docs "type alias docs") - return $ TypeDeclaration name' (Alias canonicalType) docs' + return $ TypeDeclaration name' (Alias canonicalType) docs' annotationSet' + boxedTypeDeclaration :: Parser TypeDeclaration boxedTypeDeclaration = do + annotationSet' <- annotationSet "boxed type annotations" string' "boxed" "boxed type keyword" spaces typename <- identifier "boxed type name" @@ -251,8 +265,8 @@ boxedTypeDeclaration = do char ')' spaces char ';' - docs' <- optional $ try $ spaces >> (docs "boed type docs") - return $ TypeDeclaration name' (BoxedType innerType) docs' + docs' <- optional $ try $ spaces >> (docs "boxed type docs") + return $ TypeDeclaration name' (BoxedType innerType) docs' annotationSet' enumMember :: Parser EnumMember enumMember = do @@ -280,6 +294,7 @@ handleNameDuplication label declarations cont = enumTypeDeclaration :: Parser TypeDeclaration enumTypeDeclaration = do + annotationSet' <- annotationSet "enum type annotations" string "enum" "enum keyword" spaces typename <- name "enum type name" @@ -308,7 +323,8 @@ enumTypeDeclaration = do Right memberSet -> do spaces char ';' - return $ TypeDeclaration typename (EnumType memberSet) docs' + return $ TypeDeclaration typename (EnumType memberSet) + docs' annotationSet' fieldsOrParameters :: forall a. (String, String) -> (Name -> TypeExpression -> Maybe Docs -> a) @@ -348,6 +364,7 @@ fieldSet = do recordTypeDeclaration :: Parser TypeDeclaration recordTypeDeclaration = do + annotationSet' <- annotationSet "record type annotations" string "record" "record keyword" spaces typename <- name "record type name" @@ -363,7 +380,7 @@ recordTypeDeclaration = do char ')' spaces char ';' - return $ TypeDeclaration typename (RecordType fields') docs' + return $ TypeDeclaration typename (RecordType fields') docs' annotationSet' tag :: Parser Tag tag = do @@ -384,6 +401,7 @@ tag = do unionTypeDeclaration :: Parser TypeDeclaration unionTypeDeclaration = do + annotationSet' <- annotationSet "union type annotations" string "union" "union keyword" spaces typename <- name "union type name" @@ -399,14 +417,14 @@ unionTypeDeclaration = do spaces char ';' handleNameDuplication "tag" tags' $ \tagSet -> - return $ TypeDeclaration typename (UnionType tagSet) docs' + return $ TypeDeclaration typename (UnionType tagSet) docs' annotationSet' typeDeclaration :: Parser TypeDeclaration typeDeclaration = - ( aliasTypeDeclaration <|> - boxedTypeDeclaration <|> - enumTypeDeclaration <|> - recordTypeDeclaration <|> + ( try aliasTypeDeclaration <|> + try boxedTypeDeclaration <|> + try enumTypeDeclaration <|> + try recordTypeDeclaration <|> unionTypeDeclaration ) "type declaration (e.g. boxed, enum, record, union)" diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs index 993bd8e..09400dc 100644 --- a/src/Nirum/Targets/Python.hs +++ b/src/Nirum/Targets/Python.hs @@ -294,15 +294,15 @@ compileTypeExpression source modifier = do MapModifier _ _ -> undefined -- never happen! compileTypeDeclaration :: Source -> TypeDeclaration -> CodeGen Code -compileTypeDeclaration _ (TypeDeclaration _ (PrimitiveType _ _) _) = +compileTypeDeclaration _ (TypeDeclaration _ (PrimitiveType _ _) _ _) = return "" -- never used -compileTypeDeclaration src (TypeDeclaration typename (Alias ctype) _) = do +compileTypeDeclaration src (TypeDeclaration typename (Alias ctype) _ _) = do ctypeExpr <- compileTypeExpression src ctype return [qq| # TODO: docstring {toClassName' typename} = $ctypeExpr |] -compileTypeDeclaration src (TypeDeclaration typename (BoxedType itype) _) = do +compileTypeDeclaration src (TypeDeclaration typename (BoxedType itype) _ _) = do let className = toClassName' typename itypeExpr <- compileTypeExpression src itype withStandardImport "typing" $ @@ -341,7 +341,7 @@ class $className: type(self), self.value ) |] -compileTypeDeclaration _ (TypeDeclaration typename (EnumType members) _) = do +compileTypeDeclaration _ (TypeDeclaration typename (EnumType members) _ _) = do let className = toClassName' typename memberNames = T.intercalate "\n " @@ -361,7 +361,7 @@ class $className(enum.Enum): def __nirum_deserialize__(cls: type, value: str) -> '{className}': return cls(value.replace('-', '_')) # FIXME: validate input |] -compileTypeDeclaration src (TypeDeclaration typename (RecordType fields) _) = do +compileTypeDeclaration src (TypeDeclaration typename (RecordType fields) _ _) = do typeExprCodes <- mapM (compileTypeExpression src) [typeExpr | (Field _ typeExpr _) <- toList fields] let className = toClassName' typename @@ -428,7 +428,7 @@ class $className: def __nirum_deserialize__(cls: type, value) -> '{className}': return deserialize_record_type(cls, value) |] -compileTypeDeclaration src (TypeDeclaration typename (UnionType tags) _) = do +compileTypeDeclaration src (TypeDeclaration typename (UnionType tags) _ _) = do fieldCodes <- mapM (uncurry (compileUnionTag src typename)) tagNameNFields let className = toClassName' typename fieldCodes' = T.intercalate "\n\n" fieldCodes diff --git a/test/Nirum/Constructs/AnnotationSpec.hs b/test/Nirum/Constructs/AnnotationSpec.hs index a22f37f..6f1bbcf 100644 --- a/test/Nirum/Constructs/AnnotationSpec.hs +++ b/test/Nirum/Constructs/AnnotationSpec.hs @@ -4,16 +4,15 @@ module Nirum.Constructs.AnnotationSpec where import Test.Hspec.Meta import qualified Data.Map.Strict as M -import Nirum.Constructs.Annotation ( Annotation (Annotation) - , AnnotationSet (AnnotationSet) - , NameDuplication ( - AnnotationNameDuplication - ) - , empty - , fromList - , toCode - , toList - ) +import Nirum.Constructs.Annotation + ( Annotation (Annotation) + , AnnotationSet (AnnotationSet) + , NameDuplication (AnnotationNameDuplication) + , empty + , fromList + , toCode + , toList + ) spec :: Spec spec = do @@ -41,4 +40,4 @@ spec = do Right set -> set Left _ -> empty it "toList" $ - (fromList $ toList annotationSet) `shouldBe` Right annotationSet + fromList (toList annotationSet) `shouldBe` Right annotationSet diff --git a/test/Nirum/Constructs/ModuleSpec.hs b/test/Nirum/Constructs/ModuleSpec.hs index 3d616b8..8b9b764 100644 --- a/test/Nirum/Constructs/ModuleSpec.hs +++ b/test/Nirum/Constructs/ModuleSpec.hs @@ -5,6 +5,7 @@ import Test.Hspec.Meta import Text.InterpolatedString.Perl6 (q) import Nirum.Constructs (Construct(toCode)) +import Nirum.Constructs.Annotation (empty) import Nirum.Constructs.DeclarationSet (DeclarationSet) import Nirum.Constructs.Module (Module(..), imports) import Nirum.Constructs.TypeDeclaration ( Type(..) @@ -16,8 +17,10 @@ import Nirum.Constructs.TypeDeclaration ( Type(..) spec :: Spec spec = describe "Module" $ do - let pathT = TypeDeclaration "path" (Alias "text") $ Just "path string" - offsetT = TypeDeclaration "offset" (BoxedType "float64") Nothing + let pathT = TypeDeclaration "path" (Alias "text") + (Just "path string") empty + offsetT = + TypeDeclaration "offset" (BoxedType "float64") Nothing empty decls = [ Import ["foo", "bar"] "baz" , Import ["foo", "bar"] "qux" , Import ["zzz"] "qqq" diff --git a/test/Nirum/Constructs/TypeDeclarationSpec.hs b/test/Nirum/Constructs/TypeDeclarationSpec.hs index 12afcb8..1c5e6f7 100644 --- a/test/Nirum/Constructs/TypeDeclarationSpec.hs +++ b/test/Nirum/Constructs/TypeDeclarationSpec.hs @@ -5,6 +5,7 @@ import qualified Data.Text as T import Test.Hspec.Meta import Nirum.Constructs (Construct(toCode)) +import Nirum.Constructs.Annotation (empty) import Nirum.Constructs.Declaration (Declaration(name, docs)) import Nirum.Constructs.DeclarationSet (DeclarationSet) import Nirum.Constructs.Service (Method(Method), Service(Service)) @@ -25,6 +26,7 @@ spec = do a = TypeDeclaration { typename = "path" , type' = alias , typeDocs = Nothing + , typeAnnotations = empty } b = a { typeDocs = Just "docs"} specify "name" $ do @@ -41,6 +43,7 @@ spec = do a = TypeDeclaration { typename = "offset" , type' = boxed , typeDocs = Nothing + , typeAnnotations = empty } b = a { typeDocs = Just "docs" } specify "name" $ do @@ -61,6 +64,7 @@ spec = do a = TypeDeclaration { typename = "country" , type' = enum , typeDocs = Nothing + , typeAnnotations = empty } b = a { typeDocs = Just "country codes" } specify "toCode" $ do @@ -88,6 +92,7 @@ spec = do a = TypeDeclaration { typename = "person" , type' = record , typeDocs = Nothing + , typeAnnotations = empty } b = a { typeDocs = Just "person record type" } specify "toCode" $ do @@ -119,6 +124,7 @@ spec = do a = TypeDeclaration { typename = "shape" , type' = union , typeDocs = Nothing + , typeAnnotations = empty } b = a { typeDocs = Just "shape type" } specify "toCode" $ do @@ -139,7 +145,7 @@ spec = do \ ;" context "PrimitiveType" $ do let primitiveType = PrimitiveType Text String - decl = TypeDeclaration "text" primitiveType Nothing + decl = TypeDeclaration "text" primitiveType Nothing empty specify "toCode" $ T.lines (toCode decl) `shouldSatisfy` all (T.isPrefixOf "//" . T.stripStart) diff --git a/test/Nirum/PackageSpec.hs b/test/Nirum/PackageSpec.hs index c87eb9b..8ffdddc 100644 --- a/test/Nirum/PackageSpec.hs +++ b/test/Nirum/PackageSpec.hs @@ -5,6 +5,7 @@ import qualified Data.Map.Strict as M import System.FilePath (()) import Test.Hspec.Meta +import Nirum.Constructs.Annotation (empty) import Nirum.Constructs.Module (Module(Module), coreModulePath) import Nirum.Constructs.ModulePath (ModulePath) import Nirum.Constructs.TypeDeclaration ( JsonType(String) @@ -46,12 +47,12 @@ validPackage = , (["foo"], Module [] $ Just "foo") , (["qux"], Module [] $ Just "qux") , ( ["abc"] - , Module [TypeDeclaration "a" (Alias "text") Nothing] + , Module [TypeDeclaration "a" (Alias "text") Nothing empty] Nothing ) , ( ["xyz"] , Module [ Import ["abc"] "a" - , TypeDeclaration "x" (Alias "text") Nothing + , TypeDeclaration "x" (Alias "text") Nothing empty ] Nothing ) ] @@ -62,7 +63,9 @@ missingImportsModules = , Import ["foo", "bar"] "zzz" -- MissingModulePathError , Import ["baz"] "qux" ] Nothing) - , (["baz"], Module [ TypeDeclaration "qux" (Alias "text") Nothing ] Nothing) + , ( ["baz"] + , Module [ TypeDeclaration "qux" (Alias "text") Nothing empty ] Nothing + ) , (["qux"], Module [ Import ["foo"] "abc" -- MissingImportError , Import ["foo"] "def" -- MissingImportError ] Nothing) @@ -71,16 +74,19 @@ missingImportsModules = circularImportsModules :: M.Map ModulePath Module circularImportsModules = [ (["asdf"], Module [ Import ["asdf"] "foo" - , TypeDeclaration "bar" (Alias "text") Nothing + , TypeDeclaration "bar" (Alias "text") Nothing empty ] Nothing) - , (["abc", "def"], Module [Import ["abc", "ghi"] "bar" - , TypeDeclaration "foo" (Alias "text") Nothing + , (["abc", "def"], Module [ Import ["abc", "ghi"] "bar" + , TypeDeclaration + "foo" (Alias "text") Nothing empty ] Nothing) - , (["abc", "ghi"], Module [Import ["abc", "xyz"] "baz" - , TypeDeclaration "bar" (Alias "text") Nothing + , (["abc", "ghi"], Module [ Import ["abc", "xyz"] "baz" + , TypeDeclaration + "bar" (Alias "text") Nothing empty ] Nothing) - , (["abc", "xyz"], Module [Import ["abc", "def"] "foo" - , TypeDeclaration "baz" (Alias "text") Nothing + , (["abc", "xyz"], Module [ Import ["abc", "def"] "foo" + , TypeDeclaration + "baz" (Alias "text") Nothing empty ] Nothing) ] @@ -178,9 +184,11 @@ spec = do docs bm' `shouldBe` Just "foo" specify "types" $ do types bm `shouldBe` [] - types abc `shouldBe` [TypeDeclaration "a" (Alias "text") Nothing] + types abc `shouldBe` [TypeDeclaration + "a" (Alias "text") Nothing empty] types xyz `shouldBe` [ Import ["abc"] "a" - , TypeDeclaration "x" (Alias "text") Nothing + , TypeDeclaration + "x" (Alias "text") Nothing empty ] specify "lookupType" $ do lookupType "a" bm `shouldBe` Missing diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs index b9a3c09..fdb610a 100644 --- a/test/Nirum/ParserSpec.hs +++ b/test/Nirum/ParserSpec.hs @@ -2,7 +2,7 @@ module Nirum.ParserSpec where import Control.Monad (forM_) -import Data.Either (isLeft, isRight, lefts) +import Data.Either (isLeft, isRight, lefts, rights) import Data.List (isSuffixOf) import Data.Maybe (fromJust) import Prelude hiding (readFile) @@ -19,25 +19,29 @@ import Text.Megaparsec.Pos (Pos, SourcePos(sourceColumn, sourceLine), mkPos) import Text.Megaparsec.Text (Parser) import qualified Nirum.Parser as P -import Nirum.Constructs (Construct(toCode)) -import Nirum.Constructs.Annotation (Annotation(Annotation)) -import Nirum.Constructs.Declaration (Docs(Docs)) +import Nirum.Constructs (Construct (toCode)) +import Nirum.Constructs.Annotation ( Annotation (Annotation) + , AnnotationSet + , empty + , fromList + ) +import Nirum.Constructs.Declaration (Docs (Docs)) import Nirum.Constructs.DeclarationSet (DeclarationSet) import Nirum.Constructs.DeclarationSetSpec (SampleDecl(..)) import Nirum.Constructs.Identifier (fromText) -import Nirum.Constructs.Module (Module(Module)) +import Nirum.Constructs.Module (Module (Module)) import Nirum.Constructs.Name (Name(..)) import Nirum.Constructs.Service ( Method (Method) , Parameter (Parameter) , Service (Service) ) -import Nirum.Constructs.TypeDeclaration ( EnumMember(EnumMember) - , Field(Field) - , Tag(Tag) - , Type(..) - , TypeDeclaration(..) +import Nirum.Constructs.TypeDeclaration ( EnumMember (EnumMember) + , Field (Field) + , Tag (Tag) + , Type (..) + , TypeDeclaration (..) ) -import Nirum.Constructs.TypeExpression (TypeExpression(..)) +import Nirum.Constructs.TypeExpression (TypeExpression (..)) shouldBeRight :: (Eq l, Eq r, Show l, Show r) => Either l r -> r -> Expectation shouldBeRight actual expected = actual `shouldBe` Right expected @@ -69,6 +73,10 @@ helperFuncs parser = parseResult `shouldSatisfy` isLeft erroredPos parseResult `shouldBe` (line', col') + +fooAnnotationSet :: AnnotationSet +fooAnnotationSet = head $ rights [fromList [Annotation "foo" "bar"]] + spec :: Spec spec = do describe "identifier" $ do @@ -154,16 +162,17 @@ spec = do parse' "`enum`/`boxed`" `shouldBeRight` Name "enum" "boxed" parse' "`enum` / `boxed`" `shouldBeRight` Name "enum" "boxed" - describe "annoation" $ do + describe "annotation" $ do let (parse', expectError) = helperFuncs P.annotation - rightAnnotaiton = Right (Annotation "name-abc" "wo\"rld") + rightAnnotaiton = Annotation "name-abc" "wo\"rld" it "success" $ do - parse' "[name-abc: \"wo\\\"rld\"]" `shouldBe` rightAnnotaiton - parse' "[name-abc:\"wo\\\"rld\"]" `shouldBe` rightAnnotaiton - parse' "[name-abc:\"wo\\\"rld\" ]" `shouldBe` rightAnnotaiton - parse' "[name-abc: \"wo\\\"rld\" ]" `shouldBe` rightAnnotaiton - parse' "[ name-abc : \"wo\\\"rld\"]" `shouldBe` rightAnnotaiton - parse' "[name-abc : \"wo\\\"rld\"]" `shouldBe` rightAnnotaiton + parse' "[name-abc: \"wo\\\"rld\"]" `shouldBeRight` rightAnnotaiton + parse' "[name-abc:\"wo\\\"rld\"]" `shouldBeRight` rightAnnotaiton + parse' "[name-abc:\"wo\\\"rld\" ]" `shouldBeRight` rightAnnotaiton + parse' "[name-abc: \"wo\\\"rld\" ]" `shouldBeRight` rightAnnotaiton + parse' "[ name-abc : \"wo\\\"rld\"]" `shouldBeRight` + rightAnnotaiton + parse' "[name-abc : \"wo\\\"rld\"]" `shouldBeRight` rightAnnotaiton it "fails to parse if annotation name start with hyphen" $ do expectError "[-abc: \"helloworld\"]" 1 2 expectError "[-abc-d: \"helloworld\"]" 1 2 @@ -172,6 +181,19 @@ spec = do it "fails to parse without double quotes" $ expectError "[foobar: helloworld]" 1 10 + describe "annotationSet" $ do + let (parse', expectError) = helperFuncs P.annotationSet + annotationSet = head $ rights [fromList [ Annotation "a" "b" + , Annotation "c" "d" + ] + ] + it "success" $ do + parse' "[a: \"b\"][c: \"d\"]" `shouldBeRight` annotationSet + parse' "[a: \"b\"] [c: \"d\"]" `shouldBeRight` annotationSet + parse' "[a: \"b\"] [c: \"d\"] " `shouldBeRight` annotationSet + it "fails to parse if has duplicated name" $ + expectError "[a: \"b\"][a: \"c\"]" 1 17 + describe "typeIdentifier" $ do let (parse', expectError) = helperFuncs P.typeIdentifier it "fails to parse if the input is not a valid identifier" $ @@ -345,12 +367,19 @@ spec = do let (parse', expectError) = helpers it "emits (TypeDeclaration (Alias ...)) if succeeded to parse" $ do parse' "type path = text;" `shouldBeRight` - TypeDeclaration "path" (Alias "text") Nothing + TypeDeclaration "path" (Alias "text") Nothing empty parse' "type path = text;\n# docs" `shouldBeRight` - TypeDeclaration "path" (Alias "text") (Just $ Docs "docs\n") + TypeDeclaration "path" (Alias "text") + (Just $ Docs "docs\n") empty parse' "type path = text;\n# docs\n# docs..." `shouldBeRight` TypeDeclaration "path" (Alias "text") (Just $ Docs "docs\ndocs...\n") + empty + parse' "[foo: \"bar\"] type path = text;\n# docs\n# docs..." + `shouldBeRight` + TypeDeclaration "path" (Alias "text") + (Just $ Docs "docs\ndocs...\n") + fooAnnotationSet specify "its name can't have behind name since \ \its canonical type's behind name would be used instead" $ expectError "type path/error = text;" 1 10 @@ -359,14 +388,20 @@ spec = do let (parse', expectError) = helpers it "emits (TypeDeclaration (BoxedType ...)) if succeeded to parse" $ do parse' "boxed offset (float64);" `shouldBeRight` - TypeDeclaration "offset" (BoxedType "float64") Nothing + TypeDeclaration "offset" (BoxedType "float64") Nothing empty parse' "boxed offset (float64);\n# docs" `shouldBeRight` TypeDeclaration "offset" (BoxedType "float64") (Just $ Docs "docs\n") + empty parse' "boxed offset (float64);\n# docs\n# docs..." `shouldBeRight` TypeDeclaration "offset" (BoxedType "float64") (Just $ Docs "docs\ndocs...\n") - it "cannot have behind name" $ + empty + parse' "[foo: \"bar\"]\nboxed offset (float64);\n# docs\n# docs..." + `shouldBeRight` + TypeDeclaration "offset" (BoxedType "float64") + (Just $ Docs "docs\ndocs...\n") + fooAnnotationSet expectError "boxed offset/behind (float64);" 1 13 descTypeDecl "enumTypeDeclaration" P.enumTypeDeclaration $ \helpers -> do @@ -381,6 +416,7 @@ spec = do , EnumMember "unknown" (Just "docs2\n") ] :: DeclarationSet EnumMember expected = TypeDeclaration "gender" (EnumType members') Nothing + empty parse' "enum gender = male | female | unknown;" `shouldBeRight` expected parse' "enum gender=male|female|unknown;" `shouldBeRight` expected @@ -394,6 +430,11 @@ spec = do `shouldBeRight` TypeDeclaration "gender" (EnumType membersWithDocs) Nothing + empty + parse' "[foo: \"bar\"]\nenum gender=male|female|unknown;" + `shouldBeRight` + TypeDeclaration "gender" (EnumType members') + Nothing fooAnnotationSet it "fails to parse if there are duplicated facial names" $ expectError "enum dup = a/b\n\ \ | b/c\n\ @@ -413,7 +454,7 @@ spec = do , Field "gender" "gender" Nothing ] :: DeclarationSet Field record = RecordType fields' - a = TypeDeclaration "person" record Nothing + a = TypeDeclaration "person" record Nothing empty b = a { typeDocs = Just "person record type" } -- without docs, last field with trailing comma parse' "record person (\n\ @@ -445,6 +486,16 @@ spec = do \ # date of birth\n\ \ gender gender\n\ \);" `shouldBeRight` b + -- without docs, last field with trailing comma + parse' "[foo: \"bar\"]\n\ + \record person (\n\ + \ text name,\n\ + \ date dob,\n\ + \ # date of birth\n\ + \ gender gender,\n\ + \);" + `shouldBeRight` + TypeDeclaration "person" record Nothing fooAnnotationSet it "should have one or more fields" $ do expectError "record unit ();" 1 14 expectError "record unit (\n# docs\n);" 3 1 @@ -478,7 +529,7 @@ spec = do , Tag "none" [] Nothing ] union = UnionType tags' - a = TypeDeclaration "shape" union Nothing + a = TypeDeclaration "shape" union Nothing empty b = a { typeDocs = Just "shape type" } parse' "union shape\n\ \ = circle (point origin, \ @@ -662,8 +713,10 @@ spec = do let (parse', expectError) = helperFuncs parser' it "emits Module if succeeded to parse" $ do let decls = [ TypeDeclaration "path" (Alias "text") Nothing + empty , TypeDeclaration "offset" (BoxedType "float64") Nothing + empty ] parse' "type path = text; boxed offset (float64);" `shouldBeRight` Module decls Nothing @@ -673,9 +726,9 @@ spec = do parse' "" `shouldBeRight` Module [] Nothing parse' "# docs" `shouldBeRight` Module [] (Just "docs") it "errors if there are any duplicated facial names" $ - expectError "type a = text;\ntype a/b = text;" 2 7 + expectError "type a = text;\ntype a/b = text;" 2 1 it "errors if there are any duplicated behind names" $ - expectError "type b = text;\ntype a/b = text;" 2 7 + expectError "type b = text;\ntype a/b = text;" 2 1 describe "modulePath" $ do let (parse', expectError) = helperFuncs P.modulePath diff --git a/test/Nirum/Targets/PythonSpec.hs b/test/Nirum/Targets/PythonSpec.hs index 6cd4575..543985d 100644 --- a/test/Nirum/Targets/PythonSpec.hs +++ b/test/Nirum/Targets/PythonSpec.hs @@ -37,6 +37,7 @@ import Text.InterpolatedString.Perl6 (q, qq) import Text.Megaparsec (char, digitChar, runParser, some, space, string') import Text.Megaparsec.String (Parser) +import Nirum.Constructs.Annotation (empty) import Nirum.Constructs.DeclarationSet (DeclarationSet) import Nirum.Constructs.Module (Module(Module)) import Nirum.Constructs.Name (Name(Name)) @@ -231,18 +232,21 @@ makeDummySource m = , ( ["foo", "bar"] , Module [ Import ["qux"] "path" , TypeDeclaration "path-box" (BoxedType "path") Nothing - , TypeDeclaration "int-box" (BoxedType "bigint") Nothing + empty + , TypeDeclaration "int-box" (BoxedType "bigint") + Nothing empty , TypeDeclaration "point" (RecordType [ Field "x" "int64" Nothing , Field "y" "int64" Nothing ]) Nothing + empty ] Nothing ) , ( ["qux"] , Module - [ TypeDeclaration "path" (Alias "text") Nothing - , TypeDeclaration "name" (BoxedType "text") Nothing + [ TypeDeclaration "path" (Alias "text") Nothing empty + , TypeDeclaration "name" (BoxedType "text") Nothing empty ] Nothing ) @@ -446,7 +450,8 @@ spec = parallel $ do describe "compilePackage" $ do specify "boxed type" $ do - let decl = TypeDeclaration "float-box" (BoxedType "float64") Nothing + let decl = TypeDeclaration "float-box" (BoxedType "float64") + Nothing empty tT decl "isinstance(FloatBox, type)" tT decl "FloatBox(3.14).value == 3.14" tT decl "FloatBox(3.14) == FloatBox(3.14)" @@ -461,6 +466,7 @@ spec = parallel $ do let decls = [ Import ["foo", "bar"] "path-box" , TypeDeclaration "imported-type-box" (BoxedType "path-box") Nothing + empty ] tT' decls "isinstance(ImportedTypeBox, type)" tT' decls [q|ImportedTypeBox(PathBox('/path/string')).value.value == @@ -489,6 +495,7 @@ spec = parallel $ do let boxedAlias = [ Import ["qux"] "path" , TypeDeclaration "way" (BoxedType "path") Nothing + empty ] tT' boxedAlias "Way('.').value == '.'" tT' boxedAlias "Way(Path('.')).value == '.'" @@ -496,6 +503,7 @@ spec = parallel $ do tT' boxedAlias "Way('.').__nirum_serialize__() == '.'" let aliasBoxed = [ Import ["qux"] "name" , TypeDeclaration "irum" (Alias "name") Nothing + empty ] tT' aliasBoxed "Name('khj') == Irum('khj')" tT' aliasBoxed "Irum.__nirum_deserialize__('khj') == Irum('khj')" @@ -507,6 +515,7 @@ spec = parallel $ do , EnumMember (Name "female" "yeoseong") Nothing ] :: DeclarationSet EnumMember decl = TypeDeclaration "gender" (EnumType members) Nothing + empty tT decl "type(Gender) is enum.EnumMeta" tT decl "set(Gender) == {Gender.male, Gender.female}" tT decl "Gender.male.value == 'male'" @@ -523,6 +532,7 @@ spec = parallel $ do , "nagisa-kaworu" ] :: DeclarationSet EnumMember decl' = TypeDeclaration "eva-char" (EnumType members') Nothing + empty tT decl' "type(EvaChar) is enum.EnumMeta" tT decl' "set(EvaChar) == {EvaChar.soryu_asuka_langley, \ \ EvaChar.ayanami_rei, \ @@ -542,6 +552,7 @@ spec = parallel $ do ] payload = "{'_type': 'point', 'x': 3, 'top': 14}" :: T.Text decl = TypeDeclaration "point" (RecordType fields) Nothing + empty tT decl "isinstance(Point, type)" tT decl "Point(left=3, top=14).left == 3" tT decl "Point(left=3, top=14).top == 14" @@ -566,6 +577,7 @@ spec = parallel $ do ] decls = [ Import ["foo", "bar"] "int-box" , TypeDeclaration "point" (RecordType fields') Nothing + empty ] payload' = "{'_type': 'point', 'left': 3, 'top': 14}" :: T.Text tT' decls "isinstance(Point, type)" @@ -598,6 +610,7 @@ spec = parallel $ do , TypeDeclaration "point3d" (RecordType fields'') Nothing + empty ] tT' decls' "isinstance(Point3d, type)" tT' decls' [q|Point3d(xy=Point(x=1, y=2), z=3).xy == @@ -617,7 +630,7 @@ spec = parallel $ do specify "record type with one field" $ do let fields = [ Field "length" "bigint" Nothing ] payload = "{'_type': 'line', 'length': 3}" :: T.Text - decl = TypeDeclaration "line" (RecordType fields) Nothing + decl = TypeDeclaration "line" (RecordType fields) Nothing empty tT decl "isinstance(Line, type)" tT decl "Line(length=10).length == 10" tT decl "Line.__slots__ == ('length', )" @@ -640,7 +653,7 @@ spec = parallel $ do , eastAsianNameTag , cultureAgnosticNameTag ] - decl = TypeDeclaration "name" (UnionType tags) Nothing + decl = TypeDeclaration "name" (UnionType tags) Nothing empty tT decl "isinstance(Name, type)" tT decl "Name.Tag.western_name.value == 'western_name'" tT decl "Name.Tag.east_asian_name.value == 'east_asian_name'" @@ -727,7 +740,7 @@ spec = parallel $ do [ Field "country" "text" Nothing ] Nothing tags = [cultureAgnosticNameTag] - decl = TypeDeclaration "music" (UnionType tags) Nothing + decl = TypeDeclaration "music" (UnionType tags) Nothing empty tT decl "Pop(country='KR').country == 'KR'" tT decl "Pop(country='KR') == Pop(country='KR')" tT decl "Pop(country='US') != Pop(country='KR')" @@ -739,7 +752,7 @@ spec = parallel $ do [ Field "country" "text" Nothing ] Nothing tags = [pop] - decl = TypeDeclaration "music" (UnionType tags) Nothing + decl = TypeDeclaration "music" (UnionType tags) Nothing empty tT decl "Pop(country='KR').__nirum_tag__.value == 'popular_music'" specify "service" $ do let null' = ServiceDeclaration "null-service" (Service []) Nothing From 725599678ce785b64b866b0f5d538c4cae152eb6 Mon Sep 17 00:00:00 2001 From: Hyojun Kang Date: Thu, 11 Aug 2016 03:49:09 +0900 Subject: [PATCH 5/6] Annotation on ServiceDeclaration --- src/Nirum/Constructs/Annotation.hs | 2 +- src/Nirum/Constructs/TypeDeclaration.hs | 11 ++++--- src/Nirum/Parser.hs | 6 ++-- src/Nirum/Targets/Python.hs | 2 +- test/Nirum/Constructs/TypeDeclarationSpec.hs | 31 ++++++++++++++++---- test/Nirum/ParserSpec.hs | 14 ++++++++- test/Nirum/Targets/PythonSpec.hs | 6 ++-- 7 files changed, 55 insertions(+), 17 deletions(-) diff --git a/src/Nirum/Constructs/Annotation.hs b/src/Nirum/Constructs/Annotation.hs index 7e75546..7ea4c4b 100644 --- a/src/Nirum/Constructs/Annotation.hs +++ b/src/Nirum/Constructs/Annotation.hs @@ -37,7 +37,7 @@ data AnnotationSet instance Construct AnnotationSet where toCode AnnotationSet {annotations = annotations'} = - T.intercalate "\n" $ map toCode (M.elems annotations') + T.concat [s | e <- M.elems annotations', s <- [toCode e, "\n"]] data NameDuplication = AnnotationNameDuplication Identifier deriving (Eq, Ord, Show) diff --git a/src/Nirum/Constructs/TypeDeclaration.hs b/src/Nirum/Constructs/TypeDeclaration.hs index 64aac5d..4176a4c 100644 --- a/src/Nirum/Constructs/TypeDeclaration.hs +++ b/src/Nirum/Constructs/TypeDeclaration.hs @@ -11,6 +11,7 @@ module Nirum.Constructs.TypeDeclaration ( EnumMember(EnumMember) , importName , modulePath , service + , serviceAnnotations , serviceDocs , serviceName , type' @@ -118,6 +119,7 @@ data TypeDeclaration | ServiceDeclaration { serviceName :: Name , service :: Service , serviceDocs :: Maybe Docs + , serviceAnnotations :: AnnotationSet } | Import { modulePath :: ModulePath , importName :: Identifier @@ -186,8 +188,9 @@ instance Construct TypeDeclaration where docString Nothing = "" docString (Just (Docs d)) = T.concat ["\n// ", T.replace "\n" "\n// " $ T.stripEnd d, "\n"] - toCode (ServiceDeclaration name' (Service methods) docs') = - T.concat [ "service " + toCode (ServiceDeclaration name' (Service methods) docs' annotations') = + T.concat [ toCode annotations' + , "service " , toCode name' , " (" , toCodeWithPrefix "\n " docs' @@ -217,8 +220,8 @@ instance Construct TypeDeclaration where instance Declaration TypeDeclaration where name (TypeDeclaration name' _ _ _) = name' - name (ServiceDeclaration name' _ _) = name' + name (ServiceDeclaration name' _ _ _) = name' name (Import _ identifier) = Name identifier identifier docs (TypeDeclaration _ _ docs' _) = docs' - docs (ServiceDeclaration _ _ docs') = docs' + docs (ServiceDeclaration _ _ docs' _) = docs' docs (Import _ _) = Nothing diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs index f59ed10..b812ee1 100644 --- a/src/Nirum/Parser.hs +++ b/src/Nirum/Parser.hs @@ -463,6 +463,7 @@ methodSet = do serviceDeclaration :: Parser TypeDeclaration serviceDeclaration = do + annotationSet' <- annotationSet "service annotation" string "service" "service keyword" spaces serviceName <- name "service name" @@ -478,7 +479,8 @@ serviceDeclaration = do char ')' spaces char ';' - return $ ServiceDeclaration serviceName (Service methods') docs' + return $ ServiceDeclaration serviceName (Service methods') + docs' annotationSet' modulePath :: Parser ModulePath modulePath = do @@ -526,7 +528,7 @@ module' = do spaces return importList types <- many $ do - typeDecl <- typeDeclaration <|> + typeDecl <- try typeDeclaration <|> (serviceDeclaration "service declaration") spaces return typeDecl diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs index 09400dc..f751d8d 100644 --- a/src/Nirum/Targets/Python.hs +++ b/src/Nirum/Targets/Python.hs @@ -488,7 +488,7 @@ $fieldCodes' toNamePair [name | (name, _) <- tagNameNFields] ",\n " -compileTypeDeclaration src (ServiceDeclaration name (Service methods) _) = do +compileTypeDeclaration src (ServiceDeclaration name (Service methods) _ _) = do let methods' = toList methods methodMetadata <- mapM compileMethodMetadata methods' let methodMetadata' = commaNl methodMetadata diff --git a/test/Nirum/Constructs/TypeDeclarationSpec.hs b/test/Nirum/Constructs/TypeDeclarationSpec.hs index 1c5e6f7..c5654f8 100644 --- a/test/Nirum/Constructs/TypeDeclarationSpec.hs +++ b/test/Nirum/Constructs/TypeDeclarationSpec.hs @@ -1,11 +1,16 @@ {-# LANGUAGE OverloadedLists, OverloadedStrings #-} module Nirum.Constructs.TypeDeclarationSpec where +import Data.Either (rights) import qualified Data.Text as T import Test.Hspec.Meta import Nirum.Constructs (Construct(toCode)) -import Nirum.Constructs.Annotation (empty) +import Nirum.Constructs.Annotation ( Annotation (Annotation) + , AnnotationSet + , fromList + , empty + ) import Nirum.Constructs.Declaration (Declaration(name, docs)) import Nirum.Constructs.DeclarationSet (DeclarationSet) import Nirum.Constructs.Service (Method(Method), Service(Service)) @@ -18,6 +23,9 @@ import Nirum.Constructs.TypeDeclaration ( EnumMember(EnumMember) , TypeDeclaration(..) ) +barAnnotationSet :: AnnotationSet +barAnnotationSet = head $ rights [fromList [Annotation "bar" "baz"]] + spec :: Spec spec = do describe "TypeDeclaration" $ do @@ -149,15 +157,23 @@ spec = do specify "toCode" $ T.lines (toCode decl) `shouldSatisfy` all (T.isPrefixOf "//" . T.stripStart) - context "SerciceDeclaration" $ do + context "ServiceDeclaration" $ do let nullService = Service [] nullDecl = ServiceDeclaration "null-service" nullService Nothing - nullDecl' = ServiceDeclaration "null-service" nullService $ - Just "Null service declaration." + empty + nullDecl' = + ServiceDeclaration "null-service" nullService + (Just "Null service declaration.") + empty pingService = Service [ Method "ping" [] "bool" Nothing ] pingDecl = ServiceDeclaration "ping-service" pingService Nothing - pingDecl' = ServiceDeclaration "ping-service" pingService $ - Just "Ping service declaration." + empty + pingDecl' = + ServiceDeclaration "ping-service" pingService + (Just "Ping service declaration.") + empty + annoDecl = ServiceDeclaration "anno-service" pingService + Nothing barAnnotationSet specify "toCode" $ do toCode nullDecl `shouldBe` "service null-service ();" toCode nullDecl' `shouldBe` "service null-service (\n\ @@ -170,6 +186,9 @@ spec = do \ # Ping service declaration.\n\ \ bool ping ()\n\ \);" + toCode annoDecl `shouldBe` + "[bar: \"baz\"]\n\ + \service anno-service (bool ping ());" -- TODO: more tests context "Import" $ do let import' = Import ["foo", "bar"] "baz" diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs index fdb610a..41842e6 100644 --- a/test/Nirum/ParserSpec.hs +++ b/test/Nirum/ParserSpec.hs @@ -623,13 +623,14 @@ spec = do let (parse', expectError) = helperFuncs P.serviceDeclaration it "emits ServiceDeclaration if succeeded to parse" $ do parse' "service null-service();" `shouldBeRight` - ServiceDeclaration "null-service" (Service []) Nothing + ServiceDeclaration "null-service" (Service []) Nothing empty parse' "service null-service (\n\ \ # Service having no methods.\n\ \);" `shouldBeRight` ServiceDeclaration "null-service" (Service []) (Just "Service having no methods.") + empty parse' "service one-method-service(\n\ \ user get-user(uuid user-id)\n\ \);" `shouldBeRight` @@ -641,6 +642,7 @@ spec = do Nothing ]) Nothing + empty parse' "service one-method-service (\n\ \ # Service having only one method.\n\ \ user get-user (\n\ @@ -656,6 +658,7 @@ spec = do (Just "Gets an user by its id.") ]) (Just "Service having only one method.") + empty parse' "service user-service (\n\ \ # Service having multiple methods.\n\ \ user create-user (\n\ @@ -679,6 +682,15 @@ spec = do (Just "Gets an user by its id.") ]) (Just "Service having multiple methods.") + empty + parse' "[foo: \"bar\"]\n\ + \service null-service (\n\ + \ # Service having no methods.\n\ + \);" `shouldBeRight` + ServiceDeclaration "null-service" + (Service []) + (Just "Service having no methods.") + fooAnnotationSet it "fails to parse if there are methods of the same facial name" $ do expectError "service method-dups (\n\ \ bool same-name ()\n\ diff --git a/test/Nirum/Targets/PythonSpec.hs b/test/Nirum/Targets/PythonSpec.hs index 543985d..dcbcde1 100644 --- a/test/Nirum/Targets/PythonSpec.hs +++ b/test/Nirum/Targets/PythonSpec.hs @@ -755,12 +755,14 @@ spec = parallel $ do decl = TypeDeclaration "music" (UnionType tags) Nothing empty tT decl "Pop(country='KR').__nirum_tag__.value == 'popular_music'" specify "service" $ do - let null' = ServiceDeclaration "null-service" (Service []) Nothing + let null' = ServiceDeclaration "null-service" (Service []) + Nothing empty pingService = Service [Method "ping" [Parameter "nonce" "text" Nothing] "bool" Nothing] - ping' = ServiceDeclaration "ping-service" pingService Nothing + ping' = ServiceDeclaration "ping-service" pingService + Nothing empty tT null' "issubclass(NullService, __import__('nirum').rpc.Service)" tT ping' "issubclass(PingService, __import__('nirum').rpc.Service)" tT ping' "set(PingService.ping.__annotations__) == \ From f6e1934c30dc20fc0759ff00a39d0c356d3d9d99 Mon Sep 17 00:00:00 2001 From: Hyojun Kang Date: Thu, 11 Aug 2016 04:12:05 +0900 Subject: [PATCH 6/6] Annotation on Method --- src/Nirum/Constructs/Annotation.hs | 6 ++-- src/Nirum/Constructs/Service.hs | 13 ++++++-- src/Nirum/Parser.hs | 5 +-- src/Nirum/Targets/Python.hs | 4 +-- test/Nirum/Constructs/ServiceSpec.hs | 33 ++++++++++++++------ test/Nirum/Constructs/TypeDeclarationSpec.hs | 2 +- test/Nirum/ParserSpec.hs | 22 ++++++++++--- test/Nirum/Targets/PythonSpec.hs | 3 +- 8 files changed, 62 insertions(+), 26 deletions(-) diff --git a/src/Nirum/Constructs/Annotation.hs b/src/Nirum/Constructs/Annotation.hs index 7ea4c4b..c1e4dc0 100644 --- a/src/Nirum/Constructs/Annotation.hs +++ b/src/Nirum/Constructs/Annotation.hs @@ -10,10 +10,10 @@ module Nirum.Constructs.Annotation ( Annotation(Annotation) , toList ) where -import Text.InterpolatedString.Perl6 (qq) -import qualified Data.Text as T import qualified Data.Map.Strict as M import qualified Data.Set as S +import qualified Data.Text as T +import Text.InterpolatedString.Perl6 (qq) import Nirum.Constructs (Construct (toCode)) import Nirum.Constructs.Identifier (Identifier) @@ -31,7 +31,7 @@ instance Construct Annotation where data AnnotationSet -- | The set of 'Annotation' values. - -- Evenry annotaiton name has to be unique in the set. + -- Every annotation name has to be unique in the set. = AnnotationSet { annotations :: M.Map Identifier Annotation } deriving (Eq, Ord, Show) diff --git a/src/Nirum/Constructs/Service.hs b/src/Nirum/Constructs/Service.hs index 1258396..e2c2e2d 100644 --- a/src/Nirum/Constructs/Service.hs +++ b/src/Nirum/Constructs/Service.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Nirum.Constructs.Service ( Method ( Method + , methodAnnotations , methodDocs , methodName , parameters @@ -12,6 +13,7 @@ module Nirum.Constructs.Service ( Method ( Method import qualified Data.Text as T import Nirum.Constructs (Construct(toCode)) +import Nirum.Constructs.Annotation (AnnotationSet) import Nirum.Constructs.Declaration ( Declaration(name, docs) , Docs , toCodeWithPrefix @@ -40,13 +42,18 @@ instance Declaration Parameter where -- | 'Service' method. data Method = Method { methodName :: Name , parameters :: DeclarationSet Parameter - , returnType :: TypeExpression + , returnType :: TypeExpression , methodDocs :: Maybe Docs + , methodAnnotations :: AnnotationSet } deriving (Eq, Ord, Show) instance Construct Method where - toCode method@Method { parameters = params, methodDocs = docs' } = - T.concat $ [ toCode $ returnType method + toCode method@Method { parameters = params + , methodDocs = docs' + , methodAnnotations = annotationSet' + } = + T.concat $ [ toCode annotationSet' + , toCode $ returnType method , " " , toCode $ methodName method , " (" diff --git a/src/Nirum/Parser.hs b/src/Nirum/Parser.hs index b812ee1..5c661a1 100644 --- a/src/Nirum/Parser.hs +++ b/src/Nirum/Parser.hs @@ -55,7 +55,7 @@ import Text.Megaparsec ( Token , (<|>) , () ) -import Text.Megaparsec.Char (char +import Text.Megaparsec.Char ( char , eol , noneOf , spaceChar @@ -438,6 +438,7 @@ parameterSet = option empty $ try $ do method :: Parser Method method = do + annotationSet' <- annotationSet "service method annotation" returnType <- typeExpression "method return type" spaces1 methodName <- name "method name" @@ -451,7 +452,7 @@ method = do params <- parameterSet spaces char ')' - return $ Method methodName params returnType docs' + return $ Method methodName params returnType docs' annotationSet' methods :: Parser [Method] methods = method `sepEndBy` try (spaces >> char ',' >> spaces) diff --git a/src/Nirum/Targets/Python.hs b/src/Nirum/Targets/Python.hs index f751d8d..da5bcfa 100644 --- a/src/Nirum/Targets/Python.hs +++ b/src/Nirum/Targets/Python.hs @@ -515,7 +515,7 @@ class $className(service_type): commaNl :: [T.Text] -> T.Text commaNl = T.intercalate ",\n" compileMethod :: Method -> CodeGen Code - compileMethod (Method mName params rtype _) = do + compileMethod (Method mName params rtype _ _) = do let mName' = toAttributeName' mName params' <- mapM compileParameter $ toList params rtypeExpr <- compileTypeExpression src rtype @@ -528,7 +528,7 @@ class $className(service_type): pTypeExpr <- compileTypeExpression src pType return [qq|{toAttributeName' pName}: $pTypeExpr|] compileMethodMetadata :: Method -> CodeGen Code - compileMethodMetadata (Method mName params rtype _) = do + compileMethodMetadata (Method mName params rtype _ _) = do let params' = toList params :: [Parameter] rtypeExpr <- compileTypeExpression src rtype paramMetadata <- mapM compileParameterMetadata params' diff --git a/test/Nirum/Constructs/ServiceSpec.hs b/test/Nirum/Constructs/ServiceSpec.hs index 9e4822a..1533ce6 100644 --- a/test/Nirum/Constructs/ServiceSpec.hs +++ b/test/Nirum/Constructs/ServiceSpec.hs @@ -3,6 +3,7 @@ module Nirum.Constructs.ServiceSpec where import Test.Hspec.Meta +import Nirum.Constructs.Annotation (Annotation (Annotation), empty, fromList) import Nirum.Constructs.Declaration (toCode) import Nirum.Constructs.Service (Method(Method), Parameter(Parameter)) import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier @@ -10,8 +11,10 @@ import Nirum.Constructs.TypeExpression ( TypeExpression ( ListModifier ) ) + spec :: Spec spec = do + let Right methodAnno = fromList [Annotation "http-get" "/ping/"] describe "Parameter" $ specify "toCode" $ do toCode (Parameter "dob" "date" Nothing) `shouldBe` "date dob," @@ -19,28 +22,34 @@ spec = do "date dob,\n# docs..." describe "Method" $ specify "toCode" $ do - toCode (Method "ping" [] "bool" Nothing) `shouldBe` + toCode (Method "ping" [] "bool" Nothing empty) `shouldBe` "bool ping ()," - toCode (Method "ping" [] "bool" $ Just "docs...") `shouldBe` + toCode (Method "ping" [] "bool" Nothing methodAnno) `shouldBe` + "[http-get: \"/ping/\"]\nbool ping ()," + toCode (Method "ping" [] "bool" (Just "docs...") empty) `shouldBe` "bool ping (\n # docs...\n)," toCode (Method "get-user" [Parameter "user-id" "uuid" Nothing] (OptionModifier "user") - Nothing) `shouldBe` "user? get-user (uuid user-id)," + Nothing + empty) `shouldBe` "user? get-user (uuid user-id)," toCode (Method "get-user" [Parameter "user-id" "uuid" Nothing] (OptionModifier "user") - $ Just "docs...") `shouldBe` + (Just "docs...") + empty) `shouldBe` "user? get-user (\n # docs...\n uuid user-id,\n)," toCode (Method "get-user" [Parameter "user-id" "uuid" $ Just "param docs..."] (OptionModifier "user") - Nothing) `shouldBe` + Nothing + empty) `shouldBe` "user? get-user (\n uuid user-id,\n # param docs...\n)," toCode (Method "get-user" [Parameter "user-id" "uuid" $ Just "param docs..."] (OptionModifier "user") - $ Just "docs...") `shouldBe` + (Just "docs...") + empty) `shouldBe` "user? get-user (\n\ \ # docs...\n\ \ uuid user-id,\n\ @@ -51,14 +60,16 @@ spec = do , Parameter "keyword" "text" Nothing ] (ListModifier "post") - Nothing) `shouldBe` + Nothing + empty) `shouldBe` "[post] search-posts (\n uuid blog-id,\n text keyword,\n)," toCode (Method "search-posts" [ Parameter "blog-id" "uuid" Nothing , Parameter "keyword" "text" Nothing ] (ListModifier "post") - $ Just "docs...") `shouldBe` + (Just "docs...") + empty) `shouldBe` "[post] search-posts (\n\ \ # docs...\n\ \ uuid blog-id,\n\ @@ -69,7 +80,8 @@ spec = do , Parameter "keyword" "text" $ Just "keyword..." ] (ListModifier "post") - Nothing) `shouldBe` + Nothing + empty) `shouldBe` "[post] search-posts (\n\ \ uuid blog-id,\n\ \ # blog id...\n\ @@ -81,7 +93,8 @@ spec = do , Parameter "keyword" "text" $ Just "keyword..." ] (ListModifier "post") - $ Just "docs...") `shouldBe` + (Just "docs...") + empty) `shouldBe` "[post] search-posts (\n\ \ # docs...\n\ \ uuid blog-id,\n\ diff --git a/test/Nirum/Constructs/TypeDeclarationSpec.hs b/test/Nirum/Constructs/TypeDeclarationSpec.hs index c5654f8..8726864 100644 --- a/test/Nirum/Constructs/TypeDeclarationSpec.hs +++ b/test/Nirum/Constructs/TypeDeclarationSpec.hs @@ -165,7 +165,7 @@ spec = do ServiceDeclaration "null-service" nullService (Just "Null service declaration.") empty - pingService = Service [ Method "ping" [] "bool" Nothing ] + pingService = Service [ Method "ping" [] "bool" Nothing empty ] pingDecl = ServiceDeclaration "ping-service" pingService Nothing empty pingDecl' = diff --git a/test/Nirum/ParserSpec.hs b/test/Nirum/ParserSpec.hs index 41842e6..2b6fd45 100644 --- a/test/Nirum/ParserSpec.hs +++ b/test/Nirum/ParserSpec.hs @@ -569,23 +569,31 @@ spec = do describe "method" $ do let (parse', expectError) = helperFuncs P.method + httpGetAnnotation = + head $ rights [fromList [Annotation "http-get" "/get-name/"]] it "emits Method if succeeded to parse" $ do parse' "text get-name()" `shouldBeRight` - Method "get-name" [] "text" Nothing + Method "get-name" [] "text" Nothing empty parse' "text get-name (person user)" `shouldBeRight` Method "get-name" [Parameter "user" "person" Nothing] - "text" Nothing + "text" Nothing empty parse' "text get-name ( person user,text default )" `shouldBeRight` Method "get-name" [ Parameter "user" "person" Nothing , Parameter "default" "text" Nothing ] - "text" Nothing + "text" Nothing empty + parse' "[http-get: \"/get-name/\"] text get-name ( person user,text default )" `shouldBeRight` + Method "get-name" + [ Parameter "user" "person" Nothing + , Parameter "default" "text" Nothing + ] + "text" Nothing httpGetAnnotation it "can have docs" $ do parse' "text get-name (\n\ \ # Gets the name.\n\ \)" `shouldBeRight` - Method "get-name" [] "text" (Just "Gets the name.") + Method "get-name" [] "text" (Just "Gets the name.") empty parse' "text get-name (\n\ \ # Gets the name of the user.\n\ \ person user,\n\ @@ -594,6 +602,7 @@ spec = do [Parameter "user" "person" Nothing] "text" (Just "Gets the name of the user.") + empty parse' "text get-name (\n\ \ # Gets the name of the user.\n\ \ person user,\n\ @@ -610,6 +619,7 @@ spec = do ] "text" (Just "Gets the name of the user.") + empty it "fails to parse if there are parameters of the same facial name" $ do expectError "bool pred(text a, text a/b)" 1 11 expectError "bool pred(text a/b, text a)" 1 11 @@ -640,6 +650,7 @@ spec = do [Parameter "user-id" "uuid" Nothing] "user" Nothing + empty ]) Nothing empty @@ -656,6 +667,7 @@ spec = do [Parameter "user-id" "uuid" Nothing] "user" (Just "Gets an user by its id.") + empty ]) (Just "Service having only one method.") empty @@ -676,10 +688,12 @@ spec = do [Parameter "user" "user" Nothing] "user" (Just "Creates a new user") + empty , Method "get-user" [Parameter "user-id" "uuid" Nothing] "user" (Just "Gets an user by its id.") + empty ]) (Just "Service having multiple methods.") empty diff --git a/test/Nirum/Targets/PythonSpec.hs b/test/Nirum/Targets/PythonSpec.hs index dcbcde1..d1e02cc 100644 --- a/test/Nirum/Targets/PythonSpec.hs +++ b/test/Nirum/Targets/PythonSpec.hs @@ -760,7 +760,8 @@ spec = parallel $ do pingService = Service [Method "ping" [Parameter "nonce" "text" Nothing] "bool" - Nothing] + Nothing + empty] ping' = ServiceDeclaration "ping-service" pingService Nothing empty tT null' "issubclass(NullService, __import__('nirum').rpc.Service)"