From bbd3107dea50323d73ee6c79f1ff3cdaf4a35b65 Mon Sep 17 00:00:00 2001 From: Liam McDermott Date: Wed, 9 Oct 2024 15:07:38 -0400 Subject: [PATCH 1/4] Fix incorrectly referenced variable in View generator. --- ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs b/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs index 7ffe6d24c..72c06b81e 100644 --- a/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs +++ b/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs @@ -80,7 +80,7 @@ buildPlan' schema config = genericView = [trimming| ${viewHeader} - data ${nameWithSuffix} = {$nameWithSuffix} + data ${nameWithSuffix} = ${nameWithSuffix} instance View ${nameWithSuffix} where html ${nameWithSuffix} { .. } = [hsx| From e02a4e38e2475329ec40413d80becb464811b8a1 Mon Sep 17 00:00:00 2001 From: Liam McDermott Date: Wed, 9 Oct 2024 15:22:41 -0400 Subject: [PATCH 2/4] Fix missing brackets in View generator. --- ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs b/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs index 72c06b81e..ae3e19765 100644 --- a/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs +++ b/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs @@ -80,7 +80,7 @@ buildPlan' schema config = genericView = [trimming| ${viewHeader} - data ${nameWithSuffix} = ${nameWithSuffix} + data ${nameWithSuffix} = {${nameWithSuffix}} instance View ${nameWithSuffix} where html ${nameWithSuffix} { .. } = [hsx| From db98a1f2279a9e56bc249504f3abb86fe0e0bf82 Mon Sep 17 00:00:00 2001 From: Liam McDermott Date: Wed, 9 Oct 2024 16:29:14 -0400 Subject: [PATCH 3/4] Add `tableNameToViewName` and make view generator use it. --- IHP/NameSupport.hs | 12 ++++++++++++ Test/NameSupportSpec.hs | 11 +++++++++++ ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs | 5 +++-- 3 files changed, 26 insertions(+), 2 deletions(-) diff --git a/IHP/NameSupport.hs b/IHP/NameSupport.hs index 2d9c0ef73..e4e9e9c22 100644 --- a/IHP/NameSupport.hs +++ b/IHP/NameSupport.hs @@ -13,6 +13,7 @@ module IHP.NameSupport , fieldNameToColumnName , escapeHaskellKeyword , tableNameToControllerName +, tableNameToViewName , enumValueToControllerName , toSlug , module IHP.NameSupport.Inflections @@ -67,6 +68,17 @@ tableNameToControllerName tableName = do else ucfirst tableName {-# INLINABLE tableNameToControllerName #-} +-- | Transforms an underscore table name to a name for a view +-- +-- >>> tableNameToViewName "users" +-- +-- >>> tableNameToViewName "projects" +-- +-- >>> tableNameToViewName "user_projects" +tableNameToViewName :: Text -> Text +tableNameToViewName = tableNameToControllerName +{-# INLINABLE tableNameToViewName #-} + -- | Transforms a enum value to a name for a model -- -- >>> enumValueToControllerName "happy" diff --git a/Test/NameSupportSpec.hs b/Test/NameSupportSpec.hs index d7036c3ee..8216c5a79 100644 --- a/Test/NameSupportSpec.hs +++ b/Test/NameSupportSpec.hs @@ -33,6 +33,17 @@ tests = do tableNameToControllerName "users_projects" `shouldBe` "UsersProjects" tableNameToControllerName "people" `shouldBe` "People" + describe "tableNameToViewName" do + it "should deal with empty input" do + tableNameToViewName "" `shouldBe` "" + + it "should transform table names to controller names" do + tableNameToViewName "users" `shouldBe` "Users" + tableNameToViewName "projects" `shouldBe` "Projects" + tableNameToViewName "user_projects" `shouldBe` "UserProjects" + tableNameToViewName "users_projects" `shouldBe` "UsersProjects" + tableNameToViewName "people" `shouldBe` "People" + describe "enumValueToControllerName" do it "should handle spaces in table names" do enumValueToControllerName "very happy" `shouldBe` "VeryHappy" diff --git a/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs b/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs index ae3e19765..dd32eb8e1 100644 --- a/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs +++ b/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs @@ -15,8 +15,8 @@ data ViewConfig = ViewConfig } deriving (Eq, Show) buildPlan :: Text -> Text -> Text -> IO (Either Text [GeneratorAction]) -buildPlan viewName applicationName controllerName' = - if (null viewName || null controllerName') +buildPlan viewName' applicationName controllerName' = + if (null viewName' || null controllerName') then pure $ Left "Neither view name nor controller name can be empty" else do schema <- SchemaDesigner.parseSchemaSql >>= \case @@ -24,6 +24,7 @@ buildPlan viewName applicationName controllerName' = Right statements -> pure statements let modelName = tableNameToModelName controllerName' let controllerName = tableNameToControllerName controllerName' + let viewName = tableNameToViewName viewName' let paginationEnabled = False let viewConfig = ViewConfig { .. } pure $ Right $ buildPlan' schema viewConfig From 84f2cbdda9fb23a5c15c0d108f318cfa66733413 Mon Sep 17 00:00:00 2001 From: Liam McDermott Date: Wed, 9 Oct 2024 17:03:57 -0400 Subject: [PATCH 4/4] Fix view generator tests. - Tests were enforcing incorrect Haskell code generation for `genericView` - Update tests to use `tableNameToViewName` like controller tests. - Add tests view names with underscores and camel case. --- Test/IDE/CodeGeneration/ViewGenerator.hs | 43 +++++++++++++++++++++--- ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs | 2 +- 2 files changed, 40 insertions(+), 5 deletions(-) diff --git a/Test/IDE/CodeGeneration/ViewGenerator.hs b/Test/IDE/CodeGeneration/ViewGenerator.hs index c229172f9..4c96bbdfd 100644 --- a/Test/IDE/CodeGeneration/ViewGenerator.hs +++ b/Test/IDE/CodeGeneration/ViewGenerator.hs @@ -35,7 +35,8 @@ tests = do } ] it "should build a view with name \"EditView\"" do - let viewName = "EditView" + let rawViewName = "EditView" + let viewName = tableNameToViewName rawViewName let rawControllerName = "Pages" let controllerName = tableNameToControllerName rawControllerName let modelName = tableNameToModelName rawControllerName @@ -50,8 +51,41 @@ tests = do + it "should build a view with name \"edit_view\"" do + let rawViewName = "edit_view" + let viewName = tableNameToViewName rawViewName + let rawControllerName = "Pages" + let controllerName = tableNameToControllerName rawControllerName + let modelName = tableNameToModelName rawControllerName + let applicationName = "Web" + let paginationEnabled = False + let config = ViewGenerator.ViewConfig { .. } + let builtPlan = ViewGenerator.buildPlan' schema config + + builtPlan `shouldBe` + [ EnsureDirectory {directory = "Web/View/Pages"},CreateFile {filePath = "Web/View/Pages/Edit.hs", fileContent = "module Web.View.Pages.Edit where\nimport Web.View.Prelude\n\ndata EditView = EditView { page :: Page }\n\ninstance View EditView where\n html EditView { .. } = [hsx|\n {breadcrumb}\n

Edit Page

\n {renderForm page}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Pages\" PagesAction\n , breadcrumbText \"Edit Page\"\n ]\n\nrenderForm :: Page -> Html\nrenderForm page = formFor page [hsx|\n \n {submitButton}\n\n|]"},AddImport {filePath = "Web/Controller/Pages.hs", fileContent = "import Web.View.Pages.Edit"} + ] + + + it "should build a view with name \"editView\"" do + let rawViewName = "editView" + let viewName = tableNameToViewName rawViewName + let rawControllerName = "Pages" + let controllerName = tableNameToControllerName rawControllerName + let modelName = tableNameToModelName rawControllerName + let applicationName = "Web" + let paginationEnabled = False + let config = ViewGenerator.ViewConfig { .. } + let builtPlan = ViewGenerator.buildPlan' schema config + + builtPlan `shouldBe` + [ EnsureDirectory {directory = "Web/View/Pages"},CreateFile {filePath = "Web/View/Pages/Edit.hs", fileContent = "module Web.View.Pages.Edit where\nimport Web.View.Prelude\n\ndata EditView = EditView { page :: Page }\n\ninstance View EditView where\n html EditView { .. } = [hsx|\n {breadcrumb}\n

Edit Page

\n {renderForm page}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Pages\" PagesAction\n , breadcrumbText \"Edit Page\"\n ]\n\nrenderForm :: Page -> Html\nrenderForm page = formFor page [hsx|\n \n {submitButton}\n\n|]"},AddImport {filePath = "Web/Controller/Pages.hs", fileContent = "import Web.View.Pages.Edit"} + ] + + it "should build a view with name \"Edit\"" do - let viewName = "Edit" + let rawViewName = "Edit" + let viewName = tableNameToViewName rawViewName let rawControllerName = "Pages" let controllerName = tableNameToControllerName rawControllerName let modelName = tableNameToModelName rawControllerName @@ -66,7 +100,8 @@ tests = do it "should build a view with name \"Test\"" do - let viewName = "Test" + let rawViewName = "Test" + let viewName = tableNameToViewName rawViewName let rawControllerName = "Pages" let controllerName = tableNameToControllerName rawControllerName let modelName = tableNameToModelName rawControllerName @@ -76,5 +111,5 @@ tests = do let builtPlan = ViewGenerator.buildPlan' schema config builtPlan `shouldBe` - [ EnsureDirectory {directory = "Web/View/Pages"},CreateFile {filePath = "Web/View/Pages/Test.hs", fileContent = "module Web.View.Pages.Test where\nimport Web.View.Prelude\ndata TestView = {TestView}\n\ninstance View TestView where\n html TestView { .. } = [hsx|\n {breadcrumb}\n

TestView

\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Tests\" PagesAction\n , breadcrumbText \"TestView\"\n ]"},AddImport {filePath = "Web/Controller/Pages.hs", fileContent = "import Web.View.Pages.Test"} + [ EnsureDirectory {directory = "Web/View/Pages"},CreateFile {filePath = "Web/View/Pages/Test.hs", fileContent = "module Web.View.Pages.Test where\nimport Web.View.Prelude\ndata TestView = TestView\n\ninstance View TestView where\n html TestView { .. } = [hsx|\n {breadcrumb}\n

TestView

\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Tests\" PagesAction\n , breadcrumbText \"TestView\"\n ]"},AddImport {filePath = "Web/Controller/Pages.hs", fileContent = "import Web.View.Pages.Test"} ] \ No newline at end of file diff --git a/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs b/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs index dd32eb8e1..3cecdae59 100644 --- a/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs +++ b/ihp-ide/IHP/IDE/CodeGen/ViewGenerator.hs @@ -81,7 +81,7 @@ buildPlan' schema config = genericView = [trimming| ${viewHeader} - data ${nameWithSuffix} = {${nameWithSuffix}} + data ${nameWithSuffix} = ${nameWithSuffix} instance View ${nameWithSuffix} where html ${nameWithSuffix} { .. } = [hsx|