Skip to content

Commit 846f4de

Browse files
thomasjmthomasjm
authored
Fix more issues with Maybes inside tuple encodings (#52)
* Add MaybeTuples tests * Add getTypeScriptTypeOrOptionalNull helper to use in tuple instances * Use TH to derive tuple instances up to size 10 * Use getTypeScriptTypeOrOptionalNull to tidy TH.hs * Fix a few warnings * Tighten up a couple haddocks * Add size-1 and size-2 tuples to TestBoilerplate.hs
1 parent b02479d commit 846f4de

File tree

13 files changed

+159
-57
lines changed

13 files changed

+159
-57
lines changed

‎aeson-typescript.cabal‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 1.12
22

3-
-- This file has been generated from package.yaml by hpack version 0.37.0.
3+
-- This file has been generated from package.yaml by hpack version 0.38.0.
44
--
55
-- see: https://github.com/sol/hpack
66

@@ -46,6 +46,7 @@ library
4646
other-modules:
4747
Data.Aeson.TypeScript.Formatting
4848
Data.Aeson.TypeScript.Instances
49+
Data.Aeson.TypeScript.Instances.TupleGen
4950
Data.Aeson.TypeScript.Lookup
5051
Data.Aeson.TypeScript.Transform
5152
Data.Aeson.TypeScript.TypeManipulation
@@ -89,6 +90,7 @@ test-suite aeson-typescript-tests
8990
GetDoc
9091
HigherKind
9192
LegalNameSpec
93+
MaybeTuples
9294
NoOmitNothingFields
9395
ObjectWithSingleFieldNoTagSingleConstructors
9496
ObjectWithSingleFieldTagSingleConstructors
@@ -106,6 +108,7 @@ test-suite aeson-typescript-tests
106108
Util.Aeson
107109
Data.Aeson.TypeScript.Formatting
108110
Data.Aeson.TypeScript.Instances
111+
Data.Aeson.TypeScript.Instances.TupleGen
109112
Data.Aeson.TypeScript.Internal
110113
Data.Aeson.TypeScript.LegalName
111114
Data.Aeson.TypeScript.Lookup

‎src/Data/Aeson/TypeScript/Instances.hs‎

Lines changed: 3 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@
1313
module Data.Aeson.TypeScript.Instances where
1414

1515
import qualified Data.Aeson as A
16+
import Data.Aeson.TypeScript.Instances.TupleGen
1617
import Data.Aeson.TypeScript.Types
1718
import Data.Data
1819
import Data.Functor.Compose (Compose)
@@ -121,26 +122,8 @@ instance (TypeScript a, TypeScript b) => TypeScript (Either a b) where
121122
, (TSType (Proxy :: Proxy b))
122123
]
123124

124-
instance (TypeScript a, TypeScript b) => TypeScript (a, b) where
125-
getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}]|]
126-
getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a))
127-
, (TSType (Proxy :: Proxy b))
128-
]
129-
130-
instance (TypeScript a, TypeScript b, TypeScript c) => TypeScript (a, b, c) where
131-
getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}, #{getTypeScriptType (Proxy :: Proxy c)}]|]
132-
getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a))
133-
, (TSType (Proxy :: Proxy b))
134-
, (TSType (Proxy :: Proxy c))
135-
]
136-
137-
instance (TypeScript a, TypeScript b, TypeScript c, TypeScript d) => TypeScript (a, b, c, d) where
138-
getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}, #{getTypeScriptType (Proxy :: Proxy c)}, #{getTypeScriptType (Proxy :: Proxy d)}]|]
139-
getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a))
140-
, (TSType (Proxy :: Proxy b))
141-
, (TSType (Proxy :: Proxy c))
142-
, (TSType (Proxy :: Proxy d))
143-
]
125+
-- Derive instance TypeScript (a, b), instance TypeScript (a, b, c), etc. up to size 10
126+
mkTupleInstances 10
144127

145128
instance forall a k (b :: k). (Typeable k, Typeable b, TypeScript a) => TypeScript (Const a b) where
146129
getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy a)

‎src/Data/Aeson/TypeScript/Instances/TupleGen.hs‎

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
{-# LANGUAGE QuasiQuotes #-}
3+
4+
module Data.Aeson.TypeScript.Instances.TupleGen where
5+
6+
import Data.Aeson.TypeScript.Types
7+
import Data.Data
8+
import Data.List (intercalate)
9+
import qualified Data.List as L
10+
import Language.Haskell.TH
11+
12+
13+
mkTupleInstance :: Int -> Q Dec
14+
mkTupleInstance n = do
15+
let typeVars = take n $ map (mkName . (:[])) ['a'..]
16+
constraints = map (\tv -> AppT (ConT ''TypeScript) (VarT tv)) typeVars
17+
tupleType = foldl AppT (TupleT n) (map VarT typeVars)
18+
instanceHead = AppT (ConT ''TypeScript) tupleType
19+
20+
getTypeBody <- buildTypeBody typeVars
21+
let getTypeMethod = FunD 'getTypeScriptType [Clause [WildP] (NormalB getTypeBody) []]
22+
23+
let tsTypes = map (\tv -> AppE (ConE 'TSType) (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) (VarT tv)))) typeVars
24+
getParentsMethod = FunD 'getParentTypes [Clause [WildP] (NormalB (AppE (VarE 'L.nub) (ListE tsTypes))) []]
25+
26+
return $ InstanceD Nothing constraints instanceHead [getTypeMethod, getParentsMethod]
27+
28+
buildTypeBody :: [Name] -> Q Exp
29+
buildTypeBody typeVars = do
30+
let calls = map (\tv -> AppE (VarE 'getTypeScriptTypeOrOptionalNull)
31+
(SigE (ConE 'Proxy) (AppT (ConT ''Proxy) (VarT tv)))) typeVars
32+
parts = [LitE (StringL "[")] ++ intercalate [LitE (StringL ", ")] (map (:[]) calls) ++ [LitE (StringL "]")]
33+
return $ foldr1 (\a b -> InfixE (Just a) (VarE '(++)) (Just b)) parts
34+
35+
mkTupleInstances :: Int -> Q [Dec]
36+
mkTupleInstances maxArity = mapM mkTupleInstance [2..maxArity]

‎src/Data/Aeson/TypeScript/Recursive.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,6 @@ import qualified Data.Set as S
3232
import Data.String.Interpolate
3333
import Language.Haskell.TH as TH
3434
import Language.Haskell.TH.Datatype
35-
import Language.Haskell.TH.Syntax hiding (lift)
3635

3736

3837
getTransitiveClosure :: S.Set TSType -> S.Set TSType

‎src/Data/Aeson/TypeScript/TH.hs‎

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -289,9 +289,7 @@ handleConstructor (ExtraTypeScriptOptions {..}) options (DatatypeInfo {..}) gene
289289
#if MIN_VERSION_aeson(0,10,0)
290290
| unwrapUnaryRecords options && (isSingleRecordConstructor ci) -> do
291291
let [typ] = constructorFields ci
292-
stringExp <- lift $ case typ of
293-
(AppT (ConT name) t) | name == ''Maybe && not (omitNothingFields options) -> [|$(getTypeAsStringExp t) <> " | null"|]
294-
_ -> getTypeAsStringExp typ
292+
stringExp <- lift $ [|getTypeScriptTypeOrOptionalNull (Proxy :: Proxy $(return typ))|]
295293
alternatives <- lift [|TSTypeAlternatives $(TH.stringE interfaceName)
296294
$(genericVariablesListExpr True genericVariables)
297295
[$(return stringExp)]
@@ -309,9 +307,7 @@ handleConstructor (ExtraTypeScriptOptions {..}) options (DatatypeInfo {..}) gene
309307

310308
tupleEncoding = do
311309
let typ = contentsTupleTypeSubstituted genericVariables ci
312-
stringExp <- lift $ case typ of
313-
(AppT (ConT name) t) | name == ''Maybe -> [|$(getTypeAsStringExp t) <> " | null"|]
314-
_ -> getTypeAsStringExp typ
310+
stringExp <- lift $ [|getTypeScriptTypeOrOptionalNull (Proxy :: Proxy $(return typ))|]
315311

316312
lift [|TSTypeAlternatives $(TH.stringE interfaceName)
317313
$(genericVariablesListExpr True genericVariables)
@@ -326,7 +322,7 @@ handleConstructor (ExtraTypeScriptOptions {..}) options (DatatypeInfo {..}) gene
326322
getTSFields :: WriterT [ExtraDeclOrGenericInfo] Q [Exp]
327323
getTSFields = forM (namesAndTypes options genericVariables ci) $ \(name, nameString, typ) -> do
328324
(fieldTyp, optAsBool) <- lift $ case typ of
329-
(AppT (ConT name) t) | name == ''Maybe && not (omitNothingFields options) ->
325+
(AppT (ConT name') t) | name' == ''Maybe && not (omitNothingFields options) ->
330326
( , ) <$> [|$(getTypeAsStringExp t) <> " | null"|] <*> getOptionalAsBoolExp t
331327
_ -> ( , ) <$> getTypeAsStringExp typ <*> getOptionalAsBoolExp typ
332328

‎src/Data/Aeson/TypeScript/Types.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -70,6 +70,12 @@ class (Typeable a) => TypeScript a where
7070
-- ^ Special flag to indicate whether this type corresponds to a template variable.
7171
isGenericVariable _ = False
7272

73+
74+
getTypeScriptTypeOrOptionalNull :: TypeScript a => Proxy a -> String
75+
getTypeScriptTypeOrOptionalNull proxy = getTypeScriptType proxy <> extra
76+
where
77+
extra = if getTypeScriptOptional proxy then " | null" else ""
78+
7379
-- | An existential wrapper for any TypeScript instance.
7480
data TSType = forall a. (Typeable a, TypeScript a) => TSType { unTSType :: Proxy a }
7581

‎src/Data/Aeson/TypeScript/Util.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ import Data.Aeson.TypeScript.Instances ()
1212
import Data.Aeson.TypeScript.Types
1313
import qualified Data.List as L
1414
import Data.Proxy
15+
import Data.String (IsString)
1516
import Data.String.Interpolate
1617
import qualified Data.Text as T
1718
import Language.Haskell.TH hiding (stringE)
@@ -82,12 +83,12 @@ getTypeAsStringExp typ = [|getTypeScriptType (Proxy :: Proxy $(return typ))|]
8283
getOptionalAsBoolExp :: Type -> Q Exp
8384
getOptionalAsBoolExp typ = [|getTypeScriptOptional (Proxy :: Proxy $(return typ))|]
8485

85-
-- | Helper to apply a type constructor to a list of type args
86+
-- | Apply a type constructor to a list of type args
8687
applyToArgsT :: Type -> [Type] -> Type
8788
applyToArgsT constructor [] = constructor
8889
applyToArgsT constructor (x:xs) = applyToArgsT (AppT constructor x) xs
8990

90-
-- | Helper to apply a function a list of args
91+
-- | Apply a function to a list of args
9192
applyToArgsE :: Exp -> [Exp] -> Exp
9293
applyToArgsE f [] = f
9394
applyToArgsE f (x:xs) = applyToArgsE (AppE f x) xs
@@ -183,6 +184,7 @@ mapType g (ImplicitParamT x typ) = ImplicitParamT x (mapType g typ)
183184
#endif
184185
mapType _ x = x
185186

187+
tryPromote :: (Eq a1, Eq a2, IsString a2) => Type -> [(a1, (a3, a2))] -> a1 -> Type
186188
tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "")) = ConT ''T
187189
tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T")) = ConT ''T
188190
tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T1")) = ConT ''T1

‎test/Basic.hs‎

Lines changed: 0 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -17,9 +17,6 @@ data Unit2 = Unit2
1717
$(deriveTypeScript (A.defaultOptions { A.tagSingleConstructors = True
1818
, A.constructorTagModifier = const "foo" }) ''Unit2)
1919

20-
data Test1 = Test1 (Maybe Int)
21-
deriveTypeScript A.defaultOptions ''Test1
22-
2320
tests :: SpecWith ()
2421
tests = describe "Basic tests" $ do
2522
describe "tagSingleConstructors and constructorTagModifier" $ do
@@ -29,17 +26,5 @@ tests = describe "Basic tests" $ do
2926
, TSTypeAlternatives "IUnit1" [] ["void[]"] Nothing
3027
])
3128

32-
it [i|Works with a unit with constructorTagModifier|] $ do
33-
(getTypeScriptDeclarations (Proxy :: Proxy Unit2)) `shouldBe` ([
34-
TSTypeAlternatives "Unit2" [] ["\"foo\""] Nothing
35-
])
36-
37-
it [i|Maybe tuple encoding includes null option|] $ do
38-
(getTypeScriptDeclarations (Proxy :: Proxy Test1)) `shouldBe` ([
39-
TSTypeAlternatives "Test1" [] ["ITest1"] Nothing
40-
, TSTypeAlternatives "ITest1" [] ["number | null"] Nothing
41-
])
42-
43-
4429
main :: IO ()
4530
main = hspec tests

‎test/MaybeTuples.hs‎

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
2+
module MaybeTuples (tests) where
3+
4+
import Data.Aeson as A
5+
import Data.Aeson.TypeScript.TH
6+
import Data.Aeson.TypeScript.Types
7+
import Data.Proxy
8+
import Data.String.Interpolate
9+
import Prelude hiding (Double)
10+
import Test.Hspec
11+
12+
13+
data Maybe1 = Maybe1 (Maybe Int)
14+
deriveTypeScript A.defaultOptions ''Maybe1
15+
16+
data Maybe2 = Maybe2 String (Maybe Int)
17+
deriveTypeScript A.defaultOptions ''Maybe2
18+
19+
data Maybe3 = Maybe3 String (String, String) (Maybe Int)
20+
deriveTypeScript A.defaultOptions ''Maybe3
21+
22+
data Maybe4 = Maybe4 Int Int Int (Maybe Int)
23+
deriveTypeScript A.defaultOptions ''Maybe4
24+
25+
data Maybe5 = Maybe5 Int Int Int Int (Maybe Int)
26+
deriveTypeScript A.defaultOptions ''Maybe5
27+
28+
data Maybe6 = Maybe6 Int Int Int Int Int (Maybe Int)
29+
deriveTypeScript A.defaultOptions ''Maybe6
30+
31+
data MaybeRecord = MaybeRecord {
32+
foo :: String
33+
, bar :: Maybe Int
34+
}
35+
deriveTypeScript A.defaultOptions ''MaybeRecord
36+
37+
tests :: SpecWith ()
38+
tests = describe "Maybes in tuple encodings" $ do
39+
describe "tagSingleConstructors and constructorTagModifier" $ do
40+
it [i|Maybe 1 tuple encoding includes null option|] $ do
41+
(getTypeScriptDeclarations (Proxy :: Proxy Maybe1)) `shouldBe` ([
42+
TSTypeAlternatives "Maybe1" [] ["IMaybe1"] Nothing
43+
, TSTypeAlternatives "IMaybe1" [] ["number | null"] Nothing
44+
])
45+
46+
it [i|Maybe 2 tuple encoding includes null option|] $ do
47+
(getTypeScriptDeclarations (Proxy :: Proxy Maybe2)) `shouldBe` ([
48+
TSTypeAlternatives "Maybe2" [] ["IMaybe2"] Nothing
49+
, TSTypeAlternatives "IMaybe2" [] ["[string, number | null]"] Nothing
50+
])
51+
52+
it [i|Maybe 3 tuple encoding includes null option|] $ do
53+
(getTypeScriptDeclarations (Proxy :: Proxy Maybe3)) `shouldBe` ([
54+
TSTypeAlternatives "Maybe3" [] ["IMaybe3"] Nothing
55+
, TSTypeAlternatives "IMaybe3" [] ["[string, [string, string], number | null]"] Nothing
56+
])
57+
58+
it [i|Maybe 4 tuple encoding includes null option|] $ do
59+
(getTypeScriptDeclarations (Proxy :: Proxy Maybe4)) `shouldBe` ([
60+
TSTypeAlternatives "Maybe4" [] ["IMaybe4"] Nothing
61+
, TSTypeAlternatives "IMaybe4" [] ["[number, number, number, number | null]"] Nothing
62+
])
63+
64+
it [i|Maybe 5 tuple encoding includes null option|] $ do
65+
(getTypeScriptDeclarations (Proxy :: Proxy Maybe5)) `shouldBe` ([
66+
TSTypeAlternatives "Maybe5" [] ["IMaybe5"] Nothing
67+
, TSTypeAlternatives "IMaybe5" [] ["[number, number, number, number, number | null]"] Nothing
68+
])
69+
70+
it [i|Maybe 6 tuple encoding includes null option|] $ do
71+
(getTypeScriptDeclarations (Proxy :: Proxy Maybe6)) `shouldBe` ([
72+
TSTypeAlternatives "Maybe6" [] ["IMaybe6"] Nothing
73+
, TSTypeAlternatives "IMaybe6" [] ["[number, number, number, number, number, number | null]"] Nothing
74+
])
75+
76+
77+
main :: IO ()
78+
main = hspec tests

‎test/NoOmitNothingFields.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -13,9 +13,9 @@ $(testDeclarations "NoOmitNothingFields" (A.defaultOptions {omitNothingFields =
1313
allTests :: SpecWith ()
1414
allTests = describe "NoOmitNothingFields" $ do
1515
it "encodes as expected" $ do
16-
let decls = getTypeScriptDeclarations (Proxy :: Proxy Optional)
16+
let decls = getTypeScriptDeclarations (Proxy :: Proxy OptionalRecord)
1717

18-
decls `shouldBe` [TSTypeAlternatives "Optional" [] ["IOptional"] Nothing
19-
, TSInterfaceDeclaration "IOptional" [] [TSField False "optionalInt" "number | null" Nothing] Nothing]
18+
decls `shouldBe` [TSTypeAlternatives "OptionalRecord" [] ["IOptionalRecord"] Nothing
19+
, TSInterfaceDeclaration "IOptionalRecord" [] [TSField False "optionalInt" "number | null" Nothing] Nothing]
2020

2121
tests

0 commit comments

Comments
 (0)