ENH use cli flag for config path

app/Main.hs

@@ -10,84 +10,101 @@ import           Internal.Insert
 import           Internal.Types
 import           Internal.Utils
 
--- import           Import.Config
-
 import           Control.Monad.Trans.Reader
 
 import           Options.Applicative
 
+import           System.FilePath
+
 main :: IO ()
 main = parse =<< execParser o
   where
     o = info (options <**> helper)
       ( fullDesc
         <> progDesc "Pwn your budget"
-        <> header "pwncase - your budget, your life"
+        <> header "pwncash - your budget, your life"
       )
 
-data Options = Reset
+data Options = Options FilePath Mode
+
+data Mode = Reset
   | DumpCurrencies
   | DumpAccounts
   | DumpAccountKeys
   | Sync
 
-options :: Parser Options
-options = reset
-  <|> dumpCurrencies
-  <|> dumpAccounts
-  <|> dumpAccountKeys
-  <|> sync
+configFile :: Parser FilePath
+configFile = strOption
+  ( long "config"
+  <> short 'c'
+  <> metavar "CONFIG"
+  <> value "main.dhall"
+  <> help "config file to use"
+  )
 
-reset :: Parser Options
+options :: Parser Options
+options = getConf reset
+  <|> getConf dumpCurrencies
+  <|> getConf dumpAccounts
+  <|> getConf dumpAccountKeys
+  <|> getConf sync
+  where
+    getConf m = Options <$> configFile <*> m
+
+reset :: Parser Mode
 reset = flag' Reset
   ( long "reset"
-    <> short 'r'
+    <> short 'R'
     <> help "Reset the database"
   )
 
-dumpCurrencies :: Parser Options
+dumpCurrencies :: Parser Mode
 dumpCurrencies = flag' DumpCurrencies
   ( long "currencies"
-    <> short 'c'
+    <> short 'C'
     <> help "Dump all currencies in the configuration"
   )
 
-dumpAccounts :: Parser Options
+dumpAccounts :: Parser Mode
 dumpAccounts = flag' DumpAccounts
   ( long "accounts"
-    <> short 'a'
+    <> short 'A'
     <> help "Dump all accounts in the configuration"
   )
 
 -- TODO 'alias' is a better name for these
-dumpAccountKeys :: Parser Options
+dumpAccountKeys :: Parser Mode
 dumpAccountKeys = flag' DumpAccountKeys
   ( long "account_keys"
-    <> short 'k'
+    <> short 'K'
     <> help "Dump all account keys/aliases"
   )
 
-sync :: Parser Options
-sync = pure Sync
+sync :: Parser Mode
+sync = flag' Sync
+  ( long "sync"
+    <> short 'S'
+    <> help "Sync config to database"
+  )
 
 parse :: Options -> IO ()
-parse Reset           = migrate_ nukeTables
-parse DumpAccounts    = runDumpAccounts
-parse DumpAccountKeys = runDumpAccountKeys
-parse DumpCurrencies  = runDumpCurrencies
-parse Sync            = runSync
+parse (Options _ Reset)           = migrate_ nukeTables
+parse (Options c DumpAccounts)    = runDumpAccounts c
+parse (Options c DumpAccountKeys) = runDumpAccountKeys c
+parse (Options c DumpCurrencies)  = runDumpCurrencies c
+parse (Options c Sync)            = runSync c
 
-runDumpCurrencies :: IO ()
-runDumpCurrencies = do
-  cs <- currencies <$> readConfig "config/config.dhall"
+runDumpCurrencies :: FilePath -> IO ()
+runDumpCurrencies c = do
+  cs <- currencies <$> readConfig c
   putStrLn $ T.unpack $ T.unlines $ fmap fmt cs
   where
     fmt Currency { curSymbol = s, curFullname = f } =
       T.concat [s, ": ", f]
 
-runDumpAccounts :: IO ()
-runDumpAccounts = do
-  ar <- accounts <$> readConfig "config/config.dhall"
+runDumpAccounts :: FilePath -> IO ()
+runDumpAccounts c = do
+  ar <- accounts <$> readConfig c
   mapM_ (\(h, f) -> printTree h $ f ar) ps
   where
     ps = [ ("Assets", arAssets)
@@ -107,9 +124,9 @@ runDumpAccounts = do
       let ind = T.replicate (i * 2) " "
       putStrLn $ T.unpack $ T.concat [ind, n, ": ", d]
 
-runDumpAccountKeys :: IO ()
-runDumpAccountKeys = do
-  ar <- accounts <$> readConfig "config/config.dhall"
+runDumpAccountKeys :: FilePath -> IO ()
+runDumpAccountKeys c = do
+  ar <- accounts <$> readConfig c
   let ks = paths2IDs
         $ fmap (double . fst)
         $ concatMap (t3 . uncurry tree2Records)
@@ -121,12 +138,12 @@ runDumpAccountKeys = do
     t3 (_, _, x) = x
     double x = (x, x)
 
-runSync :: IO ()
-runSync = do
-  config <- readConfig "config/config.dhall"
+runSync :: FilePath -> IO ()
+runSync c = do
+  config <- readConfig c
   migrate_ $ do
     s <- getDBState config
-    flip runReaderT s $ do
+    flip runReaderT (s $ takeDirectory c) $ do
       insertBudget $ budget config
       insertStatements config
     showBalances

budget.cabal

@@ -46,6 +46,7 @@ library
     , data-fix
     , dhall >=1.41.2
     , esqueleto
+    , filepath
     , ghc >=9.0.2
     , hashable
     , lens >=5.0.1
@@ -81,6 +82,7 @@ executable pwncash
     , data-fix
     , dhall >=1.41.2
     , esqueleto
+    , filepath
     , ghc >=9.0.2
     , hashable
     , lens >=5.0.1

lib/Internal/Database/Model.hs

@@ -72,6 +72,7 @@ data DBState = DBState
   , kmBudgetInterval    :: !MaybeBounds
   , kmStatementInterval :: !MaybeBounds
   , kmNewCommits        :: ![Int]
+  , kmConfigDir         :: FilePath
   }
 
 type MappingT m a = ReaderT DBState (SqlPersistT m) a

lib/Internal/Database/Ops.hs

@@ -280,15 +280,18 @@ indexAcntRoot r =
   where
     (ars, aprs, ms) = unzip3 $ uncurry tree2Records <$> flattenAcntRoot r
 
-getDBState :: MonadIO m => Config -> SqlPersistT m DBState
+getDBState :: MonadIO m => Config -> SqlPersistT m (FilePath -> DBState)
 getDBState c = do
   am <- updateAccounts $ accounts c
   cm <- updateCurrencies $ currencies c
   hs <- updateHashes c
-  return $ DBState
+  -- TODO not sure how I feel about this, probably will change this struct alot
+  -- in the future so whatever...for now
+  return $ \f -> DBState
     { kmCurrency = cm
     , kmAccount = am
     , kmBudgetInterval = intervalMaybeBounds $ budgetInterval $ global c
     , kmStatementInterval = intervalMaybeBounds $ statementInterval $ global c
     , kmNewCommits = hs
+    , kmConfigDir = f
     }

lib/Internal/Insert.hs

@@ -252,7 +252,7 @@ insertManual m@Manual { manualDate = dp
 insertImport :: MonadIO m => Import -> MappingT m ()
 insertImport i = whenHash CTImport i $ \c -> do
   bounds <- asks kmStatementInterval
-  bs <- liftIO $ readImport i
+  bs <- readImport i
   -- TODO this isn't efficient, the whole file will be read and maybe no
   -- transactions will be desired
   rs <- mapM resolveTx $ filter (inMaybeBounds bounds . txDate) bs

lib/Internal/Statement.hs

@@ -7,6 +7,9 @@ module Internal.Statement
   ( readImport
   ) where
 
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Reader
+
 import           Data.Bifunctor
 import qualified Data.ByteString.Lazy       as BL
 import           Data.Csv
@@ -20,32 +23,36 @@ import qualified Data.Text.Encoding   as TE
 import           Data.Time
 import qualified Data.Vector                as V
 
+import           Internal.Database.Model
 import           Internal.Types
 import           Internal.Utils
 
 import           Numeric.Natural
 
+import           System.FilePath
+
 -- TODO this probably won't scale well (pipes?)
 
-readImport :: Import -> IO [BalTx]
+readImport :: MonadIO m => Import -> MappingT m [BalTx]
 readImport Import { impPaths = ps
                   , impMatches = ms
                   , impTxOpts = ns
                   , impDelim = d
                   , impSkipLines = n
-                  -- , impTx = f
                   } = do
   rs <- L.sort . concat <$> mapM (readImport_ n d ns) ps
   let (ts, es, notfound) = matchRecords ms rs
-  mapM_ putStrLn $ reverse es
-  mapM_ print notfound
+  liftIO $ mapM_ putStrLn $ reverse es
+  liftIO $ mapM_ print notfound
   return ts
 
-readImport_ :: Natural -> Word -> TxOpts -> FilePath -> IO [TxRecord]
+readImport_ :: MonadIO m => Natural -> Word -> TxOpts -> FilePath
+  -> MappingT m [TxRecord]
 readImport_ n delim tns p = do
-  bs <- BL.readFile p
+  dir <- asks kmConfigDir
+  bs <- liftIO $ BL.readFile $ dir </> p
   case decodeByNameWithP (parseTxRecord tns) opts $ skip bs of
-    Left m       -> putStrLn m >> return []
+    Left m       -> liftIO $ putStrLn m >> return []
     Right (_, v) -> return $ catMaybes $ V.toList v
   where
     opts = defaultDecodeOptions { decDelimiter = fromIntegral delim }

package.yaml

@@ -45,6 +45,7 @@ dependencies:
 - optparse-applicative
 - recursion-schemes
 - data-fix
+- filepath
 
 library:
   source-dirs: lib/