From 7a74b86f6de2b27e00df43834f00a8c0361a0002 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 6 Jul 2018 21:34:57 +0200
Subject: [PATCH] Add "clear" argument to fill-db.hs

---
 fill-db.hs         | 20 ++++++++++++++++++--
 src/Application.hs |  2 +-
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/fill-db.hs b/fill-db.hs
index 0465dc665..8fe5b89ac 100755
--- a/fill-db.hs
+++ b/fill-db.hs
@@ -4,14 +4,30 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MultiWayIf #-}
 
 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
 
 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
   now <- liftIO getCurrentTime
   let
diff --git a/src/Application.hs b/src/Application.hs
index 159fb2655..4d9e54e11 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -7,7 +7,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
-    ( getApplicationDev
+    ( getApplicationDev, getAppDevSettings
     , appMain
     , develMain
     , makeFoundation