nirum-0.2.0: test/Nirum/Constructs/TypeDeclarationSpec.hs
{-# LANGUAGE OverloadedLists #-}
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 ( 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))
import Nirum.Constructs.TypeDeclaration ( EnumMember(EnumMember)
, Field(Field)
, JsonType(String)
, PrimitiveTypeIdentifier(Text)
, Tag(Tag)
, Type(..)
, TypeDeclaration(..)
)
import Util (singleDocs)
barAnnotationSet :: AnnotationSet
barAnnotationSet = head $ rights [fromList [Annotation "bar" (Just "baz")]]
spec :: Spec
spec = do
describe "TypeDeclaration" $ do
context "Alias" $ do
let alias = Alias "text"
a = TypeDeclaration { typename = "path"
, type' = alias
, typeAnnotations = empty
}
b = a { typeAnnotations = singleDocs "docs" }
specify "name" $ do
name a `shouldBe` "path"
name b `shouldBe` "path"
specify "docs" $ do
docs a `shouldBe` Nothing
docs b `shouldBe` Just "docs"
specify "toCode" $ do
toCode a `shouldBe` "type path = text;"
toCode b `shouldBe` "type path = text;\n# docs"
context "UnboxedType" $ do
let unboxed = UnboxedType "float64"
a = TypeDeclaration { typename = "offset"
, type' = unboxed
, typeAnnotations = empty
}
b = a { typeAnnotations = singleDocs "docs" }
specify "name" $ do
name a `shouldBe` "offset"
name b `shouldBe` "offset"
specify "docs" $ do
docs a `shouldBe` Nothing
docs b `shouldBe` Just "docs"
specify "toCode" $ do
toCode a `shouldBe` "unboxed offset (float64);"
toCode b `shouldBe` "unboxed offset (float64);\n# docs"
context "EnumType" $ do
let enumMembers = [ EnumMember "kr" empty
, EnumMember "jp" (singleDocs "Japan")
, EnumMember "us" (singleDocs "United States")
] :: DeclarationSet EnumMember
enum = EnumType enumMembers
a = TypeDeclaration { typename = "country"
, type' = enum
, typeAnnotations = empty
}
b = a { typeAnnotations = singleDocs "country codes" }
specify "toCode" $ do
toCode a `shouldBe` "enum country\n\
\ = kr\n\
\ | jp\n\
\ # Japan\n\
\ | us\n\
\ # United States\n\
\ ;"
toCode b `shouldBe` "enum country\n\
\ # country codes\n\
\ = kr\n\
\ | jp\n\
\ # Japan\n\
\ | us\n\
\ # United States\n\
\ ;"
context "RecordType" $ do
let fields' = [ Field "name" "text" empty
, Field "dob" "date" (singleDocs "date of birth")
, Field "gender" "gender" empty
] :: DeclarationSet Field
record = RecordType fields'
a = TypeDeclaration { typename = "person"
, type' = record
, typeAnnotations = empty
}
b = a { typeAnnotations = singleDocs "person record type" }
specify "toCode" $ do
toCode a `shouldBe` "record person (\n\
\ text name,\n\
\ date dob,\n\
\ # date of birth\n\
\ gender gender,\n\
\);"
toCode b `shouldBe` "record person (\n\
\ # person record type\n\n\
\ text name,\n\
\ date dob,\n\
\ # date of birth\n\
\ gender gender,\n\
\);"
context "UnionType" $ do
let circleFields = [ Field "origin" "point" empty
, Field "radius" "offset" empty
]
rectangleFields = [ Field "upper-left" "point" empty
, Field "lower-right" "point" empty
]
tags' = [ Tag "circle" circleFields empty
, Tag "rectangle" rectangleFields empty
, Tag "none" [] empty
]
union = UnionType tags'
a = TypeDeclaration { typename = "shape"
, type' = union
, typeAnnotations = empty
}
b = a { typeAnnotations = singleDocs "shape type" }
specify "toCode" $ do
toCode a `shouldBe` "union shape\n\
\ = circle (point origin, \
\offset radius,)\n\
\ | rectangle (point upper-left, \
\point lower-right,)\n\
\ | none\n\
\ ;"
toCode b `shouldBe` "union shape\n\
\ # shape type\n\
\ = circle (point origin, \
\offset radius,)\n\
\ | rectangle (point upper-left, \
\point lower-right,)\n\
\ | none\n\
\ ;"
context "PrimitiveType" $ do
let primitiveType = PrimitiveType Text String
decl = TypeDeclaration "text" primitiveType empty
specify "toCode" $
T.lines (toCode decl) `shouldSatisfy`
all (T.isPrefixOf "//" . T.stripStart)
context "ServiceDeclaration" $ do
let nullService = Service []
nullDecl = ServiceDeclaration "null-service" nullService empty
nullDecl' =
ServiceDeclaration "null-service" nullService
(singleDocs "Null service declaration.")
pingService = Service [ Method "ping" [] "bool" Nothing empty ]
pingDecl = ServiceDeclaration "ping-service" pingService empty
pingDecl' =
ServiceDeclaration "ping-service" pingService
(singleDocs "Ping service declaration.")
annoDecl = ServiceDeclaration "anno-service" pingService
barAnnotationSet
specify "toCode" $ do
toCode nullDecl `shouldBe` "service null-service ();"
toCode nullDecl' `shouldBe` "service null-service (\n\
\ # Null service declaration.\n\
\);"
toCode pingDecl `shouldBe`
"service ping-service (bool ping ());"
toCode pingDecl' `shouldBe`
"service ping-service (\n\
\ # 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" empty
specify "name" $
name import' `shouldBe` "baz"
specify "docs" $
docs import' `shouldBe` Nothing
specify "toCode" $
toCode import' `shouldBe` "import foo.bar (baz);\n"
describe "EnumMember" $ do
let kr = EnumMember "kr" empty
jp = EnumMember "jp" (singleDocs "Japan")
specify "toCode" $ do
toCode kr `shouldBe` "kr"
toCode jp `shouldBe` "jp\n# Japan"
specify "fromString" $
"test" `shouldBe` EnumMember "test" empty
describe "Field" $
specify "toCode" $ do
toCode (Field "name" "text" empty) `shouldBe` "text name,"
toCode (Field "dob" "date" (singleDocs "date of birth")) `shouldBe`
"date dob,\n# date of birth"
describe "Tag" $
specify "toCode" $ do
let fields' = [ Field "origin" "point" empty
, Field "radius" "offset" empty
]
toCode (Tag "circle" fields' empty)
`shouldBe` "circle (point origin, offset radius,)"
toCode (Tag "circle" fields' (singleDocs "docs"))
`shouldBe` "circle (point origin, offset radius,)\n# docs"
toCode (Tag "unit" [] empty) `shouldBe` "unit"
toCode (Tag "unit" [] (singleDocs "docs")) `shouldBe` "unit\n# docs"