From 6f3e2689fb5d0d3d89047982e0d90e0c67e666a6 Mon Sep 17 00:00:00 2001 From: Marc Scholten Date: Tue, 8 Aug 2023 13:06:16 +0200 Subject: [PATCH 1/3] Added isValid function to check whether a record is valid quickly --- IHP/Controller/Param.hs | 2 +- IHP/ModelSupport.hs | 13 +++++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/IHP/Controller/Param.hs b/IHP/Controller/Param.hs index 59a0e20af..b6af58660 100644 --- a/IHP/Controller/Param.hs +++ b/IHP/Controller/Param.hs @@ -631,7 +631,7 @@ instance (FillParams rest record {-# INLINE fill #-} ifValid :: (HasField "meta" model ModelSupport.MetaBag) => (Either model model -> IO r) -> model -> IO r -ifValid branch model = branch $! if isEmpty model.meta.annotations +ifValid branch model = branch $! if ModelSupport.isValid model then Right model else Left model {-# INLINE ifValid #-} diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index f906544f9..abef9a46a 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -1010,3 +1010,16 @@ onlyWhereReferences field referenced records = filter (\record -> get field reco -- See 'onlyWhere' for more details. onlyWhereReferencesMaybe :: forall record fieldName value referencedRecord. (KnownSymbol fieldName, HasField fieldName record (Maybe value), Eq value, HasField "id" referencedRecord value) => Proxy fieldName -> referencedRecord -> [record] -> [record] onlyWhereReferencesMaybe field referenced records = filter (\record -> get field record == Just referenced.id) records + +-- | Returns True when a record has no validation errors attached from a previous validation call +-- +-- Example: +-- +-- > isValidProject :: Project -> Bool +-- > isValidProject project = +-- > project +-- > |> validateField #name isNonEmpty +-- > |> isValid +-- +isValid :: forall record. (HasField "meta" record MetaBag) => record -> Bool +isValid record = isEmpty record.meta.annotations \ No newline at end of file From 9f54047874e7a7898f7da09c1baffb8be23afbff Mon Sep 17 00:00:00 2001 From: Marc Scholten Date: Tue, 8 Aug 2023 16:35:41 +0200 Subject: [PATCH 2/3] Fixed unhelpful error message when running migrations When the migration SQL code is missing a `;`, we get an error regarding an unexpected `INSERT INTO`. The user will be confused when the migration isn't even containing any `INSERT TO` calls at all. To fix this we terminate the current statement by force adding a `;` --- IHP/SchemaMigration.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/IHP/SchemaMigration.hs b/IHP/SchemaMigration.hs index 9a4f559c9..942ed67ae 100644 --- a/IHP/SchemaMigration.hs +++ b/IHP/SchemaMigration.hs @@ -41,7 +41,7 @@ runMigration migration@Migration { revision, migrationFile } = do let fullSql = [trimming| BEGIN; - ${migrationSql} + ${migrationSql}; INSERT INTO schema_migrations (revision) VALUES (?); COMMIT; |] From 91e3108021bfdb14c2f7b23551bcfa6066248294 Mon Sep 17 00:00:00 2001 From: Marc Scholten Date: Tue, 8 Aug 2023 22:07:52 +0200 Subject: [PATCH 3/3] improved space handling in view generator --- IHP/IDE/CodeGen/ViewGenerator.hs | 2 +- Test/IDE/CodeGeneration/ControllerGenerator.hs | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/IHP/IDE/CodeGen/ViewGenerator.hs b/IHP/IDE/CodeGen/ViewGenerator.hs index be646c9a1..7ffe6d24c 100644 --- a/IHP/IDE/CodeGen/ViewGenerator.hs +++ b/IHP/IDE/CodeGen/ViewGenerator.hs @@ -173,7 +173,7 @@ buildPlan' schema config = indexView = [trimming| ${viewHeader} - data IndexView = IndexView { ${pluralVariableName} :: [${singularName}] ${importPagination} } + data IndexView = IndexView { ${pluralVariableName} :: [${singularName}]${importPagination} } instance View IndexView where html IndexView { .. } = [hsx| diff --git a/Test/IDE/CodeGeneration/ControllerGenerator.hs b/Test/IDE/CodeGeneration/ControllerGenerator.hs index dc7c5d308..5c65af63c 100644 --- a/Test/IDE/CodeGeneration/ControllerGenerator.hs +++ b/Test/IDE/CodeGeneration/ControllerGenerator.hs @@ -82,7 +82,7 @@ tests = do , AppendToMarker {marker = "-- Controller Imports", filePath = "Web/FrontController.hs", fileContent = "import Web.Controller.Pages"} , AppendToMarker {marker = "-- Generator Marker", filePath = "Web/FrontController.hs", fileContent = " , parseRoute @PagesController"} , EnsureDirectory {directory = "Web/View/Pages"} - , CreateFile {filePath = "Web/View/Pages/Index.hs", fileContent = "module Web.View.Pages.Index where\nimport Web.View.Prelude\n\ndata IndexView = IndexView { pages :: [Page] }\n\ninstance View IndexView where\n html IndexView { .. } = [hsx|\n {breadcrumb}\n\n

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach pages renderPage}\n
Page
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Pages\" PagesAction\n ]\n\nrenderPage :: Page -> Html\nrenderPage page = [hsx|\n \n {page}\n Show\n Edit\n Delete\n \n|]"} + , CreateFile {filePath = "Web/View/Pages/Index.hs", fileContent = "module Web.View.Pages.Index where\nimport Web.View.Prelude\n\ndata IndexView = IndexView { pages :: [Page] }\n\ninstance View IndexView where\n html IndexView { .. } = [hsx|\n {breadcrumb}\n\n

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach pages renderPage}\n
Page
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Pages\" PagesAction\n ]\n\nrenderPage :: Page -> Html\nrenderPage page = [hsx|\n \n {page}\n Show\n Edit\n Delete\n \n|]"} , AddImport {filePath = "Web/Controller/Pages.hs", fileContent = "import Web.View.Pages.Index"} , EnsureDirectory {directory = "Web/View/Pages"} , CreateFile {filePath = "Web/View/Pages/New.hs", fileContent = "module Web.View.Pages.New where\nimport Web.View.Prelude\n\ndata NewView = NewView { page :: Page }\n\ninstance View NewView where\n html NewView { .. } = [hsx|\n {breadcrumb}\n

New Page

\n {renderForm page}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Pages\" PagesAction\n , breadcrumbText \"New Page\"\n ]\n\nrenderForm :: Page -> Html\nrenderForm page = formFor page [hsx|\n \n {submitButton}\n\n|]"} @@ -113,7 +113,7 @@ tests = do , AppendToMarker {marker = "-- Controller Imports", filePath = "Web/FrontController.hs", fileContent = "import Web.Controller.Page"} , AppendToMarker {marker = "-- Generator Marker", filePath = "Web/FrontController.hs", fileContent = " , parseRoute @PageController"} , EnsureDirectory {directory = "Web/View/Page"} - , CreateFile {filePath = "Web/View/Page/Index.hs", fileContent = "module Web.View.Page.Index where\nimport Web.View.Prelude\n\ndata IndexView = IndexView { page :: [Page] }\n\ninstance View IndexView where\n html IndexView { .. } = [hsx|\n {breadcrumb}\n\n

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach page renderPage}\n
Page
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Pages\" PagesAction\n ]\n\nrenderPage :: Page -> Html\nrenderPage page = [hsx|\n \n {page}\n Show\n Edit\n Delete\n \n|]"} + , CreateFile {filePath = "Web/View/Page/Index.hs", fileContent = "module Web.View.Page.Index where\nimport Web.View.Prelude\n\ndata IndexView = IndexView { page :: [Page] }\n\ninstance View IndexView where\n html IndexView { .. } = [hsx|\n {breadcrumb}\n\n

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach page renderPage}\n
Page
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Pages\" PagesAction\n ]\n\nrenderPage :: Page -> Html\nrenderPage page = [hsx|\n \n {page}\n Show\n Edit\n Delete\n \n|]"} , AddImport {filePath = "Web/Controller/Page.hs", fileContent = "import Web.View.Page.Index"} , EnsureDirectory {directory = "Web/View/Page"} , CreateFile {filePath = "Web/View/Page/New.hs", fileContent = "module Web.View.Page.New where\nimport Web.View.Prelude\n\ndata NewView = NewView { page :: Page }\n\ninstance View NewView where\n html NewView { .. } = [hsx|\n {breadcrumb}\n

New Page

\n {renderForm page}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"Pages\" PagesAction\n , breadcrumbText \"New Page\"\n ]\n\nrenderForm :: Page -> Html\nrenderForm page = formFor page [hsx|\n \n {submitButton}\n\n|]"} @@ -142,7 +142,7 @@ tests = do , AppendToMarker {marker = "-- Controller Imports", filePath = "Web/FrontController.hs", fileContent = "import Web.Controller.PageComment"} , AppendToMarker {marker = "-- Generator Marker", filePath = "Web/FrontController.hs", fileContent = " , parseRoute @PageCommentController"} , EnsureDirectory {directory = "Web/View/PageComment"} - , CreateFile {filePath = "Web/View/PageComment/Index.hs", fileContent = "module Web.View.PageComment.Index where\nimport Web.View.Prelude\n\ndata IndexView = IndexView { pageComment :: [PageComment] }\n\ninstance View IndexView where\n html IndexView { .. } = [hsx|\n {breadcrumb}\n\n

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach pageComment renderPageComment}\n
PageComment
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"PageComments\" PageCommentsAction\n ]\n\nrenderPageComment :: PageComment -> Html\nrenderPageComment pageComment = [hsx|\n \n {pageComment}\n Show\n Edit\n Delete\n \n|]"} + , CreateFile {filePath = "Web/View/PageComment/Index.hs", fileContent = "module Web.View.PageComment.Index where\nimport Web.View.Prelude\n\ndata IndexView = IndexView { pageComment :: [PageComment] }\n\ninstance View IndexView where\n html IndexView { .. } = [hsx|\n {breadcrumb}\n\n

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach pageComment renderPageComment}\n
PageComment
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"PageComments\" PageCommentsAction\n ]\n\nrenderPageComment :: PageComment -> Html\nrenderPageComment pageComment = [hsx|\n \n {pageComment}\n Show\n Edit\n Delete\n \n|]"} , AddImport {filePath = "Web/Controller/PageComment.hs", fileContent = "import Web.View.PageComment.Index"} , EnsureDirectory {directory = "Web/View/PageComment"} , CreateFile {filePath = "Web/View/PageComment/New.hs", fileContent = "module Web.View.PageComment.New where\nimport Web.View.Prelude\n\ndata NewView = NewView { pageComment :: PageComment }\n\ninstance View NewView where\n html NewView { .. } = [hsx|\n {breadcrumb}\n

New PageComment

\n {renderForm pageComment}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"PageComments\" PageCommentsAction\n , breadcrumbText \"New PageComment\"\n ]\n\nrenderForm :: PageComment -> Html\nrenderForm pageComment = formFor pageComment [hsx|\n \n {submitButton}\n\n|]"} @@ -172,7 +172,7 @@ tests = do , AppendToMarker {marker = "-- Controller Imports", filePath = "Web/FrontController.hs", fileContent = "import Web.Controller.PageComment"} , AppendToMarker {marker = "-- Generator Marker", filePath = "Web/FrontController.hs", fileContent = " , parseRoute @PageCommentController"} , EnsureDirectory {directory = "Web/View/PageComment"} - , CreateFile {filePath = "Web/View/PageComment/Index.hs", fileContent = "module Web.View.PageComment.Index where\nimport Web.View.Prelude\n\ndata IndexView = IndexView { pageComment :: [PageComment] }\n\ninstance View IndexView where\n html IndexView { .. } = [hsx|\n {breadcrumb}\n\n

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach pageComment renderPageComment}\n
PageComment
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"PageComments\" PageCommentsAction\n ]\n\nrenderPageComment :: PageComment -> Html\nrenderPageComment pageComment = [hsx|\n \n {pageComment}\n Show\n Edit\n Delete\n \n|]"} + , CreateFile {filePath = "Web/View/PageComment/Index.hs", fileContent = "module Web.View.PageComment.Index where\nimport Web.View.Prelude\n\ndata IndexView = IndexView { pageComment :: [PageComment] }\n\ninstance View IndexView where\n html IndexView { .. } = [hsx|\n {breadcrumb}\n\n

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach pageComment renderPageComment}\n
PageComment
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"PageComments\" PageCommentsAction\n ]\n\nrenderPageComment :: PageComment -> Html\nrenderPageComment pageComment = [hsx|\n \n {pageComment}\n Show\n Edit\n Delete\n \n|]"} , AddImport {filePath = "Web/Controller/PageComment.hs", fileContent = "import Web.View.PageComment.Index"} , EnsureDirectory {directory = "Web/View/PageComment"} , CreateFile {filePath = "Web/View/PageComment/New.hs", fileContent = "module Web.View.PageComment.New where\nimport Web.View.Prelude\n\ndata NewView = NewView { pageComment :: PageComment }\n\ninstance View NewView where\n html NewView { .. } = [hsx|\n {breadcrumb}\n

New PageComment

\n {renderForm pageComment}\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"PageComments\" PageCommentsAction\n , breadcrumbText \"New PageComment\"\n ]\n\nrenderForm :: PageComment -> Html\nrenderForm pageComment = formFor pageComment [hsx|\n \n {submitButton}\n\n|]"} @@ -203,7 +203,7 @@ tests = do , AppendToMarker {marker = "-- Controller Imports", filePath = "Web/FrontController.hs", fileContent = "import Web.Controller.People"} , AppendToMarker {marker = "-- Generator Marker", filePath = "Web/FrontController.hs", fileContent = " , parseRoute @PeopleController"} , EnsureDirectory {directory = "Web/View/People"} - , 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

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach people renderPerson}\n
Person
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"People\" PeopleAction\n ]\n\nrenderPerson :: Person -> Html\nrenderPerson person = [hsx|\n \n {person}\n Show\n Edit\n Delete\n \n|]"} + , 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

Index+ New

\n
\n \n \n \n \n \n \n \n \n \n {forEach people renderPerson}\n
Person
\n \n
\n |]\n where\n breadcrumb = renderBreadcrumb\n [ breadcrumbLink \"People\" PeopleAction\n ]\n\nrenderPerson :: Person -> Html\nrenderPerson person = [hsx|\n \n {person}\n Show\n Edit\n Delete\n \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

New Person

\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|]"}