{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, ExistentialQuantification, FlexibleInstances, NamedFieldPuns, MultiWayIf, ViewPatterns, LambdaCase, PolyKinds #-} module Data.Aeson.TypeScript.Recursive ( getTransitiveClosure , getTypeScriptDeclarationsRecursively ) where import Data.Aeson.TypeScript.Instances () import Data.Aeson.TypeScript.TH import Data.Function import Data.Proxy import qualified Data.Set as S getTransitiveClosure :: S.Set TSType -> S.Set TSType getTransitiveClosure :: Set TSType -> Set TSType getTransitiveClosure Set TSType initialTypes = ((Set TSType -> Set TSType) -> Set TSType -> Set TSType) -> Set TSType -> Set TSType forall a. (a -> a) -> a fix (\Set TSType -> Set TSType loop Set TSType items -> let items' :: Set TSType items' = [Set TSType] -> Set TSType forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a S.unions (Set TSType items Set TSType -> [Set TSType] -> [Set TSType] forall a. a -> [a] -> [a] : [TSType -> Set TSType getMore TSType x | TSType x <- Set TSType -> [TSType] forall a. Set a -> [a] S.toList Set TSType items]) in if | Set TSType items' Set TSType -> Set TSType -> Bool forall a. Eq a => a -> a -> Bool == Set TSType items -> Set TSType items | Bool otherwise -> Set TSType -> Set TSType loop Set TSType items' ) Set TSType initialTypes where getMore :: TSType -> S.Set TSType getMore :: TSType -> Set TSType getMore (TSType Proxy a x) = [TSType] -> Set TSType forall a. Ord a => [a] -> Set a S.fromList ([TSType] -> Set TSType) -> [TSType] -> Set TSType forall a b. (a -> b) -> a -> b $ Proxy a -> [TSType] forall k (a :: k). TypeScript a => Proxy a -> [TSType] getParentTypes Proxy a x getTypeScriptDeclarationsRecursively :: (TypeScript a) => Proxy a -> [TSDeclaration] getTypeScriptDeclarationsRecursively :: Proxy a -> [TSDeclaration] getTypeScriptDeclarationsRecursively Proxy a initialType = Set TSDeclaration -> [TSDeclaration] forall a. Set a -> [a] S.toList (Set TSDeclaration -> [TSDeclaration]) -> Set TSDeclaration -> [TSDeclaration] forall a b. (a -> b) -> a -> b $ [TSDeclaration] -> Set TSDeclaration forall a. Ord a => [a] -> Set a S.fromList [TSDeclaration] declarations where closure :: Set TSType closure = Set TSType -> Set TSType getTransitiveClosure ([TSType] -> Set TSType forall a. Ord a => [a] -> Set a S.fromList [Proxy a -> TSType forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType TSType Proxy a initialType]) declarations :: [TSDeclaration] declarations = [[TSDeclaration]] -> [TSDeclaration] forall a. Monoid a => [a] -> a mconcat [Proxy a -> [TSDeclaration] forall k (a :: k). TypeScript a => Proxy a -> [TSDeclaration] getTypeScriptDeclarations Proxy a x | TSType Proxy a x <- Set TSType -> [TSType] forall a. Set a -> [a] S.toList Set TSType closure]