{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
module Gargoyle.PostgreSQL.Nix where

import Data.ByteString (ByteString)

import Gargoyle
import Gargoyle.PostgreSQL

import Paths_gargoyle_postgresql_nix
import System.Which

postgresNix :: IO (Gargoyle FilePath ByteString)
postgresNix :: IO (Gargoyle FilePath ByteString)
postgresNix = do
  FilePath
bindir <- IO FilePath
getBinDir
  Gargoyle FilePath ByteString -> IO (Gargoyle FilePath ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Gargoyle FilePath ByteString -> IO (Gargoyle FilePath ByteString))
-> Gargoyle FilePath ByteString
-> IO (Gargoyle FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ (FilePath
-> (FilePath -> FilePath -> IO ()) -> Gargoyle FilePath ByteString
mkPostgresGargoyle $(staticWhich "pg_ctl") FilePath -> FilePath -> IO ()
shutdownPostgresFast)
    { _gargoyle_exec :: FilePath
_gargoyle_exec = FilePath
bindir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/gargoyle-nix-postgres-monitor"
    }