module IHP.IDE.CodeGen.View.Generators where import IHP.ViewPrelude import IHP.IDE.ToolServer.Types import IHP.IDE.ToolServer.Layout import IHP.IDE.CodeGen.Types import qualified Data.Text as Text import IHP.IDE.ToolServer.Helper.View data GeneratorsView = GeneratorsView instance View GeneratorsView where html GeneratorsView = [hsx|
{renderFlashMessages}
{generator "Controller" (pathTo NewControllerAction) copyIcon} {generator "Action" (pathTo NewActionAction) copyIcon} {generator "View" (pathTo NewViewAction) copyIcon} {generator "Mail" (pathTo NewMailAction) copyIcon} {generator "Background Job" (pathTo NewJobAction) cogsIcon} {generator "Script" (pathTo NewScriptAction) copyIcon} {generator "Migration" (pathTo NewMigrationAction) dataIcon} {generator "Application" (pathTo NewApplicationAction) copyIcon}
|] where generator :: Text -> Text -> Html -> Html generator name path icon = [hsx|
{icon}
{name}
|] renderPlan (Left error) = [hsx|{error}|] renderPlan (Right actions) = [hsx|
{forEach actions renderGeneratorAction}
|] renderGeneratorAction CreateFile { .. } = [hsx|
{filePath}
{Text.strip fileContent}
|] renderGeneratorAction AppendToFile { .. } = [hsx|
Append to {filePath}
{Text.strip fileContent}
|] renderGeneratorAction AppendToMarker { .. } = [hsx|
Append to {filePath}
{Text.strip fileContent}
|] renderGeneratorAction AddImport { .. } = [hsx|
Append to {filePath}
{Text.strip fileContent}
|] renderGeneratorAction AddAction { .. } = [hsx|
Append to {filePath}
{Text.strip fileContent}
|] renderGeneratorAction AddMountToFrontController { .. } = [hsx|
Mount to FrontController {filePath}
{Text.strip applicationName}
|] renderGeneratorAction AddToDataConstructor { .. } = [hsx|
Append to {filePath}
{Text.strip fileContent}
|] renderGeneratorAction EnsureDirectory {} = mempty renderGeneratorAction RunShellCommand {} = mempty