Fix @no-emit-typescript for simple enums

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
 

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

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<T1>", "Right<T2>"] Nothing
+  getTypeScriptDeclarations _ = [TSTypeAlternatives "Either" ["T1", "T2"] [("Left<T1>", Nothing), ("Right<T2>", Nothing)] Nothing
                                , TSInterfaceDeclaration "Left" ["T"] [TSField False "Left" "T" Nothing] Nothing
                                , TSInterfaceDeclaration "Right" ["T"] [TSField False "Right" "T" Nothing] Nothing
                                ]

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)

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)

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 ()

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<T>"] Nothing
+        , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] [("DeployEnvironment2[T]", Nothing)] Nothing
+        , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] [("ISimple<T>", 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<T>"] Nothing
+        TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] [("IUser<T>", 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<T>"] Nothing
+        , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] [("IUser<T>", Nothing)] Nothing
         ])
 
 main :: IO ()

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 ()

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<T>","IUnary<T>"] Nothing
+      ,TSTypeAlternatives "Complex" ["T"] [("IProduct<T>", Nothing), ("IUnary<T>", Nothing)] Nothing
       ]
 
   it [i|Complex2 makes the declaration and types correctly|] $ do
     (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex2 String))) `shouldBe` [
-      TSTypeAlternatives "Complex2" ["T"] ["IProduct2<T>"] Nothing
-      ,TSTypeAlternatives "IProduct2" ["T"] ["[number, T]"] Nothing
+      TSTypeAlternatives "Complex2" ["T"] [("IProduct2<T>", 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<T>"] Nothing
+      ,TSTypeAlternatives "Complex3" ["T"] [("IProduct3<T>", Nothing)] Nothing
       ]
 
     (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex3 Int))) `shouldBe` [
       TSInterfaceDeclaration "IProduct3" ["T"] [TSField False "record3" "T[]" Nothing] Nothing
-      ,TSTypeAlternatives "Complex3" ["T"] ["IProduct3<T>"] Nothing
+      ,TSTypeAlternatives "Complex3" ["T"] [("IProduct3<T>", 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<T>"] Nothing
+      ,TSTypeAlternatives "Complex4" ["T"] [("IProduct4<T>", Nothing)] Nothing
       ]
 
 main :: IO ()

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")

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<T>"] Nothing,
+        TSTypeAlternatives "HigherKind" ["T"] [("IHigherKind<T>", 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<string>" Nothing] Nothing
         ])
 
     it [i|works with an interface inside|] $ do
       (getTypeScriptDeclarations (Proxy :: Proxy (HigherKindWithUnary T))) `shouldBe` ([
-        TSTypeAlternatives "HigherKindWithUnary" ["T"] ["IUnary<T>"] Nothing,
-        TSTypeAlternatives "IUnary" ["T"] ["number"] Nothing
+        TSTypeAlternatives "HigherKindWithUnary" ["T"] [("IUnary<T>", 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<T1, T2>"] Nothing,
+        TSTypeAlternatives "DoubleHigherKind" ["T1","T2"] [("IDoubleHigherKind<T1, T2>", Nothing)] Nothing,
         TSInterfaceDeclaration "IDoubleHigherKind" ["T1","T2"] [TSField False "someList" "T2[]" Nothing
                                                                , TSField False "higherKindThing" "HigherKind<T1>" Nothing] Nothing
         ])