packages feed

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 }
            ]