@@ -21,6 +21,7 @@ import Control.Monad.Writer
21import Data.Aeson
21import Data.Aeson
22import Data.Char
22import Data.Char
23import Data.Data (Data)
23import Data.Data (Data)
24+import Data.Foldable (traverse_)
24import Data.HashMap.Strict (HashMap)
25import Data.HashMap.Strict (HashMap)
25import qualified Data.HashMap.Strict as HashMap
26import qualified Data.HashMap.Strict as HashMap
26import "unordered-containers" Data.HashSet (HashSet)
27import "unordered-containers" Data.HashSet (HashSet)
@@ -196,6 +197,27 @@ inlineSchemas names = inlineSchemasWhen (`elem` names)
196inlineAllSchemas :: Data s => Definitions -> s -> s
197inlineAllSchemas :: Data s => Definitions -> s -> s
197inlineAllSchemas = inlineSchemasWhen (const True)
198inlineAllSchemas = inlineSchemasWhen (const True)
200+-- | Inline all /non-recursive/ schemas for which the definition
201+-- can be found in @'Definitions'@.
202+inlineNonRecursiveSchemas :: Data s => Definitions -> s -> s
203+inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
206+ case HashMap.lookup name defs of
207+ Just schema -> name `notElem` execDeclare (usedNames schema) mempty
210+ usedNames schema = traverse_ schemaRefNames (schema ^.. template)
212+ schemaRefNames :: Referenced Schema -> Declare [T.Text] ()
213+ schemaRefNames ref = case ref of
214+ Ref (Reference name) -> do
215+ seen <- looks (name `elem`)
216+ when (not seen) $ do
218+ traverse_ usedNames (HashMap.lookup name defs)
219+ Inline subschema -> usedNames subschema
199class GToSchema (f :: * -> *) where
221class GToSchema (f :: * -> *) where
200 gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare Definitions NamedSchema
222 gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare Definitions NamedSchema