From 7b01c7eb03541ba8485035fe50aabca10afd5b73 Mon Sep 17 00:00:00 2001 From: Christopher Fraser 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