Merge pull request #352 from digitallyinduced/data-rework

Data Explorer Rework
digitallyinduced · Aug 30, 2020 · 2d5451a · 2d5451a
2 parents 96211c5 + bbd264b
commit 2d5451a
Show file tree

Hide file tree

Showing 9 changed files with 74 additions and 31 deletions.
diff --git a/IHP/IDE/Data/Controller.hs b/IHP/IDE/Data/Controller.hs
@@ -30,6 +30,8 @@ instance Controller DataController where
 
         rows :: [[DynamicField]] <- PG.query connection "SELECT * FROM ? ORDER BY id" (PG.Only (PG.Identifier tableName))
 
+        tableCols <- fetchTableCols connection tableName
+
         PG.close connection
         render ShowTableRowsView { .. }
 
@@ -70,7 +72,6 @@ instance Controller DataController where
         tableCols <- fetchTableCols connection tableName
         let values :: [Text] = map (\col -> param @Text (cs (get #columnName col))) tableCols
         let query = "INSERT INTO " <> tableName <> " VALUES (" <> intercalate "," values <> ")"
-        putStrLn (query)
         PG.execute_ connection (PG.Query . cs $! query)
         PG.close connection
         redirectTo ShowTableRowsAction { .. }
@@ -109,6 +110,18 @@ instance Controller DataController where
         let targetId = cs id
         PG.close connection
         render EditValueView { .. }
+
+    action ToggleBooleanFieldAction { tableName, targetName, id } = do
+        let id :: String = cs (param @Text "id")
+        let tableName = param "tableName"
+        connection <- connectToAppDb
+        tableNames <- fetchTableNames connection
+        tableCols <- fetchTableCols connection tableName
+        let query = PG.Query ("UPDATE ? SET ? = NOT ? WHERE id = ?")
+        let params = (PG.Identifier tableName, PG.Identifier targetName, PG.Identifier targetName, id)
+        PG.execute connection query params
+        PG.close connection
+        redirectTo ShowTableRowsAction { .. }
 
 
 connectToAppDb = do

diff --git a/IHP/IDE/Data/View/EditRow.hs b/IHP/IDE/Data/View/EditRow.hs
@@ -22,21 +22,25 @@ data EditRowView = EditRowView
 
 instance View EditRowView ViewContext where
     html EditRowView { .. } = [hsx|
-        <div class="container pt-5">
-            {customQuery ""}
+        <div class="mx-2 pt-5">
             <div class="row no-gutters bg-white">
                 {renderTableSelector tableNames tableName}
                 <div class="col" style="overflow: scroll; max-height: 80vh">
                     {renderRows rows tableBody tableName}
                 </div>
             </div>
+            {customQuery ""}
         </div>
         {Just modal}
     |]
         where
             tableBody = [hsx|<tbody>{forEach rows renderRow}</tbody>|]
-            renderRow fields = [hsx|<tr>{forEach fields renderField}</tr>|]
-            renderField DynamicField { .. } = [hsx|<td><span data-fieldname={fieldName}>{fieldValue}</span></td>|]
+            renderRow fields = [hsx|<tr>{forEach fields (renderField id)}</tr>|]
+                where
+                    id = (cs (fromMaybe "" (get #fieldValue (fromJust (headMay fields)))))
+            renderField id DynamicField { .. } | fieldName == "id" = [hsx|<td><span data-fieldname={fieldName}><a class="no-link border rounded p-1" href={EditRowValueAction tableName (cs fieldName) id}>{renderId (sqlValueToText fieldValue)}</a></span></td>|]
+            renderField id DynamicField { .. } | isBoolField fieldName tableCols && not (isNothing fieldValue) = [hsx|<td><span data-fieldname={fieldName}><input type="checkbox" onclick={onClick tableName fieldName id} checked={sqlValueToText fieldValue == "t"} /></span></td>|]
+            renderField id DynamicField { .. } = [hsx|<td><span data-fieldname={fieldName}><a class="no-link" href={EditRowValueAction tableName (cs fieldName) id}>{sqlValueToText fieldValue}</a></span></td>|]
 
 
             modalContent = [hsx|
@@ -66,4 +70,6 @@ instance View EditRowView ViewContext where
                             class="form-control"
                             value={"'" <> (fromMaybe "" (get #fieldValue (snd col))) <> "'"}
                             />
-                    </div>|]
+                    </div>|]
+
+            onClick tableName fieldName id = "window.location.assign(" <> tshow (pathTo (ToggleBooleanFieldAction tableName (cs fieldName) id)) <> ")"
diff --git a/IHP/IDE/Data/View/EditValue.hs b/IHP/IDE/Data/View/EditValue.hs
@@ -21,14 +21,14 @@ data EditValueView = EditValueView
 
 instance View EditValueView ViewContext where
     html EditValueView { .. } = [hsx|
-        <div class="container pt-5">
-            {customQuery ""}
+        <div class="mx-2 pt-5">
             <div class="row no-gutters bg-white">
                 {renderTableSelector tableNames tableName}
                 <div class="col" style="overflow: scroll; max-height: 80vh">
                     {renderRows rows tableBody tableName}
                 </div>
             </div>
+            {customQuery ""}
         </div>
         {script}
     |]
@@ -55,7 +55,7 @@ instance View EditValueView ViewContext where
                     <input type="hidden" name="tableName" value={tableName}/>
                     <button type="submit" class="d-none">Edit</button>
                 </form></td>|]
-                else [hsx|<td><span data-fieldname={fieldName}><a class="no-link" href={EditRowValueAction tableName (cs fieldName) id}>{fieldValue}</a></span></td>|]
+                else [hsx|<td><span data-fieldname={fieldName}><a class="no-link" href={EditRowValueAction tableName (cs fieldName) id}>{sqlValueToText fieldValue}</a></span></td>|]
             renderValue DynamicField { .. } = [hsx|<input type="hidden" name={fieldName} value={"'" <> fromMaybe "" fieldValue <> "'"}/>|]
             script = preEscapedToHtml [plain|
                 <script>

diff --git a/IHP/IDE/Data/View/Layout.hs b/IHP/IDE/Data/View/Layout.hs
@@ -1,17 +1,15 @@
-module IHP.IDE.Data.View.Layout (customQuery, tableHead, renderColumnHead, columnNames, renderRows) where
+module IHP.IDE.Data.View.Layout (customQuery, tableHead, renderColumnHead, columnNames, renderRows, sqlValueToText, renderId, isBoolField) where
 
 import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types hiding (columnNames)
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
 
 customQuery :: Text -> Html
-customQuery input = [hsx|<div class="p-2 rounded mb-2" style="background-color: #002B36;"><div id="queryInput">{input}</div></div>|]
+customQuery input = [hsx|<div class="p-2 rounded mt-2" style="background-color: #002B36;"><div id="queryInput" style="height:16px">{input}</div></div>|]
 
 tableHead :: [[DynamicField]] -> Text -> Html
-tableHead rows tableName = [hsx|<thead><tr>{forEach (columnNames rows) renderColumnHead}
-        <td><a href={NewRowAction tableName} class="btn btn-primary btn-sm">Add</a></td>
-    </tr></thead>|]
+tableHead rows tableName = [hsx|<thead><tr>{forEach (columnNames rows) renderColumnHead}</tr></thead>|]
 renderColumnHead name = [hsx|<th>{name}</th>|]
 
 columnNames rows = map (get #fieldName) (fromMaybe [] (head rows))
@@ -22,4 +20,14 @@ renderRows rows body tableName = [hsx|
         {tableHead rows tableName}
         {body}
     </table>
-|]
+|]
+
+sqlValueToText :: Maybe ByteString -> Text
+sqlValueToText (Just value) = cs value
+sqlValueToText Nothing = "NULL"
+
+renderId id = take 4 (cs id) <> ".." <> reverse (take 4 (reverse (cs id)))
+
+isBoolField fieldName tableCols = case (find (\c -> get #columnName c == (cs fieldName)) tableCols) of
+    Just columnDef -> (get #columnType columnDef) == "boolean"
+    Nothing -> False
diff --git a/IHP/IDE/Data/View/NewRow.hs b/IHP/IDE/Data/View/NewRow.hs
@@ -20,21 +20,25 @@ data NewRowView = NewRowView
 
 instance View NewRowView ViewContext where
     html NewRowView { .. } = [hsx|
-        <div class="container pt-5">
-            {customQuery ""}
+        <div class="mx-2 pt-5">
             <div class="row no-gutters bg-white">
                 {renderTableSelector tableNames tableName}
                 <div class="col" style="overflow: scroll; max-height: 80vh">
                     {renderRows rows tableBody tableName}
                 </div>
             </div>
+            {customQuery ""}
         </div>
         {Just modal}
     |]
         where
             tableBody = [hsx|<tbody>{forEach rows renderRow}</tbody>|]
-            renderRow fields = [hsx|<tr>{forEach fields renderField}</tr>|]
-            renderField DynamicField { .. } = [hsx|<td><span data-fieldname={fieldName}>{fieldValue}</span></td>|]
+            renderRow fields = [hsx|<tr>{forEach fields (renderField id)}</tr>|]
+                where
+                    id = (cs (fromMaybe "" (get #fieldValue (fromJust (headMay fields)))))
+            renderField id DynamicField { .. } | fieldName == "id" = [hsx|<td><span data-fieldname={fieldName}><a class="no-link border rounded p-1" href={EditRowValueAction tableName (cs fieldName) id}>{renderId (sqlValueToText fieldValue)}</a></span></td>|]
+            renderField id DynamicField { .. } | isBoolField fieldName tableCols && not (isNothing fieldValue) = [hsx|<td><span data-fieldname={fieldName}><input type="checkbox" onclick={onClick tableName fieldName id} checked={sqlValueToText fieldValue == "t"} /></span></td>|]
+            renderField id DynamicField { .. } = [hsx|<td><span data-fieldname={fieldName}><a class="no-link" href={EditRowValueAction tableName (cs fieldName) id}>{sqlValueToText fieldValue}</a></span></td>|]
 
             modalContent = [hsx|
                 <form method="POST" action={CreateRowAction}>
@@ -63,4 +67,6 @@ instance View NewRowView ViewContext where
                             class="form-control"
                             value={fromMaybe "''" (get #columnDefault col)}
                             />
-                    </div>|]
+                    </div>|]
+
+            onClick tableName fieldName id = "window.location.assign(" <> tshow (pathTo (ToggleBooleanFieldAction tableName (cs fieldName) id)) <> ")"
diff --git a/IHP/IDE/Data/View/ShowDatabase.hs b/IHP/IDE/Data/View/ShowDatabase.hs
@@ -14,11 +14,11 @@ data ShowDatabaseView = ShowDatabaseView {
 
 instance View ShowDatabaseView ViewContext where
     html ShowDatabaseView { .. } = [hsx|
-        <div class="container pt-5">
-            {customQuery ""}
+        <div class="mx-2 pt-5">
             <div class="row no-gutters bg-white">
                 {renderTableSelector tableNames ""}
             </div>
+            {customQuery ""}
         </div>
     |]
 
@@ -29,6 +29,7 @@ renderTableSelector tableNames activeTableName = [hsx|
             <h5>Tables</h5>
         </div>
         {forEach tableNames renderTable}
+        <div class="text-muted context-menu-notice">Right click to open context menu</div>
     </div>
 |]
     where

diff --git a/IHP/IDE/Data/View/ShowQuery.hs b/IHP/IDE/Data/View/ShowQuery.hs
@@ -17,13 +17,13 @@ data ShowQueryView = ShowQueryView
 
 instance View ShowQueryView ViewContext where
     html ShowQueryView { .. } = [hsx|
-        <div class="container pt-5">
-            {customQuery query}
+        <div class="mx-2 pt-5">
             <div class="row no-gutters bg-white">
                 <div class="col" style="overflow: scroll; max-height: 80vh">
                     {renderRows}
                 </div>
             </div>
+            {customQuery query}
         </div>
     |]
         where
@@ -39,6 +39,6 @@ instance View ShowQueryView ViewContext where
 
             tableBody = [hsx|<tbody>{forEach rows renderRow}</tbody>|]
             renderRow fields = [hsx|<tr>{forEach fields renderField}</tr>|]
-            renderField DynamicField { .. } = [hsx|<td><span data-fieldname={fieldName}>{fieldValue}</span></td>|]
+            renderField DynamicField { .. } = [hsx|<td><span data-fieldname={fieldName}>{sqlValueToText fieldValue}</span></td>|]
 
             columnNames = map (get #fieldName) (fromMaybe [] (head rows))
diff --git a/IHP/IDE/Data/View/ShowTableRows.hs b/IHP/IDE/Data/View/ShowTableRows.hs
@@ -15,24 +15,28 @@ data ShowTableRowsView = ShowTableRowsView
     { tableNames :: [Text]
     , tableName :: Text
     , rows :: [[DynamicField]]
+    , tableCols :: [ColumnDefinition]
     }
 
 instance View ShowTableRowsView ViewContext where
     html ShowTableRowsView { .. } = [hsx|
-        <div class="container pt-5">
-            {customQuery ""}
+        <div class="mx-2 pt-5">
             <div class="row no-gutters bg-white">
                 {renderTableSelector tableNames tableName}
-                <div class="col" style="overflow: scroll; max-height: 80vh">
+                <div class="col" style="overflow: scroll; max-height: 80vh" oncontextmenu="showContextMenu('context-menu-data-root')">
                     {renderRows rows tableBody tableName}
                 </div>
             </div>
+            {customQuery ""}
+        </div>
+        <div class="custom-menu menu-for-column shadow backdrop-blur" id="context-menu-data-root">
+            <a href={NewRowAction tableName}>Add Row</a>
         </div>
     |]
         where
 
             tableBody = [hsx|<tbody>{forEach rows renderRow}</tbody>|]
-            renderRow fields = [hsx|<tr oncontextmenu={"showContextMenu('" <> contextMenuId <> "');"}>{forEach fields (renderField id)}</tr>
+            renderRow fields = [hsx|<tr oncontextmenu={"showContextMenu('" <> contextMenuId <> "'); event.stopPropagation();"}>{forEach fields (renderField id)}</tr>
             <div class="custom-menu menu-for-column shadow backdrop-blur" id={contextMenuId}>
                 <a href={EditRowAction tableName id}>Edit Row</a>
                 <a href={DeleteEntryAction id tableName} class="js-delete">Delete Row</a>
@@ -42,6 +46,10 @@ instance View ShowTableRowsView ViewContext where
                 where
                     contextMenuId = "context-menu-column-" <> tshow id
                     id = (cs (fromMaybe "" (get #fieldValue (fromJust (headMay fields)))))
-            renderField id DynamicField { .. } = [hsx|<td><span data-fieldname={fieldName}><a class="no-link" href={EditRowValueAction tableName (cs fieldName) id}>{fieldValue}</a></span></td>|]
+            renderField id DynamicField { .. } | fieldName == "id" = [hsx|<td><span data-fieldname={fieldName}><a class="no-link border rounded p-1" href={EditRowValueAction tableName (cs fieldName) id}>{renderId (sqlValueToText fieldValue)}</a></span></td>|]
+            renderField id DynamicField { .. } | isBoolField fieldName tableCols && not (isNothing fieldValue) = [hsx|<td><span data-fieldname={fieldName}><input type="checkbox" onclick={onClick tableName fieldName id} checked={sqlValueToText fieldValue == "t"} /></span></td>|]
+            renderField id DynamicField { .. } = [hsx|<td><span data-fieldname={fieldName}><a class="no-link" href={EditRowValueAction tableName (cs fieldName) id}>{sqlValueToText fieldValue}</a></span></td>|]
+
+            columnNames = map (get #fieldName) (fromMaybe [] (head rows))
 
-            columnNames = map (get #fieldName) (fromMaybe [] (head rows))
+            onClick tableName fieldName id = "window.location.assign(" <> tshow (pathTo (ToggleBooleanFieldAction tableName (cs fieldName) id)) <> ")"
diff --git a/IHP/IDE/ToolServer/Types.hs b/IHP/IDE/ToolServer/Types.hs
@@ -82,6 +82,7 @@ data DataController
     | EditRowAction { tableName :: Text, id :: Text }
     | UpdateRowAction
     | EditRowValueAction { tableName :: Text, targetName :: Text, id :: Text }
+    | ToggleBooleanFieldAction { tableName :: Text, targetName :: Text, id :: Text }
     deriving (Eq, Show, Data)
 
 data LogsController