Show sql errors in the same page instead of showing crash page

digitallyinduced · Jun 20, 2021 · a69d682 · a69d682
1 parent b394e87
commit a69d682
Show file tree

Hide file tree

Showing 2 changed files with 38 additions and 16 deletions.
diff --git a/IHP/IDE/Data/Controller.hs b/IHP/IDE/Data/Controller.hs
@@ -17,8 +17,8 @@ import qualified Database.PostgreSQL.Simple.ToField as PG
 import qualified Database.PostgreSQL.Simple.Types as PG
 import qualified Data.Text as T
 import qualified Data.ByteString.Builder
-
 import qualified Data.ByteString.Char8 as BS
+import Data.Functor ((<&>))
 
 instance Controller DataController where
     action ShowDatabaseAction = do
@@ -41,9 +41,15 @@ instance Controller DataController where
 
     action ShowQueryAction = do
         connection <- connectToAppDb
-        let query = (param @Text "query")
-        when (query == "") $ redirectTo ShowDatabaseAction
-        rows :: [[DynamicField]] <- if isQuery query then PG.query_ connection (fromString (cs query)) else PG.execute_ connection (fromString (cs query)) >> return []
+        let queryText = param @Text "query"
+        when (queryText == "") $ redirectTo ShowDatabaseAction
+        let query = fromString $ cs queryText
+
+        queryResult :: Either PG.SqlError [[DynamicField]] <- if isQuery queryText then
+                (PG.query_ connection query <&> Right) `catch` (pure . Left)
+            else
+                PG.execute_ connection query >> pure (Right []) `catch` (pure . Left)
+
         PG.close connection
         render ShowQueryView { .. }
 

diff --git a/IHP/IDE/Data/View/ShowQuery.hs b/IHP/IDE/Data/View/ShowQuery.hs
@@ -1,5 +1,6 @@
 module IHP.IDE.Data.View.ShowQuery where
 
+import qualified Database.PostgreSQL.Simple as PG
 import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Layout
@@ -9,8 +10,8 @@ import IHP.IDE.Data.View.ShowDatabase
 import IHP.IDE.Data.View.Layout
 
 data ShowQueryView = ShowQueryView
-    { rows :: [[DynamicField]]
-    , query :: Text
+    { queryResult :: Either PG.SqlError [[DynamicField]]
+    , queryText :: Text
     }
 
 instance View ShowQueryView where
@@ -21,22 +22,37 @@ instance View ShowQueryView where
                     {renderRows}
                 </div>
             </div>
-            {customQuery query}
+            {customQuery queryText}
         </div>
     |]
         where
-            renderRows = [hsx|
-                <table class="table table-sm table-hover table-striped data-rows-table">
-                    {tableHead}
-                    {tableBody}
-                </table>
-            |]
+            renderRows = case queryResult of
+                Right rows -> [hsx|
+                    <table class="table table-sm table-hover table-striped data-rows-table">
+                        {tableHead rows}
+                        {tableBody rows}
+                    </table>
+                |]
+                Left sqlError -> [hsx|
+                    <div class="alert alert-danger" role="alert">
+                        <h4 class="alert-heading">SQL Error - {get #sqlExecStatus sqlError}</h4>
+                        {showIfNotEmpty "Message" (get #sqlErrorMsg sqlError)}
+                        {showIfNotEmpty "Details" (get #sqlErrorDetail sqlError)}
+                        {showIfNotEmpty "Hint" (get #sqlErrorHint sqlError)}
+                        {showIfNotEmpty "State" (get #sqlState sqlError)}
+                    </div>
+                |]
 
-            tableHead = [hsx|<thead><tr>{forEach columnNames renderColumnHead}</tr></thead>|]
+            tableHead rows = [hsx|<thead><tr>{forEach (columnNames rows) renderColumnHead}</tr></thead>|]
             renderColumnHead name = [hsx|<th>{name}</th>|]
 
-            tableBody = [hsx|<tbody>{forEach rows renderRow}</tbody>|]
+            tableBody rows = [hsx|<tbody>{forEach rows renderRow}</tbody>|]
             renderRow fields = [hsx|<tr>{forEach fields renderField}</tr>|]
             renderField DynamicField { .. } = [hsx|<td><span data-fieldname={fieldName}>{sqlValueToText fieldValue}</span></td>|]
 
-            columnNames = map (get #fieldName) (fromMaybe [] (head rows))
+            columnNames rows = maybe [] (map (get #fieldName)) (head rows)
+
+            showIfNotEmpty :: Text -> ByteString -> Html
+            showIfNotEmpty title text = case text of
+                "" -> mempty
+                _ -> [hsx|<div><strong>{title}:</strong> {text}</div>|]