{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module OpenAPI.Generate.Monad where
import qualified Control.Monad.Reader as MR
import qualified Control.Monad.Writer as MW
import Data.List
import Data.Text (Text)
import qualified OpenAPI.Generate.Flags as OAF
import qualified OpenAPI.Generate.Reference as Ref
import qualified OpenAPI.Generate.Types as OAT
import qualified OpenAPI.Generate.Types.Schema as OAS
data GeneratorEnvironment
= GeneratorEnvironment
{ currentPath :: [Text],
references :: Ref.ReferenceMap,
flags :: OAF.Flags
}
deriving (Show, Eq)
data GeneratorLogSeverity = ErrorSeverity | WarningSeverity | InfoSeverity
deriving (Show, Eq)
data GeneratorLogEntry
= GeneratorLogEntry
{ path :: [Text],
severity :: GeneratorLogSeverity,
message :: Text
}
deriving (Show, Eq)
type GeneratorLogs = [GeneratorLogEntry]
newtype Generator a = Generator {unGenerator :: MW.WriterT GeneratorLogs (MR.Reader GeneratorEnvironment) a}
deriving (Functor, Applicative, Monad, MR.MonadReader GeneratorEnvironment, MW.MonadWriter GeneratorLogs)
runGenerator :: GeneratorEnvironment -> Generator a -> (a, GeneratorLogs)
runGenerator e (Generator g) = MR.runReader (MW.runWriterT g) e
createEnvironment :: OAF.Flags -> Ref.ReferenceMap -> GeneratorEnvironment
createEnvironment flags references =
GeneratorEnvironment
{ currentPath = [],
references = references,
flags = flags
}
logMessage :: GeneratorLogSeverity -> Text -> Generator ()
logMessage severity message = do
path' <- MR.asks currentPath
MW.tell [GeneratorLogEntry {path = path', severity = severity, message = message}]
logError :: Text -> Generator ()
logError = logMessage ErrorSeverity
logWarning :: Text -> Generator ()
logWarning = logMessage WarningSeverity
logInfo :: Text -> Generator ()
logInfo = logMessage InfoSeverity
transformGeneratorLogs :: GeneratorLogs -> [Text]
transformGeneratorLogs =
fmap
( \GeneratorLogEntry {..} ->
transformSeverity severity <> " (" <> transformPath path <> "): " <> message
)
transformSeverity :: GeneratorLogSeverity -> Text
transformSeverity ErrorSeverity = "ERROR"
transformSeverity WarningSeverity = "WARN"
transformSeverity InfoSeverity = "INFO"
transformPath :: [Text] -> Text
transformPath = mconcat . intersperse "."
nested :: Text -> Generator a -> Generator a
nested pathItem = MR.local $ \g -> g {currentPath = currentPath g <> [pathItem]}
createReferenceLookupM :: (Text -> Ref.ReferenceMap -> Maybe a) -> Text -> Generator (Maybe a)
createReferenceLookupM fn key = MR.asks $ fn key . references
getSchemaReferenceM :: Text -> Generator (Maybe OAS.SchemaObject)
getSchemaReferenceM = createReferenceLookupM Ref.getSchemaReference
getResponseReferenceM :: Text -> Generator (Maybe OAT.ResponseObject)
getResponseReferenceM = createReferenceLookupM Ref.getResponseReference
getParameterReferenceM :: Text -> Generator (Maybe OAT.ParameterObject)
getParameterReferenceM = createReferenceLookupM Ref.getParameterReference
getExampleReferenceM :: Text -> Generator (Maybe OAT.ExampleObject)
getExampleReferenceM = createReferenceLookupM Ref.getExampleReference
getRequestBodyReferenceM :: Text -> Generator (Maybe OAT.RequestBodyObject)
getRequestBodyReferenceM = createReferenceLookupM Ref.getRequestBodyReference
getHeaderReferenceM :: Text -> Generator (Maybe OAT.HeaderObject)
getHeaderReferenceM = createReferenceLookupM Ref.getHeaderReference
getSecuritySchemeReferenceM :: Text -> Generator (Maybe OAT.SecuritySchemeObject)
getSecuritySchemeReferenceM = createReferenceLookupM Ref.getSecuritySchemeReference
getFlags :: Generator OAF.Flags
getFlags = MR.asks flags
getFlag :: (OAF.Flags -> a) -> Generator a
getFlag f = MR.asks $ f . flags