{-# LANGUAGE OverloadedStrings #-}

-- | Functionality to split models into multiple modules according to their dependencies
module OpenAPI.Generate.ModelDependencies
  ( getModelModulesFromModelsWithDependencies,
    ModuleDefinition,
    Models,
    ModelContentWithDependencies,
    ModelWithDependencies,
  )
where

import Data.List (find, isPrefixOf, partition)
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Language.Haskell.TH
import Language.Haskell.TH.PprLib hiding ((<>))
import qualified OpenAPI.Generate.Doc as Doc
import OpenAPI.Generate.Internal.Util

-- | A module definition with a name as a string list with the different module levels (e. g. [\"OpenAPI\", \"Generate\"] for "OpenAPI.Generate")
-- and the 'Doc' representing the module content
type ModuleDefinition = ([String], Doc)

-- | A set of model names (typically used as dependency list)
type Models = Set.Set Text

-- | A tuple containing the content and the dependencies of a model
type ModelContentWithDependencies = (Q Doc, Models)

-- | Represents a model with a name, content and dependencies
type ModelWithDependencies = (Text, ModelContentWithDependencies)

typesModule :: String
typesModule :: [Char]
typesModule = [Char]
"Types"

-- | Analyzes the dependencies of the provided models and splits them into modules.
-- All models which would form an own module but only consist of a type alias are put in a module named by 'Doc.typeAliasModule'.
getModelModulesFromModelsWithDependencies :: String -> Models -> Bool -> [ModelWithDependencies] -> Q [ModuleDefinition]
getModelModulesFromModelsWithDependencies :: [Char]
-> Models
-> Bool
-> [ModelWithDependencies]
-> Q [ModuleDefinition]
getModelModulesFromModelsWithDependencies [Char]
mainModuleName Models
operationAndWhiteListDependencies Bool
outputAllSchemas [ModelWithDependencies]
models = do
  let modelsToGenerate :: [ModelWithDependencies]
modelsToGenerate =
        if Bool
outputAllSchemas
          then [ModelWithDependencies]
models
          else Models -> [ModelWithDependencies] -> [ModelWithDependencies]
filterRequiredModels Models
operationAndWhiteListDependencies [ModelWithDependencies]
models
      prependTypesModule :: Text -> [Char]
prependTypesModule = (([Char]
typesModule [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".") [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
      prependMainModule :: [Char] -> [Char]
prependMainModule = (([Char]
mainModuleName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".") [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>)
  [(Text, (Doc, Models))]
modelsWithResolvedContent <-
    (ModelWithDependencies -> Q (Text, (Doc, Models)))
-> [ModelWithDependencies] -> Q [(Text, (Doc, Models))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
      ( \(Text
name, (Q Doc
contentQ, Models
dependencies)) -> do
          Doc
content <- Q Doc
contentQ
          (Text, (Doc, Models)) -> Q (Text, (Doc, Models))
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
name, (Doc
content, Models
dependencies))
      )
      [ModelWithDependencies]
modelsToGenerate
  let ([(Text, (Doc, Models))]
typeAliasModels, [(Text, (Doc, Models))]
modelsWithContent) = ((Text, (Doc, Models)) -> Bool)
-> [(Text, (Doc, Models))]
-> ([(Text, (Doc, Models))], [(Text, (Doc, Models))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Text
_, (Doc
content, Models
_)) -> Doc -> Bool
isTypeAliasModule Doc
content) [(Text, (Doc, Models))]
modelsWithResolvedContent
      (Models
typeAliasModuleNames, Doc
typeAliasContent, Models
typeAliasDependencies) =
        ((Text, (Doc, Models))
 -> (Models, Doc, Models) -> (Models, Doc, Models))
-> (Models, Doc, Models)
-> [(Text, (Doc, Models))]
-> (Models, Doc, Models)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          ( \(Text
name, (Doc
content, Models
dependencies)) (Models
names, Doc
allContent, Models
allDependencies) ->
              (Text -> Models -> Models
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
name Models
names, Doc
allContent Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
"" Doc -> Doc -> Doc
$$ Doc
content, Models -> Models -> Models
forall a. Ord a => Set a -> Set a -> Set a
Set.union Models
dependencies Models
allDependencies)
          )
          (Models
forall a. Set a
Set.empty, Doc
empty, Models
forall a. Set a
Set.empty)
          [(Text, (Doc, Models))]
typeAliasModels
      modules :: [ModuleDefinition]
modules =
        ((Text, (Doc, Models)) -> ModuleDefinition)
-> [(Text, (Doc, Models))] -> [ModuleDefinition]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ( \(Text
modelName, (Doc
doc, Models
dependencies)) ->
              ( [[Char]
typesModule, Text -> [Char]
T.unpack Text
modelName],
                [Char] -> [Char] -> [[Char]] -> [Char] -> Doc -> Doc
Doc.addModelModuleHeader
                  [Char]
mainModuleName
                  (Text -> [Char]
prependTypesModule Text
modelName)
                  (Text -> [Char]
prependTypesModule (Text -> [Char]) -> [Text] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Models -> [Text]
forall a. Set a -> [a]
Set.toList (Models -> Models -> Models
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Models
dependencies (Models -> Models) -> Models -> Models
forall a b. (a -> b) -> a -> b
$ Text -> Models -> Models
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
modelName Models
typeAliasModuleNames))
                  ([Char]
"Contains the types generated from the schema " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
modelName)
                  Doc
doc
              )
          )
          [(Text, (Doc, Models))]
modelsWithContent
      modelModuleNames :: [[Char]]
modelModuleNames = (ModuleDefinition -> [Char]) -> [ModuleDefinition] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[Char]] -> [Char]
joinWithPoint ([[Char]] -> [Char])
-> (ModuleDefinition -> [[Char]]) -> ModuleDefinition -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleDefinition -> [[Char]]
forall a b. (a, b) -> a
fst) [ModuleDefinition]
modules
  [ModuleDefinition] -> Q [ModuleDefinition]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleDefinition] -> Q [ModuleDefinition])
-> [ModuleDefinition] -> Q [ModuleDefinition]
forall a b. (a -> b) -> a -> b
$
    ( [[Char]
typesModule],
      [Char] -> [[Char]] -> [Char] -> Doc
Doc.createModuleHeaderWithReexports
        ([Char] -> [Char]
prependMainModule [Char]
typesModule)
        (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> [Char]
prependMainModule ([Char]
Doc.typeAliasModule [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
modelModuleNames))
        [Char]
"Rexports all type modules (used in the operation modules)."
    )
      ModuleDefinition -> [ModuleDefinition] -> [ModuleDefinition]
forall a. a -> [a] -> [a]
: ( [[Char]
Doc.typeAliasModule],
          [Char] -> [Char] -> [[Char]] -> [Char] -> Doc -> Doc
Doc.addModelModuleHeader
            [Char]
mainModuleName
            [Char]
Doc.typeAliasModule
            (Text -> [Char]
prependTypesModule (Text -> [Char]) -> [Text] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Models -> [Text]
forall a. Set a -> [a]
Set.toList (Models -> Models -> Models
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Models
typeAliasDependencies Models
typeAliasModuleNames))
            [Char]
"Contains all types with cyclic dependencies (between each other or to itself)"
            Doc
typeAliasContent
        )
      ModuleDefinition -> [ModuleDefinition] -> [ModuleDefinition]
forall a. a -> [a] -> [a]
: [ModuleDefinition]
modules

isTypeAliasModule :: Doc -> Bool
isTypeAliasModule :: Doc -> Bool
isTypeAliasModule =
  ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
    ( \[Char]
l ->
        [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"--" [Char]
l
          Bool -> Bool -> Bool
|| [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"type" [Char]
l
          Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
l
    )
    ([[Char]] -> Bool) -> (Doc -> [[Char]]) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
    ([Char] -> [[Char]]) -> (Doc -> [Char]) -> Doc -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Char]
forall a. Show a => a -> [Char]
show

filterRequiredModels :: Models -> [ModelWithDependencies] -> [ModelWithDependencies]
filterRequiredModels :: Models -> [ModelWithDependencies] -> [ModelWithDependencies]
filterRequiredModels Models
deps [ModelWithDependencies]
models =
  let namesOfRequiredModels :: Models
namesOfRequiredModels = Models -> [ModelWithDependencies] -> Models
resolveRequiredModels Models
deps [ModelWithDependencies]
models
   in (ModelWithDependencies -> Bool)
-> [ModelWithDependencies] -> [ModelWithDependencies]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Models -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Models
namesOfRequiredModels) (Text -> Bool)
-> (ModelWithDependencies -> Text) -> ModelWithDependencies -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelWithDependencies -> Text
forall a b. (a, b) -> a
fst) [ModelWithDependencies]
models

resolveRequiredModels :: Models -> [ModelWithDependencies] -> Models
resolveRequiredModels :: Models -> [ModelWithDependencies] -> Models
resolveRequiredModels Models
deps [ModelWithDependencies]
models =
  let newDeps :: Models
newDeps = [Models] -> Models
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Models] -> Models) -> [Models] -> Models
forall a b. (a -> b) -> a -> b
$ (Q Doc, Models) -> Models
forall a b. (a, b) -> b
snd ((Q Doc, Models) -> Models)
-> (ModelWithDependencies -> (Q Doc, Models))
-> ModelWithDependencies
-> Models
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelWithDependencies -> (Q Doc, Models)
forall a b. (a, b) -> b
snd (ModelWithDependencies -> Models)
-> [ModelWithDependencies] -> [Models]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe ModelWithDependencies)
-> [Text] -> [ModelWithDependencies]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (\Text
dep -> (ModelWithDependencies -> Bool)
-> [ModelWithDependencies] -> Maybe ModelWithDependencies
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
dep) (Text -> Bool)
-> (ModelWithDependencies -> Text) -> ModelWithDependencies -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelWithDependencies -> Text
forall a b. (a, b) -> a
fst) [ModelWithDependencies]
models) (Models -> [Text]
forall a. Set a -> [a]
Set.toList Models
deps)
   in if Models
newDeps Models -> Models -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Models
deps
        then Models
deps
        else Models -> [ModelWithDependencies] -> Models
resolveRequiredModels (Models -> Models -> Models
forall a. Ord a => Set a -> Set a -> Set a
Set.union Models
deps Models
newDeps) [ModelWithDependencies]
models