ihp-ide-1.5.0: IHP/IDE/CodeGen/ActionGenerator.hs
module IHP.IDE.CodeGen.ActionGenerator (buildPlan) where
import IHP.Prelude
import qualified Data.Text as Text
import IHP.IDE.CodeGen.Types
import IHP.Postgres.Types
import qualified IHP.IDE.CodeGen.ViewGenerator as ViewGenerator
import Text.Countable (pluralize)
data ActionConfig = ActionConfig
{ controllerName :: Text
, applicationName :: Text
, modelName :: Text
, actionName :: Text
} deriving (Eq, Show)
buildPlan :: Text -> Text -> Text -> Bool -> IO (Either Text [GeneratorAction])
buildPlan actionName applicationName controllerName doGenerateView=
if (null actionName || null controllerName)
then pure $ Left "Neither action name nor controller name can be empty"
else do
schema <- loadAppSchema
let actionConfig = ActionConfig {controllerName, applicationName, modelName, actionName }
let actionPlan = generateGenericAction schema actionConfig doGenerateView
if doGenerateView
then do
viewPlan <- ViewGenerator.buildPlan viewName applicationName controllerName
case viewPlan of
Right viewPlan' -> pure $ Right $ actionPlan ++ viewPlan'
Left error -> pure $ Left error
else pure $ Right $ actionPlan
where
viewName = ucfirst $ if "Action" `isSuffixOf` actionName
then Text.dropEnd 6 actionName
else actionName
modelName = tableNameToModelName controllerName
-- E.g. qualifiedViewModuleName config "Edit" == "Web.View.Users.Edit"
-- qualifiedViewModuleName :: ActionConfig -> Text -> Text
-- qualifiedViewModuleName config viewName =
-- config.applicationName <> ".View." <> config.controllerName <> "." <> viewName
generateGenericAction :: [Statement] -> ActionConfig -> Bool -> [GeneratorAction]
generateGenericAction schema config doGenerateView =
let
controllerName = config.controllerName
name = ucfirst $ config.actionName
singularName = config.modelName
(nameWithSuffix, viewName) = ensureSuffix "Action" name
indexAction = pluralize singularName <> "Action"
specialCases = [
(indexAction, indexContent)
, ("Show" <> singularName <> "Action", showContent)
, ("Edit" <> singularName <> "Action", editContent)
, ("Update" <> singularName <> "Action", updateContent)
, ("Create" <> singularName <> "Action", createContent)
, ("Delete" <> singularName <> "Action", deleteContent)
]
actionContent = if doGenerateView
then
" action " <> nameWithSuffix <> " = " <> "do" <> "\n"
<> " render " <> viewName <> "View { .. }\n"
else
""
<> " action " <> nameWithSuffix <> " = " <> "do" <> "\n"
<> " redirectTo "<> controllerName <> "Action\n"
modelVariablePlural = lcfirst name
modelVariableSingular = lcfirst singularName
idFieldName = lcfirst singularName <> "Id"
idType = "Id " <> singularName
model = ucfirst singularName
tableFound = [ modelNameToTableName modelVariableSingular, modelVariableSingular ]
|> mapMaybe (columnsForTable schema)
|> headMay
|> isJust
actionBodyConfig = ActionBodyConfig { singularName, modelVariableSingular, idFieldName, model, indexAction = name <> "Action", tableFound }
indexContent =
""
<> " action " <> name <> "Action = do\n"
<> " " <> modelVariablePlural <> " <- query @" <> model <> " |> fetch\n"
<> " render IndexView { .. }\n"
newContent = generateNewActionBody actionBodyConfig
showContent = generateShowActionBody actionBodyConfig
editContent = generateEditActionBody actionBodyConfig
updateContent = generateUpdateActionBody actionBodyConfig
createContent = generateCreateActionBody actionBodyConfig
deleteContent = generateDeleteActionBody actionBodyConfig
typesContentGeneric =
" | " <> nameWithSuffix
typesContentWithParameter =
" | " <> nameWithSuffix <> " { " <> idFieldName <> " :: !(" <> idType <> ") }\n"
chosenContent = fromMaybe actionContent (lookup nameWithSuffix specialCases)
chosenType = if chosenContent `elem` [actionContent, newContent, createContent, indexContent]
then typesContentGeneric
else typesContentWithParameter
in
[ AddAction { filePath = textToOsPath (config.applicationName <> "/Controller/" <> controllerName <> ".hs"), fileContent = chosenContent}
, AddToDataConstructor { dataConstructor = "data " <> controllerName, filePath = textToOsPath (config.applicationName <> "/Types.hs"), fileContent = chosenType }
]