{-# 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 :: ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints eo :: ExtraTypeScriptOptions eo@(ExtraTypeScriptOptions {[Name] Maybe String keyType :: ExtraTypeScriptOptions -> Maybe String typeFamiliesToMapToTypeScript :: ExtraTypeScriptOptions -> [Name] keyType :: Maybe String typeFamiliesToMapToTypeScript :: [Name] ..}) (AppT (ConT Name name) Type typ) Name var | Type typ forall a. Eq a => a -> a -> Bool == Name -> Type VarT Name var Bool -> Bool -> Bool && (Name name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `L.elem` [Name] typeFamiliesToMapToTypeScript) = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Name -> Q Info reify Name name) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case FamilyI (ClosedTypeFamilyD (TypeFamilyHead Name typeFamilyName [TyVarBndr ()] _ FamilyResultSig _ Maybe InjectivityAnn _) [TySynEqn] _) [Dec] _ -> do forall w (m :: * -> *). MonadWriter w m => w -> m () tell [Name -> GenericInfoExtra -> GenericInfo GenericInfo Name var (Name -> GenericInfoExtra TypeFamilyKey Name typeFamilyName)] ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ Name var FamilyI (OpenTypeFamilyD (TypeFamilyHead Name typeFamilyName [TyVarBndr ()] _ FamilyResultSig _ Maybe InjectivityAnn _)) [Dec] _ -> do forall w (m :: * -> *). MonadWriter w m => w -> m () tell [Name -> GenericInfoExtra -> GenericInfo GenericInfo Name var (Name -> GenericInfoExtra TypeFamilyKey Name typeFamilyName)] ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ Name var Info _ -> ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ Name var | Bool otherwise = ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ Name var searchForConstraints ExtraTypeScriptOptions eo (AppT Type typ1 Type typ2) Name var = ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ1 Name var forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ2 Name var searchForConstraints ExtraTypeScriptOptions eo (SigT Type typ Type _) Name var = ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ Name var searchForConstraints ExtraTypeScriptOptions eo (InfixT Type typ1 Name _ Type typ2) Name var = ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ1 Name var forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ2 Name var searchForConstraints ExtraTypeScriptOptions eo (UInfixT Type typ1 Name _ Type typ2) Name var = ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ1 Name var forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ2 Name var searchForConstraints ExtraTypeScriptOptions eo (ParensT Type typ) Name var = ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ Name var #if MIN_VERSION_template_haskell(2,15,0) searchForConstraints ExtraTypeScriptOptions eo (AppKindT Type typ Type _) Name var = ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ Name var searchForConstraints ExtraTypeScriptOptions eo (ImplicitParamT String _ Type typ) Name var = ExtraTypeScriptOptions -> Type -> Name -> WriterT [GenericInfo] Q () searchForConstraints ExtraTypeScriptOptions eo Type typ Name var #endif searchForConstraints ExtraTypeScriptOptions _ Type _ Name _ = forall (m :: * -> *) a. Monad m => a -> m a return () hasFreeTypeVariable :: Type -> Bool hasFreeTypeVariable :: Type -> Bool hasFreeTypeVariable (VarT Name _) = Bool True hasFreeTypeVariable (AppT Type typ1 Type typ2) = Type -> Bool hasFreeTypeVariable Type typ1 Bool -> Bool -> Bool || Type -> Bool hasFreeTypeVariable Type typ2 hasFreeTypeVariable (SigT Type typ Type _) = Type -> Bool hasFreeTypeVariable Type typ hasFreeTypeVariable (InfixT Type typ1 Name _ Type typ2) = Type -> Bool hasFreeTypeVariable Type typ1 Bool -> Bool -> Bool || Type -> Bool hasFreeTypeVariable Type typ2 hasFreeTypeVariable (UInfixT Type typ1 Name _ Type typ2) = Type -> Bool hasFreeTypeVariable Type typ1 Bool -> Bool -> Bool || Type -> Bool hasFreeTypeVariable Type typ2 hasFreeTypeVariable (ParensT Type typ) = Type -> Bool hasFreeTypeVariable Type typ #if MIN_VERSION_template_haskell(2,15,0) hasFreeTypeVariable (AppKindT Type typ Type _) = Type -> Bool hasFreeTypeVariable Type typ hasFreeTypeVariable (ImplicitParamT String _ Type typ) = Type -> Bool hasFreeTypeVariable Type typ #endif hasFreeTypeVariable Type _ = Bool False unifyGenericVariable :: [GenericInfo] -> String unifyGenericVariable :: [GenericInfo] -> String unifyGenericVariable [GenericInfo] genericInfos = case [Name -> String nameBase Name name | GenericInfo Name _ (TypeFamilyKey Name name) <- [GenericInfo] genericInfos] of [] -> String "" [String] names -> String " extends keyof " forall a. Semigroup a => a -> a -> a <> (forall a. [a] -> [[a]] -> [a] L.intercalate String " & " [String] names)