From 5d6038292e8be289179b813141585bed34790f86 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 11 Dec 2022 18:34:05 -0500 Subject: [PATCH] ENH use cli flag for config path --- app/Main.hs | 93 ++++++++++++++++++++-------------- budget.cabal | 2 + lib/Internal/Database/Model.hs | 1 + lib/Internal/Database/Ops.hs | 7 ++- lib/Internal/Insert.hs | 2 +- lib/Internal/Statement.hs | 33 +++++++----- package.yaml | 1 + 7 files changed, 85 insertions(+), 54 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 22756fe..25ff80b 100644 --- a/app/Main.hs +++ b/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 diff --git a/budget.cabal b/budget.cabal index 03252e0..5cf2899 100644 --- a/budget.cabal +++ b/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 diff --git a/lib/Internal/Database/Model.hs b/lib/Internal/Database/Model.hs index 3a11627..fe3946e 100644 --- a/lib/Internal/Database/Model.hs +++ b/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 diff --git a/lib/Internal/Database/Ops.hs b/lib/Internal/Database/Ops.hs index 60c43a5..d7f74a6 100644 --- a/lib/Internal/Database/Ops.hs +++ b/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 } diff --git a/lib/Internal/Insert.hs b/lib/Internal/Insert.hs index 3bcddbe..2152c1b 100644 --- a/lib/Internal/Insert.hs +++ b/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 diff --git a/lib/Internal/Statement.hs b/lib/Internal/Statement.hs index b158cee..6d36c14 100644 --- a/lib/Internal/Statement.hs +++ b/lib/Internal/Statement.hs @@ -7,45 +7,52 @@ 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 qualified Data.ByteString.Lazy as BL import Data.Csv import Data.Either -import qualified Data.List as L -import qualified Data.Map as M +import qualified Data.List as L +import qualified Data.Map as M import Data.Maybe import Data.Ord -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import Data.Time -import qualified Data.Vector as V +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 } diff --git a/package.yaml b/package.yaml index 20ed72b..9d7e62d 100644 --- a/package.yaml +++ b/package.yaml @@ -45,6 +45,7 @@ dependencies: - optparse-applicative - recursion-schemes - data-fix +- filepath library: source-dirs: lib/