68 lines
2.3 KiB
Haskell
Executable File
68 lines
2.3 KiB
Haskell
Executable File
module Database
|
|
( main
|
|
, truncateDb
|
|
, module Database.Fill
|
|
) where
|
|
|
|
import "uniworx" Import hiding (Option(..))
|
|
import "uniworx" Application (db, getAppDevSettings)
|
|
|
|
import UnliftIO.Pool (destroyAllResources)
|
|
|
|
import Database.Persist.Postgresql
|
|
import Control.Monad.Logger
|
|
|
|
import System.Console.GetOpt
|
|
import System.Exit (exitWith, ExitCode(..))
|
|
import System.IO (hPutStrLn)
|
|
|
|
import Database.Persist.Sql.Raw.QQ
|
|
|
|
import Database.Fill (fillDb)
|
|
|
|
|
|
data DBAction = DBClear
|
|
| DBTruncate
|
|
| DBMigrate
|
|
| DBFill
|
|
|
|
|
|
argsDescr :: [OptDescr DBAction]
|
|
argsDescr =
|
|
[ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user"
|
|
, Option ['t'] ["truncate"] (NoArg DBTruncate) "Truncate all tables mentioned in the current schema (This cannot be run concurrently with any other activity accessing the database)"
|
|
, Option ['m'] ["migrate"] (NoArg DBMigrate) "Perform database migration"
|
|
, Option ['f'] ["fill"] (NoArg DBFill) "Fill database with example data"
|
|
]
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
args <- map unpack <$> getArgs
|
|
case getOpt Permute argsDescr args of
|
|
(acts@(_:_), [], []) -> forM_ acts $ \case
|
|
DBClear -> runStderrLoggingT $ do -- We don't use `db` here, since we do /not/ want any migrations to run, yet
|
|
settings <- liftIO getAppDevSettings
|
|
withPostgresqlConn (pgConnStr $ appDatabaseConf settings) . runSqlConn $ do
|
|
[executeQQ|drop owned by current_user|] :: ReaderT SqlBackend _ ()
|
|
DBTruncate -> db $ do
|
|
foundation <- getYesod
|
|
liftIO . destroyAllResources $ appConnPool foundation
|
|
truncateDb
|
|
DBMigrate -> db $ return ()
|
|
DBFill -> db $ fillDb
|
|
(_, _, errs) -> do
|
|
forM_ errs $ hPutStrLn stderr
|
|
hPutStrLn stderr $ usageInfo "uniworxdb" argsDescr
|
|
exitWith $ ExitFailure 2
|
|
|
|
truncateDb :: MonadIO m => ReaderT SqlBackend m ()
|
|
truncateDb = do
|
|
tables <- map unSingle <$> [sqlQQ|SELECT table_name FROM information_schema.tables WHERE table_schema = 'public'|]
|
|
sqlBackend <- ask
|
|
|
|
let escapedTables = map (connEscapeName sqlBackend . DBName) $ filter (not . (`elem` protected)) tables
|
|
query = "TRUNCATE TABLE " ++ intercalate ", " escapedTables ++ " RESTART IDENTITY"
|
|
protected = ["applied_migration"]
|
|
rawExecute query []
|