added pagination + menu

IDE/IHP/IDE/Data/Controller.hs

@@ -18,6 +18,8 @@ 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
+
 instance Controller DataController where
     action ShowDatabaseAction = do
         connection <- connectToAppDb
@@ -26,11 +28,15 @@ instance Controller DataController where
         render ShowDatabaseView { .. }
 
     action ShowTableRowsAction { tableName } = do
+        let page :: Int = paramOrDefault @Int 1 "page"
+        let pageSize :: Int = paramOrDefault @Int 20 "rows"
         connection <- connectToAppDb
         tableNames <- fetchTableNames connection
         primaryKeyFields <- tablePrimaryKeyFields connection tableName
-        rows :: [[DynamicField]] <- fetchRows connection tableName
+        rows :: [[DynamicField]] <- fetchRowsPage connection tableName page pageSize
         tableCols <- fetchTableCols connection tableName
+        totalRows <- tableLength connection tableName
+        putStrLn (show totalRows)
         PG.close connection
         render ShowTableRowsView { .. }
 
@@ -179,6 +185,25 @@ fetchRows connection tableName = do
 
     PG.query_ connection (PG.Query . cs $! query)
 
+fetchRowsPage :: FromRow r => PG.Connection -> Text -> Int -> Int -> IO [r]
+fetchRowsPage connection tableName page rows = do
+    pkFields <- tablePrimaryKeyFields connection tableName
+    let slice = " OFFSET " <> show (page * rows - rows) <> " ROWS FETCH FIRST " <> show rows <> " ROWS ONLY"
+    let query = "SELECT * FROM " <> tableName <> " ORDER BY " <> intercalate ", " pkFields <> slice 
+    putStrLn query
+
+    PG.query_ connection (PG.Query . cs $! query)
+
+tableLength :: _ => PG.Connection -> Text -> IO (Int)
+tableLength connection tableName = do
+    let query = "SELECT count(*) FROM " <> tableName
+
+    a :: [[DynamicField]] <- PG.query_ connection (PG.Query . cs $! query)
+    let (Just value) = get #fieldValue (a!!0!!0)
+    let (Just length) = (BS.readInt value)
+    pure (fst length)
+
+
 -- parseValues sqlMode isBoolField input
 parseValues :: Bool -> Bool -> Text -> PG.Action
 parseValues _ True "on" = PG.toField True

IDE/IHP/IDE/Data/View/ShowTableRows.hs

@@ -16,15 +16,22 @@ data ShowTableRowsView = ShowTableRowsView
     , rows :: [[DynamicField]]
     , tableCols :: [ColumnDefinition]
     , primaryKeyFields :: [Text]
+    , pageSize :: Int
+    , page :: Int
+    , totalRows :: Int
     }
 
 instance View ShowTableRowsView where
     html ShowTableRowsView { .. } = [hsx|
         <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" oncontextmenu="showContextMenu('context-menu-data-root')">
-                    {renderRows rows tableBody tableName}
+                <div class="col" oncontextmenu="showContextMenu('context-menu-data-root')">
+                    <div style="overflow: scroll; max-height: 80vh">
+                        {renderRows rows tableBody tableName}
+                    </div>
+                    {pageMenu}
+
                 </div>
             </div>
             {customQuery ""}
@@ -54,3 +61,32 @@ instance View ShowTableRowsView where
             columnNames = map (get #fieldName) (fromMaybe [] (head rows))
 
             onClick tableName fieldName primaryKey = "window.location.assign(" <> tshow (pathTo (ToggleBooleanFieldAction tableName (cs fieldName) primaryKey)) <> ")"
+
+            totalPages = [1..ceiling (fromIntegral(totalRows) / fromIntegral(pageSize))]
+
+            pageMenu = if length totalPages <= 1 
+                then mempty
+                else [hsx|
+                    <div style="position: absolute; bottom: 0; height: 30px" class="d-flex justify-content-center w-100 bg-white" oncontextmenu="showContextMenu('context-menu-pagination'); event.stopPropagation();">
+                        {backButton}
+                        {forEach (totalPages) renderPageButton}
+                        {nextButton}  
+                    </div>
+                    <div class="custom-menu menu-for-column shadow backdrop-blur" id="context-menu-pagination">
+                        <span class="text-muted mx-3">Display Rows</span>
+                        <a href={pathTo (ShowTableRowsAction tableName) <> "&page=" <> show page <> "&rows=20"}>20</a>
+                        <a href={pathTo (ShowTableRowsAction tableName) <> "&page=" <> show page <> "&rows=50"}>50</a>
+                        <a href={pathTo (ShowTableRowsAction tableName) <> "&page=" <> show page <> "&rows=100"}>100</a>
+                    </div>
+                |]
+                    where 
+                        backButton = if page > 1
+                            then [hsx|<a href={pathTo (ShowTableRowsAction tableName) <> "&page=" <> show (page-1) <> "&rows=" <> show pageSize} class="mx-3 text-muted">{"< Back" :: Text}</a>|]
+                            else [hsx|<a class="mx-3 text-muted" style="cursor: not-allowed">{"< Back" :: Text}</a>|]
+                        nextButton = if page < length totalPages
+                            then [hsx|<a href={pathTo (ShowTableRowsAction tableName) <> "&page=" <> show (page+1) <> "&rows=" <> show pageSize} class="mx-3 text-muted">{"Next >" :: Text}</a>|]
+                            else [hsx|<a class="mx-3 text-muted" style="cursor: not-allowed">{"Next >" :: Text}</a>|]
+
+
+            renderPageButton :: Int -> Html
+            renderPageButton nr = [hsx|<a href={pathTo (ShowTableRowsAction tableName) <> "&page=" <> show nr <> "&rows=" <> show pageSize} class={classes ["mx-2", (if page==nr then "text-dark font-weight-bold" else "text-muted")]}>{nr}</a>|]

IDE/IHP/IDE/ToolServer/Types.hs

@@ -109,6 +109,8 @@ data DynamicField = DynamicField
     , fieldName :: ByteString
     } deriving (Show)
 
+data TableLength = TableLength { tableSize :: Int }
+
 data ColumnDefinition = ColumnDefinition
     { columnName :: Text
     , columnType :: Text