ENH use cli flag for config path

This commit is contained in:
Nathan Dwarshuis 2022-12-11 18:34:05 -05:00
parent 7dc9b7b07b
commit 5d6038292e
7 changed files with 85 additions and 54 deletions

View File

@ -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

View File

@ -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

View File

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

View File

@ -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
}

View File

@ -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

View File

@ -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 }

View File

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