Fix @no-emit-typescript for simple enums (redux)

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,7 +22,7 @@ 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 ((fmap alternativeTypeName . filter (not . isNoEmitTypeScriptAlternative)) -> names) maybeDoc) =
   makeDocPrefix maybeDoc <> mainDeclaration
   where
     mainDeclaration = case chooseTypeAlternativesFormat typeAlternativesFormat of
@@ -87,7 +87,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 (alternativeTypeName x `L.elem` removedNames)] }
     removeReferencesToRemovedNames _ x = x
 
     declarations = allDeclarations
@@ -119,3 +119,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 :: TSAlternativeType -> Bool
+isNoEmitTypeScriptAlternative (TSAlternativeType _ (Just doc)) = noEmitTypeScriptAnnotation `L.isInfixOf` doc
+isNoEmitTypeScriptAlternative _ = False

src/Data/Aeson/TypeScript/TH.hs

@@ -145,7 +145,7 @@
   , T9(..)
   , T10(..)
 
   , module Data.Aeson.TypeScript.Instances
   ) where
 
 import Control.Monad
@@ -248,7 +248,7 @@
   if | (length datatypeCons == 1) && not (getTagSingleConstructors options) -> do
          writeSingleConstructorEncoding
          brackets <- lift $ getBracketsExpression False genericVariables
-         lift [|$(TH.stringE interfaceName) <> $(return brackets)|]
+         lift [|TSAlternativeType ($(TH.stringE interfaceName) <> $(return brackets)) Nothing|]
      | allConstructorsAreNullary datatypeCons && allNullaryToStringTag options -> stringEncoding
 
      -- With UntaggedValue, nullary constructors are encoded as strings
@@ -258,15 +258,15 @@
      | isObjectWithSingleField $ sumEncoding options -> do
          writeSingleConstructorEncoding
          brackets <- lift $ getBracketsExpression False genericVariables
-         lift [|"{" <> $(TH.stringE $ show $ constructorNameToUse options ci) <> ": " <> $(TH.stringE interfaceName) <> $(return brackets) <> "}"|]
+         lift [|TSAlternativeType ("{" <> $(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 [|TSAlternativeType ("[" <> $(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 [|TSAlternativeType ($(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,13 @@
          decl <- lift $ assembleInterfaceDeclaration (ListE (tagField ++ tsFields))
          tell [ExtraDecl decl]
          brackets <- lift $ getBracketsExpression False genericVariables
-         lift [|$(TH.stringE interfaceName) <> $(return brackets)|]
+         lift [|TSAlternativeType ($(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 [| TSAlternativeType $(TH.stringE tagName)
+                                $(tryGetDoc haddockModifier (constructorName ci)) |]
 
     writeSingleConstructorEncoding = if
       | constructorVariant ci == NormalConstructor -> do
@@ -288,11 +291,11 @@
 
 #if MIN_VERSION_aeson(0,10,0)
       | unwrapUnaryRecords options && (isSingleRecordConstructor ci) -> do
           let [typ] = constructorFields ci
           stringExp <- lift $ [|getTypeScriptTypeOrOptionalNull (Proxy :: Proxy $(return typ))|]
           alternatives <- lift [|TSTypeAlternatives $(TH.stringE interfaceName)
                                                     $(genericVariablesListExpr True genericVariables)
-                                                    [$(return stringExp)]
+                                                    [TSAlternativeType $(return stringExp) Nothing]
                                                     $(tryGetDoc haddockModifier (constructorName ci))|]
           tell [ExtraDecl alternatives]
 #endif
@@ -311,7 +314,7 @@
 
       lift [|TSTypeAlternatives $(TH.stringE interfaceName)
                                 $(genericVariablesListExpr True genericVariables)
-                                [$(return stringExp)]
+                                [TSAlternativeType $(return stringExp) Nothing]
                                 $(tryGetDoc haddockModifier (constructorName ci))|]
 
     assembleInterfaceDeclaration members = [|TSInterfaceDeclaration $(TH.stringE interfaceName)

src/Data/Aeson/TypeScript/Types.hs

@@ -94,11 +94,23 @@ data TSDeclaration = TSInterfaceDeclaration { interfaceName :: String
                                             , interfaceDoc :: Maybe String }
                    | TSTypeAlternatives { typeName :: String
                                         , typeGenericVariables :: [String]
-                                        , alternativeTypes :: [String]
+                                        , alternativeTypes :: [TSAlternativeType]
                                         , typeDoc :: Maybe String }
                    | TSRawDeclaration { text :: String }
   deriving (Show, Eq, Ord)
 
+data TSAlternativeType = TSAlternativeType {
+  -- | The type name/expression for this alternative
+  alternativeTypeName :: String
+  -- | Haddock documentation for this alternative
+  , alternativeTypeDoc :: Maybe String
+  } deriving (Show, Eq, Ord)
+
+-- | Allows constructing 'TSAlternativeType' from string literals.
+-- This keeps test code clean by allowing plain strings instead of full constructors.
+instance IsString TSAlternativeType where
+  fromString s = TSAlternativeType s Nothing
+
 data TSField = TSField
   { fieldOptional :: Bool
   , fieldName :: String

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,7 +31,7 @@ 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>", "IUnary<T>"] Nothing
       ]
 
   it [i|Complex2 makes the declaration and types correctly|] $ do