{-# 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]