nirum-0.1.0: test/Nirum/Constructs/TypeDeclarationSpec.hs
{-# 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 ( 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(..)
)
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
, typeDocs = Nothing
, typeAnnotations = empty
}
b = a { typeDocs = Just "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 "BoxedType" $ do
let boxed = BoxedType "float64"
a = TypeDeclaration { typename = "offset"
, type' = boxed
, typeDocs = Nothing
, typeAnnotations = empty
}
b = a { typeDocs = Just "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` "boxed offset (float64);"
toCode b `shouldBe` "boxed offset (float64);\n# docs"
context "EnumType" $ do
let enumMembers = [ EnumMember "kr" Nothing
, EnumMember "jp" $ Just "Japan"
, EnumMember "us" $ Just "United States"
] :: DeclarationSet EnumMember
enum = EnumType enumMembers
a = TypeDeclaration { typename = "country"
, type' = enum
, typeDocs = Nothing
, typeAnnotations = empty
}
b = a { typeDocs = Just "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" Nothing
, Field "dob" "date" $ Just "date of birth"
, Field "gender" "gender" Nothing
] :: DeclarationSet Field
record = RecordType fields'
a = TypeDeclaration { typename = "person"
, type' = record
, typeDocs = Nothing
, typeAnnotations = empty
}
b = a { typeDocs = Just "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" Nothing
, Field "radius" "offset" Nothing
]
rectangleFields = [ Field "upper-left" "point" Nothing
, Field "lower-right" "point" Nothing
]
tags' = [ Tag "circle" circleFields Nothing
, Tag "rectangle" rectangleFields Nothing
, Tag "none" [] Nothing
]
union = UnionType tags'
a = TypeDeclaration { typename = "shape"
, type' = union
, typeDocs = Nothing
, typeAnnotations = empty
}
b = a { typeDocs = Just "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 Nothing empty
specify "toCode" $
T.lines (toCode decl) `shouldSatisfy`
all (T.isPrefixOf "//" . T.stripStart)
context "ServiceDeclaration" $ do
let nullService = Service []
nullDecl = ServiceDeclaration "null-service" nullService Nothing
empty
nullDecl' =
ServiceDeclaration "null-service" nullService
(Just "Null service declaration.")
empty
pingService = Service [ Method "ping" [] "bool" Nothing Nothing empty ]
pingDecl = ServiceDeclaration "ping-service" pingService Nothing
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\
\ # 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"
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" Nothing
jp = EnumMember "jp" $ Just "Japan"
specify "toCode" $ do
toCode kr `shouldBe` "kr"
toCode jp `shouldBe` "jp\n# Japan"
specify "fromString" $
"test" `shouldBe` EnumMember "test" Nothing
describe "Field" $
specify "toCode" $ do
toCode (Field "name" "text" Nothing) `shouldBe` "text name,"
toCode (Field "dob" "date" $ Just "date of birth") `shouldBe`
"date dob,\n# date of birth"
describe "Tag" $
specify "toCode" $ do
let fields' = [ Field "origin" "point" Nothing
, Field "radius" "offset" Nothing
]
toCode (Tag "circle" fields' Nothing)
`shouldBe` "circle (point origin, offset radius,)"
toCode (Tag "circle" fields' $ Just "docs")
`shouldBe` "circle (point origin, offset radius,)\n# docs"
toCode (Tag "unit" [] Nothing) `shouldBe` "unit"
toCode (Tag "unit" [] $ Just "docs") `shouldBe` "unit\n# docs"