pwncash/app/Main.hs

169 lines
3.9 KiB
Haskell
Raw Normal View History

2023-01-24 22:15:32 -05:00
{-# LANGUAGE LambdaCase #-}
2022-12-11 17:51:11 -05:00
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Internal.Config
import Internal.Database.Ops
import Internal.Insert
import Internal.Types
import Internal.Utils
import Options.Applicative
import RIO
import RIO.FilePath
import qualified RIO.Text as T
2022-12-11 18:34:05 -05:00
2022-12-11 17:51:11 -05:00
main :: IO ()
main = parse =<< execParser o
where
o =
info
(options <**> helper)
( fullDesc
<> progDesc "Pwn your budget"
<> header "pwncash - your budget, your life"
)
2022-12-11 17:51:11 -05:00
2022-12-11 18:34:05 -05:00
data Options = Options FilePath Mode
data Mode
= Reset
2022-12-11 17:51:11 -05:00
| DumpCurrencies
| DumpAccounts
| DumpAccountKeys
| Sync
2022-12-11 18:34:05 -05:00
configFile :: Parser FilePath
configFile =
strOption
( long "config"
<> short 'c'
<> metavar "CONFIG"
<> value "main.dhall"
<> help "config file to use"
)
2022-12-11 18:34:05 -05:00
2022-12-11 17:51:11 -05:00
options :: Parser Options
options =
getConf reset
<|> getConf dumpCurrencies
<|> getConf dumpAccounts
<|> getConf dumpAccountKeys
<|> getConf sync
2022-12-11 18:34:05 -05:00
where
getConf m = Options <$> configFile <*> m
2022-12-11 17:51:11 -05:00
2022-12-11 18:34:05 -05:00
reset :: Parser Mode
reset =
flag'
Reset
( long "reset"
<> short 'R'
<> help "Reset the database"
)
2022-12-11 17:51:11 -05:00
2022-12-11 18:34:05 -05:00
dumpCurrencies :: Parser Mode
dumpCurrencies =
flag'
DumpCurrencies
( long "currencies"
<> short 'C'
<> help "Dump all currencies in the configuration"
)
2022-12-11 17:51:11 -05:00
2022-12-11 18:34:05 -05:00
dumpAccounts :: Parser Mode
dumpAccounts =
flag'
DumpAccounts
( long "accounts"
<> short 'A'
<> help "Dump all accounts in the configuration"
)
2022-12-11 17:51:11 -05:00
-- TODO 'alias' is a better name for these
2022-12-11 18:34:05 -05:00
dumpAccountKeys :: Parser Mode
dumpAccountKeys =
flag'
DumpAccountKeys
( long "account_keys"
<> short 'K'
<> help "Dump all account keys/aliases"
)
2022-12-11 17:51:11 -05:00
2022-12-11 18:34:05 -05:00
sync :: Parser Mode
sync =
flag'
Sync
( long "sync"
<> short 'S'
<> help "Sync config to database"
)
2022-12-11 17:51:11 -05:00
parse :: Options -> IO ()
parse (Options c Reset) = do
2022-12-11 18:53:54 -05:00
config <- readConfig c
migrate_ (sqlConfig config) nukeTables
parse (Options c DumpAccounts) = runDumpAccounts c
2022-12-11 18:34:05 -05:00
parse (Options c DumpAccountKeys) = runDumpAccountKeys c
parse (Options c DumpCurrencies) = runDumpCurrencies c
parse (Options c Sync) = runSync c
2022-12-11 18:34:05 -05:00
2023-01-05 22:23:22 -05:00
runDumpCurrencies :: MonadUnliftIO m => FilePath -> m ()
2022-12-11 18:34:05 -05:00
runDumpCurrencies c = do
cs <- currencies <$> readConfig c
2023-01-05 22:23:22 -05:00
liftIO $ putStrLn $ T.unpack $ T.unlines $ fmap fmt cs
2022-12-11 17:51:11 -05:00
where
fmt Currency {curSymbol = s, curFullname = f} =
2022-12-11 17:51:11 -05:00
T.concat [s, ": ", f]
2023-01-05 22:23:22 -05:00
runDumpAccounts :: MonadUnliftIO m => FilePath -> m ()
2022-12-11 18:34:05 -05:00
runDumpAccounts c = do
ar <- accounts <$> readConfig c
2022-12-11 17:51:11 -05:00
mapM_ (\(h, f) -> printTree h $ f ar) ps
where
ps =
[ ("Assets", arAssets)
, ("Equity", arEquity)
, ("Expenses", arExpenses)
, ("Income", arIncome)
, ("Liabilities", arLiabilities)
]
2022-12-11 17:51:11 -05:00
printTree h ts = do
2023-01-05 22:23:22 -05:00
liftIO $ putStrLn h
2022-12-11 17:51:11 -05:00
mapM (go 1) ts
go i (Placeholder d n cs) = do
printAcnt i d n
mapM_ (go (i + 1)) cs
go i (Account d n) = printAcnt i d n
printAcnt i d n = do
let ind = T.replicate (i * 2) " "
2023-01-05 22:23:22 -05:00
liftIO $ putStrLn $ T.unpack $ T.concat [ind, n, ": ", d]
2022-12-11 17:51:11 -05:00
2023-01-05 22:23:22 -05:00
runDumpAccountKeys :: MonadUnliftIO m => FilePath -> m ()
2022-12-11 18:34:05 -05:00
runDumpAccountKeys c = do
ar <- accounts <$> readConfig c
let ks =
paths2IDs $
fmap (double . fst) $
concatMap (t3 . uncurry tree2Records) $
flattenAcntRoot ar
2022-12-11 17:51:11 -05:00
mapM_ (uncurry printPair) ks
where
printPair i p = do
2023-01-05 22:23:22 -05:00
liftIO $ putStrLn $ T.unpack $ T.concat [acntPath2Text p, ": ", i]
2022-12-11 17:51:11 -05:00
t3 (_, _, x) = x
double x = (x, x)
2023-01-05 22:23:22 -05:00
runSync :: MonadUnliftIO m => FilePath -> m ()
2022-12-11 18:34:05 -05:00
runSync c = do
config <- readConfig c
2023-01-28 19:32:56 -05:00
migrate_ (sqlConfig config) $ do
s <- getDBState config
flip runReaderT (s $ takeDirectory c) $ do
es1 <- insertBudget $ budget config
es2 <- insertStatements config
let es = es1 ++ es2
unless (null es) $ throwIO $ InsertException es
2023-01-07 23:41:56 -05:00
-- showBalances