{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
module Data.Aeson.TypeScript.TH (
deriveTypeScript
, deriveTypeScript'
, deriveTypeScriptLookupType
, TypeScript(..)
, TSType(..)
, TSDeclaration(TSRawDeclaration)
, formatTSDeclarations
, formatTSDeclarations'
, formatTSDeclaration
, FormattingOptions(..)
, defaultFormattingOptions
, defaultNameFormatter
, SumTypeFormat(..)
, ExportMode(..)
, defaultExtraTypeScriptOptions
, keyType
, typeFamiliesToMapToTypeScript
, ExtraTypeScriptOptions
, HasJSONOptions(..)
, deriveJSONAndTypeScript
, deriveJSONAndTypeScript'
, T(..)
, T1(..)
, T2(..)
, T3(..)
, 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
deriveTypeScript' :: Options
-> Name
-> ExtraTypeScriptOptions
-> 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'
let eligibleGenericVars :: [Name]
eligibleGenericVars = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DatatypeInfo -> [Type]
getDataTypeVars DatatypeInfo
datatypeInfo') forall a b. (a -> b) -> a -> b
$ \case
SigT (VarT Name
n) Type
StarT -> forall a. a -> Maybe a
Just Name
n
Type
_ -> forall a. Maybe a
Nothing
let varsAndTVars :: [(Name, String)]
varsAndTVars = case [Name]
eligibleGenericVars of
[] -> []
[Name
x] -> [(Name
x, String
"T")]
[Name]
xs -> forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
xs [String]
allStarConstructors''
[(Name, (String, String))]
genericVariablesAndSuffixes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, String)]
varsAndTVars forall a b. (a -> b) -> a -> b
$ \(Name
var, String
tvar) -> do
(()
_, [GenericInfo]
genericInfos) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
datatypeInfo') forall a b. (a -> b) -> a -> b
$ \ConstructorInfo
ci ->
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) 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
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
var, ([GenericInfo] -> String
unifyGenericVariable [GenericInfo]
genericInfos, String
tvar))
((\[ConstructorInfo]
x -> (DatatypeInfo
datatypeInfo' { datatypeCons :: [ConstructorInfo]
datatypeCons = [ConstructorInfo]
x })) -> DatatypeInfo
dti, [ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfosInitial) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
datatypeInfo') forall a b. (a -> b) -> a -> b
$ \ConstructorInfo
ci ->
((\[Type]
x -> ConstructorInfo
ci { constructorFields :: [Type]
constructorFields = [Type]
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ConstructorInfo -> [Type]
constructorFields ConstructorInfo
ci) forall a b. (a -> b) -> a -> b
$
ExtraTypeScriptOptions
-> Type -> WriterT [ExtraDeclOrGenericInfo] Q Type
transformTypeFamilies ExtraTypeScriptOptions
extraOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, (String, String))] -> Type -> Type
mapType [(Name, (String, String))]
genericVariablesAndSuffixes
let [Type]
constructorPreds :: [Pred] = [Type -> Type -> Type
AppT (Name -> Type
ConT ''TypeScript) Type
x | Type
x <- forall a. Monoid a => [a] -> a
mconcat 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 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 <- forall a. Monoid a => [a] -> a
mconcat 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 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]
([Exp]
types, ([ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfosInitial forall a. Semigroup a => a -> a -> a
<>) -> [ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfos) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 $(TH.stringE $ getTypeName (datatypeName dti))
$(genericVariablesListExpr True genericVariablesAndSuffixes)
$(listE $ fmap return types)
$(tryGetDoc (haddockModifier extraOptions) (datatypeName dti))|]
Exp
declarationsFunctionBody <- [| $(return typeDeclaration) : $(listE (fmap return [x | ExtraDecl x <- extraDeclsOrGenericInfos])) |]
Exp
getTypeScriptTypeExp <- [|$(TH.stringE $ getTypeName (datatypeName dti)) <> $(getBracketsExpressionAllTypesNoSuffix genericVariablesAndSuffixes)|]
Exp
getParentTypesExp <- forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE [ [|TSType (Proxy :: Proxy $(return t))|]
| Type
t <- (forall a. Monoid a => [a] -> a
mconcat 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')) forall a. Semigroup a => a -> a -> a
<> [Type
x | ExtraParentType Type
x <- [ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfos]]
let predicates :: [Type]
predicates = forall a. Eq a => [a] -> [a]
L.nub ([Type]
constructorPreds forall a. Semigroup a => a -> a -> a
<> [Type]
constructorPreds' forall a. Semigroup a => a -> a -> a
<> [Type]
typeVariablePreds 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just String
kt -> do
Exp
keyTypeExp <- [|$(TH.stringE kt)|]
forall (m :: * -> *) a. Monad m => a -> m a
return 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) (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) []]
] forall a. Semigroup a => a -> a -> a
<> [Dec]
keyTypeDecl)]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => [a] -> a
mconcat [[Dec]
x | ExtraTopLevelDecs [Dec]
x <- [ExtraDeclOrGenericInfo]
extraDeclsOrGenericInfos] forall a. Semigroup a => a -> a -> a
<> [Dec]
inst)
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
haddockModifier :: ExtraTypeScriptOptions -> String -> String
haddockModifier :: String -> String
keyType :: Maybe String
typeFamiliesToMapToTypeScript :: [Name]
typeFamiliesToMapToTypeScript :: ExtraTypeScriptOptions -> [Name]
keyType :: ExtraTypeScriptOptions -> Maybe String
..}) Options
options (DatatypeInfo {[Type]
[TyVarBndrUnit]
[ConstructorInfo]
Name
DatatypeVariant
datatypeContext :: DatatypeInfo -> [Type]
datatypeName :: DatatypeInfo -> Name
datatypeVars :: DatatypeInfo -> [TyVarBndrUnit]
datatypeInstTypes :: DatatypeInfo -> [Type]
datatypeVariant :: DatatypeInfo -> DatatypeVariant
datatypeCons :: [ConstructorInfo]
datatypeVariant :: DatatypeVariant
datatypeInstTypes :: [Type]
datatypeVars :: [TyVarBndrUnit]
datatypeName :: Name
datatypeContext :: [Type]
datatypeCons :: DatatypeInfo -> [ConstructorInfo]
..}) [(Name, (String, String))]
genericVariables ConstructorInfo
ci = do
if | (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ConstructorInfo]
datatypeCons 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|$(TH.stringE interfaceName) <> $(return brackets)|]
| [ConstructorInfo] -> Bool
allConstructorsAreNullary [ConstructorInfo]
datatypeCons Bool -> Bool -> Bool
&& Options -> Bool
allNullaryToStringTag Options
options -> WriterT [ExtraDeclOrGenericInfo] Q Exp
stringEncoding
| (SumEncoding -> Bool
isUntaggedValue 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
| SumEncoding -> Bool
isObjectWithSingleField forall a b. (a -> b) -> a -> b
$ Options -> SumEncoding
sumEncoding Options
options -> do
WriterT [ExtraDeclOrGenericInfo] Q ()
writeSingleConstructorEncoding
Exp
brackets <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|"{" <> $(TH.stringE $ show $ constructorNameToUse options ci) <> ": " <> $(TH.stringE interfaceName) <> $(return brackets) <> "}"|]
| SumEncoding -> Bool
isTwoElemArray forall a b. (a -> b) -> a -> b
$ Options -> SumEncoding
sumEncoding Options
options -> do
WriterT [ExtraDeclOrGenericInfo] Q ()
writeSingleConstructorEncoding
Exp
brackets <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|"[" <> $(TH.stringE $ show $ constructorNameToUse options ci) <> ", " <> $(TH.stringE interfaceName) <> $(return brackets) <> "]"|]
| SumEncoding -> Bool
isUntaggedValue forall a b. (a -> b) -> a -> b
$ Options -> SumEncoding
sumEncoding Options
options -> do
WriterT [ExtraDeclOrGenericInfo] Q ()
writeSingleConstructorEncoding
Exp
brackets <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|$(TH.stringE interfaceName) <> $(return brackets)|]
| Bool
otherwise -> do
[Exp]
tagField :: [Exp] <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ case Options -> SumEncoding
sumEncoding Options
options of
TaggedObject String
tagFieldName String
_ -> (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [|TSField False $(TH.stringE tagFieldName) $(TH.stringE [i|"#{constructorNameToUse options ci}"|]) Nothing|]
SumEncoding
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
[Exp]
tsFields <- WriterT [ExtraDeclOrGenericInfo] Q [Exp]
getTSFields
Exp
decl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Exp -> Q Exp
assembleInterfaceDeclaration ([Exp] -> Exp
ListE ([Exp]
tagField forall a. [a] -> [a] -> [a]
++ [Exp]
tsFields))
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Exp -> ExtraDeclOrGenericInfo
ExtraDecl Exp
decl]
Exp
brackets <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Bool -> [(Name, (String, String))] -> Q Exp
getBracketsExpression Bool
False [(Name, (String, String))]
genericVariables
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|$(TH.stringE interfaceName) <> $(return brackets)|]
where
stringEncoding :: WriterT [ExtraDeclOrGenericInfo] Q Exp
stringEncoding = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== ConstructorVariant
NormalConstructor -> do
Exp
encoding <- WriterT [ExtraDeclOrGenericInfo] Q Exp
tupleEncoding
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ case Type
typ of
(AppT (ConT Name
name) Type
t) | Name
name forall a. Eq a => a -> a -> Bool
== ''Maybe Bool -> Bool -> Bool
&& Bool -> Bool
not (Options -> Bool
omitNothingFields Options
options) -> [|$(getTypeAsStringExp t) <> " | null"|]
Type
_ -> Type -> Q Exp
getTypeAsStringExp Type
typ
Exp
alternatives <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|TSTypeAlternatives $(TH.stringE interfaceName)
$(genericVariablesListExpr True genericVariables)
[$(return stringExp)]
$(tryGetDoc haddockModifier (constructorName ci))|]
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Exp -> Q Exp
assembleInterfaceDeclaration ([Exp] -> Exp
ListE [Exp]
tsFields)
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Exp -> ExtraDeclOrGenericInfo
ExtraDecl Exp
decl]
interfaceName :: String
interfaceName = String
"I" forall a. Semigroup a => a -> a -> a
<> (Name -> String
lastNameComponent' forall a b. (a -> b) -> a -> b
$ ConstructorInfo -> Name
constructorName ConstructorInfo
ci)
tupleEncoding :: WriterT [ExtraDeclOrGenericInfo] Q Exp
tupleEncoding =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [|TSTypeAlternatives $(TH.stringE interfaceName)
$(genericVariablesListExpr True genericVariables)
[getTypeScriptType (Proxy :: Proxy $(return (contentsTupleTypeSubstituted genericVariables ci)))]
$(tryGetDoc haddockModifier (constructorName ci))|]
assembleInterfaceDeclaration :: Exp -> Q Exp
assembleInterfaceDeclaration Exp
members = [|TSInterfaceDeclaration $(TH.stringE interfaceName)
$(genericVariablesListExpr True genericVariables)
$(return members)
$(tryGetDoc haddockModifier (constructorName ci))|]
getTSFields :: WriterT [ExtraDeclOrGenericInfo] Q [Exp]
getTSFields :: WriterT [ExtraDeclOrGenericInfo] Q [Exp]
getTSFields = 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) forall a b. (a -> b) -> a -> b
$ \(Name
name, String
nameString, Type
typ) -> do
(Exp
fieldTyp, Exp
optAsBool) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ case Type
typ of
(AppT (ConT Name
name) Type
t) | Name
name forall a. Eq a => a -> a -> Bool
== ''Maybe Bool -> Bool -> Bool
&& Bool -> Bool
not (Options -> Bool
omitNothingFields Options
options) ->
( , ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [|$(getTypeAsStringExp t) <> " | null"|] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Q Exp
getOptionalAsBoolExp Type
t
Type
_ -> ( , ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Exp
getTypeAsStringExp Type
typ forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Q Exp
getOptionalAsBoolExp Type
typ
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift [| TSField $(return optAsBool) $(TH.stringE nameString) $(return fieldTyp) $(tryGetDoc haddockModifier name) |]
isSingleRecordConstructor :: ConstructorInfo -> Bool
isSingleRecordConstructor (ConstructorInfo -> ConstructorVariant
constructorVariant -> RecordConstructor [Name
_]) = Bool
True
isSingleRecordConstructor ConstructorInfo
_ = Bool
False
deriveJSONAndTypeScript :: Options
-> Name
-> Q [Dec]
deriveJSONAndTypeScript :: Options -> Name -> Q [Dec]
deriveJSONAndTypeScript Options
options Name
name = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Options -> Name -> Q [Dec]
deriveTypeScript Options
options Name
name) 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
-> Name
-> ExtraTypeScriptOptions
-> Q [Dec]
deriveJSONAndTypeScript' :: Options -> Name -> ExtraTypeScriptOptions -> Q [Dec]
deriveJSONAndTypeScript' Options
options Name
name ExtraTypeScriptOptions
extraOptions = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Options -> Name -> ExtraTypeScriptOptions -> Q [Dec]
deriveTypeScript' Options
options Name
name ExtraTypeScriptOptions
extraOptions) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Options -> Name -> Q [Dec]
A.deriveJSON Options
options Name
name)
deriveTypeScript :: Options
-> Name
-> Q [Dec]
deriveTypeScript :: Options -> Name -> Q [Dec]
deriveTypeScript Options
options Name
name = Options -> Name -> ExtraTypeScriptOptions -> Q [Dec]
deriveTypeScript' Options
options Name
name ExtraTypeScriptOptions
defaultExtraTypeScriptOptions