From 7b01c7eb03541ba8485035fe50aabca10afd5b73 Mon Sep 17 00:00:00 2001
From: Christopher Fraser <chris@capital-match.com>
Date: Wed, 24 Jul 2019 18:01:27 +0800
Subject: [PATCH] Implement support for unwrapUnaryRecords option

---
 src/Data/Aeson/TypeScript/TH.hs                 |  7 +++++--
 test/ObjectWithSingleFieldUnwrapUnaryRecords.hs | 13 +++++++++++++
 test/Spec.hs                                    |  2 ++
 3 files changed, 20 insertions(+), 2 deletions(-)
 create mode 100644 test/ObjectWithSingleFieldUnwrapUnaryRecords.hs

diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs
index d9298aa..04f8a6d 100644
--- a/src/Data/Aeson/TypeScript/TH.hs
+++ b/src/Data/Aeson/TypeScript/TH.hs
@@ -244,8 +244,8 @@ getDeclarationFunctionBody options _name datatypeInfo@(DatatypeInfo {..}) = do
 -- | Return a string to go in the top-level type declaration, plus an optional expression containing a declaration
 handleConstructor :: Options -> DatatypeInfo -> [String] -> ConstructorInfo -> (Exp, Maybe Exp)
 handleConstructor options (DatatypeInfo {..}) genericVariables ci@(ConstructorInfo {}) =
-  if | isSingleConstructorType && not (getTagSingleConstructors options) -> (stringE interfaceName, singleConstructorEncoding)
-
+  if | isSingleConstructorType && isUnaryRecord ci && unwrapUnaryRecords options -> (getTypeAsStringExp . head . constructorFields $ ci, Nothing)
+     | isSingleConstructorType && not (getTagSingleConstructors options) -> (stringE interfaceName, singleConstructorEncoding)
      | allConstructorsAreNullary datatypeCons && allNullaryToStringTag options -> stringEncoding
      -- With UntaggedValue, nullary constructors are encoded as strings
      | (isUntaggedValue $ sumEncoding options) && isConstructorNullary ci -> stringEncoding
@@ -278,6 +278,9 @@ handleConstructor options (DatatypeInfo {..}) genericVariables ci@(ConstructorIn
                                                           | otherwise -> [(contentsFieldName, contentsTupleType)]
         _ -> [(constructorNameToUse, contentsTupleType)]
 
+    isUnaryRecord (constructorVariant -> RecordConstructor names) = length names == 1
+    isUnaryRecord _ = False
+
     tagField = case sumEncoding options of
       TaggedObject tagFieldName _ -> [(AppE (AppE (AppE (ConE 'TSField) (ConE 'False))
                                               (stringE tagFieldName))
diff --git a/test/ObjectWithSingleFieldUnwrapUnaryRecords.hs b/test/ObjectWithSingleFieldUnwrapUnaryRecords.hs
new file mode 100644
index 0000000..021e62e
--- /dev/null
+++ b/test/ObjectWithSingleFieldUnwrapUnaryRecords.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-}
+
+module ObjectWithSingleFieldUnwrapUnaryRecords (tests) where
+
+import Data.Aeson as A
+import Data.Aeson.TH as A
+import Test.Hspec
+import TestBoilerplate
+import Util
+
+$(testDeclarations "ObjectWithSingleField with unwrapUnaryRecords=True" A.defaultOptions {unwrapUnaryRecords = True})
+
+main = hspec tests
diff --git a/test/Spec.hs b/test/Spec.hs
index 33dd58b..688d756 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -6,6 +6,7 @@ import Test.Hspec
 import qualified HigherKind
 import qualified ObjectWithSingleFieldNoTagSingleConstructors
 import qualified ObjectWithSingleFieldTagSingleConstructors
+import qualified ObjectWithSingleFieldUnwrapUnaryRecords
 import qualified TaggedObjectNoTagSingleConstructors
 import qualified TaggedObjectTagSingleConstructors
 import qualified TwoElemArrayNoTagSingleConstructors
@@ -16,6 +17,7 @@ import qualified UntaggedTagSingleConstructors
 main = hspec $ do
   ObjectWithSingleFieldTagSingleConstructors.tests
   ObjectWithSingleFieldNoTagSingleConstructors.tests
+  ObjectWithSingleFieldUnwrapUnaryRecords.tests
   TaggedObjectTagSingleConstructors.tests
   TaggedObjectNoTagSingleConstructors.tests
   TwoElemArrayTagSingleConstructors.tests