Make fill-db.hs (now db.hs) much fancier

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
+  args <- map unpack <$> getArgs
-  forM_ args $ \arg -> if
+  case getOpt Permute argsDescr args of
-    | arg == "clear" -> runStderrLoggingT $ do -- We don't use `db` here, since we do /not/ want any migrations to run, yet
+    (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
+      DBFill -> db $ fillDb
-  fillDb
+    (_, _, errs) -> do
+      forM_ errs $ hPutStrLn stderr
+      hPutStrLn stderr $ usageInfo "db.hs" argsDescr
+      exitWith $ ExitFailure 2
 
-fillDb :: IO ()
+fillDb :: DB ()
-fillDb = db $ do
+fillDb = do
   defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings
   now <- liftIO getCurrentTime
   let