{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module PGExtras.Queries.VacuumStats (vacuumStatsSQL, displayVacuumStats) where

import PGExtras.Helpers (maybeText)
import Database.PostgreSQL.Simple
import Text.RawString.QQ
import qualified Data.Text as Text
import Control.Monad (forM_)
import Data.List (intercalate)

vacuumStatsSQL :: Query
vacuumStatsSQL :: Query
vacuumStatsSQL = [r|WITH table_opts AS (
  SELECT
    pg_class.oid, relname, nspname, array_to_string(reloptions, '') AS relopts
  FROM
     pg_class INNER JOIN pg_namespace ns ON relnamespace = ns.oid
), vacuum_settings AS (
  SELECT
    oid, relname, nspname,
    CASE
      WHEN relopts LIKE '%autovacuum_vacuum_threshold%'
        THEN substring(relopts, '.*autovacuum_vacuum_threshold=([0-9.]+).*')::integer
        ELSE current_setting('autovacuum_vacuum_threshold')::integer
      END AS autovacuum_vacuum_threshold,
    CASE
      WHEN relopts LIKE '%autovacuum_vacuum_scale_factor%'
        THEN substring(relopts, '.*autovacuum_vacuum_scale_factor=([0-9.]+).*')::real
        ELSE current_setting('autovacuum_vacuum_scale_factor')::real
      END AS autovacuum_vacuum_scale_factor
  FROM
    table_opts
)
SELECT
  vacuum_settings.nspname AS schema,
  vacuum_settings.relname AS table,
  to_char(psut.last_vacuum, 'YYYY-MM-DD HH24:MI') AS last_vacuum,
  to_char(psut.last_autovacuum, 'YYYY-MM-DD HH24:MI') AS last_autovacuum,
  to_char(pg_class.reltuples, '9G999G999G999') AS rowcount,
  to_char(psut.n_dead_tup, '9G999G999G999') AS dead_rowcount,
  to_char(autovacuum_vacuum_threshold
       + (autovacuum_vacuum_scale_factor::numeric * pg_class.reltuples), '9G999G999G999') AS autovacuum_threshold,
  CASE
    WHEN autovacuum_vacuum_threshold + (autovacuum_vacuum_scale_factor::numeric * pg_class.reltuples) < psut.n_dead_tup
    THEN 'yes'
  END AS expect_autovacuum
FROM
  pg_stat_user_tables psut INNER JOIN pg_class ON psut.relid = pg_class.oid
    INNER JOIN vacuum_settings ON pg_class.oid = vacuum_settings.oid
ORDER BY 1;|]

displayVacuumStats :: [(Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text)] -> IO ()
displayVacuumStats :: [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text, Maybe Text, Maybe Text)]
-> IO ()
displayVacuumStats rows :: [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text, Maybe Text, Maybe Text)]
rows = do
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
description
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " | " [String]
tableHeaders
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text, Maybe Text, Maybe Text)]
-> ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> IO ())
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text, Maybe Text, Maybe Text)]
rows (((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
  -> IO ())
 -> IO ())
-> ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(arg1 :: Maybe Text
arg1, arg2 :: Maybe Text
arg2, arg3 :: Maybe Text
arg3, arg4 :: Maybe Text
arg4, arg5 :: Maybe Text
arg5, arg6 :: Maybe Text
arg6, arg7 :: Maybe Text
arg7, arg8 :: Maybe Text
arg8) ->
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> String
maybeText(Maybe Text
arg1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Text -> String
maybeText(Maybe Text
arg2) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Text -> String
maybeText(Maybe Text
arg3) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Text -> String
maybeText(Maybe Text
arg4) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Text -> String
maybeText(Maybe Text
arg5) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Text -> String
maybeText(Maybe Text
arg6) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Text -> String
maybeText(Maybe Text
arg7) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Text -> String
maybeText(Maybe Text
arg8)

description :: [Char]
description :: String
description = "Dead rows and whether an automatic vacuum is expected to be triggered"

tableHeaders :: [[Char]]
tableHeaders :: [String]
tableHeaders = ["schema", "table", "last_vacuum", "last_autovacuum", "rowcount", "dead_rowcount", "autovacuum_threshold", "expect_autovacuum"]