module Webserver.Control.Sql (
  acquirePool,
  runSession,
  releasePool,
  getConnectionSettings,
  generateTable,
  generateView,
  generateType,
  baseDerives,
) where

----------------------------------------------------------------------------------------------------

import           Control.Exception     (Exception, throwIO)
import           Data.Aeson            (FromJSON, ToJSON)
import           Data.Maybe            (fromMaybe)

import qualified Data.ByteString.Char8 as BS8
import           GHC.Generics          (Generic)
import qualified Hasql.Connection      as Connection
import           Hasql.Generate        (Config (..), ConnectionInfo (..),
                                        fromTable, fromType, fromView, generate,
                                        withDefaultedCols, withDerivations)
import qualified Hasql.Pool            as Pool
import qualified Hasql.Pool.Config     as PoolConfig
import qualified Hasql.Session         as Session
import           Language.Haskell.TH   (Dec, Name, Q, runIO)

import qualified System.Environment    as Env

----------------------------------------------------------------------------------------------------
-- Shared environment reading
----------------------------------------------------------------------------------------------------

{-  Read PostgreSQL connection info from standard environment variables
    (PGUSER, PGPASSWORD, PGHOST, PGPORT, PGDATABASE).
    Returns a PgSimpleInfo with Maybe String fields — Nothing defers to libpq defaults.
    Used by both compile-time TH and runtime pool acquisition.
-}
readPgEnv :: IO ConnectionInfo
readPgEnv = do
  pgUser <- Env.lookupEnv "PGUSER"
  pgPassword <- Env.lookupEnv "PGPASSWORD"
  pgHost <- Env.lookupEnv "PGHOST"
  pgPort <- Env.lookupEnv "PGPORT"
  pgDatabase <- Env.lookupEnv "PGDATABASE"
  return <| PgSimpleInfo {pgHost, pgPort, pgUser, pgPassword, pgDatabase}

----------------------------------------------------------------------------------------------------
-- Compile-time TH
----------------------------------------------------------------------------------------------------

{-  Project-wide compile-time config for hasql-generate.
    Reads PGUSER, PGPASSWORD, PGHOST, PGPORT, PGDATABASE from the environment
    at compile time via readPgEnv.
-}
defaultConfig :: Q Config
defaultConfig =
  runIO <| do
    connection <- readPgEnv
    return
      <| Config
        { connection
        , allowDuplicateRecordFields = True
        , newtypePrimaryKeys = False
        , globalOverrides = []
        }

{-  Base derive list applied to every table splice. -}
baseDerives :: [Name]
baseDerives = [''Show, ''Eq, ''Ord, ''Generic, ''FromJSON, ''ToJSON]

{-  Generate a type and CRUD instances for a table using project defaults.
    Usage: @$(Sql.generateTable "public" "users")@
-}
generateTable :: String -> String -> Q [Dec]
generateTable schema table = do
  cfg <- defaultConfig
  generate
    cfg
    ( fromTable schema table
        |> withDerivations baseDerives
        |> withDefaultedCols ["id"]
    )

{-  Generate a type and select instances for a view using project defaults.
    Usage: @$(Sql.generateView "public" "users_view")@
-}
generateView :: String -> String -> Q [Dec]
generateView schema view = do
  cfg <- defaultConfig
  generate
    cfg
    ( fromView schema view
        |> withDerivations baseDerives
    )

{-  Generate a type and enum instances for a type using project defaults.
    Usage: @$(Sql.generateType "public" "user_type")@
-}
generateType :: String -> String -> Q [Dec]
generateType schema type_ = do
  cfg <- defaultConfig
  generate
    cfg
    ( fromType schema type_
        |> withDerivations baseDerives
    )

----------------------------------------------------------------------------------------------------
-- Runtime pool management
----------------------------------------------------------------------------------------------------

{-  Build a libpq-format connection settings ByteString from environment variables.
    Falls back to development defaults for each parameter.
-}
getConnectionSettings :: IO Connection.Settings
getConnectionSettings = do
  PgSimpleInfo {pgHost, pgPort, pgUser, pgPassword, pgDatabase} <- readPgEnv
  let host = fromMaybe "127.0.0.1" pgHost
      port = fromMaybe "5433" pgPort
      user = fromMaybe "admin" pgUser
      pass = fromMaybe "pass" pgPassword
      db = fromMaybe "webserver" pgDatabase
  return
    <| BS8.pack
    <| "host="
    <> host
    <> " port="
    <> port
    <> " dbname="
    <> db
    <> " user="
    <> user
    <> " password="
    <> pass

{-  Create a hasql connection pool for runtime use.
-}
acquirePool :: IO Pool.Pool
acquirePool = do
  connSettings <- getConnectionSettings
  Pool.acquire
    <| PoolConfig.settings
      [ PoolConfig.size 8
      , PoolConfig.acquisitionTimeout 10
      , PoolConfig.staticConnectionSettings connSettings
      ]

{-  Release all idle connections in the pool.
-}
releasePool :: Pool.Pool -> IO ()
releasePool = Pool.release

{-  Run a hasql Session against the pool, throwing on error.
-}
runSession :: Pool.Pool -> Session.Session a -> IO a
runSession pool session =
  Pool.use pool session >>= \case
    Left err -> throwIO <| PoolUsageError err
    Right a -> return a

----------------------------------------------------------------------------------------------------

newtype PoolUsageError = PoolUsageError Pool.UsageError

instance Show PoolUsageError where
  show (PoolUsageError err) = "Pool usage error: " <> show err

instance Exception PoolUsageError