Fix dbTable

- Row numbering now works as expected
  - Default sorting & filtering now actually gets applied

src/Handler/Utils/Table/Pagination.hs

@@ -22,7 +22,7 @@ module Handler.Utils.Table.Pagination
   , FilterColumn(..), IsFilterColumn
   , DBRow(..), DBOutput
   , DBTable(..), IsDBTable(..)
-  , PaginationSettings(..)
+  , PaginationSettings(..), PaginationInput(..), piIsUnset
   , PSValidator(..)
   , defaultFilter, defaultSorting
   , restrictFilter, restrictSorting
@@ -160,16 +160,41 @@ instance Default PaginationSettings where
     , psShortcircuit = False
     }
 
-newtype PSValidator m x = PSValidator { runPSValidator :: DBTable m x -> Maybe PaginationSettings -> ([SomeMessage UniWorX], PaginationSettings) }
+data PaginationInput = PaginationInput
+  { piSorting      :: Maybe [(CI Text, SortDirection)]
+  , piFilter       :: Maybe (Map (CI Text) [Text])
+  , piLimit        :: Maybe Int64
+  , piPage         :: Maybe Int64
+  , piShortcircuit :: Bool
+  }
+
+piIsUnset :: PaginationInput -> Bool
+piIsUnset PaginationInput{..} = and
+  [ isNothing piSorting
+  , isNothing piFilter
+  , isNothing piLimit
+  , isNothing piPage
+  , not piShortcircuit
+  ]
+
+newtype PSValidator m x = PSValidator { runPSValidator :: DBTable m x -> Maybe PaginationInput -> ([SomeMessage UniWorX], PaginationSettings) }
 
 instance Default (PSValidator m x) where
   def = PSValidator $ \DBTable{..} -> \case
     Nothing -> def
-    Just ps -> swap . (\act -> execRWS act () ps) $ do
-      l <- gets psLimit
-      when (l <= 0) $ do
-        modify $ \ps -> ps { psLimit = psLimit def }
-        tell . pure $ SomeMessage MsgPSLimitNonPositive
+    Just pi -> swap . (\act -> execRWS act pi def) $ do
+      asks piSorting >>= maybe (return ()) (\s -> modify $ \ps -> ps { psSorting = s })
+      asks piFilter >>= maybe (return ()) (\f -> modify $ \ps -> ps { psFilter = f })
+      
+      l <- asks piLimit
+      case l of
+        Just l'
+          | l' >= 0   -> tell . pure $ SomeMessage MsgPSLimitNonPositive
+          | otherwise -> modify $ \ps -> ps { psLimit = l' }
+        Nothing -> return ()
+
+      asks piPage >>= maybe (return ()) (\p -> modify $ \ps -> ps { psPage = p })
+      asks piShortcircuit >>= (\s -> modify $ \ps -> ps { psShortcircuit = s })
 
 defaultFilter :: Map (CI Text) [Text] -> PSValidator m x -> PSValidator m x
 defaultFilter psFilter (runPSValidator -> f) = PSValidator g
@@ -281,24 +306,25 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
       , fieldEnctype = UrlEncoded
       }
     
-  psResult <- runInputGetResult $ PaginationSettings
-    <$> (fromMaybe [] <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting"))
-    <*> (Map.mapMaybe ((\args -> args <$ guard (not $ null args)) =<<) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ CI.foldedCase k) dbtFilter)
-    <*> (fromMaybe (psLimit defPS) <$> iopt intField (wIdent "pagesize"))
-    <*> (fromMaybe (psPage  defPS) <$> iopt intField (wIdent "page"))
+  psResult <- runInputGetResult $ PaginationInput
+    <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting")
+    <*> ((\m -> m <$ guard (not $ Map.null m)) . Map.mapMaybe ((\args -> args <$ guard (not $ null args)) =<<) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ CI.foldedCase k) dbtFilter)
+    <*> iopt intField (wIdent "pagesize")
+    <*> iopt intField (wIdent "page")
     <*> ireq checkBoxField (wIdent "table-only")
 
-  $(logDebug) . tshow $ (,,,,) <$> (length . psSorting <$> psResult)
-                               <*> (Map.keys . psFilter <$> psResult)
-                               <*> (psLimit <$> psResult)
-                               <*> (psPage <$> psResult)
-                               <*> (psShortcircuit <$> psResult)
+  $(logDebug) . tshow $ (,,,,) <$> (piSorting <$> psResult)
+                               <*> (piFilter <$> psResult)
+                               <*> (piLimit <$> psResult)
+                               <*> (piPage <$> psResult)
+                               <*> (piShortcircuit <$> psResult)
 
   let
     (errs, PaginationSettings{..}) = case psResult of
-      FormSuccess ps   -> runPSValidator dbtable $ Just ps
-      FormFailure errs -> first (map SomeMessage errs <>) $ runPSValidator dbtable Nothing
-      FormMissing      -> runPSValidator dbtable Nothing
+      FormSuccess pi
+        | not (piIsUnset pi) -> runPSValidator dbtable $ Just pi
+      FormFailure errs       -> first (map SomeMessage errs <>) $ runPSValidator dbtable Nothing
+      _                      -> runPSValidator dbtable Nothing
     psSorting' = map (first (dbtSorting !)) psSorting
     sqlQuery' = E.from $ \t -> dbtSQLQuery t
       <* E.orderBy (map (sqlSortDirection t) psSorting')
@@ -308,13 +334,13 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
 
   mapM_ (addMessageI "warning") errs
 
-  rows' <- runDB . E.select $ (,) <$> pure (E.unsafeSqlValue "row_number() OVER ()" :: E.SqlExpr (E.Value Int64), E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64)) <*> sqlQuery'
+  rows' <- runDB . E.select $ (,) <$> pure (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64)) <*> sqlQuery'
 
   let
     rowCount
-      | ((_, E.Value n), _):_ <- rows' = n
+      | (E.Value n, _):_ <- rows' = n
       | otherwise = 0
-    rows = map (\((E.Value dbrIndex, E.Value dbrCount), dbrOutput) -> DBRow{..}) rows'
+    rows = map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'
 
     table' :: WriterT x m Widget
     table' = do