{-# LANGUAGE OverloadedStrings #-}

module PGExtras (
  extrasAllLocksRows,
  extrasAllLocks,
  extrasBloatRows,
  extrasBloat,
  extrasBlockingRows,
  extrasBlocking,
  extrasCacheHitRows,
  extrasCacheHit,
  extrasCallsRows,
  extrasCalls,
  extrasExtensionsRows,
  extrasExtensions,
  extrasIndexCacheHitRows,
  extrasIndexCacheHit,
  extrasIndexSizeRows,
  extrasIndexSize,
  extrasIndexUsageRows,
  extrasIndexUsage,
  extrasKillAllRows,
  extrasKillAll,
  extrasLocksRows,
  extrasLocks,
  extrasLongRunningQueriesRows,
  extrasLongRunningQueries,
  extrasMandelbrotRows,
  extrasMandelbrot,
  extrasRecordsRankRows,
  extrasRecordsRank,
  extrasSeqScansRows,
  extrasSeqScans,
  extrasTableCacheHitRows,
  extrasTableCacheHit,
  extrasTableIndexesSizeRows,
  extrasTableIndexesSize,
  extrasTableSizeRows,
  extrasTableSize,
  extrasTotalIndexSizeRows,
  extrasTotalIndexSize,
  extrasTotalTableSizeRows,
  extrasTotalTableSize,
  extrasUnusedIndexesRows,
  extrasUnusedIndexes,
  extrasVacuumStatsRows,
  extrasVacuumStats
) where

import Database.PostgreSQL.Simple
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Text as Text
import Data.Time (ZonedTime)

import PGExtras.Queries.AllLocks (allLocksSQL, displayAllLocks)
import PGExtras.Queries.Bloat (bloatSQL, displayBloat)
import PGExtras.Queries.Blocking (blockingSQL, displayBlocking)
import PGExtras.Queries.CacheHit (cacheHitSQL, displayCacheHit)
import PGExtras.Queries.Calls (callsSQL, displayCalls)
import PGExtras.Queries.Extensions (extensionsSQL, displayExtensions)
import PGExtras.Queries.IndexCacheHit (indexCacheHitSQL, displayIndexCacheHit)
import PGExtras.Queries.IndexSize (indexSizeSQL, displayIndexSize)
import PGExtras.Queries.IndexUsage (indexUsageSQL, displayIndexUsage)
import PGExtras.Queries.KillAll (killAllSQL, displayKillAll)
import PGExtras.Queries.Locks (locksSQL, displayLocks)
import PGExtras.Queries.LongRunningQueries (longRunningQueriesSQL, displayLongRunningQueries)
import PGExtras.Queries.Mandelbrot (mandelbrotSQL, displayMandelbrot)
import PGExtras.Queries.RecordsRank (recordsRankSQL, displayRecordsRank)
import PGExtras.Queries.SeqScans (seqScansSQL, displaySeqScans)
import PGExtras.Queries.TableCacheHit (tableCacheHitSQL, displayTableCacheHit)
import PGExtras.Queries.TableIndexesSize (tableIndexesSizeSQL, displayTableIndexesSize)
import PGExtras.Queries.TableSize (tableSizeSQL, displayTableSize)
import PGExtras.Queries.TotalIndexSize (totalIndexSizeSQL, displayTotalIndexSize)
import PGExtras.Queries.TotalTableSize (totalTableSizeSQL, displayTotalTableSize)
import PGExtras.Queries.UnusedIndexes (unusedIndexesSQL, displayUnusedIndexes)
import PGExtras.Queries.VacuumStats (vacuumStatsSQL, displayVacuumStats)

-- AllLocks

extrasAllLocksRows :: [Char] -> IO [(Maybe Int, Maybe Text.Text, Maybe Text.Text, Maybe Bool, Maybe Text.Text, Maybe Text.Text, Maybe ZonedTime)]
extrasAllLocksRows :: [Char]
-> IO
     [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
       Maybe Text, Maybe ZonedTime)]
extrasAllLocksRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query
-> IO
     [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
       Maybe Text, Maybe ZonedTime)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
allLocksSQL

extrasAllLocks :: [Char] -> IO ()
extrasAllLocks :: [Char] -> IO ()
extrasAllLocks databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
  Maybe Text, Maybe ZonedTime)]
rows <- [Char]
-> IO
     [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
       Maybe Text, Maybe ZonedTime)]
extrasAllLocksRows [Char]
databaseUrl
  [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
  Maybe Text, Maybe ZonedTime)]
-> IO ()
displayAllLocks [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
  Maybe Text, Maybe ZonedTime)]
rows

-- Bloat

extrasBloatRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Rational, Maybe Text.Text)]
extrasBloatRows :: [Char]
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Rational, Maybe Text)]
extrasBloatRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Rational, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
bloatSQL

extrasBloat :: [Char] -> IO ()
extrasBloat :: [Char] -> IO ()
extrasBloat databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Rational, Maybe Text)]
rows <- [Char]
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Rational, Maybe Text)]
extrasBloatRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Rational, Maybe Text)]
-> IO ()
displayBloat [(Maybe Text, Maybe Text, Maybe Text, Maybe Rational, Maybe Text)]
rows

-- Blocking

extrasBlockingRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text)]
extrasBlockingRows :: [Char]
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
       Maybe Text)]
extrasBlockingRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
       Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
blockingSQL

extrasBlocking :: [Char] -> IO ()
extrasBlocking :: [Char] -> IO ()
extrasBlocking databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text)]
rows <- [Char]
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
       Maybe Text)]
extrasBlockingRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text)]
-> IO ()
displayBlocking [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text)]
rows

-- CacheHit

extrasCacheHitRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text)]
extrasCacheHitRows :: [Char] -> IO [(Maybe Text, Maybe Text)]
extrasCacheHitRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
cacheHitSQL

extrasCacheHit :: [Char] -> IO ()
extrasCacheHit :: [Char] -> IO ()
extrasCacheHit databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text)]
extrasCacheHitRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text)] -> IO ()
displayCacheHit [(Maybe Text, Maybe Text)]
rows

-- Calls

extrasCallsRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text)]
extrasCallsRows :: [Char]
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
extrasCallsRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
callsSQL

extrasCalls :: [Char] -> IO ()
extrasCalls :: [Char] -> IO ()
extrasCalls databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
rows <- [Char]
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
extrasCallsRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
-> IO ()
displayCalls [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
rows

-- Extensions

extrasExtensionsRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text)]
extrasExtensionsRows :: [Char] -> IO [(Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
extrasExtensionsRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query -> IO [(Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
extensionsSQL

extrasExtensions :: [Char] -> IO ()

extrasExtensions :: [Char] -> IO ()
extrasExtensions databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
extrasExtensionsRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Text)] -> IO ()
displayExtensions [(Maybe Text, Maybe Text, Maybe Text, Maybe Text)]
rows

-- IndexCacheHit

extrasIndexCacheHitRows :: [Char] -> IO [(Maybe Text.Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text.Text)]
extrasIndexCacheHitRows :: [Char]
-> IO [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
extrasIndexCacheHitRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query
-> IO [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
indexCacheHitSQL

extrasIndexCacheHit :: [Char] -> IO ()
extrasIndexCacheHit :: [Char] -> IO ()
extrasIndexCacheHit databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
rows <- [Char]
-> IO [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
extrasIndexCacheHitRows [Char]
databaseUrl
  [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
-> IO ()
displayIndexCacheHit [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
rows

-- IndexSize

extrasIndexSizeRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text)]
extrasIndexSizeRows :: [Char] -> IO [(Maybe Text, Maybe Text)]
extrasIndexSizeRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
indexSizeSQL

extrasIndexSize :: [Char] -> IO ()
extrasIndexSize :: [Char] -> IO ()
extrasIndexSize databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text)]
extrasIndexSizeRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text)] -> IO ()
displayIndexSize [(Maybe Text, Maybe Text)]
rows

-- IndexUsage

extrasIndexUsageRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text, Maybe Int)]
extrasIndexUsageRows :: [Char] -> IO [(Maybe Text, Maybe Text, Maybe Int)]
extrasIndexUsageRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Text, Maybe Int)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
indexUsageSQL

extrasIndexUsage :: [Char] -> IO ()
extrasIndexUsage :: [Char] -> IO ()
extrasIndexUsage databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text, Maybe Int)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text, Maybe Int)]
extrasIndexUsageRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text, Maybe Int)] -> IO ()
displayIndexUsage [(Maybe Text, Maybe Text, Maybe Int)]
rows

-- KillAll

extrasKillAllRows :: [Char] -> IO [(Maybe Bool, Maybe Text.Text)]
extrasKillAllRows :: [Char] -> IO [(Maybe Bool, Maybe Text)]
extrasKillAllRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Bool, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
killAllSQL

extrasKillAll :: [Char] -> IO ()
extrasKillAll :: [Char] -> IO ()
extrasKillAll databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Bool, Maybe Text)]
rows <- [Char] -> IO [(Maybe Bool, Maybe Text)]
extrasKillAllRows [Char]
databaseUrl
  [(Maybe Bool, Maybe Text)] -> IO ()
displayKillAll [(Maybe Bool, Maybe Text)]
rows

-- Locks

extrasLocksRows :: [Char] -> IO [(Maybe Int, Maybe Text.Text, Maybe Text.Text, Maybe Bool, Maybe Text.Text, Maybe Text.Text, Maybe ZonedTime)]
extrasLocksRows :: [Char]
-> IO
     [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
       Maybe Text, Maybe ZonedTime)]
extrasLocksRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query
-> IO
     [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
       Maybe Text, Maybe ZonedTime)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
locksSQL

extrasLocks :: [Char] -> IO ()
extrasLocks :: [Char] -> IO ()
extrasLocks databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
  Maybe Text, Maybe ZonedTime)]
rows <- [Char]
-> IO
     [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
       Maybe Text, Maybe ZonedTime)]
extrasLocksRows [Char]
databaseUrl
  [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
  Maybe Text, Maybe ZonedTime)]
-> IO ()
displayLocks [(Maybe Int, Maybe Text, Maybe Text, Maybe Bool, Maybe Text,
  Maybe Text, Maybe ZonedTime)]
rows

-- LongRunningQueries

extrasLongRunningQueriesRows :: [Char] -> IO [(Maybe Int, Maybe ZonedTime, Maybe Text.Text)]
extrasLongRunningQueriesRows :: [Char] -> IO [(Maybe Int, Maybe ZonedTime, Maybe Text)]
extrasLongRunningQueriesRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query -> IO [(Maybe Int, Maybe ZonedTime, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
longRunningQueriesSQL

extrasLongRunningQueries :: [Char] -> IO ()
extrasLongRunningQueries :: [Char] -> IO ()
extrasLongRunningQueries databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Int, Maybe ZonedTime, Maybe Text)]
rows <- [Char] -> IO [(Maybe Int, Maybe ZonedTime, Maybe Text)]
extrasLongRunningQueriesRows [Char]
databaseUrl
  [(Maybe Int, Maybe ZonedTime, Maybe Text)] -> IO ()
displayLongRunningQueries [(Maybe Int, Maybe ZonedTime, Maybe Text)]
rows

-- Mandelbrot

extrasMandelbrotRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text)]
extrasMandelbrotRows :: [Char] -> IO [(Maybe Text, Maybe Text)]
extrasMandelbrotRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
mandelbrotSQL

extrasMandelbrot :: [Char] -> IO ()
extrasMandelbrot :: [Char] -> IO ()
extrasMandelbrot databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text)]
extrasMandelbrotRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text)] -> IO ()
displayMandelbrot [(Maybe Text, Maybe Text)]
rows

-- RecordsRank

extrasRecordsRankRows :: [Char] -> IO [(Maybe Text.Text, Maybe Int)]
extrasRecordsRankRows :: [Char] -> IO [(Maybe Text, Maybe Int)]
extrasRecordsRankRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Int)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
recordsRankSQL

extrasRecordsRank :: [Char] -> IO ()
extrasRecordsRank :: [Char] -> IO ()
extrasRecordsRank databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Int)]
rows <- [Char] -> IO [(Maybe Text, Maybe Int)]
extrasRecordsRankRows [Char]
databaseUrl
  [(Maybe Text, Maybe Int)] -> IO ()
displayRecordsRank [(Maybe Text, Maybe Int)]
rows

-- SeqScans

extrasSeqScansRows :: [Char] -> IO [(Maybe Text.Text, Maybe Int)]
extrasSeqScansRows :: [Char] -> IO [(Maybe Text, Maybe Int)]
extrasSeqScansRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Int)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
seqScansSQL

extrasSeqScans :: [Char] -> IO ()
extrasSeqScans :: [Char] -> IO ()
extrasSeqScans databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Int)]
rows <- [Char] -> IO [(Maybe Text, Maybe Int)]
extrasSeqScansRows [Char]
databaseUrl
  [(Maybe Text, Maybe Int)] -> IO ()
displaySeqScans [(Maybe Text, Maybe Int)]
rows

-- TableCacheHit

extrasTableCacheHitRows :: [Char] -> IO [(Maybe Text.Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text.Text)]
extrasTableCacheHitRows :: [Char]
-> IO [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
extrasTableCacheHitRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query
-> IO [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
tableCacheHitSQL

extrasTableCacheHit :: [Char] -> IO ()
extrasTableCacheHit :: [Char] -> IO ()
extrasTableCacheHit databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
rows <- [Char]
-> IO [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
extrasTableCacheHitRows [Char]
databaseUrl
  [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
-> IO ()
displayTableCacheHit [(Maybe Text, Maybe Int, Maybe Int, Maybe Int, Maybe Text)]
rows

-- TableIndexesSize

extrasTableIndexesSizeRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text)]
extrasTableIndexesSizeRows :: [Char] -> IO [(Maybe Text, Maybe Text)]
extrasTableIndexesSizeRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
tableIndexesSizeSQL

extrasTableIndexesSize :: [Char] -> IO ()
extrasTableIndexesSize :: [Char] -> IO ()
extrasTableIndexesSize databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text)]
extrasTableIndexesSizeRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text)] -> IO ()
displayTableIndexesSize [(Maybe Text, Maybe Text)]
rows

-- TableSize

extrasTableSizeRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text)]
extrasTableSizeRows :: [Char] -> IO [(Maybe Text, Maybe Text)]
extrasTableSizeRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
tableSizeSQL

extrasTableSize :: [Char] -> IO ()
extrasTableSize :: [Char] -> IO ()
extrasTableSize databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text)]
extrasTableSizeRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text)] -> IO ()
displayTableSize [(Maybe Text, Maybe Text)]
rows

-- TotalIndexSize

extrasTotalIndexSizeRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text)]
extrasTotalIndexSizeRows :: [Char] -> IO [(Maybe Text, Maybe Text)]
extrasTotalIndexSizeRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
totalIndexSizeSQL

extrasTotalIndexSize :: [Char] -> IO ()
extrasTotalIndexSize :: [Char] -> IO ()
extrasTotalIndexSize databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text)]
extrasTotalIndexSizeRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text)] -> IO ()
displayTotalIndexSize [(Maybe Text, Maybe Text)]
rows

-- TotalTableSize

extrasTotalTableSizeRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text)]
extrasTotalTableSizeRows :: [Char] -> IO [(Maybe Text, Maybe Text)]
extrasTotalTableSizeRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection -> Query -> IO [(Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
totalTableSizeSQL

extrasTotalTableSize :: [Char] -> IO ()
extrasTotalTableSize :: [Char] -> IO ()
extrasTotalTableSize databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text)]
extrasTotalTableSizeRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text)] -> IO ()
displayTotalTableSize [(Maybe Text, Maybe Text)]
rows

-- UnusedIndexes

extrasUnusedIndexesRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Int)]
extrasUnusedIndexesRows :: [Char] -> IO [(Maybe Text, Maybe Text, Maybe Text, Maybe Int)]
extrasUnusedIndexesRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query -> IO [(Maybe Text, Maybe Text, Maybe Text, Maybe Int)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
unusedIndexesSQL

extrasUnusedIndexes :: [Char] -> IO ()
extrasUnusedIndexes :: [Char] -> IO ()
extrasUnusedIndexes databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Int)]
rows <- [Char] -> IO [(Maybe Text, Maybe Text, Maybe Text, Maybe Int)]
extrasUnusedIndexesRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Int)] -> IO ()
displayUnusedIndexes [(Maybe Text, Maybe Text, Maybe Text, Maybe Int)]
rows

-- VacuumStats

extrasVacuumStatsRows :: [Char] -> IO [(Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text, Maybe Text.Text)]
extrasVacuumStatsRows :: [Char]
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
       Maybe Text, Maybe Text, Maybe Text)]
extrasVacuumStatsRows databaseUrl :: [Char]
databaseUrl = do
  Connection
conn <- [Char] -> IO Connection
dbConnection [Char]
databaseUrl
  Connection
-> Query
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
       Maybe Text, Maybe Text, Maybe Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
vacuumStatsSQL

extrasVacuumStats :: [Char] -> IO ()
extrasVacuumStats :: [Char] -> IO ()
extrasVacuumStats databaseUrl :: [Char]
databaseUrl = do
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text, Maybe Text, Maybe Text)]
rows <- [Char]
-> IO
     [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
       Maybe Text, Maybe Text, Maybe Text)]
extrasVacuumStatsRows [Char]
databaseUrl
  [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text, Maybe Text, Maybe Text)]
-> IO ()
displayVacuumStats [(Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
  Maybe Text, Maybe Text, Maybe Text)]
rows

-- Other

dbConnection :: [Char] -> IO Connection
dbConnection :: [Char] -> IO Connection
dbConnection databaseUrl :: [Char]
databaseUrl = do
  ByteString -> IO Connection
connectPostgreSQL (ByteString -> IO Connection) -> ByteString -> IO Connection
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
Char8.pack [Char]
databaseUrl