Add "clear" argument to fill-db.hs
This commit is contained in:
parent
5101cf9c1e
commit
7a74b86f6d
20
fill-db.hs
20
fill-db.hs
@ -4,14 +4,30 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PackageImports #-}
|
{-# LANGUAGE PackageImports #-}
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
|
|
||||||
import "uniworx" Import
|
import "uniworx" Import
|
||||||
import "uniworx" Application (db)
|
import "uniworx" Application (db, getAppDevSettings)
|
||||||
|
|
||||||
|
import Database.Persist.Postgresql
|
||||||
|
import Database.Persist.Sql
|
||||||
|
import Control.Monad.Logger
|
||||||
|
|
||||||
import Data.Time
|
import Data.Time
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = db $ do
|
main = do
|
||||||
|
args <- liftIO getArgs
|
||||||
|
forM_ args $ \arg -> if
|
||||||
|
| arg == "clear" -> 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
|
||||||
|
rawExecute "drop owned by current_user;" []
|
||||||
|
| otherwise -> error $ "unknown argument: " <> unpack arg
|
||||||
|
fillDb
|
||||||
|
|
||||||
|
fillDb :: IO ()
|
||||||
|
fillDb = db $ do
|
||||||
defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings
|
defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
let
|
let
|
||||||
|
|||||||
@ -7,7 +7,7 @@
|
|||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
module Application
|
module Application
|
||||||
( getApplicationDev
|
( getApplicationDev, getAppDevSettings
|
||||||
, appMain
|
, appMain
|
||||||
, develMain
|
, develMain
|
||||||
, makeFoundation
|
, makeFoundation
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user