aeson-typescript 0.3.0.1 → 0.4.0.0

raw patch · 29 files changed

+1143/−433 lines, 29 filesdep +transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• LICENSE +1/−1
• aeson-typescript.cabal +20/−7
• dev/Live.hs +77/−0
• dev/Live2.hs +28/−0
• dev/Live3.hs +27/−0
• dev/Live4.hs +33/−0
• dev/Live5.hs +80/−0
• dev/Live6.hs +39/−0
• src/Data/Aeson/TypeScript/Formatting.hs +1/−1
• src/Data/Aeson/TypeScript/Instances.hs +41/−27
• src/Data/Aeson/TypeScript/Internal.hs +1/−0
• src/Data/Aeson/TypeScript/Lookup.hs +8/−3
• src/Data/Aeson/TypeScript/Recursive.hs +118/−5
• src/Data/Aeson/TypeScript/TH.hs +67/−122
• src/Data/Aeson/TypeScript/Transform.hs +86/−0
• src/Data/Aeson/TypeScript/TypeManipulation.hs +70/−0
• src/Data/Aeson/TypeScript/Types.hs +17/−2
• src/Data/Aeson/TypeScript/Util.hs +80/−20
• test/ClosedTypeFamilies.hs +91/−0
• test/Generic.hs +82/−0
• test/Live.hs +0/−73
• test/Live2.hs +0/−28
• test/LiveLogging.hs +0/−32
• test/NoOmitNothingFields.hs +21/−18
• test/OpenTypeFamilies.hs +91/−0
• test/Spec.hs +7/−3
• test/TypeFamilies.hs +0/−91
• test/UnwrapUnaryRecords.hs +46/−0

@@ -1,5 +1,16 @@ # Change log +## 0.4.0.0++* Add new built-in instances (Word8, Int32, Int64, Map, HashSet)+* Export TSField in the Internal module+* Avoid producing redundant constraints (for fewer warnings when using -Wredundant-constraints)+* Encode maps as mapped types (allows you to have unions as keys)+* Support mapping open type families to lookup types (+ progress on handling promoted types)+* Improve propagation of T variables in declarations+* Add support for "key types", in case you have custom implementations of FromJSONKey/ToJSONKey+* Add ability to recursively derive missing instances (fragile)+ ## 0.3.0.1  * Support GHC 9.0.1

@@ -1,4 +1,4 @@-Copyright Tom McLaughlin (c) 2017+Copyright Tom McLaughlin (c) 2022  All rights reserved. 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           aeson-typescript-version:        0.3.0.1+version:        0.4.0.0 synopsis:       Generate TypeScript definition files from your ADTs description:    Please see the README on Github at <https://github.com/codedownio/aeson-typescript#readme> category:       Text, Web, JSON@@ -13,7 +13,7 @@ bug-reports:    https://github.com/codedownio/aeson-typescript/issues author:         Tom McLaughlin maintainer:     tom@codedown.io-copyright:      2021 CodeDown+copyright:      2022 CodeDown license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -40,6 +40,8 @@       Data.Aeson.TypeScript.Formatting       Data.Aeson.TypeScript.Instances       Data.Aeson.TypeScript.Lookup+      Data.Aeson.TypeScript.Transform+      Data.Aeson.TypeScript.TypeManipulation       Data.Aeson.TypeScript.Types       Data.Aeson.TypeScript.Util       Paths_aeson_typescript@@ -54,31 +56,32 @@     , template-haskell     , text     , th-abstraction+    , transformers     , unordered-containers   default-language: Haskell2010 -test-suite aeson-typescript-test+test-suite aeson-typescript-tests   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:       Basic+      ClosedTypeFamilies       Formatting+      Generic       HigherKind-      Live-      Live2-      LiveLogging       NoOmitNothingFields       ObjectWithSingleFieldNoTagSingleConstructors       ObjectWithSingleFieldTagSingleConstructors       OmitNothingFields+      OpenTypeFamilies       TaggedObjectNoTagSingleConstructors       TaggedObjectTagSingleConstructors       TestBoilerplate       TwoElemArrayNoTagSingleConstructors       TwoElemArrayTagSingleConstructors-      TypeFamilies       UntaggedNoTagSingleConstructors       UntaggedTagSingleConstructors+      UnwrapUnaryRecords       Util       Data.Aeson.TypeScript.Formatting       Data.Aeson.TypeScript.Instances@@ -86,12 +89,21 @@       Data.Aeson.TypeScript.Lookup       Data.Aeson.TypeScript.Recursive       Data.Aeson.TypeScript.TH+      Data.Aeson.TypeScript.Transform+      Data.Aeson.TypeScript.TypeManipulation       Data.Aeson.TypeScript.Types       Data.Aeson.TypeScript.Util+      Live+      Live2+      Live3+      Live4+      Live5+      Live6       Paths_aeson_typescript   hs-source-dirs:       test       src+      dev   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N   build-depends:       aeson@@ -109,5 +121,6 @@     , temporary     , text     , th-abstraction+    , transformers     , unordered-containers   default-language: Haskell2010

@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Live where++import Data.Aeson as A+import Data.Aeson.TypeScript.Recursive+import Data.Aeson.TypeScript.TH+import Data.Function+import Data.Functor.Identity+import Data.Kind+import Data.Map+import Data.Proxy+import Data.String.Interpolate+import qualified Data.Text as T+import Prelude hiding (Double)+++instance TypeScript Identity where getTypeScriptType _ = "any"++data SingleDE = SingleDE+instance TypeScript SingleDE where getTypeScriptType _ = [i|"single"|]++data K8SDE = K8SDE+instance TypeScript K8SDE where getTypeScriptType _ = [i|"k8s"|]++data SingleNodeEnvironment = SingleNodeEnvironment+  deriving (Eq, Show)+instance TypeScript SingleNodeEnvironment where getTypeScriptType _ = [i|"single_node_env"|]++data K8SEnvironment = K8SEnvironment+  deriving (Eq, Show)+instance TypeScript K8SEnvironment where getTypeScriptType _ = [i|"k8s_env"|]++data Nullable (c :: Type -> Type) x+data Exposed x+type family Columnar (f :: Type -> Type) x where+    Columnar Exposed x = Exposed x+    Columnar Identity x = x+    Columnar (Nullable c) x = Columnar c (Maybe x)+    Columnar f x = f x++type family DeployEnvironment env = result | result -> env where+  DeployEnvironment SingleNodeEnvironment = SingleDE+  DeployEnvironment K8SEnvironment = K8SDE+  DeployEnvironment T = ()++-- * The main type++data UserT env f = User {+  _userDeployEnv  :: Columnar f (DeployEnvironment env)+  }++data Complex3 k = Complex3 {+  bulkCommandNoArgKeys :: Map T.Text k+  } deriving (Show)+++deriveTypeScript' A.defaultOptions ''UserT (defaultExtraTypeScriptOptions { typeFamiliesToMapToTypeScript = [''DeployEnvironment] })++main :: IO ()+main = getTypeScriptDeclarationsRecursively (Proxy :: Proxy (UserT T Identity))+     & formatTSDeclarations+     & putStrLn

@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilyDependencies #-}++module Live2 where++import Data.Aeson as A+import Data.Aeson.TypeScript.TH+import Data.Function+import Data.Proxy++       +data TestT a = TestT {+  listOfA :: [a]+  , maybeA :: Maybe a+  }+$(deriveTypeScript A.defaultOptions ''TestT)++main :: IO ()+main = getTypeScriptDeclarations (Proxy :: Proxy (TestT Int))+     & formatTSDeclarations+     & putStrLn

@@ -0,0 +1,27 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilyDependencies #-}++module Live3 where++import Data.Aeson as A+import Data.Aeson.TypeScript.TH+import Data.Function+import Data.Proxy+++data Test = TestBlah {x :: Int, y :: Bool}++$(deriveTypeScript (A.defaultOptions { A.tagSingleConstructors = True }) ''Test)++main :: IO ()+main = getTypeScriptDeclarations (Proxy @Test)+     & formatTSDeclarations+     & putStrLn

@@ -0,0 +1,33 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilyDependencies #-}++module Live4 where++import Data.Aeson as A+import Data.Aeson.TypeScript.Recursive+import Data.Aeson.TypeScript.TH+import Data.Function+import Data.Proxy+import TestBoilerplate+++type family DeployEnvironment2 env = result | result -> env+type instance DeployEnvironment2 SingleNodeEnvironment = SingleDE+type instance DeployEnvironment2 K8SEnvironment = K8SDE+type instance DeployEnvironment2 T = ()+newtype Simple env = Simple (DeployEnvironment2 env)+$(deriveTypeScript' A.defaultOptions ''Simple (defaultExtraTypeScriptOptions { typeFamiliesToMapToTypeScript = [''DeployEnvironment2] }))++main :: IO ()+main = getTypeScriptDeclarationsRecursively (Proxy @(Simple T))+     & formatTSDeclarations+     & putStrLn

@@ -0,0 +1,80 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE DeriveGeneric #-}++module Live5 where++import Data.Aeson as A+import Data.Aeson.TypeScript.Recursive+import Data.Aeson.TypeScript.TH+import Data.Function+import Data.Kind as Kind+import Data.Proxy+import qualified Data.Text as T+import Data.Typeable+import Data.Void+import GHC.Generics+import TestBoilerplate+++-- data From = FromServer | FromClient+-- data MethodType = Notification | Request++-- data Method (f :: From) (t :: MethodType) where+--   Login :: Method 'FromClient 'Request+--   ReportClick :: Method 'FromClient 'Notification++-- instance TypeScript Login where getTypeScriptType _ = "asdf"+-- instance TypeScript ReportClick where getTypeScriptType _ = "fdsa"++-- data LoginParams = LoginParams {+--   loginUsername :: T.Text+--   , loginPassword :: T.Text+--   }+-- $(deriveJSONAndTypeScript A.defaultOptions ''LoginParams)+++-- data ReportClickParams = ReportClickParams {+--   reportClickX :: Int+--   , reportClickY :: Int+--   }+-- $(deriveJSONAndTypeScript A.defaultOptions ''ReportClickParams)++-- type family MessageParams (m :: Method f t) :: Kind.Type where+--   MessageParams 'Login = LoginParams+--   MessageParams 'ReportClick = ReportClickParams++-- data SMethod (m :: Method f t) where+--   SLogin :: SMethod 'Login+--   SReportClick :: SMethod 'ReportClick++-- data RequestMessage (m :: Method f 'Request) =+--   RequestMessage {+--     _id :: T.Text+--     , _method :: SMethod m+--     , _params :: MessageParams m+--     }++-- data LoginResult = LoginResult { profilePicture :: T.Text }+-- $(deriveJSONAndTypeScript A.defaultOptions ''LoginResult)++-- type family ResponseResult (m :: Method f 'Request) :: Kind.Type where+--   ResponseResult 'Login = LoginResult+--   ResponseResult _ = Void++-- deriveTypeScript' A.defaultOptions ''RequestMessage (ExtraTypeScriptOptions [''MessageParams])++-- -- main :: IO ()+-- -- main = getTypeScriptDeclarationsRecursively (Proxy @(RequestMessage (Method FromClient Request)))+-- --      & formatTSDeclarations+-- --      & putStrLn

@@ -0,0 +1,39 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE DeriveGeneric #-}++module Live6 where++import Data.Aeson as A+import Data.Aeson.TypeScript.TH+import Data.Function+import Data.Map+import Data.Proxy+import Data.Text+++data Complex a = Product Int a | Unary Int deriving Eq++data Complex2 a = Product2 Int a++data Complex3 k = Complex3 {+  bulkCommandNoArgKeys :: Map Text k+  } deriving (Show)+$(deriveTypeScript defaultOptions ''Complex3)++main :: IO ()+-- main = printThing (Proxy @(BulkCommandNoArg Int))+main = printThing (Proxy @(Complex3 Double))++printThing x = getTypeScriptDeclarations x+             & formatTSDeclarations+             & putStrLn

@@ -35,7 +35,7 @@ }|] where ls = T.intercalate "\n" $ fmap T.pack [(replicate numIndentSpaces ' ') <> formatTSField member <> ";"| member <- members]           modifiedInterfaceName = (\(li, name) -> li <> interfaceNameModifier name) . splitAt 1 $ interfaceName -formatTSDeclaration (FormattingOptions {..}) (TSRawDeclaration text) = text+formatTSDeclaration _ (TSRawDeclaration text) = text  exportPrefix :: ExportMode -> String exportPrefix ExportEach = "export "

@@ -10,17 +10,22 @@ import Data.Aeson.TypeScript.Types import Data.Data import Data.HashMap.Strict+import Data.HashSet import qualified Data.List as L+import Data.Map.Strict import Data.Set import Data.String.Interpolate import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Void+import Data.Word+import GHC.Int  #if !MIN_VERSION_base(4,11,0) import Data.Monoid #endif + instance TypeScript () where   getTypeScriptType _ = "void" @@ -48,12 +53,21 @@ instance TypeScript Int where   getTypeScriptType _ = "number" +instance TypeScript Int32 where+  getTypeScriptType _ = "number"++instance TypeScript Int64 where+  getTypeScriptType _ = "number"+ instance TypeScript Char where   getTypeScriptType _ = "string" +instance TypeScript Word8 where+  getTypeScriptType _ = "number"+ instance {-# OVERLAPPABLE #-} (TypeScript a) => TypeScript [a] where   getTypeScriptType _ = (getTypeScriptType (Proxy :: Proxy a)) ++ "[]"-  getParentTypes _ = (TSType (Proxy :: Proxy a)) : (getParentTypes (Proxy :: Proxy a))+  getParentTypes _ = [TSType (Proxy :: Proxy a)]  instance {-# OVERLAPPING #-} TypeScript [Char] where   getTypeScriptType _ = "string"@@ -64,37 +78,30 @@                                , TSInterfaceDeclaration "Left" ["T"] [TSField False "Left" "T"]                                , TSInterfaceDeclaration "Right" ["T"] [TSField False "Right" "T"]                                ]-  getParentTypes _ = L.nub ((TSType (Proxy :: Proxy a))-                            : (TSType (Proxy :: Proxy b))-                            : (getParentTypes (Proxy :: Proxy a))-                            <> (getParentTypes (Proxy :: Proxy b)))+  getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a))+                           , (TSType (Proxy :: Proxy b))+                           ]  instance (TypeScript a, TypeScript b) => TypeScript (a, b) where   getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}]|]-  getParentTypes _ = L.nub ((TSType (Proxy :: Proxy a))-                            : (TSType (Proxy :: Proxy b))-                            : (getParentTypes (Proxy :: Proxy a))-                            <> (getParentTypes (Proxy :: Proxy b)))+  getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a))+                           , (TSType (Proxy :: Proxy b))+                           ]  instance (TypeScript a, TypeScript b, TypeScript c) => TypeScript (a, b, c) where   getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}, #{getTypeScriptType (Proxy :: Proxy c)}]|]-  getParentTypes _ = L.nub ((TSType (Proxy :: Proxy a))-                            : (TSType (Proxy :: Proxy b))-                            : (TSType (Proxy :: Proxy c))-                            : (getParentTypes (Proxy :: Proxy a))-                            <> (getParentTypes (Proxy :: Proxy b))-                            <> (getParentTypes (Proxy :: Proxy c)))+  getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a))+                           , (TSType (Proxy :: Proxy b))+                           , (TSType (Proxy :: Proxy c))+                           ]  instance (TypeScript a, TypeScript b, TypeScript c, TypeScript d) => TypeScript (a, b, c, d) where   getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}, #{getTypeScriptType (Proxy :: Proxy c)}, #{getTypeScriptType (Proxy :: Proxy d)}]|]-  getParentTypes _ = L.nub ((TSType (Proxy :: Proxy a))-                            : (TSType (Proxy :: Proxy b))-                            : (TSType (Proxy :: Proxy c))-                            : (TSType (Proxy :: Proxy d))-                            : (getParentTypes (Proxy :: Proxy a))-                            <> (getParentTypes (Proxy :: Proxy b))-                            <> (getParentTypes (Proxy :: Proxy c))-                            <> (getParentTypes (Proxy :: Proxy d)))+  getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a))+                           , (TSType (Proxy :: Proxy b))+                           , (TSType (Proxy :: Proxy c))+                           , (TSType (Proxy :: Proxy d))+                           ]  instance (TypeScript a) => TypeScript (Maybe a) where   getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy a)@@ -104,11 +111,18 @@ instance TypeScript A.Value where   getTypeScriptType _ = "any"; +instance (TypeScript a, TypeScript b) => TypeScript (Map a b) where+  getTypeScriptType _ = "{[k in " ++ getTypeScriptKeyType (Proxy :: Proxy a) ++ "]?: " ++ getTypeScriptType (Proxy :: Proxy b) ++ "}"+  getParentTypes _ = [TSType (Proxy :: Proxy a), TSType (Proxy :: Proxy b)]+ instance (TypeScript a, TypeScript b) => TypeScript (HashMap a b) where-  getTypeScriptType _ = [i|{[k: #{getTypeScriptType (Proxy :: Proxy a)}]: #{getTypeScriptType (Proxy :: Proxy b)}}|]-  getParentTypes _ = L.nub ((getParentTypes (Proxy :: Proxy a))-                            <> (getParentTypes (Proxy :: Proxy b)))+  getTypeScriptType _ = [i|{[k in #{getTypeScriptKeyType (Proxy :: Proxy a)}]?: #{getTypeScriptType (Proxy :: Proxy b)}}|]+  getParentTypes _ = L.nub [TSType (Proxy :: Proxy a), TSType (Proxy :: Proxy b)]  instance (TypeScript a) => TypeScript (Set a) where   getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy a) <> "[]";-  getParentTypes _ = L.nub (getParentTypes (Proxy :: Proxy a))+  getParentTypes _ = [TSType (Proxy :: Proxy a)]++instance (TypeScript a) => TypeScript (HashSet a) where+  getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy a) ++ "[]"+  getParentTypes _ = [TSType (Proxy :: Proxy a)]

@@ -3,6 +3,7 @@  module Data.Aeson.TypeScript.Internal (   TSDeclaration(..)+  , TSField(..)   ) where  import Data.Aeson.TypeScript.Types

@@ -18,6 +18,8 @@ import Control.Monad import Data.Aeson.TypeScript.Instances () import Data.Aeson.TypeScript.Types+import Data.Function+import qualified Data.List as L import Data.Proxy import Data.String.Interpolate import Language.Haskell.TH hiding (stringE)@@ -44,19 +46,22 @@   fields <- forM eqns $ \case #if MIN_VERSION_template_haskell(2,15,0)     TySynEqn Nothing (AppT (ConT _) (ConT arg)) result -> do+      [| TSField False (getTypeScriptType (Proxy :: Proxy $(conT arg))) (getTypeScriptType (Proxy :: Proxy $(return result))) |]+    TySynEqn Nothing (AppT (ConT _) (PromotedT arg)) result -> do+      [| TSField False (getTypeScriptType (Proxy :: Proxy $(promotedT arg))) (getTypeScriptType (Proxy :: Proxy $(return result))) |] #else     TySynEqn [ConT arg] result -> do-#endif       [| TSField False (getTypeScriptType (Proxy :: Proxy $(conT arg))) (getTypeScriptType (Proxy :: Proxy $(return result))) |]+#endif     x -> fail [i|aeson-typescript doesn't know yet how to handle this type family equation: '#{x}'|] -  [| TSInterfaceDeclaration $(TH.stringE $ nameBase name) [] $(listE $ fmap return fields) |]+  [| TSInterfaceDeclaration $(TH.stringE $ nameBase name) [] (L.sortBy (compare `on` fieldName) $(listE $ fmap return fields)) |]  getClosedTypeFamilyImage :: [TySynEqn] -> Q [Type] getClosedTypeFamilyImage eqns = do   forM eqns $ \case #if MIN_VERSION_template_haskell(2,15,0)-    TySynEqn Nothing (AppT (ConT _) (ConT _)) result -> return result+    TySynEqn Nothing (AppT (ConT _) _) result -> return result #else     TySynEqn [ConT _] result -> return result #endif

@@ -1,22 +1,53 @@-{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, ExistentialQuantification, FlexibleInstances, NamedFieldPuns, MultiWayIf, ViewPatterns, LambdaCase, PolyKinds #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-}  module Data.Aeson.TypeScript.Recursive (+  -- * Getting declarations recursively   getTransitiveClosure   , getTypeScriptDeclarationsRecursively++  -- * Deriving missing instances recursively+  , recursivelyDeriveMissingTypeScriptInstancesFor+  , recursivelyDeriveMissingInstancesFor+  , deriveInstanceIfNecessary+  , doesTypeScriptInstanceExist+  , getAllParentTypes   ) where +import Control.Monad.State+import Control.Monad.Trans.Maybe+import Control.Monad.Writer import Data.Aeson.TypeScript.Instances () import Data.Aeson.TypeScript.TH+import Data.Bifunctor import Data.Function+import qualified Data.List as L+import Data.Maybe import Data.Proxy import qualified Data.Set as S+import Data.String.Interpolate+import Language.Haskell.TH as TH+import Language.Haskell.TH.Datatype+import Language.Haskell.TH.Syntax hiding (lift)   getTransitiveClosure :: S.Set TSType -> S.Set TSType-getTransitiveClosure initialTypes = fix (\loop items -> let items' = S.unions (items : [getMore x | x <- S.toList items]) in-                                            if | items' == items -> items-                                               | otherwise -> loop items'-                                        ) initialTypes+getTransitiveClosure = fix $ \loop items ->+  let items' = S.unions (items : [getMore x | x <- S.toList items])+   in if+          | items' == items -> items+          | otherwise -> loop items'+   where getMore :: TSType -> S.Set TSType         getMore (TSType x) = S.fromList $ getParentTypes x @@ -25,3 +56,85 @@   where     closure = getTransitiveClosure (S.fromList [TSType initialType])     declarations = mconcat [getTypeScriptDeclarations x | TSType x <- S.toList closure]+++-- * Recursively deriving missing TypeScript interfaces++recursivelyDeriveMissingTypeScriptInstancesFor :: (Monoid w) => Name -> (Name -> Q w) -> Q w+recursivelyDeriveMissingTypeScriptInstancesFor = recursivelyDeriveMissingInstancesFor doesTypeScriptInstanceExist++recursivelyDeriveMissingInstancesFor :: (Monoid w) => (Name -> Q Bool) -> Name -> (Name -> Q w) -> Q w+recursivelyDeriveMissingInstancesFor doesInstanceExist name deriveFn = execWriterT $ do+  deriveInstanceIfNecessary name deriveFn++  names <- lift $ getAllParentTypes name doesInstanceExist+  forM_ names $ \n -> deriveInstanceIfNecessary n deriveFn++deriveInstanceIfNecessary :: (Monoid w) => Name -> (Name -> Q w) -> WriterT w Q ()+deriveInstanceIfNecessary name deriveFn = do+  lift (doesTypeScriptInstanceExist name) >>= \case+    True -> return ()+    False -> do+      (lift $ nothingOnFail (deriveFn name)) >>= \case+        Nothing -> lift $ reportWarning [i|Failed to derive decls for name '#{name}'|]+        Just x -> tell x++doesTypeScriptInstanceExist :: Name -> Q Bool+doesTypeScriptInstanceExist name = do+  result :: Maybe Bool <- runMaybeT $ do+    (DatatypeInfo {..}) <- MaybeT $ nothingOnFail $ reifyDatatype name++    -- Skip names with type parameters for now+    when (datatypeVars /= []) $ fail ""++    MaybeT $ nothingOnFail $ isInstance ''TypeScript [ConT name]++  return $ fromMaybe True result++getAllParentTypes :: Name -> (Name -> Q Bool) -> Q [Name]+getAllParentTypes name pruneFn = reverse <$> execStateT (getAllParentTypes' name pruneFn) []+  where+    getAllParentTypes' :: Name -> (Name -> Q Bool) -> StateT [Name] Q ()+    getAllParentTypes' nm pfn = (lift $ nothingOnFail $ pfn nm) >>= \case+      Nothing -> return ()+      Just True -> return ()+      Just False -> (lift $ nothingOnFail (reifyDatatype nm)) >>= \case+        Nothing -> do+          lift $ reportWarning [i|Failed to reify: '#{nm}'|]+        Just (DatatypeInfo {..}) -> do+          let parentTypes = mconcat $ fmap constructorFields datatypeCons++          let maybeRecurse n = do+                st <- get+                unless (n `L.elem` st) $ do+                  modify (n :)+                  getAllParentTypes' n pfn++          forM_ parentTypes $ \typ -> do+            let names :: [Name] = fst $ execState (getNamesFromType typ) ([], [typ])+            forM_ names maybeRecurse++    getNamesFromType :: Type -> State ([Name], [Type]) ()+    getNamesFromType (ConT n) = modify (first $ addIfNotPresent n)+    getNamesFromType (AppT t1 t2) = handleTwoTypes t1 t2+    getNamesFromType (InfixT t1 _ t2) = handleTwoTypes t1 t2+    getNamesFromType (UInfixT t1 _ t2) = handleTwoTypes t1 t2+    getNamesFromType _ = return ()++    handleTwoTypes t1 t2 = do+      (_, visitedTypes) <- get+      unless (t1 `L.elem` visitedTypes) $ do+        modify (second (t1 :))+        getNamesFromType t1++      (_, visitedTypes') <- get+      unless (t2 `L.elem` visitedTypes') $ do+        modify (second (t2 :))+        getNamesFromType t2++    addIfNotPresent :: (Eq a) => a -> [a] -> [a]+    addIfNotPresent x xs | x `L.elem` xs = xs+    addIfNotPresent x xs = x : xs++nothingOnFail :: Q a -> Q (Maybe a)+nothingOnFail action = recover (return Nothing) (Just <$> action)

@@ -15,7 +15,7 @@  {-| Module:      Data.Aeson.TypeScript.TH-Copyright:   (c) 2018 Tom McLaughlin+Copyright:   (c) 2022 Tom McLaughlin License:     BSD3 Stability:   experimental Portability: portable@@ -126,11 +126,15 @@   , formatTSDeclarations'   , formatTSDeclaration   , FormattingOptions(..)+  , defaultFormattingOptions   , SumTypeFormat(..)   , ExportMode(..)    -- * Advanced options-  , ExtraTypeScriptOptions(..)+  , defaultExtraTypeScriptOptions+  , keyType+  , typeFamiliesToMapToTypeScript+  , ExtraTypeScriptOptions    -- * Convenience tools   , HasJSONOptions(..)@@ -152,14 +156,14 @@ import Data.Aeson.TypeScript.Formatting import Data.Aeson.TypeScript.Instances () import Data.Aeson.TypeScript.Lookup+import Data.Aeson.TypeScript.Transform+import Data.Aeson.TypeScript.TypeManipulation import Data.Aeson.TypeScript.Types import Data.Aeson.TypeScript.Util import qualified Data.List as L-import qualified Data.Map as M import Data.Maybe import Data.Proxy import Data.String.Interpolate-import Data.Typeable import Language.Haskell.TH hiding (stringE) import Language.Haskell.TH.Datatype import qualified Language.Haskell.TH.Lib as TH@@ -180,60 +184,67 @@   datatypeInfo' <- reifyDatatype name   assertExtensionsTurnedOn datatypeInfo' -  -- Plug in generic variables for all star free variables-  let starVars = [name | (isStarType -> Just _) <- getDataTypeVars datatypeInfo']-  let templateVarsToUse = case length starVars of-        1 -> [ConT ''T]-        _ -> take (length starVars) allStarConstructors-  let subMap = M.fromList $ zip starVars templateVarsToUse-  let dti = datatypeInfo' { datatypeCons = fmap (applySubstitution subMap) (datatypeCons datatypeInfo')}+  -- Figure out what the generic variables are+  let eligibleGenericVars = catMaybes $ flip fmap (getDataTypeVars datatypeInfo') $ \case+        SigT (VarT n) StarT -> Just n+        _ -> Nothing+  let varsAndTVars = case eligibleGenericVars of+        [] -> []+        [x] -> [(x, "T")]+        xs -> zip xs allStarConstructors''+  genericVariablesAndSuffixes <- forM varsAndTVars $ \(var, tvar) -> do+    (_, genericInfos) <- runWriterT $ forM_ (datatypeCons datatypeInfo') $ \ci ->+      forM_ (namesAndTypes options [] ci) $ \(_, typ) -> do+        searchForConstraints extraOptions typ var+    return (var, (unifyGenericVariable genericInfos, tvar)) +  -- Plug in generic variables and de-family-ify+  ((\x -> (datatypeInfo' { datatypeCons = x })) -> dti, extraDeclsOrGenericInfosInitial) <- runWriterT $ forM (datatypeCons datatypeInfo') $ \ci ->+    ((\x -> ci { constructorFields = x }) <$>) $ forM (constructorFields ci) $+      transformTypeFamilies extraOptions . mapType genericVariablesAndSuffixes+   -- Build constraints: a TypeScript constraint for every constructor type and one for every type variable.   -- Probably overkill/not exactly right, but it's a start.   let constructorPreds :: [Pred] = [AppT (ConT ''TypeScript) x | x <- mconcat $ fmap constructorFields (datatypeCons dti)-                                                               , hasFreeTypeVariable x]+                                                               , hasFreeTypeVariable x+                                                               , not $ coveredByDataTypeVars (getDataTypeVars dti) x+                                                               ]   let constructorPreds' :: [Pred] = [AppT (ConT ''TypeScript) x | x <- mconcat $ fmap constructorFields (datatypeCons datatypeInfo')-                                                                , hasFreeTypeVariable x]+                                                                , hasFreeTypeVariable x+                                                                , not $ coveredByDataTypeVars (getDataTypeVars dti) x+                                                                ]   let typeVariablePreds :: [Pred] = [AppT (ConT ''TypeScript) x | x <- getDataTypeVars dti] -  let eligibleGenericVars = catMaybes $ flip fmap (getDataTypeVars dti) $ \case-        SigT (VarT n) StarT -> Just n-        _ -> Nothing-  genericVariablesAndSuffixes <- forM eligibleGenericVars $ \var -> do-    (_, genericInfos) <- runWriterT $ forM_ (datatypeCons datatypeInfo') $ \ci ->-      forM_ (namesAndTypes options ci) $ \(_, typ) -> do-        searchForConstraints extraOptions typ var-    return (var, unifyGenericVariable genericInfos)-   -- Build the declarations-  (types, extraDeclsOrGenericInfos) <- runWriterT $ mapM (handleConstructor options extraOptions dti genericVariablesAndSuffixes) (datatypeCons dti)+  (types, (extraDeclsOrGenericInfosInitial <>) -> extraDeclsOrGenericInfos) <- runWriterT $ mapM (handleConstructor options dti genericVariablesAndSuffixes) (datatypeCons dti)   typeDeclaration <- [|TSTypeAlternatives $(TH.stringE $ getTypeName (datatypeName dti))                                           $(genericVariablesListExpr True genericVariablesAndSuffixes)                                           $(listE $ fmap return types)|]-  let extraDecls = [x | ExtraDecl x <- extraDeclsOrGenericInfos]-  let extraTopLevelDecls = mconcat [x | ExtraTopLevelDecs x <- extraDeclsOrGenericInfos]-  let predicates = constructorPreds <> constructorPreds' <> typeVariablePreds <> [x | ExtraConstraint x <- extraDeclsOrGenericInfos] -  declarationsFunctionBody <- [| $(return typeDeclaration) : $(listE (fmap return $ extraDecls)) |]--  let extraParentTypes = [x | ExtraParentType x <- extraDeclsOrGenericInfos]+  declarationsFunctionBody <- [| $(return typeDeclaration) : $(listE (fmap return [x | ExtraDecl x <- extraDeclsOrGenericInfos])) |]    -- Couldn't figure out how to put the constraints for "instance TypeScript..." in the quasiquote above without   -- introducing () when the constraints are empty, which causes "illegal tuple constraint" unless the user enables ConstraintKinds.   -- So, just use our mkInstance function   getTypeScriptTypeExp <- [|$(TH.stringE $ getTypeName (datatypeName dti)) <> $(getBracketsExpressionAllTypesNoSuffix genericVariablesAndSuffixes)|]   getParentTypesExp <- listE [ [|TSType (Proxy :: Proxy $(return t))|]-                             | t <- (mconcat $ fmap constructorFields (datatypeCons datatypeInfo')) <> extraParentTypes]-  let inst = [mkInstance predicates (AppT (ConT ''TypeScript) (foldl AppT (ConT name) (getDataTypeVars dti))) [+                             | t <- (mconcat $ fmap constructorFields (datatypeCons datatypeInfo')) <> [x | ExtraParentType x <- extraDeclsOrGenericInfos]]+  let predicates = L.nub (constructorPreds <> constructorPreds' <> typeVariablePreds <> [x | ExtraConstraint x <- extraDeclsOrGenericInfos])+  keyTypeDecl <- case keyType extraOptions of+    Nothing -> return []+    Just kt -> do+      keyTypeExp <- [|$(TH.stringE kt)|]+      return $ [FunD 'getTypeScriptKeyType [Clause [WildP] (NormalB keyTypeExp) []]]+  let inst = [mkInstance predicates (AppT (ConT ''TypeScript) (foldl AppT (ConT name) (getDataTypeVars dti))) ([                  FunD 'getTypeScriptType [Clause [WildP] (NormalB getTypeScriptTypeExp) []]                  , FunD 'getTypeScriptDeclarations [Clause [WildP] (NormalB declarationsFunctionBody) []]                  , FunD 'getParentTypes [Clause [WildP] (NormalB getParentTypesExp) []]-                 ]]-  return (extraTopLevelDecls <> inst)+                 ] <> keyTypeDecl)]+  return (mconcat [x | ExtraTopLevelDecs x <- extraDeclsOrGenericInfos] <> inst)  -- | Return a string to go in the top-level type declaration, plus an optional expression containing a declaration-handleConstructor :: Options -> ExtraTypeScriptOptions -> DatatypeInfo -> [(Name, String)] -> ConstructorInfo -> WriterT [ExtraDeclOrGenericInfo] Q Exp-handleConstructor options extraOptions (DatatypeInfo {..}) genericVariables ci@(ConstructorInfo {}) =+handleConstructor :: Options -> DatatypeInfo -> [(Name, (Suffix, Var))] -> ConstructorInfo -> WriterT [ExtraDeclOrGenericInfo] Q Exp+handleConstructor options (DatatypeInfo {..}) genericVariables ci = do   if | (length datatypeCons == 1) && not (getTagSingleConstructors options) -> do          writeSingleConstructorEncoding          brackets <- lift $ getBracketsExpression False genericVariables@@ -274,6 +285,19 @@       | constructorVariant ci == NormalConstructor -> do           encoding <- tupleEncoding           tell [ExtraDecl encoding]++#if MIN_VERSION_aeson(0,10,0)+      | unwrapUnaryRecords options && (isSingleRecordConstructor ci) -> do+          let [typ] = constructorFields ci+          stringExp <- lift $ case typ of+            (AppT (ConT name) t) | name == ''Maybe && not (omitNothingFields options) -> [|$(getTypeAsStringExp t) <> " | null"|]+            _ -> getTypeAsStringExp typ+          alternatives <- lift [|TSTypeAlternatives $(TH.stringE interfaceName)+                                                    $(genericVariablesListExpr True genericVariables)+                                                    [$(return stringExp)]|]+          tell [ExtraDecl alternatives]+#endif+       | otherwise -> do           tsFields <- getTSFields           decl <- lift $ assembleInterfaceDeclaration (ListE tsFields)@@ -282,104 +306,25 @@     -- * Type declaration to use     interfaceName = "I" <> (lastNameComponent' $ constructorName ci) -    tupleEncoding = do-      tupleType <- transformTypeFamilies extraOptions (contentsTupleType ci)-      lift $ [|TSTypeAlternatives $(TH.stringE interfaceName)-                                  $(genericVariablesListExpr True genericVariables)-                                  [getTypeScriptType (Proxy :: Proxy $(return tupleType))]|]+    tupleEncoding =+      lift [|TSTypeAlternatives $(TH.stringE interfaceName)+                                $(genericVariablesListExpr True genericVariables)+                                [getTypeScriptType (Proxy :: Proxy $(return (contentsTupleTypeSubstituted genericVariables ci)))]|]      assembleInterfaceDeclaration members = [|TSInterfaceDeclaration $(TH.stringE interfaceName)                                                                     $(genericVariablesListExpr True genericVariables)                                                                     $(return members)|]      getTSFields :: WriterT [ExtraDeclOrGenericInfo] Q [Exp]-    getTSFields = forM (namesAndTypes options ci) $ \(nameString, typ') -> do-      typ <- transformTypeFamilies extraOptions typ'-      when (typ /= typ') $ do-        let constraint = AppT (ConT ''TypeScript) typ-        tell [ExtraConstraint constraint]-+    getTSFields = forM (namesAndTypes options genericVariables ci) $ \(nameString, typ) -> do       (fieldTyp, optAsBool) <- lift $ case typ of         (AppT (ConT name) t) | name == ''Maybe && not (omitNothingFields options) ->           ( , ) <$> [|$(getTypeAsStringExp t) <> " | null"|] <*> getOptionalAsBoolExp t-        _ -> ( , ) <$> getTypeAsStringExp typ <*> getOptionalAsBoolExp typ'+        _ -> ( , ) <$> getTypeAsStringExp typ <*> getOptionalAsBoolExp typ       lift $ [| TSField $(return optAsBool) $(TH.stringE nameString) $(return fieldTyp) |] -transformTypeFamilies :: ExtraTypeScriptOptions -> Type -> WriterT [ExtraDeclOrGenericInfo] Q Type-transformTypeFamilies eo@(ExtraTypeScriptOptions {..}) (AppT (ConT name) typ)-  | name `L.elem` typeFamiliesToMapToTypeScript = lift (reify name) >>= \case-      FamilyI (ClosedTypeFamilyD (TypeFamilyHead typeFamilyName _ _ _) eqns) _ -> do-        name' <- lift $ newName (nameBase typeFamilyName <> "'")--        f <- lift $ newName "f"-#if MIN_VERSION_template_haskell(2,17,0)-        let inst1 = DataD [] name' [PlainTV f ()] Nothing [] []-#else-        let inst1 = DataD [] name' [PlainTV f] Nothing [] []-#endif-        tell [ExtraTopLevelDecs [inst1]]--        imageTypes <- lift $ getClosedTypeFamilyImage eqns-        inst2 <- lift $ [d|instance (Typeable g, TypeScript g) => TypeScript ($(conT name') g) where-                             getTypeScriptType _ = $(TH.stringE $ nameBase name) <> "[" <> (getTypeScriptType (Proxy :: Proxy g)) <> "]"-                             getTypeScriptDeclarations _ = [$(getClosedTypeFamilyInterfaceDecl name eqns)]-                             getParentTypes _ = $(listE [ [|TSType (Proxy :: Proxy $(return x))|] | x <- imageTypes])-                        |]-        tell [ExtraTopLevelDecs inst2]--        tell [ExtraParentType (AppT (ConT name') (ConT ''T))]--        transformTypeFamilies eo (AppT (ConT name') typ)-      _ -> AppT (ConT name) <$> transformTypeFamilies eo typ-  | otherwise = AppT (ConT name) <$> transformTypeFamilies eo typ-transformTypeFamilies eo (AppT typ1 typ2) = AppT <$> transformTypeFamilies eo typ1 <*> transformTypeFamilies eo typ2-transformTypeFamilies eo (SigT typ kind) = flip SigT kind <$> transformTypeFamilies eo typ-transformTypeFamilies eo (InfixT typ1 n typ2) = InfixT <$> transformTypeFamilies eo typ1 <*> pure n <*> transformTypeFamilies eo typ2-transformTypeFamilies eo (UInfixT typ1 n typ2) = UInfixT <$> transformTypeFamilies eo typ1 <*> pure n <*> transformTypeFamilies eo typ2-transformTypeFamilies eo (ParensT typ) = ParensT <$> transformTypeFamilies eo typ-#if MIN_VERSION_template_haskell(2,15,0)-transformTypeFamilies eo (AppKindT typ kind) = flip AppKindT kind <$> transformTypeFamilies eo typ-transformTypeFamilies eo (ImplicitParamT s typ) = ImplicitParamT s <$> transformTypeFamilies eo typ-#endif-transformTypeFamilies _ typ = return typ---searchForConstraints :: ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q ()-searchForConstraints eo@(ExtraTypeScriptOptions {..}) (AppT (ConT name) typ) var-  | typ == VarT var && (name `L.elem` typeFamiliesToMapToTypeScript) = lift (reify name) >>= \case-      FamilyI (ClosedTypeFamilyD (TypeFamilyHead typeFamilyName _ _ _) _) _ -> do-        tell [GenericInfo var (TypeFamilyKey typeFamilyName)]-        searchForConstraints eo typ var-      _ -> searchForConstraints eo typ var-  | otherwise = searchForConstraints eo typ var-searchForConstraints eo (AppT typ1 typ2) var = searchForConstraints eo typ1 var >> searchForConstraints eo typ2 var-searchForConstraints eo (SigT typ _) var = searchForConstraints eo typ var-searchForConstraints eo (InfixT typ1 _ typ2) var = searchForConstraints eo typ1 var >> searchForConstraints eo typ2 var-searchForConstraints eo (UInfixT typ1 _ typ2) var = searchForConstraints eo typ1 var >> searchForConstraints eo typ2 var-searchForConstraints eo (ParensT typ) var = searchForConstraints eo typ var-#if MIN_VERSION_template_haskell(2,15,0)-searchForConstraints eo (AppKindT typ _) var = searchForConstraints eo typ var-searchForConstraints eo (ImplicitParamT _ typ) var = searchForConstraints eo typ var-#endif-searchForConstraints _ _ _ = return ()--hasFreeTypeVariable :: Type -> Bool-hasFreeTypeVariable (VarT _) = True-hasFreeTypeVariable (AppT typ1 typ2) = hasFreeTypeVariable typ1 || hasFreeTypeVariable typ2-hasFreeTypeVariable (SigT typ _) = hasFreeTypeVariable typ-hasFreeTypeVariable (InfixT typ1 _ typ2) = hasFreeTypeVariable typ1 || hasFreeTypeVariable typ2-hasFreeTypeVariable (UInfixT typ1 _ typ2) = hasFreeTypeVariable typ1 || hasFreeTypeVariable typ2-hasFreeTypeVariable (ParensT typ) = hasFreeTypeVariable typ-#if MIN_VERSION_template_haskell(2,15,0)-hasFreeTypeVariable (AppKindT typ _) = hasFreeTypeVariable typ-hasFreeTypeVariable (ImplicitParamT _ typ) = hasFreeTypeVariable typ-#endif-hasFreeTypeVariable _ = False--unifyGenericVariable :: [GenericInfo] -> String-unifyGenericVariable genericInfos = case [nameBase name | GenericInfo _ (TypeFamilyKey name) <- genericInfos] of-  [] -> ""-  names -> " extends keyof " <> (L.intercalate " & " names)+    isSingleRecordConstructor (constructorVariant -> RecordConstructor [x]) = True+    isSingleRecordConstructor _ = False  -- * Convenience functions 

@@ -0,0 +1,86 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE LambdaCase #-}+++module Data.Aeson.TypeScript.Transform (+  transformTypeFamilies+  ) where++import Control.Monad.Writer+import Data.Aeson.TypeScript.Lookup+import Data.Aeson.TypeScript.Types+import qualified Data.List as L+import Data.Typeable+import Language.Haskell.TH hiding (stringE)+import qualified Language.Haskell.TH.Lib as TH++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif+++-- | Search the given type for type families. For each one found, emit a declaration for a new+-- corresponding concrete type and a TypeScript instance for it which emits a lookup type.+-- Then, replace all occurrences of the given type family with the concrete type in the return value.+-- Thus the type becomes "de-family-ified".+transformTypeFamilies :: ExtraTypeScriptOptions -> Type -> WriterT [ExtraDeclOrGenericInfo] Q Type+transformTypeFamilies eo@(ExtraTypeScriptOptions {..}) (AppT (ConT name) typ)+  | name `L.elem` typeFamiliesToMapToTypeScript = lift (reify name) >>= \case+      FamilyI (ClosedTypeFamilyD (TypeFamilyHead typeFamilyName _ _ _) eqns) _ -> handle typeFamilyName eqns++#if MIN_VERSION_template_haskell(2,15,0)+      FamilyI (OpenTypeFamilyD (TypeFamilyHead typeFamilyName _ _ _)) decs -> handle typeFamilyName [eqn | TySynInstD eqn <- decs]+#else+      FamilyI (OpenTypeFamilyD (TypeFamilyHead typeFamilyName _ _ _)) decs -> handle typeFamilyName [eqn | TySynInstD _name eqn <- decs]+#endif++      _ -> AppT (ConT name) <$> transformTypeFamilies eo typ+  | otherwise = AppT (ConT name) <$> transformTypeFamilies eo typ+        where+          handle :: Name -> [TySynEqn] -> WriterT [ExtraDeclOrGenericInfo] Q Type+          handle typeFamilyName eqns = do+            name' <- lift $ newName (nameBase typeFamilyName <> "'")++            f <- lift $ newName "f"+#if MIN_VERSION_template_haskell(2,17,0)+            let inst1 = DataD [] name' [PlainTV f ()] Nothing [] []+#else+            let inst1 = DataD [] name' [PlainTV f] Nothing [] []+#endif+            tell [ExtraTopLevelDecs [inst1]]++            imageTypes <- lift $ getClosedTypeFamilyImage eqns+            inst2 <- lift $ [d|instance (Typeable g, TypeScript g) => TypeScript ($(conT name') g) where+                                 getTypeScriptType _ = $(TH.stringE $ nameBase name) <> "[" <> (getTypeScriptType (Proxy :: Proxy g)) <> "]"+                                 getTypeScriptDeclarations _ = [$(getClosedTypeFamilyInterfaceDecl name eqns)]+                                 getParentTypes _ = $(listE [ [|TSType (Proxy :: Proxy $(return x))|] | x <- imageTypes])+                            |]+            tell [ExtraTopLevelDecs inst2]++            tell [ExtraParentType (AppT (ConT name') (ConT ''T))]++            ret <- transformTypeFamilies eo (AppT (ConT name') typ)+            tell [ExtraConstraint (AppT (ConT ''TypeScript) ret)]+            return ret+transformTypeFamilies eo (AppT typ1 typ2) = AppT <$> transformTypeFamilies eo typ1 <*> transformTypeFamilies eo typ2+transformTypeFamilies eo (SigT typ kind) = flip SigT kind <$> transformTypeFamilies eo typ+transformTypeFamilies eo (InfixT typ1 n typ2) = InfixT <$> transformTypeFamilies eo typ1 <*> pure n <*> transformTypeFamilies eo typ2+transformTypeFamilies eo (UInfixT typ1 n typ2) = UInfixT <$> transformTypeFamilies eo typ1 <*> pure n <*> transformTypeFamilies eo typ2+transformTypeFamilies eo (ParensT typ) = ParensT <$> transformTypeFamilies eo typ+#if MIN_VERSION_template_haskell(2,15,0)+transformTypeFamilies eo (AppKindT typ kind) = flip AppKindT kind <$> transformTypeFamilies eo typ+transformTypeFamilies eo (ImplicitParamT s typ) = ImplicitParamT s <$> transformTypeFamilies eo typ+#endif+transformTypeFamilies _ typ = return typ

@@ -0,0 +1,70 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE LambdaCase #-}++module Data.Aeson.TypeScript.TypeManipulation (+  searchForConstraints+  , hasFreeTypeVariable+  , unifyGenericVariable+  ) where++import Control.Monad.Writer+import Data.Aeson.TypeScript.Types+import qualified Data.List as L+import Language.Haskell.TH++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif+++searchForConstraints :: ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q ()+searchForConstraints eo@(ExtraTypeScriptOptions {..}) (AppT (ConT name) typ) var+  | typ == VarT var && (name `L.elem` typeFamiliesToMapToTypeScript) = lift (reify name) >>= \case+      FamilyI (ClosedTypeFamilyD (TypeFamilyHead typeFamilyName _ _ _) _) _ -> do+        tell [GenericInfo var (TypeFamilyKey typeFamilyName)]+        searchForConstraints eo typ var+      FamilyI (OpenTypeFamilyD (TypeFamilyHead typeFamilyName _ _ _)) _ -> do+        tell [GenericInfo var (TypeFamilyKey typeFamilyName)]+        searchForConstraints eo typ var+      _ -> searchForConstraints eo typ var+  | otherwise = searchForConstraints eo typ var+searchForConstraints eo (AppT typ1 typ2) var = searchForConstraints eo typ1 var >> searchForConstraints eo typ2 var+searchForConstraints eo (SigT typ _) var = searchForConstraints eo typ var+searchForConstraints eo (InfixT typ1 _ typ2) var = searchForConstraints eo typ1 var >> searchForConstraints eo typ2 var+searchForConstraints eo (UInfixT typ1 _ typ2) var = searchForConstraints eo typ1 var >> searchForConstraints eo typ2 var+searchForConstraints eo (ParensT typ) var = searchForConstraints eo typ var+#if MIN_VERSION_template_haskell(2,15,0)+searchForConstraints eo (AppKindT typ _) var = searchForConstraints eo typ var+searchForConstraints eo (ImplicitParamT _ typ) var = searchForConstraints eo typ var+#endif+searchForConstraints _ _ _ = return ()++hasFreeTypeVariable :: Type -> Bool+hasFreeTypeVariable (VarT _) = True+hasFreeTypeVariable (AppT typ1 typ2) = hasFreeTypeVariable typ1 || hasFreeTypeVariable typ2+hasFreeTypeVariable (SigT typ _) = hasFreeTypeVariable typ+hasFreeTypeVariable (InfixT typ1 _ typ2) = hasFreeTypeVariable typ1 || hasFreeTypeVariable typ2+hasFreeTypeVariable (UInfixT typ1 _ typ2) = hasFreeTypeVariable typ1 || hasFreeTypeVariable typ2+hasFreeTypeVariable (ParensT typ) = hasFreeTypeVariable typ+#if MIN_VERSION_template_haskell(2,15,0)+hasFreeTypeVariable (AppKindT typ _) = hasFreeTypeVariable typ+hasFreeTypeVariable (ImplicitParamT _ typ) = hasFreeTypeVariable typ+#endif+hasFreeTypeVariable _ = False++unifyGenericVariable :: [GenericInfo] -> String+unifyGenericVariable genericInfos = case [nameBase name | GenericInfo _ (TypeFamilyKey name) <- genericInfos] of+  [] -> ""+  names -> " extends keyof " <> (L.intercalate " & " names)

@@ -1,4 +1,11 @@-{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, ExistentialQuantification, PolyKinds, StandaloneDeriving #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE StandaloneDeriving #-}  module Data.Aeson.TypeScript.Types where @@ -47,6 +54,10 @@   getTypeScriptType :: Proxy a -> String   -- ^ Get the type as a string. +  getTypeScriptKeyType :: Proxy a -> String+  getTypeScriptKeyType proxy = getTypeScriptType proxy+  -- ^ Get the key type as a string.+   getTypeScriptOptional :: Proxy a -> Bool   -- ^ Get a flag representing whether this type is optional.   getTypeScriptOptional _ = False@@ -160,14 +171,18 @@ allStarConstructors' :: [Name] allStarConstructors' = [''T1, ''T2, ''T3, ''T4, ''T5, ''T6, ''T7, ''T8, ''T9, ''T10] +allStarConstructors'' :: [String]+allStarConstructors'' = ["T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", "T10"]+ -- | Type variable gathering  data ExtraTypeScriptOptions = ExtraTypeScriptOptions {   typeFamiliesToMapToTypeScript :: [Name]+  , keyType :: Maybe String   }  defaultExtraTypeScriptOptions :: ExtraTypeScriptOptions-defaultExtraTypeScriptOptions = ExtraTypeScriptOptions []+defaultExtraTypeScriptOptions = ExtraTypeScriptOptions [] Nothing  data ExtraDeclOrGenericInfo = ExtraDecl Exp                             | ExtraGeneric GenericInfo

@@ -1,4 +1,15 @@-{-# LANGUAGE CPP, QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, ExistentialQuantification, FlexibleInstances, NamedFieldPuns, MultiWayIf, ViewPatterns, PolyKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PolyKinds #-}  module Data.Aeson.TypeScript.Util where @@ -18,6 +29,10 @@ import Data.Monoid #endif ++type Suffix = String+type Var = String+ getDataTypeVars :: DatatypeInfo -> [Type] #if MIN_VERSION_th_abstraction(0,3,0) getDataTypeVars (DatatypeInfo {datatypeInstTypes}) = datatypeInstTypes@@ -25,6 +40,13 @@ getDataTypeVars (DatatypeInfo {datatypeVars}) = datatypeVars #endif +coveredByDataTypeVars :: [Type] -> Type -> Bool+-- Don't include a type found in a constructor if it's already found as a datatype var+coveredByDataTypeVars dataTypeVars candidate | candidate `L.elem` dataTypeVars = True+-- Don't include a type found in a constructor if the version with a simple star kind signature is already present+coveredByDataTypeVars dataTypeVars candidate | (SigT candidate StarT) `L.elem` dataTypeVars = True+coveredByDataTypeVars _ _ = False+ setDataTypeVars :: DatatypeInfo -> [Type] -> DatatypeInfo #if MIN_VERSION_th_abstraction(0,3,0) setDataTypeVars dti@(DatatypeInfo {}) vars = dti { datatypeInstTypes = vars }@@ -56,7 +78,7 @@ -- In earlier versions, it has constructors getDatatypePredicate :: Type -> Pred #if MIN_VERSION_template_haskell(2,10,0)-getDatatypePredicate typ = AppT (ConT ''TypeScript) typ+getDatatypePredicate = AppT (ConT ''TypeScript) #else getDatatypePredicate typ = ClassP ''TypeScript [typ] #endif@@ -80,7 +102,7 @@ -- Between Aeson 1.1.2.0 and 1.2.0.0, tagSingleConstructors was added getTagSingleConstructors :: Options -> Bool #if MIN_VERSION_aeson(1,2,0)-getTagSingleConstructors options = tagSingleConstructors options+getTagSingleConstructors = tagSingleConstructors #else getTagSingleConstructors _ = False #endif@@ -92,8 +114,10 @@   -- Check that necessary language extensions are turned on   scopedTypeVariablesEnabled <- isExtEnabled ScopedTypeVariables   kindSignaturesEnabled <- isExtEnabled KindSignatures-  when (not scopedTypeVariablesEnabled) $ error [i|The ScopedTypeVariables extension is required; please enable it before calling deriveTypeScript. (For example: put {-\# LANGUAGE ScopedTypeVariables \#-} at the top of the file.)|]-  when ((not kindSignaturesEnabled) && (length datatypeVars > 0)) $ error [i|The KindSignatures extension is required since type #{datatypeName} is a higher order type; please enable it before calling deriveTypeScript. (For example: put {-\# LANGUAGE KindSignatures \#-} at the top of the file.)|]+  unless scopedTypeVariablesEnabled $+    error [i|The ScopedTypeVariables extension is required; please enable it before calling deriveTypeScript. (For example: put {-\# LANGUAGE ScopedTypeVariables \#-} at the top of the file.)|]+  unless (kindSignaturesEnabled || (L.null datatypeVars)) $+    error [i|The KindSignatures extension is required since type #{datatypeName} is a higher order type; please enable it before calling deriveTypeScript. (For example: put {-\# LANGUAGE KindSignatures \#-} at the top of the file.)|] #else assertExtensionsTurnedOn _ = return () #endif@@ -119,19 +143,19 @@ -- Between Template Haskell 2.10 and 2.11, InstanceD got an additional argument mkInstance :: Cxt -> Type -> [Dec] -> Dec #if MIN_VERSION_template_haskell(2,11,0)-mkInstance context typ decs = InstanceD Nothing context typ decs+mkInstance = InstanceD Nothing #else-mkInstance context typ decs = InstanceD context typ decs+mkInstance = InstanceD #endif -namesAndTypes :: Options -> ConstructorInfo -> [(String, Type)]-namesAndTypes options ci = case constructorVariant ci of+namesAndTypes :: Options -> [(Name, (Suffix, Var))] -> ConstructorInfo -> [(String, Type)]+namesAndTypes options genericVariables ci = case constructorVariant ci of   RecordConstructor names -> zip (fmap ((fieldLabelModifier options) . lastNameComponent') names) (constructorFields ci)   _ -> case sumEncoding options of     TaggedObject _ contentsFieldName       | isConstructorNullary ci -> []-      | otherwise -> [(contentsFieldName, contentsTupleType ci)]-    _ -> [(constructorNameToUse options ci, contentsTupleType ci)]+      | otherwise -> [(contentsFieldName, contentsTupleTypeSubstituted genericVariables ci)]+    _ -> [(constructorNameToUse options ci, contentsTupleTypeSubstituted genericVariables ci)]  constructorNameToUse :: Options -> ConstructorInfo -> String constructorNameToUse options ci = (constructorTagModifier options) $ lastNameComponent' (constructorName ci)@@ -139,22 +163,58 @@ -- | Get the type of a tuple of constructor fields, as when we're packing a record-less constructor into a list contentsTupleType :: ConstructorInfo -> Type contentsTupleType ci = let fields = constructorFields ci in-  case length fields of-    0 -> AppT ListT (ConT ''())-    1 -> head fields-    x -> applyToArgsT (ConT $ tupleTypeName x) fields+  case fields of+    [] -> AppT ListT (ConT ''())+    [x] -> x+    xs-> applyToArgsT (ConT $ tupleTypeName (L.length xs)) fields -getBracketsExpression :: Bool -> [(Name, String)] -> Q Exp+contentsTupleTypeSubstituted :: [(Name, (Suffix, Var))] -> ConstructorInfo -> Type+contentsTupleTypeSubstituted genericVariables ci = let fields = constructorFields ci in+  case fields of+    [] -> AppT ListT (ConT ''())+    [x] -> mapType genericVariables x+    xs -> applyToArgsT (ConT $ tupleTypeName (L.length xs)) (fmap (mapType genericVariables) xs)++mapType :: [(Name, (Suffix, Var))] -> Type -> Type+mapType g x@(VarT name) = tryPromote x g name+mapType g x@(ConT name) = tryPromote x g name+mapType g x@(PromotedT name) = tryPromote x g name+mapType g (AppT typ1 typ2) = AppT (mapType g typ1) (mapType g typ2)+mapType g (SigT typ x) = SigT (mapType g typ) x+mapType g (InfixT typ1 x typ2) = InfixT (mapType g typ1) x (mapType g typ2)+mapType g (UInfixT typ1 x typ2) = UInfixT (mapType g typ1) x (mapType g typ2)+mapType g (ParensT typ) = ParensT (mapType g typ)+#if MIN_VERSION_template_haskell(2,15,0)+mapType g (AppKindT typ x) = AppKindT (mapType g typ) x+mapType g (ImplicitParamT x typ) = ImplicitParamT x (mapType g typ)+#endif+mapType _ x = x++tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "")) = ConT ''T+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T")) = ConT ''T+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T1")) = ConT ''T1+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T2")) = ConT ''T2+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T3")) = ConT ''T3+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T4")) = ConT ''T4+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T5")) = ConT ''T5+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T6")) = ConT ''T6+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T7")) = ConT ''T7+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T8")) = ConT ''T8+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T9")) = ConT ''T9+tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T10")) = ConT ''T10+tryPromote x _ _ = x++getBracketsExpression :: Bool -> [(Name, (Suffix, Var))] -> Q Exp getBracketsExpression _ [] = [|""|] getBracketsExpression includeSuffix names =   [|let vars = $(genericVariablesListExpr includeSuffix names) in "<" <> L.intercalate ", " vars <> ">"|] -getBracketsExpressionAllTypesNoSuffix :: [(Name, String)] -> Q Exp+getBracketsExpressionAllTypesNoSuffix :: [(Name, (Suffix, Var))] -> Q Exp getBracketsExpressionAllTypesNoSuffix [] = [|""|]-getBracketsExpressionAllTypesNoSuffix names = [|"<" <> L.intercalate ", " $(listE [ [|(getTypeScriptType (Proxy :: Proxy $(varT x)))|] | (x, _suffix) <- names]) <> ">"|]+getBracketsExpressionAllTypesNoSuffix names = [|"<" <> L.intercalate ", " $(listE [ [|(getTypeScriptType (Proxy :: Proxy $(varT x)))|] | (x, (_suffix, _)) <- names]) <> ">"|] -genericVariablesListExpr :: Bool -> [(Name, String)] -> Q Exp-genericVariablesListExpr includeSuffix genericVariables = listE (fmap (\((_, suffix), correspondingGeneric) ->+genericVariablesListExpr :: Bool -> [(Name, (Suffix, Var))] -> Q Exp+genericVariablesListExpr includeSuffix genericVariables = listE (fmap (\((_, (suffix, _)), correspondingGeneric) ->   [|(getTypeScriptType (Proxy :: Proxy $(return correspondingGeneric))) <> $(TH.stringE (if includeSuffix then suffix else ""))|])   (case genericVariables of       [x] -> [(x, ConT ''T)]

@@ -0,0 +1,91 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++module ClosedTypeFamilies (tests) where++import Data.Aeson as A+import Data.Aeson.TypeScript.Recursive+import Data.Aeson.TypeScript.TH+import Data.Aeson.TypeScript.Types+import Data.Functor.Identity+import Data.Proxy+import Data.String.Interpolate+import qualified Data.Text as T+import Prelude hiding (Double)+import Test.Hspec+import TestBoilerplate+++type family DeployEnvironment env = result | result -> env where+  DeployEnvironment SingleNodeEnvironment = SingleDE+  DeployEnvironment K8SEnvironment = K8SDE+  DeployEnvironment T = ()+data UserT env f = User {+  _userUsername :: Columnar f T.Text+  , _userCreatedAt  :: Columnar f Int+  , _userDeployEnvironment  :: Columnar f (DeployEnvironment env)+  }+$(deriveTypeScript' A.defaultOptions ''UserT (defaultExtraTypeScriptOptions { typeFamiliesToMapToTypeScript = [''DeployEnvironment] }))++type family DeployEnvironment2 env = result | result -> env where+  DeployEnvironment2 SingleNodeEnvironment = SingleDE+  DeployEnvironment2 K8SEnvironment = K8SDE+  DeployEnvironment2 T = ()+newtype Simple env = Simple (DeployEnvironment2 env)+$(deriveTypeScript' A.defaultOptions ''Simple (defaultExtraTypeScriptOptions { typeFamiliesToMapToTypeScript = [''DeployEnvironment2] }))++tests :: SpecWith ()+tests = describe "Closed type families" $ do+  describe "simple newtype" $ do+    it [i|makes the declaration and types correctly|] $ do+      (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Simple T))) `shouldBe` ([+        TSInterfaceDeclaration "DeployEnvironment2" [] [+          TSField False "\"k8s_env\"" "\"k8s\""+          , TSField False "\"single_node_env\"" "\"single\""+          , TSField False "T" "void"+          ]+        , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] ["DeployEnvironment2[T]"]+        , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] ["ISimple<T>"]+        ])++  describe "Complicated Beam-like user type" $ do+    it [i|makes the declaration and types correctly|] $ do+      (getTypeScriptDeclarations (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([+        TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser<T>"]+        , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [+            TSField False "_userUsername" "string"+            , TSField False "_userCreatedAt" "number"+            , TSField False "_userDeployEnvironment" "DeployEnvironment[T]"+            ]+        ])++    it [i|get the declarations recursively|] $ do+      (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([+        TSInterfaceDeclaration "DeployEnvironment" [] [+          TSField False "\"k8s_env\"" "\"k8s\""+          , TSField False "\"single_node_env\"" "\"single\""+          , TSField False "T" "void"+          ]+        , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [+            TSField False "_userUsername" "string"+            , TSField False "_userCreatedAt" "number"+            , TSField False "_userDeployEnvironment" "DeployEnvironment[T]"+            ]+        , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser<T>"]+        ])++main :: IO ()+main = hspec tests

@@ -0,0 +1,82 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++module Generic (tests) where++import Data.Aeson as A+import Data.Aeson.TypeScript.Recursive+import Data.Aeson.TypeScript.TH+import Data.Aeson.TypeScript.Types+import Data.Map+import Data.Proxy+import Data.String.Interpolate+import Data.Text+import Prelude hiding (Double)+import Test.Hspec+++data Complex a = Product Int a | Unary Int+$(deriveTypeScript defaultOptions ''Complex)++data Complex2 a = Product2 Int a+$(deriveTypeScript (defaultOptions { sumEncoding = UntaggedValue }) ''Complex2)++data Complex3 k = Product3 { record3 :: [k] }+$(deriveTypeScript defaultOptions ''Complex3)++data Complex4 k = Product4 { record4 :: Map Text k }+$(deriveTypeScript defaultOptions ''Complex4)++tests :: SpecWith ()+tests = describe "Generic instances" $ do+  it [i|Complex makes the declaration and types correctly|] $ do+    (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex String))) `shouldBe` [+      TSInterfaceDeclaration {interfaceName = "IProduct", interfaceGenericVariables = ["T"], interfaceMembers = [TSField {fieldOptional = False, fieldName = "tag", fieldType = "\"Product\""},TSField {fieldOptional = False, fieldName = "contents", fieldType = "[number, T]"}]}+      ,TSInterfaceDeclaration {interfaceName = "IUnary", interfaceGenericVariables = ["T"], interfaceMembers = [TSField {fieldOptional = False, fieldName = "tag", fieldType = "\"Unary\""},TSField {fieldOptional = False, fieldName = "contents", fieldType = "number"}]}+      ,TSTypeAlternatives {typeName = "Complex", typeGenericVariables = ["T"], alternativeTypes = ["IProduct<T>","IUnary<T>"]}+      ]++  it [i|Complex2 makes the declaration and types correctly|] $ do+    (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex2 String))) `shouldBe` [+      TSTypeAlternatives {typeName = "Complex2", typeGenericVariables = ["T"], alternativeTypes = ["IProduct2<T>"]}+      ,TSTypeAlternatives {typeName = "IProduct2", typeGenericVariables = ["T"], alternativeTypes = ["[number, T]"]}+      ]++  it [i|Complex3 makes the declaration and types correctly|] $ do+    (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex3 String))) `shouldBe` [+      TSInterfaceDeclaration {interfaceName = "IProduct3", interfaceGenericVariables = ["T"], interfaceMembers = [+                                 TSField {fieldOptional = False, fieldName = "record3", fieldType = "T[]"}+                                 ]}+      ,TSTypeAlternatives {typeName = "Complex3", typeGenericVariables = ["T"], alternativeTypes = ["IProduct3<T>"]}+      ]++    (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex3 Int))) `shouldBe` [+      TSInterfaceDeclaration {interfaceName = "IProduct3", interfaceGenericVariables = ["T"], interfaceMembers = [+                                 TSField {fieldOptional = False, fieldName = "record3", fieldType = "T[]"}+                                 ]}+      ,TSTypeAlternatives {typeName = "Complex3", typeGenericVariables = ["T"], alternativeTypes = ["IProduct3<T>"]}+      ]++  it [i|Complex4 makes the declaration and types correctly|] $ do+    (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex4 String))) `shouldBe` [+      TSInterfaceDeclaration {interfaceName = "IProduct4", interfaceGenericVariables = ["T"], interfaceMembers = [+                                 TSField {fieldOptional = False, fieldName = "record4", fieldType = "{[k in string]?: T}"}+                                 ]}+      ,TSTypeAlternatives {typeName = "Complex4", typeGenericVariables = ["T"], alternativeTypes = ["IProduct4<T>"]}+      ]++main :: IO ()+main = hspec tests

@@ -1,73 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Live where--import Data.Aeson as A-import Data.Aeson.TypeScript.Recursive-import Data.Aeson.TypeScript.TH-import Data.Function-import Data.Functor.Identity-import Data.Kind-import Data.Proxy-import Data.String.Interpolate-import qualified Data.Text as T-import Prelude hiding (Double)---instance TypeScript Identity where getTypeScriptType _ = "any"--data SingleDE = SingleDE-instance TypeScript SingleDE where getTypeScriptType _ = [i|"single"|]--data K8SDE = K8SDE-instance TypeScript K8SDE where getTypeScriptType _ = [i|"k8s"|]--data SingleNodeEnvironment = SingleNodeEnvironment-  deriving (Eq, Show)-instance TypeScript SingleNodeEnvironment where getTypeScriptType _ = [i|"single_node_env"|]-                                  -data K8SEnvironment = K8SEnvironment-  deriving (Eq, Show)-instance TypeScript K8SEnvironment where getTypeScriptType _ = [i|"k8s_env"|]--data Nullable (c :: Type -> Type) x-data Exposed x-type family Columnar (f :: Type -> Type) x where-    Columnar Exposed x = Exposed x-    Columnar Identity x = x-    Columnar (Nullable c) x = Columnar c (Maybe x)-    Columnar f x = f x--type family DeployEnvironment env = result | result -> env where-  DeployEnvironment SingleNodeEnvironment = SingleDE-  DeployEnvironment K8SEnvironment = K8SDE-  DeployEnvironment T = ()---- * The main type--data UserT env f = User {-  _userUsername :: Columnar f T.Text-  , _userCreatedAt  :: Columnar f Int-  , _userDeployEnvironment  :: Columnar f (DeployEnvironment env)-  }--$(deriveTypeScript' A.defaultOptions ''UserT (ExtraTypeScriptOptions [''DeployEnvironment]))--main :: IO ()-main = getTypeScriptDeclarationsRecursively (Proxy :: Proxy (UserT T Identity))-     & formatTSDeclarations-     & putStrLn

@@ -1,28 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeFamilyDependencies #-}--module Live2 where--import Data.Aeson as A-import Data.Aeson.TypeScript.TH-import Data.Function-import Data.Proxy--       -data TestT a = TestT {-  listOfA :: [a]-  , maybeA :: Maybe a-  }-$(deriveTypeScript A.defaultOptions ''TestT)--main :: IO ()-main = getTypeScriptDeclarations (Proxy :: Proxy (TestT Int))-     & formatTSDeclarations-     & putStrLn

@@ -1,32 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeFamilies #-}--module LiveLogging where--import Data.Kind-import Prelude hiding (Double)---data LoggingSource = SGeneral--data LoggingSourceTagged s where-  General :: LoggingSourceTagged 'SGeneral--type family ParamsFamily (q :: LoggingSource) :: Type where-  ParamsFamily 'SGeneral = String--data HigherKindWithTypeFamily s = TapMessageParams { params :: ParamsFamily s }--- $(deriveTypeScript A.defaultOptions ''HigherKindWithTypeFamily)---- main = do---   putStrLn $(stringE . pprint =<< (deriveTypeScript A.defaultOptions ''TestT))

@@ -1,17 +1,17 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module NoOmitNothingFields (main, tests) where+module NoOmitNothingFields (allTests) where  import Data.Aeson as A import Data.Aeson.TypeScript.TH@@ -20,21 +20,24 @@ import Test.Hspec import TestBoilerplate -$(testDeclarations "NoOmitNothingFields" (A.defaultOptions {omitNothingFields=False}))+$(testDeclarations "NoOmitNothingFields" (A.defaultOptions {omitNothingFields = False})) -main :: IO ()-main = hspec $ describe "NoOmitNothingFields" $ do+allTests :: SpecWith ()+allTests = describe "NoOmitNothingFields" $ do   it "encodes as expected" $ do     let decls = getTypeScriptDeclarations (Proxy :: Proxy Optional) -    decls `shouldBe` [TSInterfaceDeclaration {-                         interfaceName = "Optional"+    decls `shouldBe` [TSTypeAlternatives {+                         typeName = "Optional"+                         , typeGenericVariables = []+                         , alternativeTypes = ["IOptional"]+                         }+                     , TSInterfaceDeclaration {+                         interfaceName = "IOptional"                          , interfaceGenericVariables = []-                         , interfaceMembers = [-                             TSField {fieldOptional = False-                                     , fieldName = "optionalInt"-                                     , fieldType = "number | null"}-                             ]+                         , interfaceMembers = [TSField {fieldOptional = False+                                                       , fieldName = "optionalInt"+                                                       , fieldType = "number | null"}]                          }]    tests

@@ -0,0 +1,91 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++module OpenTypeFamilies (tests) where++import Data.Aeson as A+import Data.Aeson.TypeScript.Recursive+import Data.Aeson.TypeScript.TH+import Data.Aeson.TypeScript.Types+import Data.Functor.Identity+import Data.Proxy+import Data.String.Interpolate+import qualified Data.Text as T+import Prelude hiding (Double)+import Test.Hspec+import TestBoilerplate+++type family DeployEnvironment env = result | result -> env+type instance DeployEnvironment SingleNodeEnvironment = SingleDE+type instance DeployEnvironment K8SEnvironment = K8SDE+type instance DeployEnvironment T = ()+data UserT env f = User {+  _userUsername :: Columnar f T.Text+  , _userCreatedAt  :: Columnar f Int+  , _userDeployEnvironment  :: Columnar f (DeployEnvironment env)+  }+$(deriveTypeScript' A.defaultOptions ''UserT (defaultExtraTypeScriptOptions { typeFamiliesToMapToTypeScript = [''DeployEnvironment] }))++type family DeployEnvironment2 env = result | result -> env+type instance DeployEnvironment2 SingleNodeEnvironment = SingleDE+type instance DeployEnvironment2 K8SEnvironment = K8SDE+type instance DeployEnvironment2 T = ()+newtype Simple env = Simple (DeployEnvironment2 env)+$(deriveTypeScript' A.defaultOptions ''Simple (defaultExtraTypeScriptOptions { typeFamiliesToMapToTypeScript = [''DeployEnvironment2] }))++tests :: SpecWith ()+tests = describe "Open type families" $ do+  describe "simple newtype" $ do+    it [i|makes the declaration and types correctly|] $ do+      (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Simple T))) `shouldBe` ([+        TSInterfaceDeclaration "DeployEnvironment2" [] [+          TSField False "\"single_node_env\"" "\"single\""+          , TSField False "\"k8s_env\"" "\"k8s\""+          , TSField False "T" "void"+          ]+        , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] ["DeployEnvironment2[T]"]+        , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] ["ISimple<T>"]+        ])++  describe "Complicated Beam-like user type" $ do+    it [i|makes the declaration and types correctly|] $ do+      (getTypeScriptDeclarations (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([+        TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser<T>"]+        , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [+            TSField False "_userUsername" "string"+            , TSField False "_userCreatedAt" "number"+            , TSField False "_userDeployEnvironment" "DeployEnvironment[T]"+            ]+        ])++    it [i|get the declarations recursively|] $ do+      (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([+        TSInterfaceDeclaration "DeployEnvironment" [] [+          TSField False "\"single_node_env\"" "\"single\""+          , TSField False "\"k8s_env\"" "\"k8s\""+          , TSField False "T" "void"+          ]+        , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [+            TSField False "_userUsername" "string"+            , TSField False "_userCreatedAt" "number"+            , TSField False "_userDeployEnvironment" "DeployEnvironment[T]"+            ]+        , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser<T>"]+        ])++main :: IO ()+main = hspec tests

@@ -4,8 +4,9 @@ import Test.Hspec  import qualified Formatting+import qualified Generic import qualified HigherKind-import qualified TypeFamilies+import qualified ClosedTypeFamilies  import qualified ObjectWithSingleFieldNoTagSingleConstructors import qualified ObjectWithSingleFieldTagSingleConstructors@@ -17,13 +18,15 @@ import qualified UntaggedTagSingleConstructors import qualified OmitNothingFields import qualified NoOmitNothingFields+import qualified UnwrapUnaryRecords   main :: IO () main = hspec $ do   Formatting.tests+  Generic.tests   HigherKind.tests-  TypeFamilies.tests+  ClosedTypeFamilies.tests    ObjectWithSingleFieldTagSingleConstructors.tests   ObjectWithSingleFieldNoTagSingleConstructors.tests@@ -34,4 +37,5 @@   UntaggedTagSingleConstructors.tests   UntaggedNoTagSingleConstructors.tests   OmitNothingFields.tests-  NoOmitNothingFields.tests+  NoOmitNothingFields.allTests+  UnwrapUnaryRecords.allTests

@@ -1,91 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}--module TypeFamilies (tests) where--import Data.Aeson as A-import Data.Aeson.TypeScript.Recursive-import Data.Aeson.TypeScript.TH-import Data.Aeson.TypeScript.Types-import Data.Functor.Identity-import Data.Proxy-import Data.String.Interpolate-import qualified Data.Text as T-import Prelude hiding (Double)-import Test.Hspec-import TestBoilerplate---type family DeployEnvironment env = result | result -> env where-  DeployEnvironment SingleNodeEnvironment = SingleDE-  DeployEnvironment K8SEnvironment = K8SDE-  DeployEnvironment T = ()-data UserT env f = User {-  _userUsername :: Columnar f T.Text-  , _userCreatedAt  :: Columnar f Int-  , _userDeployEnvironment  :: Columnar f (DeployEnvironment env)-  }-$(deriveTypeScript' A.defaultOptions ''UserT (ExtraTypeScriptOptions [''DeployEnvironment]))--type family DeployEnvironment2 env = result | result -> env where-  DeployEnvironment2 SingleNodeEnvironment = SingleDE-  DeployEnvironment2 K8SEnvironment = K8SDE-  DeployEnvironment2 T = ()-newtype Simple env = Simple (DeployEnvironment2 env)-$(deriveTypeScript' A.defaultOptions ''Simple (ExtraTypeScriptOptions [''DeployEnvironment2]))--tests :: SpecWith ()-tests = describe "Type families" $ do-  describe "simple newtype" $ do-    it [i|makes the declaration and types correctly|] $ do-      (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Simple T))) `shouldBe` ([-        TSInterfaceDeclaration "DeployEnvironment2" [] [-          TSField False "\"single_node_env\"" "\"single\""-          , TSField False "\"k8s_env\"" "\"k8s\""-          , TSField False "T" "void"-          ]-        , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] ["DeployEnvironment2[T]"]-        , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] ["ISimple<T>"]-        ])--  describe "Complicated Beam-like user type" $ do-    it [i|makes the declaration and types correctly|] $ do-      (getTypeScriptDeclarations (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([-        TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser<T>"]-        , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [-            TSField False "_userUsername" "string"-            , TSField False "_userCreatedAt" "number"-            , TSField False "_userDeployEnvironment" "DeployEnvironment[T]"-            ]-        ])--    it [i|get the declarations recursively|] $ do-      (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([-        TSInterfaceDeclaration "DeployEnvironment" [] [-          TSField False "\"single_node_env\"" "\"single\""-          , TSField False "\"k8s_env\"" "\"k8s\""-          , TSField False "T" "void"-          ]-        , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [-            TSField False "_userUsername" "string"-            , TSField False "_userCreatedAt" "number"-            , TSField False "_userDeployEnvironment" "DeployEnvironment[T]"-            ]-        , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser<T>"]-        ])--main :: IO ()-main = hspec tests

@@ -0,0 +1,46 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module UnwrapUnaryRecords (allTests) where++import Data.Aeson as A+import Data.Aeson.TypeScript.TH+import Data.Aeson.TypeScript.Types+import Data.Proxy+import Test.Hspec+import TestBoilerplate+++#if MIN_VERSION_aeson(0,10,0)+$(testDeclarations "UnwrapUnaryRecords" (A.defaultOptions {unwrapUnaryRecords = True}))++allTests :: SpecWith ()+allTests = describe "UnwrapUnaryRecords" $ do+  it "encodes as expected" $ do+    let decls = getTypeScriptDeclarations (Proxy :: Proxy OneField)++    decls `shouldBe` [+      TSTypeAlternatives {typeName = "OneField", typeGenericVariables = [], alternativeTypes = ["IOneField"]}+      ,TSTypeAlternatives {typeName = "IOneField", typeGenericVariables = [], alternativeTypes = ["string"]}+      ]++  tests+#else+tests :: SpecWith ()+tests = describe "UnwrapUnaryRecords" $ it "tests are disabled for this Aeson version" $ 2 `shouldBe` 2++allTests = tests+#endif++-- main :: IO ()+-- main = hspec allTests