Skip to content

Implement support for unwrapUnaryRecords option #12

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 1 commit into from
Closed

Implement support for unwrapUnaryRecords option #12

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions src/Data/Aeson/TypeScript/TH.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand Down
13 changes: 13 additions & 0 deletions test/ObjectWithSingleFieldUnwrapUnaryRecords.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
2 changes: 2 additions & 0 deletions test/Spec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -16,6 +17,7 @@ import qualified UntaggedTagSingleConstructors
main = hspec $ do
ObjectWithSingleFieldTagSingleConstructors.tests
ObjectWithSingleFieldNoTagSingleConstructors.tests
ObjectWithSingleFieldUnwrapUnaryRecords.tests
TaggedObjectTagSingleConstructors.tests
TaggedObjectNoTagSingleConstructors.tests
TwoElemArrayTagSingleConstructors.tests
Expand Down