From feb3f6332bd6393036b214c3f14a2fa1d966312e Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sat, 7 Jul 2018 21:10:50 +0200
Subject: [PATCH] Make fill-db.hs (now db.hs) much fancier

---
 fill-db.hs => db.hs | 37 ++++++++++++++++++++++++++++---------
 1 file changed, 28 insertions(+), 9 deletions(-)
 rename fill-db.hs => db.hs (89%)

diff --git a/fill-db.hs b/db.hs
similarity index 89%
rename from fill-db.hs
rename to db.hs
index 8fe5b89ac..ed16a1603 100755
--- a/fill-db.hs
+++ b/db.hs
@@ -4,30 +4,49 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE LambdaCase #-}
 
-import "uniworx" Import
+import "uniworx" Import hiding (Option(..))
 import "uniworx" Application (db, getAppDevSettings)
 
 import Database.Persist.Postgresql
 import Database.Persist.Sql
 import Control.Monad.Logger
 
+import System.Console.GetOpt
+import System.Exit (exitWith, ExitCode(..))
+import System.IO (hPutStrLn, stderr)
+
 import Data.Time
 
+
+data DBAction = DBClear
+              | DBFill
+
+argsDescr :: [OptDescr DBAction]
+argsDescr =
+  [ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user"
+  , Option ['f'] ["fill"] (NoArg DBFill) "Fill database with example data"
+  ]
+
+  
 main :: IO ()
 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
+  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
           rawExecute "drop owned by current_user;" []
-    | otherwise -> error $ "unknown argument: " <> unpack arg
-  fillDb
+      DBFill -> db $ fillDb
+    (_, _, errs) -> do
+      forM_ errs $ hPutStrLn stderr
+      hPutStrLn stderr $ usageInfo "db.hs" argsDescr
+      exitWith $ ExitFailure 2
 
-fillDb :: IO ()
-fillDb = db $ do
+fillDb :: DB ()
+fillDb = do
   defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings
   now <- liftIO getCurrentTime
   let