Commit f3ad00a3 authored by Sophie Herold's avatar Sophie Herold 🌼

Adds inquire support for RETURNS TABLE

parent ace073c3
Pipeline #855 passed with stage
in 5 minutes and 1 second
name: hamsql
version: 0.10.0.0
version: 0.10.0.99
synopsis: Interpreter for SQL-structure definitions in YAML (YamSql)
category: Database
description: Interpreter for SQL-structure definitions in YAML (YamSql)
......@@ -98,7 +98,7 @@ library
file-embed == 0.0.*,
filepath == 1.4.*,
frontmatter == 0.1.*,
microlens-platform == 0.3.*,
lens == 4.15.*,
network-uri == 2.6.*,
optparse-applicative == 0.14.*,
postgresql-simple >=0.4 && <0.6,
......
......@@ -4,7 +4,8 @@
-- Some rights reserved. See COPYING, AUTHORS.
module Database.HamSql.Internal.InquireDeployed where
import Data.Text (intercalate, stripPrefix, stripSuffix)
import Data.List (zipWith4)
import Data.Text (intercalate, singleton, stripPrefix, stripSuffix)
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.SqlQQ
import Database.PostgreSQL.Simple.Types (PGArray(..), fromPGArray)
......@@ -360,23 +361,15 @@ deployedFunctions schema = do
funs <- psqlQry qry (Only $ toSqlCode schema)
return $ map toFunction funs
where
toFunction (proname, description, prorettype, proargnames, proargtypes, proargdefaults, owner, language, prosecdef, source) =
toFunction ((proname, description, prorettype, owner, language, prosecdef, source) :. args) =
Function
{ functionName = proname
, functionDescription = fromMaybe "" description
, _functionReturns = prorettype
, _functionReturns = rettype prorettype args
, _functionParameters =
let n = length $ fromPGArray proargtypes
def = fromMaybe (replicate n Nothing)
in presetEmpty $
zipWith3
toVariable
(fromPGArray proargtypes)
(def $ fromPGArray <$> proargnames)
(def $ fromPGArray <$> proargdefaults)
presetEmpty $ filter ((/= Just "t") . variableMode) $ params args
, functionTemplates = Nothing
, functionTemplateData = Nothing
, _functionReturnsColumns = Nothing
, functionVariables = Nothing
, functionPrivExecute = Nothing
, functionSecurityDefiner = preset False prosecdef
......@@ -384,21 +377,41 @@ deployedFunctions schema = do
, functionLanguage = Just language
, functionBody = source
}
params (proargnames, proargtypes, proargmodes, proargdefaults) =
let n = length $ fromPGArray proargtypes
def v (Just xs) = xs ++ (replicate (n - length xs) v)
def v Nothing = replicate n v
in zipWith4
toVariable
(fromPGArray proargtypes)
(def Nothing $ fromPGArray <$> proargnames)
(def Nothing $ fromPGArray <$> proargdefaults)
(def 'i' $ fromPGArray <$> proargmodes)
rettype prorettype args =
let tParams = filter ((== Just "t") . variableMode) $ params args
in if null tParams --prorettype /= SqlType "record"
then ReturnType prorettype
else ReturnTypeTable $ map variableToParameter tParams
qry =
[sql|
SELECT
proname,
pg_catalog.obj_description(p.oid, 'pg_proc')::text AS description,
prorettype::regtype::text,
proargnames,
ARRAY(SELECT UNNEST(proargtypes::regtype[]::text[])),
ARRAY(SELECT pg_get_function_arg_default(p.oid, n)
FROM generate_series(1, pronargs) t(n)),
CASE WHEN proowner<>current_user::regrole
THEN proowner::regrole::text END,
lanname,
prosecdef,
prosrc
prosrc,
-- function arguments
proargnames,
COALESCE(
proallargtypes::regtype[]::text[],
ARRAY(SELECT UNNEST(proargtypes::regtype[]::text[]))
) AS argtypes,
proargmodes,
ARRAY(SELECT pg_get_function_arg_default(p.oid, n)
FROM generate_series(1, pronargs) t(n)) AS argdefault
FROM pg_catalog.pg_proc AS p
JOIN pg_catalog.pg_language AS l
ON p.prolang = l.oid
......@@ -406,14 +419,29 @@ deployedFunctions schema = do
ORDER BY proname
|]
toVariable :: SqlType -> Maybe SqlName -> Maybe Text -> Variable
toVariable varType varName varDefault =
variableToParameter :: Variable -> Parameter
variableToParameter v =
Parameter
{ parameterName = variableName v
, _parameterType = _variableType v
, parameterDescription = Nothing
}
toVariable :: SqlType -> Maybe SqlName -> Maybe Text -> Char -> Variable
toVariable varType varName varDefault varMode =
Variable
{ variableName = fromMaybe undefined varName
, variableDescription = Nothing
, _variableType = varType
, variableDefault = varDefault
, variableMode = preset "IN" $ toMode varMode
}
where
toMode 'i' = "IN"
toMode 'o' = "OUT"
toMode 'b' = "INOUT"
toMode 'v' = "VARIADIC"
toMode x = singleton x
-- *** Domains
deployedDomains :: SqlName -> SqlT [Domain]
......
......@@ -165,7 +165,13 @@ normalizeOnline set = applyColumnTypes set >>= applyFunctionTypes
lensFunctionTypes :: Applicative m => [LensLike' m Setup SqlType]
lensFunctionTypes =
[ setupSchemaData .
_Just . each . schemaFunctions . _Just . each . functionReturns
_Just .
each . schemaFunctions . _Just . each . functionReturns . _ReturnType
, setupSchemaData .
_Just .
each .
schemaFunctions .
_Just . each . functionReturns . _ReturnTypeTable . each . parameterType
]
lensColumTypes :: Applicative m => [LensLike' m Setup SqlType]
......@@ -180,9 +186,11 @@ lensColumTypes =
]
normalizeTypeOnline :: SqlType -> SqlT SqlType
normalizeTypeOnline t = do
xs <- psqlQry "SELECT to_regtype(?)::text" (Only $ toSqlCode t)
return $ fromMaybe t (fromOnly $ head xs)
normalizeTypeOnline t
| t == SqlType "TABLE" = return t
| otherwise = do
xs <- psqlQry "SELECT to_regtype(?)::text" (Only $ toSqlCode t)
return $ fromMaybe t (fromOnly $ head xs)
normalizeColumnTypeOnline :: SqlType -> SqlT SqlType
normalizeColumnTypeOnline t
......
......@@ -34,8 +34,7 @@ instance ToSqlStmts (SqlContext (Schema, Function)) where
--(maybeMap _variableType (_functionParameters f)) $
"CREATE OR REPLACE FUNCTION " <> sqlFunctionIdentifierDef <> "\n" <>
"RETURNS" <->
toSqlCode (_functionReturns f) <>
sqlReturnsColumns (_functionReturnsColumns f) <>
sqlReturns (_functionReturns f) <>
"\nLANGUAGE " <>
sqlLanguage (functionLanguage f) <>
"\nSECURITY " <>
......@@ -61,12 +60,11 @@ instance ToSqlStmts (SqlContext (Schema, Function)) 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 = ""
sqlReturns (ReturnType rt) = toSqlCode rt
sqlReturns (ReturnTypeTable cs) =
"TABLE (" <\> T.intercalate ",\n" (map sqlReturnsColumn cs) <> ") "
sqlReturnsColumn c =
toSqlCode (parameterName c) <> " " <> toSqlCode (parameterType c)
toSqlCode (parameterName c) <> " " <> toSqlCode (_parameterType c)
-- If language not defined, use service for variable definitions
sqlBody
| isNothing (functionLanguage f) =
......
......@@ -11,12 +11,12 @@ module Database.HamSql.Internal.Utils
, each
) where
import Control.Lens (_Just, each, traverseOf)
import Data.List (group, intercalate, sort)
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Debug.Trace
import Lens.Micro.Platform (_Just, each, traverseOf)
import System.Exit
import System.IO (stderr)
import System.IO.Unsafe
......
......@@ -16,6 +16,7 @@ data Variable = Variable
, variableDescription :: Maybe Text
, _variableType :: SqlType
, variableDefault :: Maybe Text
, variableMode :: Maybe Text
} deriving (Generic, Show, Data)
instance FromJSON Variable where
......@@ -24,18 +25,6 @@ instance FromJSON Variable where
instance ToJSON Variable where
toJSON = toYamSqlJson
data Parameter = Parameter
{ parameterName :: SqlName
, parameterDescription :: Maybe Text
, parameterType :: SqlType
} deriving (Generic, Show, Data)
instance FromJSON Parameter where
parseJSON = parseYamSql
instance ToJSON Parameter where
toJSON = toYamSqlJson
data Abbr a b
= ShortForm a
| LongForm b
......
......@@ -13,17 +13,14 @@ data Function = Function
-- | description what the function is good for
, functionDescription :: Text
-- | return type of the function, TABLE is special (see return_columns)
, _functionReturns :: SqlType
, _functionReturns :: ReturnType
-- | parameters the function takes
, _functionParameters :: Maybe [Variable]
-- | list of templates, used for this function
, functionTemplates :: Maybe [SqlName]
-- | loaded templates, not designed for use via Yaml
--
-- __TODO: move to xfunctionInternal__
, functionTemplateData :: Maybe [FunctionTpl]
-- | if return is TABLE, gives the columns that are returned (see parameter)
, _functionReturnsColumns :: Maybe [Parameter]
-- | variables that are defined (ignored if language is given)
, functionVariables :: Maybe [Variable]
-- | Role that has the privilege to execute the function
......@@ -47,6 +44,29 @@ instance FromJSON Function where
instance ToJSON Function where
toJSON = toYamSqlJson
data Parameter = Parameter
{ parameterName :: SqlName
, parameterDescription :: Maybe Text
, _parameterType :: SqlType
} deriving (Generic, Show, Data)
instance FromJSON Parameter where
parseJSON = parseYamSql
instance ToJSON Parameter where
toJSON = toYamSqlJson
data ReturnType
= ReturnType SqlType
| ReturnTypeTable { _returntypeTable :: [Parameter] }
deriving (Generic, Show, Data)
instance FromJSON ReturnType where
parseJSON = parseYamSql
instance ToJSON ReturnType where
toJSON = toYamSqlJson
data SQL_FUNCTION =
SQL_FUNCTION
deriving (SqlObjType, Show)
......@@ -105,3 +125,9 @@ applyFunctionTpl t f =
maybeStringR Nothing = ""
makeLenses ''Function
makePrisms ''ReturnType
makeLenses ''ReturnType
makeLenses ''Parameter
......@@ -11,15 +11,16 @@ module Database.YamSql.Internal.Utils
, fromMaybe
, makeLenses
, LensLike'
, makePrisms
) where
import Control.Lens (LensLike', makeLenses, makePrisms)
import Data.Foldable (asum)
import Data.Maybe (fromMaybe)
import Data.Semigroup ((<>))
import qualified Data.Text as T
import Data.Text (Text)
import Data.Text.Lazy (toStrict)
import Lens.Micro.Platform (LensLike', makeLenses)
import Text.Pretty.Simple (pShow)
tshow :: (Show a) => a -> Text
......
......@@ -3,7 +3,7 @@ module Main where
import Control.Exception.Safe
import Control.Monad.Trans.Reader (runReaderT)
import Data.List (sort)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import qualified Data.Text.Lazy as T
import Database.PostgreSQL.Simple (Connection, close)
......@@ -20,8 +20,8 @@ import Database.HamSql.Internal.Load (loadSetup)
import Database.HamSql.Internal.PostgresCon
import Database.HamSql.Setup
import Database.HamSql.Write
import Database.YamSql
--import Database.YamSql
main :: IO ()
main =
defaultMain $
......@@ -35,9 +35,9 @@ main =
[ testCase "domain.yml" $ installSetup "test/setups/domain.yml"
, testGroup
"self-test.yml"
[ selfTestStmt "test/setups/self-test.yml"
, selfTestStruct
[ selfTestStruct
, selfTestUpgrade "test/setups/self-test.yml"
, selfTestStmt "test/setups/self-test.yml"
--, selfTestUpgrade "test/setups/self-test-empty.yml"
--, selfTestUpgradeDelete "test/setups/self-test-empty.yml"
, selfTestUpgrade "test/setups/self-test.yml"
......@@ -48,7 +48,7 @@ main =
--,selfTestStmt "test/setups/self-test-stmt.yml"
, selfTestStmt "test/setups/domain.yml"
, selfTestUpgrade "test/setups/domain.yml"
--, selfTestUpgrade "test/setups/domain-upgrade.yml"
, selfTestUpgrade "test/setups/domain-upgrade.yml"
]
]
]
......
---
name: f
description: Function f
description: Function f 1 arg
language: plpgsql
returns: int
parameters:
......
---
name: returns-table
description: Function that returns a table
language: plpgsql
returns:
table:
- name: arg1
type: int
- name: arg2
type: varchar
parameters:
- name: x1
type: character varying
---
BEGIN RETURN QUERY SELECT * FROM (VALUES (1, 'a'), (2, 'b'), (3, 'c')) AS x; END;
---
name: sreturns-table-1col
description: Function that returns a table
language: plpgsql
returns:
table:
- name: arg1
type: int
parameters:
- name: x1
type: character varying
---
BEGIN RETURN QUERY SELECT * FROM (VALUES (1), (2), (3)) AS x; END;
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment