module Database.PostgreSQL.Simple.Bind.Utils (
getFunctionDeclaration
, generateBindingsModule
) where
import Control.Arrow ((***))
import Data.List (intersperse)
import Database.PostgreSQL.Simple (Connection, Only(..), query)
import Database.PostgreSQL.Simple.Bind.Common (unwrapColumn)
import Text.Heredoc (str)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import qualified Data.Text as T
getFunctionDeclaration :: Connection -> String -> IO [String]
getFunctionDeclaration conn name = unwrapColumn <$> query conn sql' (Only $ T.pack name) where
sql' = [sql|
select 'function '
|| p.proname
|| '('||pg_catalog.pg_get_function_arguments(p.oid)||')'
|| ' returns '||pg_catalog.pg_get_function_result(p.oid)
from pg_catalog.pg_proc p
left join pg_catalog.pg_namespace n on n.oid = p.pronamespace
where p.proname ~ ('^('|| ? ||')$')
and not p.proisagg
and not p.proiswindow
and p.prorettype != ('pg_catalog.trigger'::pg_catalog.regtype);
|]
generateBindingsModule
:: Connection
-> String
-> String
-> [String]
-> IO String
generateBindingsModule conn opt name ns = do
ds <- concatMap id <$> mapM (getFunctionDeclaration conn) ns
let (optPath, optName) = (reverse *** (reverse . drop 1)) . span (/= '.') . reverse $ opt
let mkList = concat . (" " :) . intersperse "\n , "
return $ concat $ [
[str|
|
|
|
|
|
|
|]
, "module ", name, " where "
, [str|
|
|import Database.PostgreSQL.Simple.Bind (bindFunction)
|]
, "import ", optPath, " (", optName, ")"
, [str|
|import Database.PostgreSQL.Simple.Bind.Types()
|
|concat <$> mapM (bindFunction |], optName, [str|) [
|]
, (mkList . map (("\"" ++) . (++ "\"")) $ ds)
, "\n ]"]