-- This file is part of HamSql
--
-- Copyright 2016 by it's authors.
-- Some rights reserved. See COPYING, AUTHORS.
{-# LANGUAGE FlexibleInstances #-}

module Database.HamSql.Internal.Stmt.Function where

import Data.Maybe
import qualified Data.Text as T

import Database.HamSql.Internal.Stmt.Basic

stmtsDropFunction' :: SqlId -> [SqlStmt]
stmtsDropFunction' x =
  catMaybes [newSqlStmt SqlDropFunction x $ "DROP FUNCTION " <> toSqlCode x]

stmtsDropFunction :: SqlIdContentSqoArgtypes -> [Maybe SqlStmt]
stmtsDropFunction x = map Just $ stmtsDropFunction' $ sqlId x

instance ToSqlStmts (SqlContextSqoArgtypes Function) where
  toSqlStmts = stmtsDeployFunction

stmtsDeployFunction :: SetupContext
                    -> SqlContextSqoArgtypes Function
                    -> [Maybe SqlStmt]
stmtsDeployFunction SetupContext {setupContextSetup = setup} obj@SqlContextSqoArgtypes {sqlSqoArgtypesObject = f} =
  stmtCreateFunction :
  sqlSetOwner (functionOwner f) :
  stmtComment : maybeMap sqlStmtGrantExecute (functionPrivExecute f)
--name = schemaName m <.> functionName f
  where
    sqlStmtGrantExecute u = newSqlStmt SqlPriv obj $ sqlGrantExecute u
    sqlGrantExecute u =
      "GRANT EXECUTE ON FUNCTION \n" <> sqlIdCode obj <> "\nTO " <>
      prefixedRole setup u
    stmtCreateFunction =
      newSqlStmt SqlCreateFunction obj $
      --(maybeMap variableType (functionParameters f)) $
      "CREATE OR REPLACE FUNCTION " <> sqlFunctionIdentifierDef <> "\n" <>
      "RETURNS" <->
      toSqlCode (functionReturns f) <>
      sqlReturnsColumns (functionReturnsColumns f) <>
      "\nLANGUAGE " <>
      sqlLanguage (functionLanguage f) <>
      "\nSECURITY " <>
      sqlSecurity (functionSecurityDefiner f) <>
      "\nAS\n$BODY$\n" <>
      sqlBody <>
      "\n$BODY$\n"
    stmtComment = stmtCommentOn obj $ toSqlCodeString (functionDescription f)
    sqlSetOwner (Just o) =
      newSqlStmt SqlPriv obj $
      "ALTER FUNCTION " <> sqlIdCode obj <> "OWNER TO " <> prefixedRole setup o
    sqlSetOwner Nothing = Nothing
    sqlFunctionIdentifierDef =
      (toSqlCode . sqlIdNameOnly) obj <> "(\n" <>
      T.intercalate ",\n" (maybeMap sqlParameterDef (functionParameters f)) <>
      "\n)"
    -- function parameter
    sqlParameterDef p =
      toSqlCode (variableName p) <-> toSqlCode (variableType p) <->
      sqlParamDefault (variableDefault p)
      where
        sqlParamDefault Nothing = ""
        sqlParamDefault (Just x) = "DEFAULT" <-> x
    -- If function returns a table, use service for field definition
    sqlReturnsColumns cs
      | toSqlCode (functionReturns f) == "TABLE" =
        " (" <\> T.intercalate ",\n" (maybeMap sqlReturnsColumn cs) <> ") "
      | otherwise = ""
    sqlReturnsColumn c =
      toSqlCode (parameterName c) <> " " <> toSqlCode (parameterType c)
    -- If language not defined, use service for variable definitions
    sqlBody
      | isNothing (functionLanguage f) =
        "DECLARE" <\> sqlVariables (functionVariables f) <> "BEGIN" <\> body <\>
        "END;"
      | otherwise = body
      where
        body =
          T.intercalate "\n" preludes <> fromMaybe "" (functionBody f) <>
          T.intercalate "\n" postludes
        preludes :: [Text]
        preludes =
          catMaybes $maybeMap functiontplBodyPrelude (functionTemplateData f)
        postludes :: [Text]
        postludes =
          catMaybes $maybeMap functiontplBodyPostlude (functionTemplateData f)
    -- Service for variable definitions
    sqlVariables Nothing = ""
    sqlVariables (Just vs) = T.concat (map sqlVariable vs)
    sqlVariable v =
      toSqlCode (variableName v) <-> toSqlCode (variableType v) <->
      sqlVariableDefault (variableDefault v) <>
      ";\n"
    sqlVariableDefault Nothing = ""
    sqlVariableDefault (Just d) = ":=" <-> d
    -- SECURITY
    sqlSecurity (Just True) = "DEFINER"
    sqlSecurity _ = "INVOKER"
    -- LANGUAGE
    sqlLanguage Nothing = "plpgsql"
    sqlLanguage (Just lang) = lang