Skip to content

Commit

Permalink
Improved spacing in generated code
Browse files Browse the repository at this point in the history
  • Loading branch information
@mpscholten
mpscholten committed Aug 30, 2022
1 parent 90b52b3 commit 39dfead
Show file tree
Hide file tree
Showing 2 changed files with 39 additions and 8 deletions.
2 changes: 1 addition & 1 deletion IHP/IDE/CodeGen/ControllerGenerator.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -164,7 +164,7 @@ generateController schema config =
<> "build" <> singularName <> " " <> modelVariableSingular <> " = " <> modelVariableSingular <> "\n"
<> " |> fill " <> toTypeLevelList modelFields <> "\n"

toTypeLevelList values = "@" <> (if length values < 2 then "'" else "") <> tshow values
toTypeLevelList values = "@" <> (if length values < 2 then "'" else "") <> (values |> tshow |> Text.replace "," ", ")
in
""
<> "module " <> moduleName <> " where" <> "\n"
Expand Down
45 changes: 38 additions & 7 deletions Test/IDE/CodeGeneration/ControllerGenerator.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,41 @@ tests = do
]
, primaryKeyConstraint = PrimaryKeyConstraint ["id"]
, constraints = []
}
]
},
StatementCreateTable CreateTable {
name = "people"
, columns = [
Column
{ name = "id"
, columnType = PUUID
, defaultValue = Just (CallExpression "uuid_generate_v4" [])
, notNull = True
, isUnique = False
, generator = Nothing
}
,
Column
{ name = "name"
, columnType = PText
, defaultValue = Nothing
, notNull = True
, isUnique = False
, generator = Nothing
}
,
Column
{ name = "email"
, columnType = PText
, defaultValue = Nothing
, notNull = True
, isUnique = False
, generator = Nothing
}
]
, primaryKeyConstraint = PrimaryKeyConstraint ["id"]
, constraints = []
}
]
it "should build a controller with name \"pages\"" do
let rawControllerName = "pages"
let controllerName = tableNameToControllerName rawControllerName
Expand Down Expand Up @@ -162,7 +195,7 @@ tests = do
let builtPlan = ControllerGenerator.buildPlan' schema applicationName controllerName modelName pagination

builtPlan `shouldBe`
[ CreateFile {filePath = "Web/Controller/People.hs", fileContent = "module Web.Controller.People where\n\nimport Web.Controller.Prelude\nimport Web.View.People.Index\nimport Web.View.People.New\nimport Web.View.People.Edit\nimport Web.View.People.Show\n\ninstance Controller PeopleController where\n action PeopleAction = do\n people <- query @Person |> fetch\n render IndexView { .. }\n\n action NewPersonAction = do\n let person = newRecord\n render NewView { .. }\n\n action ShowPersonAction { personId } = do\n person <- fetch personId\n render ShowView { .. }\n\n action EditPersonAction { personId } = do\n person <- fetch personId\n render EditView { .. }\n\n action UpdatePersonAction { personId } = do\n person <- fetch personId\n person\n |> buildPerson\n |> ifValid \\case\n Left person -> render EditView { .. }\n Right person -> do\n person <- person |> updateRecord\n setSuccessMessage \"Person updated\"\n redirectTo EditPersonAction { .. }\n\n action CreatePersonAction = do\n let person = newRecord @Person\n person\n |> buildPerson\n |> ifValid \\case\n Left person -> render NewView { .. } \n Right person -> do\n person <- person |> createRecord\n setSuccessMessage \"Person created\"\n redirectTo PeopleAction\n\n action DeletePersonAction { personId } = do\n person <- fetch personId\n deleteRecord person\n setSuccessMessage \"Person deleted\"\n redirectTo PeopleAction\n\nbuildPerson person = person\n |> fill @'[]\n"}
[ CreateFile {filePath = "Web/Controller/People.hs", fileContent = "module Web.Controller.People where\n\nimport Web.Controller.Prelude\nimport Web.View.People.Index\nimport Web.View.People.New\nimport Web.View.People.Edit\nimport Web.View.People.Show\n\ninstance Controller PeopleController where\n action PeopleAction = do\n people <- query @Person |> fetch\n render IndexView { .. }\n\n action NewPersonAction = do\n let person = newRecord\n render NewView { .. }\n\n action ShowPersonAction { personId } = do\n person <- fetch personId\n render ShowView { .. }\n\n action EditPersonAction { personId } = do\n person <- fetch personId\n render EditView { .. }\n\n action UpdatePersonAction { personId } = do\n person <- fetch personId\n person\n |> buildPerson\n |> ifValid \\case\n Left person -> render EditView { .. }\n Right person -> do\n person <- person |> updateRecord\n setSuccessMessage \"Person updated\"\n redirectTo EditPersonAction { .. }\n\n action CreatePersonAction = do\n let person = newRecord @Person\n person\n |> buildPerson\n |> ifValid \\case\n Left person -> render NewView { .. } \n Right person -> do\n person <- person |> createRecord\n setSuccessMessage \"Person created\"\n redirectTo PeopleAction\n\n action DeletePersonAction { personId } = do\n person <- fetch personId\n deleteRecord person\n setSuccessMessage \"Person deleted\"\n redirectTo PeopleAction\n\nbuildPerson person = person\n |> fill @[\"name\", \"email\"]\n"}
, AppendToFile {filePath = "Web/Routes.hs", fileContent = "\ninstance AutoRoute PeopleController\n\n"}
, AppendToFile {filePath = "Web/Types.hs", fileContent = "\ndata PeopleController\n = PeopleAction\n | NewPersonAction\n | ShowPersonAction { personId :: !(Id Person) }\n | CreatePersonAction\n | EditPersonAction { personId :: !(Id Person) }\n | UpdatePersonAction { personId :: !(Id Person) }\n | DeletePersonAction { personId :: !(Id Person) }\n deriving (Eq, Show, Data)\n"}
, AppendToMarker {marker = "-- Controller Imports", filePath = "Web/FrontController.hs", fileContent = "import Web.Controller.People"}
Expand All @@ -171,17 +204,15 @@ tests = do
, CreateFile {filePath = "Web/View/People/Index.hs", fileContent = "module Web.View.People.Index where\nimport Web.View.Prelude\n\ndata IndexView = IndexView { people :: [Person] }\n\ninstance View IndexView where\n html IndexView { .. } = [hsx|\n {breadcrumb}\n\n <h1>Index<a href={pathTo NewPersonAction} class=\"btn btn-primary ml-4\">+ New</a></h1>\n <div class=\"table-responsive\">\n <table class=\"table\">\n <thead>\n <tr>\n <th>Person</th>\n <th></th>\n <th></th>\n <th></th>\n </tr>\n </thead>\n <tbody>{forEach people renderPerson}</tbody>\n </table>\n \n </div>\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"People\" PeopleAction\n ]\n\nrenderPerson :: Person -> Html\nrenderPerson person = [hsx|\n <tr>\n <td>{person}</td>\n <td><a href={ShowPersonAction person.id}>Show</a></td>\n <td><a href={EditPersonAction person.id} class=\"text-muted\">Edit</a></td>\n <td><a href={DeletePersonAction person.id} class=\"js-delete text-muted\">Delete</a></td>\n </tr>\n|]"}
, AddImport {filePath = "Web/Controller/People.hs", fileContent = "import Web.View.People.Index"}
, EnsureDirectory {directory = "Web/View/People"}
, CreateFile {filePath = "Web/View/People/New.hs", fileContent = "module Web.View.People.New where\nimport Web.View.Prelude\n\ndata NewView = NewView { person :: Person }\n\ninstance View NewView where\n html NewView { .. } = [hsx|\n {breadcrumb}\n <h1>New Person</h1>\n {renderForm person}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"People\" PeopleAction\n , breadcrumbText \"New Person\"\n ]\n\nrenderForm :: Person -> Html\nrenderForm person = formFor person [hsx|\n \n {submitButton}\n\n|]"}
, CreateFile {filePath = "Web/View/People/New.hs", fileContent = "module Web.View.People.New where\nimport Web.View.Prelude\n\ndata NewView = NewView { person :: Person }\n\ninstance View NewView where\n html NewView { .. } = [hsx|\n {breadcrumb}\n <h1>New Person</h1>\n {renderForm person}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"People\" PeopleAction\n , breadcrumbText \"New Person\"\n ]\n\nrenderForm :: Person -> Html\nrenderForm person = formFor person [hsx|\n {(textField #name)}\n {(textField #email)}\n {submitButton}\n\n|]"}
, AddImport {filePath = "Web/Controller/People.hs", fileContent = "import Web.View.People.New"}
, EnsureDirectory {directory = "Web/View/People"}
, CreateFile {filePath = "Web/View/People/Show.hs", fileContent = "module Web.View.People.Show where\nimport Web.View.Prelude\n\ndata ShowView = ShowView { person :: Person }\n\ninstance View ShowView where\n html ShowView { .. } = [hsx|\n {breadcrumb}\n <h1>Show Person</h1>\n <p>{person}</p>\n\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"People\" PeopleAction\n , breadcrumbText \"Show Person\"\n ]"}
, AddImport {filePath = "Web/Controller/People.hs", fileContent = "import Web.View.People.Show"}
, EnsureDirectory {directory = "Web/View/People"}
, CreateFile {filePath = "Web/View/People/Edit.hs", fileContent = "module Web.View.People.Edit where\nimport Web.View.Prelude\n\ndata EditView = EditView { person :: Person }\n\ninstance View EditView where\n html EditView { .. } = [hsx|\n {breadcrumb}\n <h1>Edit Person</h1>\n {renderForm person}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"People\" PeopleAction\n , breadcrumbText \"Edit Person\"\n ]\n\nrenderForm :: Person -> Html\nrenderForm person = formFor person [hsx|\n \n {submitButton}\n\n|]"}
, CreateFile {filePath = "Web/View/People/Edit.hs", fileContent = "module Web.View.People.Edit where\nimport Web.View.Prelude\n\ndata EditView = EditView { person :: Person }\n\ninstance View EditView where\n html EditView { .. } = [hsx|\n {breadcrumb}\n <h1>Edit Person</h1>\n {renderForm person}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"People\" PeopleAction\n , breadcrumbText \"Edit Person\"\n ]\n\nrenderForm :: Person -> Html\nrenderForm person = formFor person [hsx|\n {(textField #name)}\n {(textField #email)}\n {submitButton}\n\n|]"}
, AddImport {filePath = "Web/Controller/People.hs", fileContent = "import Web.View.People.Edit"}
]





0 comments on commit 39dfead

Please sign in to comment.