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