{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}

{-|
Module:      Data.Aeson.TypeScript.TH
Copyright:   (c) 2022 Tom McLaughlin
License:     BSD3
Stability:   experimental
Portability: portable

This library provides a way to generate TypeScript @.d.ts@ files that match your existing Aeson 'A.ToJSON' instances.
If you already use Aeson's Template Haskell support to derive your instances, then deriving TypeScript is as simple as

@
$('deriveTypeScript' myAesonOptions ''MyType)
@

For example,

@
data D a = Nullary
         | Unary Int
         | Product String Char a
         | Record { testOne   :: Double
                  , testTwo   :: Bool
                  , testThree :: D a
                  } deriving Eq
@

Next we derive the necessary instances.

@
$('deriveTypeScript' ('defaultOptions' {'fieldLabelModifier' = 'drop' 4, 'constructorTagModifier' = map toLower}) ''D)
@

Now we can use the newly created instances.

@
>>> putStrLn $ 'formatTSDeclarations' $ 'getTypeScriptDeclarations' (Proxy :: Proxy (D T))

type D\<T\> = INullary\<T\> | IUnary\<T\> | IProduct\<T\> | IRecord\<T\>;

interface INullary\<T\> {
  tag: "nullary";
}

interface IUnary\<T\> {
  tag: "unary";
  contents: number;
}

interface IProduct\<T\> {
  tag: "product";
  contents: [string, string, T];
}

interface IRecord\<T\> {
  tag: "record";
  One: number;
  Two: boolean;
  Three: D\<T\>;
}
@

It's important to make sure your JSON and TypeScript are being derived with the same options. For this reason, we
include the convenience 'HasJSONOptions' typeclass, which lets you write the options only once, like this:

@
instance HasJSONOptions MyType where getJSONOptions _ = ('defaultOptions' {'fieldLabelModifier' = 'drop' 4})

$('deriveJSON' ('getJSONOptions' (Proxy :: Proxy MyType)) ''MyType)
$('deriveTypeScript' ('getJSONOptions' (Proxy :: Proxy MyType)) ''MyType)
@

Or, if you want to be even more concise and don't mind defining the instances in the same file,

@
myOptions = 'defaultOptions' {'fieldLabelModifier' = 'drop' 4}

$('deriveJSONAndTypeScript' myOptions ''MyType)
@

Remembering that the Template Haskell 'Q' monad is an ordinary monad, you can derive instances for several types at once like this:

@
$('mconcat' \<$\> 'traverse' ('deriveJSONAndTypeScript' myOptions) [''MyType1, ''MyType2, ''MyType3])
@

Once you've defined all necessary instances, you can write a main function to dump them out into a @.d.ts@ file. For example:

@
main = putStrLn $ 'formatTSDeclarations' (
  ('getTypeScriptDeclarations' (Proxy :: Proxy MyType1)) <>
  ('getTypeScriptDeclarations' (Proxy :: Proxy MyType2)) <>
  ...
)
@

-}

module Data.Aeson.TypeScript.TH (
  deriveTypeScript
  , deriveTypeScript'
  , deriveTypeScriptLookupType

  -- * The main typeclass
  , TypeScript(..)
  , TSType(..)

  , TSDeclaration(TSRawDeclaration)

  -- * Formatting declarations
  , formatTSDeclarations
  , formatTSDeclarations'
  , formatTSDeclaration
  , FormattingOptions(..)
  , defaultFormattingOptions
  , defaultNameFormatter
  , SumTypeFormat(..)
  , ExportMode(..)

  -- * Advanced options
  , defaultExtraTypeScriptOptions
  , keyType
  , typeFamiliesToMapToTypeScript
  , ExtraTypeScriptOptions

  -- * Convenience tools
  , HasJSONOptions(..)
  , deriveJSONAndTypeScript
  , deriveJSONAndTypeScript'

  , T(..)
  , T1(..)
  , T2(..)
  , T3(..)
  , T4(..)
  , T5(..)
  , T6(..)
  , T7(..)
  , T8(..)
  , T9(..)
  , T10(..)

  , module Data.Aeson.TypeScript.Instances
  ) where

import Control.Monad
import Control.Monad.Writer
import Data.Aeson as A
import Data.Aeson.TH as A
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 Data.Maybe
import Data.Proxy
import Data.String.Interpolate
import Language.Haskell.TH hiding (stringE)
import Language.Haskell.TH.Datatype
import qualified Language.Haskell.TH.Lib as TH

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif

-- | Generates a 'TypeScript' instance declaration for the given data type.
deriveTypeScript' :: Options
                  -- ^ Encoding options.
                  -> Name
                  -- ^ Name of the type for which to generate a 'TypeScript' instance declaration.
                  -> ExtraTypeScriptOptions
                  -- ^ Extra options to control advanced features.
                  -> Q [Dec]
deriveTypeScript' :: Options -> Name -> ExtraTypeScriptOptions -> Q [Dec]
deriveTypeScript' Options
options Name
name ExtraTypeScriptOptions
extraOptions = do
  DatatypeInfo
datatypeInfo' <- Name -> Q DatatypeInfo
reifyDatatype Name
name
  DatatypeInfo -> Q ()
assertExtensionsTurnedOn DatatypeInfo
datatypeInfo'

  -- Figure out what the generic variables are
  let eligibleGenericVars :: [Name]
eligibleGenericVars = [Maybe Name] -> [Name]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Name] -> [Name]) -> [Maybe Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ((Type -> Maybe Name) -> [Type] -> [Maybe Name])
-> [Type] -> (Type -> Maybe Name) -> [Maybe Name]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Type -> Maybe Name) -> [Type] -> [Maybe Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DatatypeInfo -> [Type]
getDataTypeVars DatatypeInfo
datatypeInfo') ((Type -> Maybe Name) -> [Maybe Name])
-> (Type -> Maybe Name) -> [Maybe Name]
forall a b. (a -> b) -> a -> b
$ \case
        SigT (VarT Name
n) Type
StarT -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
        Type
_ -> Maybe Name
forall a. Maybe a
Nothing
  let varsAndTVars :: [(Name, String)]
varsAndTVars = case [Name]
eligibleGenericVars of
        [] -> []
        [Name
x] -> [(Name
x, String
"T")]
        [Name]
xs -> [Name] -> [String] -> [(Name, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
xs [String]
allStarConstructors''
  [(Name, (String, String))]
genericVariablesAndSuffixes <- [(Name, String)]
-> ((Name, String) -> Q (Name, (String, String)))
-> Q [(Name, (String, String))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, String)]
varsAndTVars (((Name, String) -> Q (Name, (String, String)))
 -> Q [(Name, (String, String))])
-> ((Name, String) -> Q (Name, (String, String)))
-> Q [(Name, (String, String))]
forall a b. (a -> b) -> a -> b
$ \(Name
var, String
tvar) -> do
    (()
_, [GenericInfo]
genericInfos) <- WriterT [GenericInfo] Q () -> Q ((), [GenericInfo])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [GenericInfo] Q () -> Q ((), [GenericInfo]))
-> WriterT [GenericInfo] Q () -> Q ((), [GenericInfo])
forall a b. (a -> b) -> a -> b
$ [ConstructorInfo]
-> (ConstructorInfo -> WriterT [GenericInfo] Q ())
-> WriterT [GenericInfo] Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
datatypeInfo') ((ConstructorInfo -> WriterT [GenericInfo] Q ())
 -> WriterT [GenericInfo] Q ())
-> (ConstructorInfo -> WriterT [GenericInfo] Q ())
-> WriterT [GenericInfo] Q ()
forall a b. (a -> b) -> a -> b
$ \ConstructorInfo
ci ->
      [(Name, String, Type)]
-> ((Name, String, Type) -> WriterT [GenericInfo] Q ())
-> WriterT [GenericInfo] Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Options
-> [(Name, (String, String))]
-> ConstructorInfo
-> [(Name, String, Type)]
namesAndTypes Options
options [] ConstructorInfo
ci) (((Name, String, Type) -> WriterT [GenericInfo] Q ())
 -> WriterT [GenericInfo] Q ())
-> ((Name, String, Type) -> WriterT [GenericInfo] Q ())
-> WriterT [GenericInfo] Q ()
forall a b. (a -> b) -> a -> b
$ \(Name
_, String
_, Type
typ) -> do
        ExtraTypeScriptOptions
-> Type -> Name -> WriterT [GenericInfo] Q ()
searchForConstraints ExtraTypeScriptOptions
extraOptions Type
typ Name
var
    (Name, (String, String)) -> Q (Name, (String, String))
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
var, ([GenericInfo] -> String
unifyGenericVariable [GenericInfo]
genericInfos, String
tvar))

  -- Plug in generic variables and de-family-ify
  ((\[ConstructorInfo]
x -> (DatatypeInfo
datatypeInfo' { datatypeCons = x })) -> DatatypeInfo
dti, [ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfosInitial) <- WriterT [ExtraDeclOrGenericInfo] Q [ConstructorInfo]
-> Q ([ConstructorInfo], [ExtraDeclOrGenericInfo])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [ExtraDeclOrGenericInfo] Q [ConstructorInfo]
 -> Q ([ConstructorInfo], [ExtraDeclOrGenericInfo]))
-> WriterT [ExtraDeclOrGenericInfo] Q [ConstructorInfo]
-> Q ([ConstructorInfo], [ExtraDeclOrGenericInfo])
forall a b. (a -> b) -> a -> b
$ [ConstructorInfo]
-> (ConstructorInfo
    -> WriterT [ExtraDeclOrGenericInfo] Q ConstructorInfo)
-> WriterT [ExtraDeclOrGenericInfo] Q [ConstructorInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
datatypeInfo') ((ConstructorInfo
  -> WriterT [ExtraDeclOrGenericInfo] Q ConstructorInfo)
 -> WriterT [ExtraDeclOrGenericInfo] Q [ConstructorInfo])
-> (ConstructorInfo
    -> WriterT [ExtraDeclOrGenericInfo] Q ConstructorInfo)
-> WriterT [ExtraDeclOrGenericInfo] Q [ConstructorInfo]
forall a b. (a -> b) -> a -> b
$ \ConstructorInfo
ci ->
    ((\[Type]
x -> ConstructorInfo
ci { constructorFields = x }) ([Type] -> ConstructorInfo)
-> WriterT [ExtraDeclOrGenericInfo] Q [Type]
-> WriterT [ExtraDeclOrGenericInfo] Q ConstructorInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (WriterT [ExtraDeclOrGenericInfo] Q [Type]
 -> WriterT [ExtraDeclOrGenericInfo] Q ConstructorInfo)
-> WriterT [ExtraDeclOrGenericInfo] Q [Type]
-> WriterT [ExtraDeclOrGenericInfo] Q ConstructorInfo
forall a b. (a -> b) -> a -> b
$ [Type]
-> (Type -> WriterT [ExtraDeclOrGenericInfo] Q Type)
-> WriterT [ExtraDeclOrGenericInfo] Q [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ConstructorInfo -> [Type]
constructorFields ConstructorInfo
ci) ((Type -> WriterT [ExtraDeclOrGenericInfo] Q Type)
 -> WriterT [ExtraDeclOrGenericInfo] Q [Type])
-> (Type -> WriterT [ExtraDeclOrGenericInfo] Q Type)
-> WriterT [ExtraDeclOrGenericInfo] Q [Type]
forall a b. (a -> b) -> a -> b
$
      ExtraTypeScriptOptions
-> Type -> WriterT [ExtraDeclOrGenericInfo] Q Type
transformTypeFamilies ExtraTypeScriptOptions
extraOptions (Type -> WriterT [ExtraDeclOrGenericInfo] Q Type)
-> (Type -> Type)
-> Type
-> WriterT [ExtraDeclOrGenericInfo] Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, (String, String))] -> Type -> Type
mapType [(Name, (String, String))]
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 [Type]
constructorPreds :: [Pred] = [Type -> Type -> Type
AppT (Name -> Type
ConT ''TypeScript) Type
x | Type
x <- [[Type]] -> [Type]
forall a. Monoid a => [a] -> a
mconcat ([[Type]] -> [Type]) -> [[Type]] -> [Type]
forall a b. (a -> b) -> a -> b
$ (ConstructorInfo -> [Type]) -> [ConstructorInfo] -> [[Type]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorInfo -> [Type]
constructorFields (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
dti)
                                                               , Type -> Bool
hasFreeTypeVariable Type
x
                                                               , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Type] -> Type -> Bool
coveredByDataTypeVars (DatatypeInfo -> [Type]
getDataTypeVars DatatypeInfo
dti) Type
x
                                                               ]
  let [Type]
constructorPreds' :: [Pred] = [Type -> Type -> Type
AppT (Name -> Type
ConT ''TypeScript) Type
x | Type
x <- [[Type]] -> [Type]
forall a. Monoid a => [a] -> a
mconcat ([[Type]] -> [Type]) -> [[Type]] -> [Type]
forall a b. (a -> b) -> a -> b
$ (ConstructorInfo -> [Type]) -> [ConstructorInfo] -> [[Type]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorInfo -> [Type]
constructorFields (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
datatypeInfo')
                                                                , Type -> Bool
hasFreeTypeVariable Type
x
                                                                , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Type] -> Type -> Bool
coveredByDataTypeVars (DatatypeInfo -> [Type]
getDataTypeVars DatatypeInfo
dti) Type
x
                                                                ]
  let [Type]
typeVariablePreds :: [Pred] = [Type -> Type -> Type
AppT (Name -> Type
ConT ''TypeScript) Type
x | Type
x <- DatatypeInfo -> [Type]
getDataTypeVars DatatypeInfo
dti]

  -- Build the declarations
  ([Exp]
types, ([ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfosInitial [ExtraDeclOrGenericInfo]
-> [ExtraDeclOrGenericInfo] -> [ExtraDeclOrGenericInfo]
forall a. Semigroup a => a -> a -> a
<>) -> [ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfos) <- WriterT [ExtraDeclOrGenericInfo] Q [Exp]
-> Q ([Exp], [ExtraDeclOrGenericInfo])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [ExtraDeclOrGenericInfo] Q [Exp]
 -> Q ([Exp], [ExtraDeclOrGenericInfo]))
-> WriterT [ExtraDeclOrGenericInfo] Q [Exp]
-> Q ([Exp], [ExtraDeclOrGenericInfo])
forall a b. (a -> b) -> a -> b
$ (ConstructorInfo -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> [ConstructorInfo] -> WriterT [ExtraDeclOrGenericInfo] Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ExtraTypeScriptOptions
-> Options
-> DatatypeInfo
-> [(Name, (String, String))]
-> ConstructorInfo
-> WriterT [ExtraDeclOrGenericInfo] Q Exp
handleConstructor ExtraTypeScriptOptions
extraOptions Options
options DatatypeInfo
dti [(Name, (String, String))]
genericVariablesAndSuffixes) (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
dti)
  Exp
typeDeclaration <- [|TSTypeAlternatives $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> String
getTypeName (DatatypeInfo -> Name
datatypeName DatatypeInfo
dti))
                                          $(Bool -> [(Name, (String, String))] -> Q Exp
genericVariablesListExpr Bool
True [(Name, (String, String))]
genericVariablesAndSuffixes)
                                          $([Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Q Exp) -> [Exp] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [Exp]
types)
                                          $((String -> String) -> Name -> Q Exp
tryGetDoc (ExtraTypeScriptOptions -> String -> String
haddockModifier ExtraTypeScriptOptions
extraOptions) (DatatypeInfo -> Name
datatypeName DatatypeInfo
dti))|]

  Exp
declarationsFunctionBody <- [| $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
typeDeclaration) : $([Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ((Exp -> Q Exp) -> [Exp] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [Exp
x | ExtraDecl Exp
x <- [ExtraDeclOrGenericInfo]
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
  Exp
getTypeScriptTypeExp <- [|$(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> String
getTypeName (DatatypeInfo -> Name
datatypeName DatatypeInfo
dti)) <> $([(Name, (String, String))] -> Q Exp
getBracketsExpressionAllTypesNoSuffix [(Name, (String, String))]
genericVariablesAndSuffixes)|]
  Exp
getParentTypesExp <- [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE [ [|TSType (Proxy :: Proxy $(Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
t))|]
                             | Type
t <- ([[Type]] -> [Type]
forall a. Monoid a => [a] -> a
mconcat ([[Type]] -> [Type]) -> [[Type]] -> [Type]
forall a b. (a -> b) -> a -> b
$ (ConstructorInfo -> [Type]) -> [ConstructorInfo] -> [[Type]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorInfo -> [Type]
constructorFields (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
datatypeInfo')) [Type] -> [Type] -> [Type]
forall a. Semigroup a => a -> a -> a
<> [Type
x | ExtraParentType Type
x <- [ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfos]]
  let predicates :: [Type]
predicates = [Type] -> [Type]
forall a. Eq a => [a] -> [a]
L.nub ([Type]
constructorPreds [Type] -> [Type] -> [Type]
forall a. Semigroup a => a -> a -> a
<> [Type]
constructorPreds' [Type] -> [Type] -> [Type]
forall a. Semigroup a => a -> a -> a
<> [Type]
typeVariablePreds [Type] -> [Type] -> [Type]
forall a. Semigroup a => a -> a -> a
<> [Type
x | ExtraConstraint Type
x <- [ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfos])
  [Dec]
keyTypeDecl <- case ExtraTypeScriptOptions -> Maybe String
keyType ExtraTypeScriptOptions
extraOptions of
    Maybe String
Nothing -> [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just String
kt -> do
      Exp
keyTypeExp <- [|$(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
kt)|]
      [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Name -> [Clause] -> Dec
FunD 'getTypeScriptKeyType [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP] (Exp -> Body
NormalB Exp
keyTypeExp) []]]
  let inst :: [Dec]
inst = [[Type] -> Type -> [Dec] -> Dec
mkInstance [Type]
predicates (Type -> Type -> Type
AppT (Name -> Type
ConT ''TypeScript) ((Type -> Type -> Type) -> Type -> [Type] -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
name) (DatatypeInfo -> [Type]
getDataTypeVars DatatypeInfo
dti))) ([
                 Name -> [Clause] -> Dec
FunD 'getTypeScriptType [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP] (Exp -> Body
NormalB Exp
getTypeScriptTypeExp) []]
                 , Name -> [Clause] -> Dec
FunD 'getTypeScriptDeclarations [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP] (Exp -> Body
NormalB Exp
declarationsFunctionBody) []]
                 , Name -> [Clause] -> Dec
FunD 'getParentTypes [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP] (Exp -> Body
NormalB Exp
getParentTypesExp) []]
                 ] [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
keyTypeDecl)]
  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Dec]] -> [Dec]
forall a. Monoid a => [a] -> a
mconcat [[Dec]
x | ExtraTopLevelDecs [Dec]
x <- [ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfos] [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
<> [Dec]
inst)

-- | Return a string to go in the top-level type declaration, plus an optional expression containing a declaration
handleConstructor :: ExtraTypeScriptOptions -> Options -> DatatypeInfo -> [(Name, (Suffix, Var))] -> ConstructorInfo -> WriterT [ExtraDeclOrGenericInfo] Q Exp
handleConstructor :: ExtraTypeScriptOptions
-> Options
-> DatatypeInfo
-> [(Name, (String, String))]
-> ConstructorInfo
-> WriterT [ExtraDeclOrGenericInfo] Q Exp
handleConstructor (ExtraTypeScriptOptions {[Name]
Maybe String
String -> String
keyType :: ExtraTypeScriptOptions -> Maybe String
typeFamiliesToMapToTypeScript :: ExtraTypeScriptOptions -> [Name]
haddockModifier :: ExtraTypeScriptOptions -> String -> String
typeFamiliesToMapToTypeScript :: [Name]
keyType :: Maybe String
haddockModifier :: String -> String
..}) Options
options (DatatypeInfo {[Type]
[TyVarBndrUnit]
[ConstructorInfo]
Name
DatatypeVariant
datatypeCons :: DatatypeInfo -> [ConstructorInfo]
datatypeName :: DatatypeInfo -> Name
datatypeContext :: [Type]
datatypeName :: Name
datatypeVars :: [TyVarBndrUnit]
datatypeInstTypes :: [Type]
datatypeVariant :: DatatypeVariant
datatypeCons :: [ConstructorInfo]
datatypeContext :: DatatypeInfo -> [Type]
datatypeVars :: DatatypeInfo -> [TyVarBndrUnit]
datatypeInstTypes :: DatatypeInfo -> [Type]
datatypeVariant :: DatatypeInfo -> DatatypeVariant
..}) [(Name, (String, String))]
genericVariables ConstructorInfo
ci = do
  if | ([ConstructorInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ConstructorInfo]
datatypeCons Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) Bool -> Bool -> Bool
&& Bool -> Bool
not (Options -> Bool
getTagSingleConstructors Options
options) -> do
         WriterT [ExtraDeclOrGenericInfo] Q ()
writeSingleConstructorEncoding
         Exp
brackets <- Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
         Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|$(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
interfaceName) <> $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
brackets)|]
     | [ConstructorInfo] -> Bool
allConstructorsAreNullary [ConstructorInfo]
datatypeCons Bool -> Bool -> Bool
&& Options -> Bool
allNullaryToStringTag Options
options -> WriterT [ExtraDeclOrGenericInfo] Q Exp
stringEncoding

     -- With UntaggedValue, nullary constructors are encoded as strings
     | (SumEncoding -> Bool
isUntaggedValue (SumEncoding -> Bool) -> SumEncoding -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> SumEncoding
sumEncoding Options
options) Bool -> Bool -> Bool
&& ConstructorInfo -> Bool
isConstructorNullary ConstructorInfo
ci -> WriterT [ExtraDeclOrGenericInfo] Q Exp
stringEncoding

     -- Treat as a sum
     | SumEncoding -> Bool
isObjectWithSingleField (SumEncoding -> Bool) -> SumEncoding -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> SumEncoding
sumEncoding Options
options -> do
         WriterT [ExtraDeclOrGenericInfo] Q ()
writeSingleConstructorEncoding
         Exp
brackets <- Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
         Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|"{" <> $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Options -> ConstructorInfo -> String
constructorNameToUse Options
options ConstructorInfo
ci) <> ": " <> $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
interfaceName) <> $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
brackets) <> "}"|]
     | SumEncoding -> Bool
isTwoElemArray (SumEncoding -> Bool) -> SumEncoding -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> SumEncoding
sumEncoding Options
options -> do
         WriterT [ExtraDeclOrGenericInfo] Q ()
writeSingleConstructorEncoding
         Exp
brackets <- Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
         Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|"[" <> $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Options -> ConstructorInfo -> String
constructorNameToUse Options
options ConstructorInfo
ci) <> ", " <> $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
interfaceName) <> $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
brackets) <> "]"|]
     | SumEncoding -> Bool
isUntaggedValue (SumEncoding -> Bool) -> SumEncoding -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> SumEncoding
sumEncoding Options
options -> do
         WriterT [ExtraDeclOrGenericInfo] Q ()
writeSingleConstructorEncoding
         Exp
brackets <- Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
         Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|$(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
interfaceName) <> $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
brackets)|]
     | Bool
otherwise -> do
         [Exp]
tagField :: [Exp] <- Q [Exp] -> WriterT [ExtraDeclOrGenericInfo] Q [Exp]
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q [Exp] -> WriterT [ExtraDeclOrGenericInfo] Q [Exp])
-> Q [Exp] -> WriterT [ExtraDeclOrGenericInfo] Q [Exp]
forall a b. (a -> b) -> a -> b
$ case Options -> SumEncoding
sumEncoding Options
options of
           TaggedObject String
tagFieldName String
_ -> (Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: []) (Exp -> [Exp]) -> Q Exp -> Q [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [|TSField False $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
tagFieldName) $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE [i|"#{constructorNameToUse options ci}"|]) Nothing|]
           SumEncoding
_ -> [Exp] -> Q [Exp]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []

         [Exp]
tsFields <- WriterT [ExtraDeclOrGenericInfo] Q [Exp]
getTSFields
         Exp
decl <- Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Q Exp
assembleInterfaceDeclaration ([Exp] -> Exp
ListE ([Exp]
tagField [Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++ [Exp]
tsFields))
         [ExtraDeclOrGenericInfo] -> WriterT [ExtraDeclOrGenericInfo] Q ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Exp -> ExtraDeclOrGenericInfo
ExtraDecl Exp
decl]
         Exp
brackets <- Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
         Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|$(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
interfaceName) <> $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
brackets)|]

  where
    stringEncoding :: WriterT [ExtraDeclOrGenericInfo] Q Exp
stringEncoding = Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE [i|"#{(constructorTagModifier options) $ getTypeName (constructorName ci)}"|]

    writeSingleConstructorEncoding :: WriterT [ExtraDeclOrGenericInfo] Q ()
writeSingleConstructorEncoding = if
      | ConstructorInfo -> ConstructorVariant
constructorVariant ConstructorInfo
ci ConstructorVariant -> ConstructorVariant -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorVariant
NormalConstructor -> do
          Exp
encoding <- WriterT [ExtraDeclOrGenericInfo] Q Exp
tupleEncoding
          [ExtraDeclOrGenericInfo] -> WriterT [ExtraDeclOrGenericInfo] Q ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Exp -> ExtraDeclOrGenericInfo
ExtraDecl Exp
encoding]

#if MIN_VERSION_aeson(0,10,0)
      | Options -> Bool
unwrapUnaryRecords Options
options Bool -> Bool -> Bool
&& (ConstructorInfo -> Bool
isSingleRecordConstructor ConstructorInfo
ci) -> do
          let [Type
typ] = ConstructorInfo -> [Type]
constructorFields ConstructorInfo
ci
          Exp
stringExp <- Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall a b. (a -> b) -> a -> b
$ case Type
typ of
            (AppT (ConT Name
name) Type
t) | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''Maybe Bool -> Bool -> Bool
&& Bool -> Bool
not (Options -> Bool
omitNothingFields Options
options) -> [|$(Type -> Q Exp
getTypeAsStringExp Type
t) <> " | null"|]
            Type
_ -> Type -> Q Exp
getTypeAsStringExp Type
typ
          Exp
alternatives <- Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|TSTypeAlternatives $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
interfaceName)
                                                    $(Bool -> [(Name, (String, String))] -> Q Exp
genericVariablesListExpr Bool
True [(Name, (String, String))]
genericVariables)
                                                    [$(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
stringExp)]
                                                    $((String -> String) -> Name -> Q Exp
tryGetDoc String -> String
haddockModifier (ConstructorInfo -> Name
constructorName ConstructorInfo
ci))|]
          [ExtraDeclOrGenericInfo] -> WriterT [ExtraDeclOrGenericInfo] Q ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Exp -> ExtraDeclOrGenericInfo
ExtraDecl Exp
alternatives]
#endif

      | Bool
otherwise -> do
          [Exp]
tsFields <- WriterT [ExtraDeclOrGenericInfo] Q [Exp]
getTSFields
          Exp
decl <- Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Q Exp
assembleInterfaceDeclaration ([Exp] -> Exp
ListE [Exp]
tsFields)
          [ExtraDeclOrGenericInfo] -> WriterT [ExtraDeclOrGenericInfo] Q ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Exp -> ExtraDeclOrGenericInfo
ExtraDecl Exp
decl]

    -- * Type declaration to use
    interfaceName :: String
interfaceName = String
"I" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Name -> String
lastNameComponent' (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ ConstructorInfo -> Name
constructorName ConstructorInfo
ci)

    tupleEncoding :: WriterT [ExtraDeclOrGenericInfo] Q Exp
tupleEncoding =
      Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|TSTypeAlternatives $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
interfaceName)
                                $(Bool -> [(Name, (String, String))] -> Q Exp
genericVariablesListExpr Bool
True [(Name, (String, String))]
genericVariables)
                                [getTypeScriptType (Proxy :: Proxy $(Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, (String, String))] -> ConstructorInfo -> Type
contentsTupleTypeSubstituted [(Name, (String, String))]
genericVariables ConstructorInfo
ci)))]
                                $((String -> String) -> Name -> Q Exp
tryGetDoc String -> String
haddockModifier (ConstructorInfo -> Name
constructorName ConstructorInfo
ci))|]

    assembleInterfaceDeclaration :: Exp -> Q Exp
assembleInterfaceDeclaration Exp
members = [|TSInterfaceDeclaration $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
interfaceName)
                                                                    $(Bool -> [(Name, (String, String))] -> Q Exp
genericVariablesListExpr Bool
True [(Name, (String, String))]
genericVariables)
                                                                    $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
members)
                                                                    $((String -> String) -> Name -> Q Exp
tryGetDoc String -> String
haddockModifier (ConstructorInfo -> Name
constructorName ConstructorInfo
ci))|]

    getTSFields :: WriterT [ExtraDeclOrGenericInfo] Q [Exp]
    getTSFields :: WriterT [ExtraDeclOrGenericInfo] Q [Exp]
getTSFields = [(Name, String, Type)]
-> ((Name, String, Type) -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> WriterT [ExtraDeclOrGenericInfo] Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Options
-> [(Name, (String, String))]
-> ConstructorInfo
-> [(Name, String, Type)]
namesAndTypes Options
options [(Name, (String, String))]
genericVariables ConstructorInfo
ci) (((Name, String, Type) -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
 -> WriterT [ExtraDeclOrGenericInfo] Q [Exp])
-> ((Name, String, Type) -> WriterT [ExtraDeclOrGenericInfo] Q Exp)
-> WriterT [ExtraDeclOrGenericInfo] Q [Exp]
forall a b. (a -> b) -> a -> b
$ \(Name
name, String
nameString, Type
typ) -> do
      (Exp
fieldTyp, Exp
optAsBool) <- Q (Exp, Exp) -> WriterT [ExtraDeclOrGenericInfo] Q (Exp, Exp)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q (Exp, Exp) -> WriterT [ExtraDeclOrGenericInfo] Q (Exp, Exp))
-> Q (Exp, Exp) -> WriterT [ExtraDeclOrGenericInfo] Q (Exp, Exp)
forall a b. (a -> b) -> a -> b
$ case Type
typ of
        (AppT (ConT Name
name) Type
t) | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''Maybe Bool -> Bool -> Bool
&& Bool -> Bool
not (Options -> Bool
omitNothingFields Options
options) ->
          ( , ) (Exp -> Exp -> (Exp, Exp)) -> Q Exp -> Q (Exp -> (Exp, Exp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [|$(Type -> Q Exp
getTypeAsStringExp Type
t) <> " | null"|] Q (Exp -> (Exp, Exp)) -> Q Exp -> Q (Exp, Exp)
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Q Exp
getOptionalAsBoolExp Type
t
        Type
_ -> ( , ) (Exp -> Exp -> (Exp, Exp)) -> Q Exp -> Q (Exp -> (Exp, Exp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Exp
getTypeAsStringExp Type
typ Q (Exp -> (Exp, Exp)) -> Q Exp -> Q (Exp, Exp)
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Q Exp
getOptionalAsBoolExp Type
typ

      Q Exp -> WriterT [ExtraDeclOrGenericInfo] Q Exp
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ExtraDeclOrGenericInfo] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [| TSField $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
optAsBool) $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE String
nameString) $(Exp -> Q Exp
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
fieldTyp) $((String -> String) -> Name -> Q Exp
tryGetDoc String -> String
haddockModifier Name
name) |]

    isSingleRecordConstructor :: ConstructorInfo -> Bool
isSingleRecordConstructor (ConstructorInfo -> ConstructorVariant
constructorVariant -> RecordConstructor [Name
_]) = Bool
True
    isSingleRecordConstructor ConstructorInfo
_ = Bool
False

-- * Convenience functions

-- | Convenience function to generate 'A.ToJSON', 'A.FromJSON', and 'TypeScript' instances simultaneously, so the instances are guaranteed to be in sync.
--
-- This function is given mainly as an illustration.
-- If you want some other permutation of instances, such as 'A.ToJSON' and 'A.TypeScript' only, just take a look at the source and write your own version.
--
-- @since 0.1.0.4
deriveJSONAndTypeScript :: Options
                        -- ^ Encoding options.
                        -> Name
                        -- ^ Name of the type for which to generate 'A.ToJSON', 'A.FromJSON', and 'TypeScript' instance declarations.
                        -> Q [Dec]
deriveJSONAndTypeScript :: Options -> Name -> Q [Dec]
deriveJSONAndTypeScript Options
options Name
name = [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
(<>) ([Dec] -> [Dec] -> [Dec]) -> Q [Dec] -> Q ([Dec] -> [Dec])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Options -> Name -> Q [Dec]
deriveTypeScript Options
options Name
name) Q ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Options -> Name -> Q [Dec]
A.deriveJSON Options
options Name
name)

deriveJSONAndTypeScript' :: Options
                         -- ^ Encoding options.
                         -> Name
                         -- ^ Name of the type for which to generate 'A.ToJSON', 'A.FromJSON', and 'TypeScript' instance declarations.
                         -> ExtraTypeScriptOptions
                         -- ^ Extra options to control advanced features.
                         -> Q [Dec]
deriveJSONAndTypeScript' :: Options -> Name -> ExtraTypeScriptOptions -> Q [Dec]
deriveJSONAndTypeScript' Options
options Name
name ExtraTypeScriptOptions
extraOptions = [Dec] -> [Dec] -> [Dec]
forall a. Semigroup a => a -> a -> a
(<>) ([Dec] -> [Dec] -> [Dec]) -> Q [Dec] -> Q ([Dec] -> [Dec])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Options -> Name -> ExtraTypeScriptOptions -> Q [Dec]
deriveTypeScript' Options
options Name
name ExtraTypeScriptOptions
extraOptions) Q ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Options -> Name -> Q [Dec]
A.deriveJSON Options
options Name
name)

-- | Generates a 'TypeScript' instance declaration for the given data type.
deriveTypeScript :: Options
                 -- ^ Encoding options.
                 -> Name
                 -- ^ Name of the type for which to generate a 'TypeScript' instance declaration.
                 -> Q [Dec]
deriveTypeScript :: Options -> Name -> Q [Dec]
deriveTypeScript Options
options Name
name = Options -> Name -> ExtraTypeScriptOptions -> Q [Dec]
deriveTypeScript' Options
options Name
name ExtraTypeScriptOptions
defaultExtraTypeScriptOptions