{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module OpenAPI.Generate.ModelDependencies
( getModelModulesFromModelsWithDependencies,
ModuleDefinition,
Models,
ModelContentWithDependencies,
ModelWithDependencies,
)
where
import Data.List
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text (Text)
import Language.Haskell.TH
import Language.Haskell.TH.PprLib hiding ((<>))
import qualified OpenAPI.Generate.Doc as Doc
import OpenAPI.Generate.Internal.Util
type ModuleDefinition = ([String], Doc)
type Models = Set.Set Text
type ModelContentWithDependencies = (Q Doc, Models)
type ModelWithDependencies = (Text, ModelContentWithDependencies)
typesModule :: String
typesModule = "Types"
cyclicTypesModule :: String
cyclicTypesModule = "CyclicTypes"
getModelModulesFromModelsWithDependencies :: String -> [ModelWithDependencies] -> Q [ModuleDefinition]
getModelModulesFromModelsWithDependencies mainModuleName = createModelModules mainModuleName . extractCyclicModuleDependentModels
createModelModules :: String -> ([ModelWithDependencies], Q Doc) -> Q [ModuleDefinition]
createModelModules mainModuleName (models, cyclicModuleContentQ) = do
let prependTypesModule = ((typesModule <> ".") <>) . T.unpack
let prependMainModule = ((mainModuleName <> ".") <>)
cyclicModuleContent <- cyclicModuleContentQ
modules <-
mapM
( \(modelName, (doc, dependencies)) ->
([typesModule, T.unpack modelName],)
. Doc.addModelModuleHeader
mainModuleName
(prependTypesModule modelName)
(prependTypesModule <$> Set.toList dependencies)
("Contains the types generated from the schema " <> T.unpack modelName)
<$> doc
)
models
let modelModuleNames = fmap (joinWithPoint . fst) modules
pure $
( [typesModule],
Doc.createModuleHeaderWithReexports
(prependMainModule typesModule)
(fmap prependMainModule (cyclicTypesModule : modelModuleNames))
"Rexports all type modules (used in the operation modules)."
)
: ( [cyclicTypesModule],
Doc.addModelModuleHeader
mainModuleName
cyclicTypesModule
modelModuleNames
"Contains all types with cyclic dependencies (between each other or to itself)"
cyclicModuleContent
)
: modules
extractCyclicModuleDependentModels :: [ModelWithDependencies] -> ([ModelWithDependencies], Q Doc)
extractCyclicModuleDependentModels models =
let (cyclicModels, extractedModels) = extractUnidirectionallyDependentModels (models, [])
in (extractedModels, vcat <$> mapM (fst . snd) cyclicModels)
extractUnidirectionallyDependentModels :: ([ModelWithDependencies], [ModelWithDependencies]) -> ([ModelWithDependencies], [ModelWithDependencies])
extractUnidirectionallyDependentModels (rest, extractedModels) =
let extractedModelNames = Set.fromList $ fmap fst extractedModels
(newExtractedModels, notExtractedModels) = partition ((`Set.isSubsetOf` extractedModelNames) . snd . snd) rest
in if null newExtractedModels
then (rest, extractedModels)
else extractUnidirectionallyDependentModels (notExtractedModels, extractedModels <> newExtractedModels)