module IHP.IDE.CodeGen.ActionGenerator (buildPlan) where import IHP.Prelude import qualified Data.Text as Text import IHP.IDE.CodeGen.Types import qualified IHP.IDE.SchemaDesigner.Parser as SchemaDesigner import IHP.IDE.SchemaDesigner.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 <- SchemaDesigner.parseSchemaSql >>= \case Left parserError -> pure [] Right statements -> pure statements 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 = if "Action" `isSuffixOf` name then name else name <> "Action" -- e.g. TestAction viewName = if "Action" `isSuffixOf` name then Text.dropEnd 6 name else 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 indexContent = "" <> " action " <> name <> "Action = do\n" <> " " <> modelVariablePlural <> " <- query @" <> model <> " |> fetch\n" <> " render IndexView { .. }\n" newContent = "" <> " action New" <> singularName <> "Action = do\n" <> " let " <> modelVariableSingular <> " = newRecord\n" <> " render NewView { .. }\n" showContent = "" <> " action Show" <> singularName <> "Action { " <> idFieldName <> " } = do\n" <> " " <> modelVariableSingular <> " <- fetch " <> idFieldName <> "\n" <> " render ShowView { .. }\n" editContent = "" <> " action Edit" <> singularName <> "Action { " <> idFieldName <> " } = do\n" <> " " <> modelVariableSingular <> " <- fetch " <> idFieldName <> "\n" <> " render EditView { .. }\n" updateContent = "" <> " action Update" <> singularName <> "Action { " <> idFieldName <> " } = do\n" <> " " <> modelVariableSingular <> " <- fetch " <> idFieldName <> "\n" <> " " <> modelVariableSingular <> "\n" <> " |> build" <> singularName <> "\n" <> " |> ifValid \\case\n" <> " Left " <> modelVariableSingular <> " -> render EditView { .. }\n" <> " Right " <> modelVariableSingular <> " -> do\n" <> " " <> modelVariableSingular <> " <- " <> modelVariableSingular <> " |> updateRecord\n" <> " setSuccessMessage \"" <> model <> " updated\"\n" <> " redirectTo Edit" <> singularName <> "Action { .. }\n" createContent = "" <> " action Create" <> singularName <> "Action = do\n" <> " let " <> modelVariableSingular <> " = newRecord @" <> model <> "\n" <> " " <> modelVariableSingular <> "\n" <> " |> build" <> singularName <> "\n" <> " |> ifValid \\case\n" <> " Left " <> modelVariableSingular <> " -> render NewView { .. }\n" <> " Right " <> modelVariableSingular <> " -> do\n" <> " " <> modelVariableSingular <> " <- " <> modelVariableSingular <> " |> createRecord\n" <> " setSuccessMessage \"" <> model <> " created\"\n" <> " redirectTo " <> name <> "Action\n" deleteContent = "" <> " action Delete" <> singularName <> "Action { " <> idFieldName <> " } = do\n" <> " " <> modelVariableSingular <> " <- fetch " <> idFieldName <> "\n" <> " deleteRecord " <> modelVariableSingular <> "\n" <> " setSuccessMessage \"" <> model <> " deleted\"\n" <> " redirectTo " <> name <> "Action\n" 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 = config.applicationName <> "/Controller/" <> controllerName <> ".hs", fileContent = chosenContent} , AddToDataConstructor { dataConstructor = "data " <> controllerName, filePath = config.applicationName <> "/Types.hs", fileContent = chosenType } ]