{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
module Data.Aeson.TypeScript.Lookup where
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)
import qualified Language.Haskell.TH.Lib as TH
deriveTypeScriptLookupType :: Name
-> String
-> Q [Dec]
deriveTypeScriptLookupType :: Name -> String -> Q [Dec]
deriveTypeScriptLookupType Name
name String
declNameStr = do
Info
info <- Name -> Q Info
reify Name
name
case Info
info of
FamilyI (ClosedTypeFamilyD (TypeFamilyHead Name
_name [TyVarBndr ()]
_vars FamilyResultSig
_sig Maybe InjectivityAnn
_maybeInject) [TySynEqn]
eqns) [Dec]
_decs -> do
Exp
interfaceDecl <- Name -> [TySynEqn] -> Q Exp
getClosedTypeFamilyInterfaceDecl Name
name [TySynEqn]
eqns
forall (m :: * -> *) a. Monad m => a -> m a
return [Name -> [Clause] -> Dec
FunD (String -> Name
mkName String
declNameStr) [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB ([Exp] -> Exp
ListE [Exp
interfaceDecl])) []]]
Info
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail [i|Expected a close type family; got #{info}|]
getClosedTypeFamilyInterfaceDecl :: Name -> [TySynEqn] -> Q Exp
getClosedTypeFamilyInterfaceDecl :: Name -> [TySynEqn] -> Q Exp
getClosedTypeFamilyInterfaceDecl Name
name [TySynEqn]
eqns = do
[Exp]
fields <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TySynEqn]
eqns forall a b. (a -> b) -> a -> b
$ \case
#if MIN_VERSION_template_haskell(2,15,0)
TySynEqn Maybe [TyVarBndr ()]
Nothing (AppT (ConT Name
_) (ConT Name
arg)) Type
result -> do
[| TSField False (getTypeScriptType (Proxy :: Proxy $(conT arg))) (getTypeScriptType (Proxy :: Proxy $(return result))) Nothing |]
TySynEqn Maybe [TyVarBndr ()]
Nothing (AppT (ConT Name
_) (PromotedT Name
arg)) Type
result -> do
[| TSField False (getTypeScriptType (Proxy :: Proxy $(promotedT arg))) (getTypeScriptType (Proxy :: Proxy $(return result))) Nothing |]
#else
TySynEqn [ConT arg] result -> do
[| TSField False (getTypeScriptType (Proxy :: Proxy $(conT arg))) (getTypeScriptType (Proxy :: Proxy $(return result))) Nothing |]
#endif
TySynEqn
x -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail [i|aeson-typescript doesn't know yet how to handle this type family equation: '#{x}'|]
[| TSInterfaceDeclaration $(TH.stringE $ nameBase name) [] (L.sortBy (compare `on` fieldName) $(listE $ fmap return fields)) Nothing |]
getClosedTypeFamilyImage :: [TySynEqn] -> Q [Type]
getClosedTypeFamilyImage :: [TySynEqn] -> Q [Type]
getClosedTypeFamilyImage [TySynEqn]
eqns = do
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TySynEqn]
eqns forall a b. (a -> b) -> a -> b
$ \case
#if MIN_VERSION_template_haskell(2,15,0)
TySynEqn Maybe [TyVarBndr ()]
Nothing (AppT (ConT Name
_) Type
_) Type
result -> forall (m :: * -> *) a. Monad m => a -> m a
return Type
result
#else
TySynEqn [ConT _] result -> return result
#endif
TySynEqn
x -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail [i|aeson-typescript doesn't know yet how to handle this type family equation: '#{x}'|]