module Database.HamSql.Internal.Stmt.Create where
import Data.Maybe
import Database.HamSql.Internal.Option
import Database.HamSql.Internal.Stmt
import Database.HamSql.Internal.Stmt.Basic
import Database.HamSql.Internal.Stmt.Commons ()
import Database.HamSql.Internal.Stmt.Database
import Database.HamSql.Internal.Stmt.Domain ()
import Database.HamSql.Internal.Stmt.Function ()
import Database.HamSql.Internal.Stmt.Role ()
import Database.HamSql.Internal.Stmt.Schema ()
import Database.HamSql.Internal.Stmt.Sequence ()
import Database.HamSql.Internal.Stmt.Table ()
import Database.HamSql.Internal.Stmt.Type ()
allSchemaElements :: Schema -> [SetupElement]
allSchemaElements schema =
[SetupElement $ SqlContext schema] ++
toElemList' schemaRoles schema ++
toElemList schemaDomains schema ++
toElemList schemaFunctions schema ++
toElemList schemaSequences schema ++
toElemList schemaTables schema ++
toElemList schemaTypes schema ++
concat
[ map (SetupElement . (\x -> SqlContext (schema, table, x))) $
tableColumns table
| table <- fromMaybe [] $ schemaTables schema ]
where
toElemList y = maybeMap (SetupElement . (\x -> SqlContext (schema, x))) . y
toElemList' y = maybeMap (SetupElement . SqlContext) . y
elementsToStmts :: SetupContext -> [SetupElement] -> [Maybe SqlStmt]
elementsToStmts setupContext = concatMap (toSqlStmts setupContext)
data SQL_OTHER =
SQL_OTHER
deriving (SqlObjType, Show)
instance ToSqlCode SQL_OTHER where
toSqlCode = const "SQL_OTHER"
emptyName :: SqlId
emptyName = SqlId $ SqlObj SQL_OTHER $ SqlName ""
sqlAddTransact :: [SqlStmt] -> [SqlStmt]
sqlAddTransact xs =
catMaybes [newSqlStmt SqlUnclassified emptyName "BEGIN TRANSACTION"] ++
xs ++ catMaybes [newSqlStmt SqlUnclassified emptyName "COMMIT"]
getSetupStatements :: OptCommon -> Setup -> [Maybe SqlStmt]
getSetupStatements opts s =
debug opts "stmtInstallSetup" $
[getStmt $ setupPreCode s] ++ schemaStatements ++ [getStmt $ setupPostCode s]
where
schemaStatements =
concat $ maybeMap (getSchemaStatements opts s) (setupSchemaData s)
getStmt (Just code) = newSqlStmt SqlPre emptyName code
getStmt Nothing = Nothing
getSchemaStatements :: OptCommon -> Setup -> Schema -> [Maybe SqlStmt]
getSchemaStatements _ setup s =
elementsToStmts (SetupContext setup) $ allSchemaElements s