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

Updates code formatting

parent 1236a4f7
......@@ -25,10 +25,7 @@ import Database.HamSql.Internal.Stmt.Database
import Database.YamSql
parserPrefs :: ParserPrefs
parserPrefs =
defaultPrefs
{ prefShowHelpOnEmpty = True
}
parserPrefs = defaultPrefs {prefShowHelpOnEmpty = True}
parseArgv :: IO Command
parseArgv = getArgs >>= parseThisArgv
......@@ -52,9 +49,7 @@ run (Install optCommon optDb optInstall)
then void $
pgsqlExecWithoutTransact
optDb
((getConUrl optDb)
{ uriPath = "/postgres"
})
((getConUrl optDb) {uriPath = "/postgres"})
(catMaybes $
stmtsCreateDatabase (optDeleteExistingDatabase optInstall) dbname)
else when (optDeleteExistingDatabase optInstall) $
......@@ -107,6 +102,4 @@ useSqlStmts optCommon optDb unfilteredStmts
| optPermitDataDeletion optDb = unfilteredStmts
| otherwise =
warnOnDiff
[ x
| x <- unfilteredStmts
, not $ stmtRequiresPermitDeletion x ]
[x | x <- unfilteredStmts, not $ stmtRequiresPermitDeletion x]
......@@ -2,7 +2,7 @@
--
-- Copyright 2014-2016 by it's authors.
-- Some rights reserved. See COPYING, AUTHORS.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Database.HamSql.Internal.DbUtils where
......@@ -14,7 +14,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import qualified Data.Text.IO as TIO
import Database.PostgreSQL.Simple
import Network.URI (URI (..), parseAbsoluteURI, uriToString)
import Network.URI (URI(..), parseAbsoluteURI, uriToString)
import Database.HamSql.Internal.Option
import Database.HamSql.Internal.Stmt
......@@ -41,11 +41,11 @@ getConUrl optDb = appendQuery "application_name=hamsql" uri
appendQuery v u =
u
{ uriQuery =
(case maybeHead $ uriQuery u of
Just '?' -> "&"
Just _ -> err $ "invalid URI" <-> tshow u
Nothing -> "?") <>
v
(case maybeHead $ uriQuery u of
Just '?' -> "&"
Just _ -> err $ "invalid URI" <-> tshow u
Nothing -> "?") <>
v
}
pgsqlExecStmt :: Connection -> SqlStmt -> IO ()
......
......@@ -16,7 +16,7 @@ import Text.DocTemplates
import Database.HamSql.Internal.Option
import Database.HamSql.Internal.Utils
import Database.HamSql.Setup
import Database.YamSql (Schema (..), SqlName (..))
import Database.YamSql (Schema(..), SqlName(..))
templateFromFile :: FilePath -> IO Template
templateFromFile "DEFAULT.rst" = return templateDefaultSchema
......
......@@ -6,7 +6,7 @@ module Database.HamSql.Internal.InquireDeployed where
import Data.Text (stripPrefix)
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.Types (PGArray (..), fromPGArray)
import Database.PostgreSQL.Simple.Types (PGArray(..), fromPGArray)
import Database.HamSql.Internal.DbUtils
import Database.HamSql.Internal.Utils
......
......@@ -14,7 +14,8 @@ import Data.Maybe
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Data.Yaml
import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents)
import System.Directory
(doesDirectoryExist, doesFileExist, getDirectoryContents)
import System.FilePath.Posix (combine, dropFileName, takeFileName)
import System.IO (stdin)
......@@ -41,10 +42,7 @@ loadSetup opts filePath = do
loadSetupSchemas :: OptCommon -> FilePath -> Setup -> IO Setup
loadSetupSchemas opts path s = do
schemaData <- loadSchemas opts path s [] (setupSchemas s)
return
s
{ setupSchemaData = Just schemaData
}
return s {setupSchemaData = Just schemaData}
loadSchemas :: OptCommon
-> FilePath
......@@ -57,11 +55,13 @@ loadSchemas optCom path setup loadedSchemas missingSchemas = do
schemas <-
sequence
[ loadSchema (T.unpack $ unsafePlainName schema)
| schema <- missingSchemas ]
| schema <- missingSchemas
]
let newDependencyNames =
nub . concat $ map (fromMaybe [] . schemaDependencies) schemas
let allLoadedSchemas = schemas ++ loadedSchemas
let newMissingDepencenyNames = newDependencyNames \\ map schemaName allLoadedSchemas
let newMissingDepencenyNames =
newDependencyNames \\ map schemaName allLoadedSchemas
loadSchemas optCom path setup allLoadedSchemas newMissingDepencenyNames
where
loadSchema :: FilePath -> IO Schema
......@@ -127,8 +127,9 @@ readSchema opts md = do
domains <- confDirFiles "domains.d" >>= mapM (readObjectFromFile opts)
sequences <- confDirFiles "sequences.d" >>= mapM (readObjectFromFile opts)
tables <- confDirFiles "tables.d" >>= mapM (readObjectFromFile opts)
functions <- let ins x s = x { functionBody = Just s }
in confDirFiles "functions.d" >>= mapM (readFunctionFromFile ins opts)
functions <-
let ins x s = x {functionBody = Just s}
in confDirFiles "functions.d" >>= mapM (readFunctionFromFile ins opts)
let schemaData' =
schemaData
{ schemaDomains = schemaDomains schemaData <> Just domains
......
......@@ -60,7 +60,8 @@ parserCommand =
parserOptNoCommand
parserCmdInstall :: Parser Command
parserCmdInstall = Install <$> parserOptCommon <*> parserOptCommonDb <*> parserOptInstall
parserCmdInstall =
Install <$> parserOptCommon <*> parserOptCommonDb <*> parserOptInstall
parserCmdUpgrade :: Parser Command
parserCmdUpgrade = Upgrade <$> parserOptCommon <*> parserOptCommonDb
......@@ -70,16 +71,18 @@ parserCmdDoc = Doc <$> parserOptCommon <*> parserOptDoc
-- Commons
data OptCommon = OptCommon
{ optSetup :: FilePath
{ optSetup :: FilePath
, optVerbose :: Bool
, optDebug :: Bool
, optDebug :: Bool
} deriving (Show)
parserOptCommon :: Parser OptCommon
parserOptCommon =
OptCommon <$>
strOption
(long "setup" <> short 's' <> help "Setup file (YAML). If '-' is supplied, the setup is read from STDIN." <> val "setup.yml" <>
(long "setup" <> short 's' <>
help "Setup file (YAML). If '-' is supplied, the setup is read from STDIN." <>
val "setup.yml" <>
action "file -X '!*.yml'" <>
action "directory") <*>
boolFlag (long "verbose" <> short 'v' <> help "Verbose") <*>
......@@ -87,11 +90,11 @@ parserOptCommon =
-- Commons Execute
data OptCommonDb = OptCommonDb
{ optEmulate :: Bool
, optPrint :: Bool
, optConnection :: String
, optPermitDataDeletion :: Bool
, optSqlLog :: Maybe FilePath
{ optEmulate :: Bool
, optPrint :: Bool
, optConnection :: String
, optPermitDataDeletion :: Bool
, optSqlLog :: Maybe FilePath
, optSqlLogHideRollbacks :: Bool
} deriving (Show)
......@@ -123,7 +126,7 @@ parserOptCommonDb =
-- Command Install
data OptInstall = OptInstall
{ optDeleteExistingDatabase :: Bool
, optDeleteResidualRoles :: Bool
, optDeleteResidualRoles :: Bool
} deriving (Show)
parserOptInstall :: Parser OptInstall
......@@ -147,7 +150,7 @@ parserOptNoCommand =
-- Command Doc
data OptDoc = OptDoc
{ optOutputDir :: FilePath
, optTemplate :: FilePath
, optTemplate :: FilePath
} deriving (Show)
parserOptDoc :: Parser OptDoc
......
......@@ -2,7 +2,7 @@
--
-- Copyright 2014-2016 by it's authors.
-- Some rights reserved. See COPYING, AUTHORS.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
......@@ -187,7 +187,8 @@ pgsqlExecStmtList opt Changed [] failed conn =
void $ pgsqlExecStmtList opt Unchanged failed [] conn
pgsqlExecStmtList opt status (x:xs) failed conn = do
savepoint <- newSavepoint conn
tryExec savepoint `catch` handleSqlError savepoint `catch` handleQueryError savepoint
tryExec savepoint `catch` handleSqlError savepoint `catch`
handleQueryError savepoint
where
tryExec savepoint = do
logStmt opt $
......@@ -206,10 +207,10 @@ pgsqlExecStmtList opt status (x:xs) failed conn = do
handleQueryError savepoint QueryError {} = proceed savepoint
-- action after execution has failed
skipQuery savepoint stmts = do
unless (optSqlLogHideRollbacks opt) $
do logStmt opt "SAVEPOINT retry;"
logStmt opt $ toSqlCode x
logStmt opt "ROLLBACK TO SAVEPOINT retry;"
unless (optSqlLogHideRollbacks opt) $ do
logStmt opt "SAVEPOINT retry;"
logStmt opt $ toSqlCode x
logStmt opt "ROLLBACK TO SAVEPOINT retry;"
rollbackToSavepoint conn savepoint
releaseSavepoint conn savepoint
pgsqlExecStmtList opt forwardStatus xs (failed ++ stmts) conn
......@@ -222,9 +223,9 @@ pgsqlExecStmtList opt status (x:xs) failed conn = do
pgsqlExecIntern :: OptCommonDb -> PgSqlMode -> URI -> [SqlStmt] -> IO Connection
pgsqlExecIntern opt mode connUrl xs = do
conn <- pgsqlConnectUrl connUrl
when (mode == PgSqlWithTransaction) $
do begin conn
pgsqlExecStmtList opt Init xs [] conn
when (mode == PgSqlWithTransaction) $ do
begin conn
pgsqlExecStmtList opt Init xs [] conn
when (mode == PgSqlWithoutTransaction) $ mapM_ (pgsqlExecStmtHandled conn) xs
return conn
......@@ -236,10 +237,7 @@ addSqlStmtType
addSqlStmtType t = map (SqlStmtId t . sqlId)
filterSqlStmtType :: SqlStmtType -> [SqlStmt] -> [SqlStmt]
filterSqlStmtType t xs =
[ x
| x <- xs
, stmtIdType x == t ]
filterSqlStmtType t xs = [x | x <- xs, stmtIdType x == t]
filterStmtsMatchingIds
:: [SqlStmtId] -- ^ Statement ids to remove
......
......@@ -13,7 +13,7 @@ import Database.HamSql.Internal.Utils
import Database.YamSql
data SqlStmtId = SqlStmtId
{ stmtType :: SqlStmtType
{ stmtType :: SqlStmtType
, stmtSqlId :: SqlId
} deriving (Eq, Ord)
......
......@@ -30,8 +30,9 @@ allSchemaElements schema =
toElemList schemaTypes schema ++
concat
[ map (SetupElement . (\x -> SqlContext (schema, table, x))) $
tableColumns table
| table <- fromMaybe [] $ schemaTables schema ]
tableColumns table
| table <- fromMaybe [] $ schemaTables schema
]
where
toElemList y = maybeMap (SetupElement . (\x -> SqlContext (schema, x))) . y
toElemList' y = maybeMap (SetupElement . SqlContext) . y
......
......@@ -22,8 +22,7 @@ instance ToSqlStmts (SqlContext (Schema, Domain)) where
toSqlStmts _ obj@(SqlContext (_, d)) =
stmtCreateDomain :
sqlDefault (domainDefault d) :
stmtCommentOn obj (domainDescription d) :
maybeMap sqlCheck (domainChecks d)
stmtCommentOn obj (domainDescription d) : maybeMap sqlCheck (domainChecks d)
where
stmtCreateDomain =
newSqlStmt SqlCreateDomain obj $
......
......@@ -22,18 +22,20 @@ stmtsDropAllPrivileges setup schemas x@(SqlObj _ n)
| null schemas = [Nothing]
| otherwise =
[ newSqlStmt SqlRevokePrivilege x $
"REVOKE ALL PRIVILEGES ON ALL" <-> objType <-> "IN SCHEMA" <->
T.intercalate ", " (map toSqlCode schemas) <->
"FROM" <->
prefixedRole setup n
| objType <- ["TABLES", "SEQUENCES", "FUNCTIONS"] ]
"REVOKE ALL PRIVILEGES ON ALL" <-> objType <-> "IN SCHEMA" <->
T.intercalate ", " (map toSqlCode schemas) <->
"FROM" <->
prefixedRole setup n
| objType <- ["TABLES", "SEQUENCES", "FUNCTIONS"]
]
stmtRevokeMembership :: Setup
-> SqlObj SQL_ROLE_MEMBERSHIP (SqlName, SqlName)
-> [Maybe SqlStmt]
stmtRevokeMembership setup x@(SqlObj _ (role, member)) =
[ newSqlStmt SqlRevokeMembership x $
"REVOKE" <-> prefixedRole setup role <-> "FROM" <-> prefixedRole setup member
"REVOKE" <-> prefixedRole setup role <-> "FROM" <->
prefixedRole setup member
]
instance ToSqlStmts (SqlContext Role) where
......
......@@ -15,19 +15,20 @@ stmtsDropSequence x =
instance ToSqlStmts (SqlContext (Schema, Sequence)) where
toSqlStmts _ obj@(SqlContext (_, Sequence {..})) =
[ newSqlStmt SqlCreateSequence obj $ "CREATE SEQUENCE" <-> sqlIdCode obj <-> startValue sequenceStartValue <-> conf
[ newSqlStmt SqlCreateSequence obj $
"CREATE SEQUENCE" <-> sqlIdCode obj <-> startValue sequenceStartValue <->
conf
, newSqlStmt SqlAlterSequence obj $
"ALTER SEQUENCE" <-> sqlIdCode obj <-> conf
, stmtCommentOn obj sequenceDescription
, stmtCommentOn obj sequenceDescription
]
where
conf = incrementBy sequenceIncrement <->
minValue sequenceMinValue <->
maxValue sequenceMaxValue <->
cache sequenceCache <->
cycled sequenceCycle <->
ownedByColumn sequenceOwnedByColumn
conf =
incrementBy sequenceIncrement <-> minValue sequenceMinValue <->
maxValue sequenceMaxValue <->
cache sequenceCache <->
cycled sequenceCycle <->
ownedByColumn sequenceOwnedByColumn
startValue Nothing = ""
startValue (Just i) = "START WITH " <> tshow i
incrementBy Nothing = "INCREMENT BY 1"
......
......@@ -97,7 +97,8 @@ instance ToSqlStmts (SqlContext (Schema, Table, Column)) where
-- SET DEFAULT
stmtAddColumnDefault = columnDefault c >>= sqlDefault
where
sqlDefault d = stmtAlterColumn SqlColumnSetDefault $ "SET DEFAULT " <> d
sqlDefault d =
stmtAlterColumn SqlColumnSetDefault $ "SET DEFAULT " <> d
-- [CHECK]
stmtsAddColumnCheck = maybeMap (stmtCheck tbl) (columnChecks c)
-- FOREIGN KEY
......@@ -137,8 +138,8 @@ instance ToSqlStmts (SqlContext (Schema, Table, Column)) where
rawColumn
{ columnType = SqlType "integer"
, columnDefault =
Just $
"nextval('" <> toSqlCode (sqlId serialSequenceContext) <> "')"
Just $
"nextval('" <> toSqlCode (sqlId serialSequenceContext) <> "')"
}
| otherwise = rawColumn
tblId = sqlIdCode tbl
......@@ -189,7 +190,8 @@ instance ToSqlStmts (SqlContext (Schema, Table)) where
sqlAddPrimaryKey ks =
let constr = tableName t <> SqlName "pkey"
in newSqlStmt SqlCreatePrimaryKeyConstr (constrId s t constr) $
"ALTER TABLE " <> sqlIdCode obj <> " ADD CONSTRAINT " <> toSqlCode constr <>
"ALTER TABLE " <> sqlIdCode obj <> " ADD CONSTRAINT " <>
toSqlCode constr <>
" PRIMARY KEY (" <>
T.intercalate ", " (map toSqlCode ks) <>
")"
......@@ -198,7 +200,8 @@ instance ToSqlStmts (SqlContext (Schema, Table)) where
sqlUniqueConstr ks =
let constr = tableName t <> uniquekeyName ks
in newSqlStmt SqlCreateUniqueConstr (constrId s t constr) $
"ALTER TABLE " <> sqlIdCode obj <> " ADD CONSTRAINT " <> toSqlCode constr <>
"ALTER TABLE " <> sqlIdCode obj <> " ADD CONSTRAINT " <>
toSqlCode constr <>
" UNIQUE (" <>
T.intercalate ", " (map toSqlCode (uniquekeyColumns ks)) <>
")"
......@@ -206,7 +209,8 @@ instance ToSqlStmts (SqlContext (Schema, Table)) where
sqlAddForeignKey' fk =
let constr = tableName t <> foreignkeyName fk
in newSqlStmt SqlCreateForeignKeyConstr (constrId s t constr) $
"ALTER TABLE " <> sqlIdCode obj <> " ADD CONSTRAINT " <> toSqlCode constr <>
"ALTER TABLE " <> sqlIdCode obj <> " ADD CONSTRAINT " <>
toSqlCode constr <>
" FOREIGN KEY (" <>
T.intercalate ", " (map toSqlCode (foreignkeyColumns fk)) <>
")" <>
......
......@@ -15,8 +15,9 @@ instance ToSqlStmts (SqlContextSqo Trigger) where
toSqlStmts = stmtsDeployTrigger
stmtsDeployTrigger :: SetupContext -> SqlContextSqo Trigger -> [Maybe SqlStmt]
stmtsDeployTrigger context obj@SqlContextSqo {sqlSqoSchema = s
,sqlSqoObject = t} =
stmtsDeployTrigger context obj@SqlContextSqo { sqlSqoSchema = s
, sqlSqoObject = t
} =
stmtsDeployFunction context (SqlContextSqoArgtypes s triggerFunction) ++
map triggerStmt (triggerTables t)
where
......
......@@ -28,9 +28,9 @@ join = intercalate
err :: Text -> a
err xs =
unsafePerformIO $
do TIO.hPutStrLn stderr ("error: " <> xs)
exitWith $ ExitFailure 1
unsafePerformIO $ do
TIO.hPutStrLn stderr ("error: " <> xs)
exitWith $ ExitFailure 1
warn :: Text -> a -> a
warn = msg "warning"
......@@ -40,9 +40,9 @@ warn' = msg' "warning"
msg :: Text -> Text -> a -> a
msg typ xs ys =
unsafePerformIO $
do msg' typ xs
return ys
unsafePerformIO $ do
msg' typ xs
return ys
msg' :: Text -> Text -> IO ()
msg' typ xs = TIO.hPutStrLn stderr (typ <> ": " <> xs)
......
......@@ -3,17 +3,17 @@
-- Copyright 2014-2016 by it's authors.
-- Some rights reserved. See COPYING, AUTHORS.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
module Database.YamSql.Internal.Commons where
import Database.YamSql.Internal.Basic
data Variable = Variable
{ variableName :: SqlName
{ variableName :: SqlName
, variableDescription :: Maybe Text
, variableType :: SqlType
, variableDefault :: Maybe Text
, variableType :: SqlType
, variableDefault :: Maybe Text
} deriving (Generic, Show, Data)
instance FromJSON Variable where
......@@ -23,9 +23,9 @@ instance ToJSON Variable where
toJSON = toYamSqlJson
data Parameter = Parameter
{ parameterName :: SqlName
{ parameterName :: SqlName
, parameterDescription :: Maybe Text
, parameterType :: SqlType
, parameterType :: SqlType
} deriving (Generic, Show, Data)
instance FromJSON Parameter where
......
......@@ -7,9 +7,9 @@ module Database.YamSql.Internal.Obj.Check where
import Database.YamSql.Internal.Basic
data Check = Check
{ checkName :: SqlName
{ checkName :: SqlName
, checkDescription :: Text
, checkCheck :: Text
, checkCheck :: Text
} deriving (Generic, Show, Data)
instance FromJSON Check where
......
......@@ -5,11 +5,11 @@ import Database.YamSql.Internal.Obj.Check
-- | Domains are aliases of an existing SQL types, possibly with checks
data Domain = Domain
{ domainName :: SqlName
{ domainName :: SqlName
, domainDescription :: Text
, domainType :: SqlType
, domainDefault :: Maybe Text
, domainChecks :: Maybe [Check]
, domainType :: SqlType
, domainDefault :: Maybe Text
, domainChecks :: Maybe [Check]
} deriving (Generic, Show, Data)
instance FromJSON Domain where
......
......@@ -9,36 +9,36 @@ import Database.YamSql.Internal.Commons
data Function = Function
-- function name
{ functionName :: SqlName
{ functionName :: SqlName
-- | description what the function is good for
, functionDescription :: Text
, functionDescription :: Text
-- | return type of the function, TABLE is special (see return_columns)
, functionReturns :: SqlType
, functionReturns :: SqlType
-- | parameters the function takes
, functionParameters :: Maybe [Variable]
, functionParameters :: Maybe [Variable]
-- | list of templates, used for this function
, functionTemplates :: Maybe [SqlName]
, functionTemplates :: Maybe [SqlName]
-- | loaded templates, not designed for use via Yaml
--
-- __TODO: move to xfunctionInternal__
, functionTemplateData :: Maybe [FunctionTpl]
, functionTemplateData :: Maybe [FunctionTpl]
-- | if return is TABLE, gives the columns that are returned (see parameter)
, functionReturnsColumns :: Maybe [Parameter]
, functionReturnsColumns :: Maybe [Parameter]
-- | variables that are defined (ignored if language is given)
, functionVariables :: Maybe [Variable]
, functionVariables :: Maybe [Variable]
-- | Role that has the privilege to execute the function
, functionPrivExecute :: Maybe [SqlName]
, functionPrivExecute :: Maybe [SqlName]
-- | If true, the function is executed with the privileges of the owner!
-- | Owner has to be given, if this is true (not implemented yet!)
, functionSecurityDefiner :: Maybe Bool
-- | owner of the function
, functionOwner :: Maybe SqlName
, functionOwner :: Maybe SqlName
-- | language in which the body is written
-- if not defined, pgsql is assumed an variables must be defined via variables
-- if pgsql is given explicitly, variables are your problem...
, functionLanguage :: Maybe Text
, functionLanguage :: Maybe Text
-- | the code of the function (body)
, functionBody :: Maybe Text
, functionBody :: Maybe Text
} deriving (Generic, Show, Data)
instance FromJSON Function where
......@@ -56,26 +56,26 @@ instance ToSqlCode SQL_FUNCTION where
data FunctionTpl = FunctionTpl
-- template name, used to refere the template via templates
{ functiontplTemplate :: SqlName
{ functiontplTemplate :: SqlName
-- description what the template is good for
, functiontplDescription :: Text
, functiontplDescription :: Text
-- language of the function has to be the same as for used templates
-- TODO: implement checks to avoid explosions here ;)
, functiontplLanguage :: Maybe Text
, functiontplLanguage :: Maybe Text
-- parameters are joined with function definition parameters
, functiontplParameters :: Maybe [Variable]
, functiontplParameters :: Maybe [Variable]
-- variables are appended to the functions variables
, functiontplVariables :: Maybe [Variable]
, functiontplVariables :: Maybe [Variable]
-- defines priv_execute, can be overwritten by function definition
, functiontplPrivExecute :: Maybe [SqlName]
, functiontplPrivExecute :: Maybe [SqlName]
-- defines security_definer, can be overwritten by function definition
, functiontplSecurityDefiner :: Maybe Bool
-- defines owner, can be overwritten by function definition
, functiontplOwner :: Maybe SqlName
, functiontplOwner :: Maybe SqlName
-- code added before the body of the function
, functiontplBodyPrelude :: Maybe Text
, functiontplBodyPrelude :: Maybe Text
-- code added after the body of the function
, functiontplBodyPostlude :: Maybe Text
, functiontplBodyPostlude :: Maybe Text
} deriving (Generic, Show, Data)
instance FromJSON FunctionTpl where
......@@ -88,17 +88,17 @@ applyFunctionTpl :: FunctionTpl -> Function -> Function
applyFunctionTpl t f =
f
{ functionPrivExecute =
maybeRight (functiontplPrivExecute t) (functionPrivExecute f)
maybeRight (functiontplPrivExecute t) (functionPrivExecute f)
, functionSecurityDefiner =
maybeRight (functiontplSecurityDefiner t) (functionSecurityDefiner f)
maybeRight (functiontplSecurityDefiner t) (functionSecurityDefiner f)
, functionOwner = maybeRight (functiontplOwner t) (functionOwner f)
, functionParameters =
maybeJoin (functionParameters f) (functiontplParameters t)
maybeJoin (functionParameters f) (functiontplParameters t)
, functionVariables = maybeJoin (functionVariables f) (functiontplVariables t)
, functionBody =
Just $
maybeStringL (functiontplBodyPrelude t) <> fromMaybe "" (functionBody f) <>
maybeStringR (functiontplBodyPostlude t)
Just $
maybeStringL (functiontplBodyPrelude t) <> fromMaybe "" (functionBody f) <>
maybeStringR (functiontplBodyPostlude t)
}
where
maybeStringL (Just xs) = xs <> "\n"
......
......@@ -7,11 +7,11 @@ module Database.YamSql.Internal.Obj.Role where
import Database.YamSql.Internal.Basic
data Role = Role
{ roleName :: SqlName
{ roleName :: SqlName
, roleDescription :: Text
, roleLogin :: Maybe Bool
, rolePassword :: Maybe Text
, roleMemberIn :: Maybe [SqlName]
, roleLogin :: Maybe Bool
, rolePassword :: Maybe Text
, roleMemberIn :: Maybe [SqlName]
} deriving (Generic, Show, Data)
instance FromJSON Role where
......
......@@ -28,26 +28,26 @@ import Database.YamSql.Internal.Obj.Type
-- Schema --
data Schema = Schema
{ schemaName :: SqlName
, schemaDescription :: Text
, schemaDependencies :: Maybe [SqlName]
, schemaFunctions :: Maybe [Function]
, schemaFunctionTemplates :: Maybe [FunctionTpl]
, schemaTables :: Maybe [Table]
, schemaTableTemplates :: Maybe [TableTpl]
, schemaRoles :: Maybe [Role]
, schemaSequences :: Maybe [Sequence]
, schemaPrivUsage :: Maybe [SqlName]
, schemaPrivSelectAll :: Maybe [SqlName]
, schemaPrivInsertAll :: Maybe [SqlName]
, schemaPrivUpdateAll :: Maybe [SqlName]
, schemaPrivDeleteAll :: Maybe [SqlName]
, schemaPrivSequenceAll :: Maybe [SqlName]
, schemaPrivExecuteAll :: Maybe [SqlName]
, schemaPrivAllAll :: Maybe [SqlName]
, schemaDomains :: Maybe [Domain]
, schemaTypes :: Maybe [Type]
, schemaExecPostInstall :: Maybe Text
{ schemaName :: SqlName
, schemaDescription :: Text
, schemaDependencies :: Maybe [SqlName]
, schemaFunctions :: Maybe [Function]
, schemaFunctionTemplates :: Maybe [FunctionTpl]
, schemaTables :: Maybe [Table]
, schemaTableTemplates :: Maybe [TableTpl]
, schemaRoles :: Maybe [Role]
, schemaSequences :: Maybe [Sequence]
, schemaPrivUsage :: Maybe [SqlName]
, schemaPrivSelectAll :: Maybe [SqlName]
, schemaPrivInsertAll :: Maybe [SqlName]
, schemaPrivUpdateAll :: Maybe [SqlName]
, schemaPrivDeleteAll :: Maybe [SqlName]
, schemaPrivSequenceAll :: Maybe [SqlName]