From e1b597b8065f2e21cddb90165aa2f5e4991f6a6f Mon Sep 17 00:00:00 2001 From: Kyle Bashour Date: Mon, 12 Jan 2026 19:02:26 -0800 Subject: [PATCH] Fix @no-emit-typescript for simple enums --- CHANGELOG.md | 1 + src/Data/Aeson/TypeScript/Formatting.hs | 20 +++++++++++++------- src/Data/Aeson/TypeScript/Instances.hs | 2 +- src/Data/Aeson/TypeScript/TH.hs | 20 ++++++++++++-------- src/Data/Aeson/TypeScript/Types.hs | 2 +- test/Basic.hs | 4 ++-- test/ClosedTypeFamilies.hs | 8 ++++---- test/Formatting.hs | 10 ++++++++++ test/Generic.hs | 12 ++++++------ test/GetDoc.hs | 2 +- test/HigherKind.hs | 10 +++++----- test/MaybeTuples.hs | 24 ++++++++++++------------ test/NoOmitNothingFields.hs | 2 +- test/OpenTypeFamilies.hs | 8 ++++---- test/UnwrapUnaryRecords.hs | 4 ++-- 15 files changed, 75 insertions(+), 54 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index aabd8b1..5ca0117 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,7 @@ ## Unreleased * Remove question mark in Data.Map instance +* Fix @no-emit-typescript not working for nullary constructors in simple enums ## 0.6.4.0 diff --git a/src/Data/Aeson/TypeScript/Formatting.hs b/src/Data/Aeson/TypeScript/Formatting.hs index 9412b53..6ab206a 100644 --- a/src/Data/Aeson/TypeScript/Formatting.hs +++ b/src/Data/Aeson/TypeScript/Formatting.hs @@ -22,27 +22,29 @@ formatTSDeclarations = formatTSDeclarations' defaultFormattingOptions -- | Format a single TypeScript declaration. This version accepts a FormattingOptions object in case you want more control over the output. formatTSDeclaration :: FormattingOptions -> TSDeclaration -> String -formatTSDeclaration (FormattingOptions {..}) (TSTypeAlternatives name genericVariables names maybeDoc) = +formatTSDeclaration (FormattingOptions {..}) (TSTypeAlternatives name genericVariables (filter (not . isNoEmitTypeScriptAlternative) -> names) maybeDoc) = makeDocPrefix maybeDoc <> mainDeclaration where + typeStrings = fmap fst names + mainDeclaration = case chooseTypeAlternativesFormat typeAlternativesFormat of Enum -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name} { #{alternativesEnum} }|] where - alternativesEnum = T.intercalate ", " $ [toEnumName entry <> "=" <> entry | entry <- T.pack <$> names] + alternativesEnum = T.intercalate ", " $ [toEnumName entry <> "=" <> entry | entry <- T.pack <$> typeStrings] EnumWithType -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name}Enum { #{alternativesEnumWithType} }#{enumType}|] where - alternativesEnumWithType = T.intercalate ", " $ [toEnumName entry <> "=" <> entry | entry <- T.pack <$> names] + alternativesEnumWithType = T.intercalate ", " $ [toEnumName entry <> "=" <> entry | entry <- T.pack <$> typeStrings] enumType = [i|\n\ntype #{name} = keyof typeof #{typeNameModifier name}Enum;|] :: T.Text TypeAlias -> [i|#{exportPrefix exportMode}type #{typeNameModifier name}#{getGenericBrackets genericVariables} = #{alternatives};|] where - alternatives = T.intercalate " | " (fmap T.pack names) + alternatives = T.intercalate " | " (fmap T.pack typeStrings) -- Only allow certain formats if some checks pass chooseTypeAlternativesFormat Enum - | all isDoubleQuotedString names = Enum + | all isDoubleQuotedString typeStrings = Enum | otherwise = TypeAlias chooseTypeAlternativesFormat EnumWithType - | all isDoubleQuotedString names = EnumWithType + | all isDoubleQuotedString typeStrings = EnumWithType | otherwise = TypeAlias chooseTypeAlternativesFormat x = x @@ -87,7 +89,7 @@ formatTSDeclarations' options allDeclarations = getDeclarationName _ = Nothing removeReferencesToRemovedNames :: [String] -> TSDeclaration -> TSDeclaration - removeReferencesToRemovedNames removedNames decl@(TSTypeAlternatives {..}) = decl { alternativeTypes = [x | x <- alternativeTypes, not (x `L.elem` removedNames)] } + removeReferencesToRemovedNames removedNames decl@(TSTypeAlternatives {..}) = decl { alternativeTypes = [x | x <- alternativeTypes, not (fst x `L.elem` removedNames)] } removeReferencesToRemovedNames _ x = x declarations = allDeclarations @@ -119,3 +121,7 @@ isNoEmitTypeScriptDeclaration :: TSDeclaration -> Bool isNoEmitTypeScriptDeclaration (TSInterfaceDeclaration {interfaceDoc=(Just doc)}) = noEmitTypeScriptAnnotation `L.isInfixOf` doc isNoEmitTypeScriptDeclaration (TSTypeAlternatives {typeDoc=(Just doc)}) = noEmitTypeScriptAnnotation `L.isInfixOf` doc isNoEmitTypeScriptDeclaration _ = False + +isNoEmitTypeScriptAlternative :: (String, Maybe String) -> Bool +isNoEmitTypeScriptAlternative (_, Just doc) = noEmitTypeScriptAnnotation `L.isInfixOf` doc +isNoEmitTypeScriptAlternative _ = False diff --git a/src/Data/Aeson/TypeScript/Instances.hs b/src/Data/Aeson/TypeScript/Instances.hs index 2f61ce6..4b87dba 100644 --- a/src/Data/Aeson/TypeScript/Instances.hs +++ b/src/Data/Aeson/TypeScript/Instances.hs @@ -114,7 +114,7 @@ instance {-# OVERLAPPING #-} TypeScript [Char] where instance (TypeScript a, TypeScript b) => TypeScript (Either a b) where getTypeScriptType _ = [i|Either<#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}>|] - getTypeScriptDeclarations _ = [TSTypeAlternatives "Either" ["T1", "T2"] ["Left", "Right"] Nothing + getTypeScriptDeclarations _ = [TSTypeAlternatives "Either" ["T1", "T2"] [("Left", Nothing), ("Right", Nothing)] Nothing , TSInterfaceDeclaration "Left" ["T"] [TSField False "Left" "T" Nothing] Nothing , TSInterfaceDeclaration "Right" ["T"] [TSField False "Right" "T" Nothing] Nothing ] diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index 6f926cf..c9099b9 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -248,7 +248,7 @@ handleConstructor (ExtraTypeScriptOptions {..}) options (DatatypeInfo {..}) gene if | (length datatypeCons == 1) && not (getTagSingleConstructors options) -> do writeSingleConstructorEncoding brackets <- lift $ getBracketsExpression False genericVariables - lift [|$(TH.stringE interfaceName) <> $(return brackets)|] + lift [|($(TH.stringE interfaceName) <> $(return brackets), Nothing)|] | allConstructorsAreNullary datatypeCons && allNullaryToStringTag options -> stringEncoding -- With UntaggedValue, nullary constructors are encoded as strings @@ -258,15 +258,15 @@ handleConstructor (ExtraTypeScriptOptions {..}) options (DatatypeInfo {..}) gene | isObjectWithSingleField $ sumEncoding options -> do writeSingleConstructorEncoding brackets <- lift $ getBracketsExpression False genericVariables - lift [|"{" <> $(TH.stringE $ show $ constructorNameToUse options ci) <> ": " <> $(TH.stringE interfaceName) <> $(return brackets) <> "}"|] + lift [|("{" <> $(TH.stringE $ show $ constructorNameToUse options ci) <> ": " <> $(TH.stringE interfaceName) <> $(return brackets) <> "}", Nothing)|] | isTwoElemArray $ sumEncoding options -> do writeSingleConstructorEncoding brackets <- lift $ getBracketsExpression False genericVariables - lift [|"[" <> $(TH.stringE $ show $ constructorNameToUse options ci) <> ", " <> $(TH.stringE interfaceName) <> $(return brackets) <> "]"|] + lift [|("[" <> $(TH.stringE $ show $ constructorNameToUse options ci) <> ", " <> $(TH.stringE interfaceName) <> $(return brackets) <> "]", Nothing)|] | isUntaggedValue $ sumEncoding options -> do writeSingleConstructorEncoding brackets <- lift $ getBracketsExpression False genericVariables - lift [|$(TH.stringE interfaceName) <> $(return brackets)|] + lift [|($(TH.stringE interfaceName) <> $(return brackets), Nothing)|] | otherwise -> do tagField :: [Exp] <- lift $ case sumEncoding options of TaggedObject tagFieldName _ -> (: []) <$> [|TSField False $(TH.stringE tagFieldName) $(TH.stringE [i|"#{constructorNameToUse options ci}"|]) Nothing|] @@ -276,10 +276,14 @@ handleConstructor (ExtraTypeScriptOptions {..}) options (DatatypeInfo {..}) gene decl <- lift $ assembleInterfaceDeclaration (ListE (tagField ++ tsFields)) tell [ExtraDecl decl] brackets <- lift $ getBracketsExpression False genericVariables - lift [|$(TH.stringE interfaceName) <> $(return brackets)|] + lift [|($(TH.stringE interfaceName) <> $(return brackets), Nothing)|] where - stringEncoding = lift $ TH.stringE [i|"#{(constructorTagModifier options) $ getTypeName (constructorName ci)}"|] + stringEncoding = do + let tagName = [i|"#{(constructorTagModifier options) $ getTypeName (constructorName ci)}"|] + lift [| ( $(TH.stringE tagName) + , $(tryGetDoc haddockModifier (constructorName ci)) + ) |] writeSingleConstructorEncoding = if | constructorVariant ci == NormalConstructor -> do @@ -292,7 +296,7 @@ handleConstructor (ExtraTypeScriptOptions {..}) options (DatatypeInfo {..}) gene stringExp <- lift $ [|getTypeScriptTypeOrOptionalNull (Proxy :: Proxy $(return typ))|] alternatives <- lift [|TSTypeAlternatives $(TH.stringE interfaceName) $(genericVariablesListExpr True genericVariables) - [$(return stringExp)] + [($(return stringExp), Nothing)] $(tryGetDoc haddockModifier (constructorName ci))|] tell [ExtraDecl alternatives] #endif @@ -311,7 +315,7 @@ handleConstructor (ExtraTypeScriptOptions {..}) options (DatatypeInfo {..}) gene lift [|TSTypeAlternatives $(TH.stringE interfaceName) $(genericVariablesListExpr True genericVariables) - [$(return stringExp)] + [($(return stringExp), Nothing)] $(tryGetDoc haddockModifier (constructorName ci))|] assembleInterfaceDeclaration members = [|TSInterfaceDeclaration $(TH.stringE interfaceName) diff --git a/src/Data/Aeson/TypeScript/Types.hs b/src/Data/Aeson/TypeScript/Types.hs index 910ec73..54aa5e8 100644 --- a/src/Data/Aeson/TypeScript/Types.hs +++ b/src/Data/Aeson/TypeScript/Types.hs @@ -94,7 +94,7 @@ data TSDeclaration = TSInterfaceDeclaration { interfaceName :: String , interfaceDoc :: Maybe String } | TSTypeAlternatives { typeName :: String , typeGenericVariables :: [String] - , alternativeTypes :: [String] + , alternativeTypes :: [(String, Maybe String)] , typeDoc :: Maybe String } | TSRawDeclaration { text :: String } deriving (Show, Eq, Ord) diff --git a/test/Basic.hs b/test/Basic.hs index a8abb3e..bc1a123 100644 --- a/test/Basic.hs +++ b/test/Basic.hs @@ -22,8 +22,8 @@ tests = describe "Basic tests" $ do describe "tagSingleConstructors and constructorTagModifier" $ do it [i|Works with a normal unit|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Unit1)) `shouldBe` ([ - TSTypeAlternatives "Unit1" [] ["IUnit1"] Nothing - , TSTypeAlternatives "IUnit1" [] ["void[]"] Nothing + TSTypeAlternatives "Unit1" [] [("IUnit1", Nothing)] Nothing + , TSTypeAlternatives "IUnit1" [] [("void[]", Nothing)] Nothing ]) main :: IO () diff --git a/test/ClosedTypeFamilies.hs b/test/ClosedTypeFamilies.hs index 0e75647..0442555 100644 --- a/test/ClosedTypeFamilies.hs +++ b/test/ClosedTypeFamilies.hs @@ -44,14 +44,14 @@ tests = describe "Closed type families" $ do , TSField False "\"single_node_env\"" "\"single\"" Nothing , TSField False "T" "void" Nothing ] Nothing - , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] ["DeployEnvironment2[T]"] Nothing - , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] ["ISimple"] Nothing + , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] [("DeployEnvironment2[T]", Nothing)] Nothing + , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] [("ISimple", Nothing)] Nothing ]) describe "Complicated Beam-like user type" $ do it [i|makes the declaration and types correctly|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([ - TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] Nothing + TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] [("IUser", Nothing)] Nothing , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [ TSField False "_userUsername" "string" Nothing , TSField False "_userCreatedAt" "number" Nothing @@ -71,7 +71,7 @@ tests = describe "Closed type families" $ do , TSField False "_userCreatedAt" "number" Nothing , TSField False "_userDeployEnvironment" "DeployEnvironment[T]" Nothing ] Nothing - , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] Nothing + , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] [("IUser", Nothing)] Nothing ]) main :: IO () diff --git a/test/Formatting.hs b/test/Formatting.hs index a86f948..4b14534 100644 --- a/test/Formatting.hs +++ b/test/Formatting.hs @@ -50,6 +50,13 @@ data NormalConstructors = | Con2 Int $(deriveTypeScript defaultOptions ''NormalConstructors) +data SimpleEnum = + EnumA + | -- | @no-emit-typescript + EnumB + | EnumC +$(deriveTypeScript defaultOptions ''SimpleEnum) + tests :: Spec tests = describe "Formatting" $ do describe "when given a Sum Type" $ do @@ -104,6 +111,9 @@ tests = describe "Formatting" $ do it [i|works on normal constructors|] $ do formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @NormalConstructors Proxy) `shouldBe` [i|type NormalConstructors = ICon2;\n\ninterface ICon2 {\n tag: "Con2";\n contents: number;\n}|] + + it [i|works on nullary constructors in simple enums|] $ do + formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @SimpleEnum Proxy) `shouldBe` [i|type SimpleEnum = "EnumA" | "EnumC";|] #endif main :: IO () diff --git a/test/Generic.hs b/test/Generic.hs index ea6d05b..1dc66a6 100644 --- a/test/Generic.hs +++ b/test/Generic.hs @@ -31,30 +31,30 @@ tests = describe "Generic instances" $ do (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex String))) `shouldBe` [ TSInterfaceDeclaration "IProduct" ["T"] [TSField False "tag" "\"Product\"" Nothing, TSField False "contents" "[number, T]" Nothing] Nothing ,TSInterfaceDeclaration "IUnary" ["T"] [TSField False "tag" "\"Unary\"" Nothing, TSField False "contents" "number" Nothing] Nothing - ,TSTypeAlternatives "Complex" ["T"] ["IProduct","IUnary"] Nothing + ,TSTypeAlternatives "Complex" ["T"] [("IProduct", Nothing), ("IUnary", Nothing)] Nothing ] it [i|Complex2 makes the declaration and types correctly|] $ do (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex2 String))) `shouldBe` [ - TSTypeAlternatives "Complex2" ["T"] ["IProduct2"] Nothing - ,TSTypeAlternatives "IProduct2" ["T"] ["[number, T]"] Nothing + TSTypeAlternatives "Complex2" ["T"] [("IProduct2", Nothing)] Nothing + ,TSTypeAlternatives "IProduct2" ["T"] [("[number, T]", Nothing)] Nothing ] it [i|Complex3 makes the declaration and types correctly|] $ do (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex3 String))) `shouldBe` [ TSInterfaceDeclaration "IProduct3" ["T"] [TSField False "record3" "T[]" Nothing] Nothing - ,TSTypeAlternatives "Complex3" ["T"] ["IProduct3"] Nothing + ,TSTypeAlternatives "Complex3" ["T"] [("IProduct3", Nothing)] Nothing ] (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex3 Int))) `shouldBe` [ TSInterfaceDeclaration "IProduct3" ["T"] [TSField False "record3" "T[]" Nothing] Nothing - ,TSTypeAlternatives "Complex3" ["T"] ["IProduct3"] Nothing + ,TSTypeAlternatives "Complex3" ["T"] [("IProduct3", Nothing)] Nothing ] it [i|Complex4 makes the declaration and types correctly|] $ do (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex4 String))) `shouldBe` [ TSInterfaceDeclaration "IProduct4" ["T"] [TSField False "record4" "{[k in string]: T}" Nothing] Nothing - ,TSTypeAlternatives "Complex4" ["T"] ["IProduct4"] Nothing + ,TSTypeAlternatives "Complex4" ["T"] [("IProduct4", Nothing)] Nothing ] main :: IO () diff --git a/test/GetDoc.hs b/test/GetDoc.hs index 73f25b7..f80e537 100644 --- a/test/GetDoc.hs +++ b/test/GetDoc.hs @@ -23,7 +23,7 @@ tests :: SpecWith () tests = describe "getDoc tests" $ do it [i|Works with a simple record type|] $ do (getTypeScriptDeclarations (Proxy :: Proxy OneField)) `shouldBe` ([ - TSTypeAlternatives "OneField" [] ["IOneField"] (Just "OneField type doc") + TSTypeAlternatives "OneField" [] [("IOneField", Nothing)] (Just "OneField type doc") , TSInterfaceDeclaration "IOneField" [] [ TSField False "simpleString" "string" (Just "This is a simple string") ] (Just "OneField constructor doc") diff --git a/test/HigherKind.hs b/test/HigherKind.hs index 3587785..390616f 100644 --- a/test/HigherKind.hs +++ b/test/HigherKind.hs @@ -36,7 +36,7 @@ tests = describe "Higher kinds" $ do describe "Kind * -> *" $ do it [i|makes the declaration and types correctly|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (HigherKind T))) `shouldBe` ([ - TSTypeAlternatives "HigherKind" ["T"] ["IHigherKind"] Nothing, + TSTypeAlternatives "HigherKind" ["T"] [("IHigherKind", Nothing)] Nothing, TSInterfaceDeclaration "IHigherKind" ["T"] [TSField False "higherKindList" "T[]" Nothing] Nothing ]) @@ -45,21 +45,21 @@ tests = describe "Higher kinds" $ do it [i|works when referenced in another type|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Foo)) `shouldBe` ([ - TSTypeAlternatives "Foo" [] ["IFoo"] Nothing, + TSTypeAlternatives "Foo" [] [("IFoo", Nothing)] Nothing, TSInterfaceDeclaration "IFoo" [] [TSField False "fooString" "string" Nothing , TSField False "fooHigherKindReference" "HigherKind" Nothing] Nothing ]) it [i|works with an interface inside|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (HigherKindWithUnary T))) `shouldBe` ([ - TSTypeAlternatives "HigherKindWithUnary" ["T"] ["IUnary"] Nothing, - TSTypeAlternatives "IUnary" ["T"] ["number"] Nothing + TSTypeAlternatives "HigherKindWithUnary" ["T"] [("IUnary", Nothing)] Nothing, + TSTypeAlternatives "IUnary" ["T"] [("number", Nothing)] Nothing ]) describe "Kind * -> * -> *" $ do it [i|makes the declaration and type correctly|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (DoubleHigherKind T1 T2))) `shouldBe` ([ - TSTypeAlternatives "DoubleHigherKind" ["T1","T2"] ["IDoubleHigherKind"] Nothing, + TSTypeAlternatives "DoubleHigherKind" ["T1","T2"] [("IDoubleHigherKind", Nothing)] Nothing, TSInterfaceDeclaration "IDoubleHigherKind" ["T1","T2"] [TSField False "someList" "T2[]" Nothing , TSField False "higherKindThing" "HigherKind" Nothing] Nothing ]) diff --git a/test/MaybeTuples.hs b/test/MaybeTuples.hs index d857f97..804adfc 100644 --- a/test/MaybeTuples.hs +++ b/test/MaybeTuples.hs @@ -39,38 +39,38 @@ tests = describe "Maybes in tuple encodings" $ do describe "tagSingleConstructors and constructorTagModifier" $ do it [i|Maybe 1 tuple encoding includes null option|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Maybe1)) `shouldBe` ([ - TSTypeAlternatives "Maybe1" [] ["IMaybe1"] Nothing - , TSTypeAlternatives "IMaybe1" [] ["number | null"] Nothing + TSTypeAlternatives "Maybe1" [] [("IMaybe1", Nothing)] Nothing + , TSTypeAlternatives "IMaybe1" [] [("number | null", Nothing)] Nothing ]) it [i|Maybe 2 tuple encoding includes null option|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Maybe2)) `shouldBe` ([ - TSTypeAlternatives "Maybe2" [] ["IMaybe2"] Nothing - , TSTypeAlternatives "IMaybe2" [] ["[string, number | null]"] Nothing + TSTypeAlternatives "Maybe2" [] [("IMaybe2", Nothing)] Nothing + , TSTypeAlternatives "IMaybe2" [] [("[string, number | null]", Nothing)] Nothing ]) it [i|Maybe 3 tuple encoding includes null option|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Maybe3)) `shouldBe` ([ - TSTypeAlternatives "Maybe3" [] ["IMaybe3"] Nothing - , TSTypeAlternatives "IMaybe3" [] ["[string, [string, string], number | null]"] Nothing + TSTypeAlternatives "Maybe3" [] [("IMaybe3", Nothing)] Nothing + , TSTypeAlternatives "IMaybe3" [] [("[string, [string, string], number | null]", Nothing)] Nothing ]) it [i|Maybe 4 tuple encoding includes null option|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Maybe4)) `shouldBe` ([ - TSTypeAlternatives "Maybe4" [] ["IMaybe4"] Nothing - , TSTypeAlternatives "IMaybe4" [] ["[number, number, number, number | null]"] Nothing + TSTypeAlternatives "Maybe4" [] [("IMaybe4", Nothing)] Nothing + , TSTypeAlternatives "IMaybe4" [] [("[number, number, number, number | null]", Nothing)] Nothing ]) it [i|Maybe 5 tuple encoding includes null option|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Maybe5)) `shouldBe` ([ - TSTypeAlternatives "Maybe5" [] ["IMaybe5"] Nothing - , TSTypeAlternatives "IMaybe5" [] ["[number, number, number, number, number | null]"] Nothing + TSTypeAlternatives "Maybe5" [] [("IMaybe5", Nothing)] Nothing + , TSTypeAlternatives "IMaybe5" [] [("[number, number, number, number, number | null]", Nothing)] Nothing ]) it [i|Maybe 6 tuple encoding includes null option|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Maybe6)) `shouldBe` ([ - TSTypeAlternatives "Maybe6" [] ["IMaybe6"] Nothing - , TSTypeAlternatives "IMaybe6" [] ["[number, number, number, number, number, number | null]"] Nothing + TSTypeAlternatives "Maybe6" [] [("IMaybe6", Nothing)] Nothing + , TSTypeAlternatives "IMaybe6" [] [("[number, number, number, number, number, number | null]", Nothing)] Nothing ]) diff --git a/test/NoOmitNothingFields.hs b/test/NoOmitNothingFields.hs index 4dd6dd8..fcc1607 100644 --- a/test/NoOmitNothingFields.hs +++ b/test/NoOmitNothingFields.hs @@ -15,7 +15,7 @@ allTests = describe "NoOmitNothingFields" $ do it "encodes as expected" $ do let decls = getTypeScriptDeclarations (Proxy :: Proxy OptionalRecord) - decls `shouldBe` [TSTypeAlternatives "OptionalRecord" [] ["IOptionalRecord"] Nothing + decls `shouldBe` [TSTypeAlternatives "OptionalRecord" [] [("IOptionalRecord", Nothing)] Nothing , TSInterfaceDeclaration "IOptionalRecord" [] [TSField False "optionalInt" "number | null" Nothing] Nothing] tests diff --git a/test/OpenTypeFamilies.hs b/test/OpenTypeFamilies.hs index 52a148e..8c8874d 100644 --- a/test/OpenTypeFamilies.hs +++ b/test/OpenTypeFamilies.hs @@ -44,14 +44,14 @@ tests = describe "Open type families" $ do , TSField False "\"k8s_env\"" "\"k8s\"" Nothing , TSField False "T" "void" Nothing ] Nothing - , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] ["DeployEnvironment2[T]"] Nothing - , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] ["ISimple"] Nothing + , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] [("DeployEnvironment2[T]", Nothing)] Nothing + , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] [("ISimple", Nothing)] Nothing ]) describe "Complicated Beam-like user type" $ do it [i|makes the declaration and types correctly|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([ - TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] Nothing + TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] [("IUser", Nothing)] Nothing , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [ TSField False "_userUsername" "string" Nothing , TSField False "_userCreatedAt" "number" Nothing @@ -71,7 +71,7 @@ tests = describe "Open type families" $ do , TSField False "_userCreatedAt" "number" Nothing , TSField False "_userDeployEnvironment" "DeployEnvironment[T]" Nothing ] Nothing - , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] Nothing + , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] [("IUser", Nothing)] Nothing ]) main :: IO () diff --git a/test/UnwrapUnaryRecords.hs b/test/UnwrapUnaryRecords.hs index 1a75fb2..cde87c2 100644 --- a/test/UnwrapUnaryRecords.hs +++ b/test/UnwrapUnaryRecords.hs @@ -19,8 +19,8 @@ allTests = describe "UnwrapUnaryRecords" $ do let decls = getTypeScriptDeclarations (Proxy :: Proxy OneField) decls `shouldBe` [ - TSTypeAlternatives "OneField" [] ["IOneField"] Nothing - ,TSTypeAlternatives "IOneField" [] ["string"] Nothing + TSTypeAlternatives "OneField" [] [("IOneField", Nothing)] Nothing + ,TSTypeAlternatives "IOneField" [] [("string", Nothing)] Nothing ] tests