Merge pull request #2004 from liammcdermott/generate-capitalised-view…

…-names Add capitalisation to view generator
digitallyinduced · Oct 10, 2024 · b27260d · b27260d
2 parents ff45e48 + 84f2cbd
commit b27260d
Show file tree

Hide file tree

Showing 4 changed files with 66 additions and 7 deletions.
diff --git 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/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        <h1>Edit Page</h1>\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        <h1>Edit Page</h1>\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        <h1>TestView</h1>\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        <h1>TestView</h1>\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"}
                 ]
diff --git 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
@@ -15,15 +15,16 @@ 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
                 Left parserError -> pure []
                 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
@@ -80,7 +81,7 @@ buildPlan' schema config =
 
             genericView = [trimming|
                 ${viewHeader}
-                data ${nameWithSuffix} = {$nameWithSuffix}
+                data ${nameWithSuffix} = ${nameWithSuffix}
 
                 instance View ${nameWithSuffix} where
                     html ${nameWithSuffix} { .. } = [hsx|