133 lines
3.2 KiB
Haskell
133 lines
3.2 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
|
||
|
|
module Main (main) where
|
||
|
|
|
||
|
|
import qualified Data.Text as T
|
||
|
|
|
||
|
|
import Internal.Config
|
||
|
|
import Internal.Database.Ops
|
||
|
|
import Internal.Insert
|
||
|
|
import Internal.Types
|
||
|
|
import Internal.Utils
|
||
|
|
|
||
|
|
-- import Import.Config
|
||
|
|
|
||
|
|
import Control.Monad.Trans.Reader
|
||
|
|
|
||
|
|
import Options.Applicative
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = parse =<< execParser o
|
||
|
|
where
|
||
|
|
o = info (options <**> helper)
|
||
|
|
( fullDesc
|
||
|
|
<> progDesc "Pwn your budget"
|
||
|
|
<> header "pwncase - your budget, your life"
|
||
|
|
)
|
||
|
|
|
||
|
|
data Options = Reset
|
||
|
|
| DumpCurrencies
|
||
|
|
| DumpAccounts
|
||
|
|
| DumpAccountKeys
|
||
|
|
| Sync
|
||
|
|
|
||
|
|
options :: Parser Options
|
||
|
|
options = reset
|
||
|
|
<|> dumpCurrencies
|
||
|
|
<|> dumpAccounts
|
||
|
|
<|> dumpAccountKeys
|
||
|
|
<|> sync
|
||
|
|
|
||
|
|
reset :: Parser Options
|
||
|
|
reset = flag' Reset
|
||
|
|
( long "reset"
|
||
|
|
<> short 'r'
|
||
|
|
<> help "Reset the database"
|
||
|
|
)
|
||
|
|
|
||
|
|
dumpCurrencies :: Parser Options
|
||
|
|
dumpCurrencies = flag' DumpCurrencies
|
||
|
|
( long "currencies"
|
||
|
|
<> short 'c'
|
||
|
|
<> help "Dump all currencies in the configuration"
|
||
|
|
)
|
||
|
|
|
||
|
|
dumpAccounts :: Parser Options
|
||
|
|
dumpAccounts = flag' DumpAccounts
|
||
|
|
( long "accounts"
|
||
|
|
<> short 'a'
|
||
|
|
<> help "Dump all accounts in the configuration"
|
||
|
|
)
|
||
|
|
|
||
|
|
-- TODO 'alias' is a better name for these
|
||
|
|
dumpAccountKeys :: Parser Options
|
||
|
|
dumpAccountKeys = flag' DumpAccountKeys
|
||
|
|
( long "account_keys"
|
||
|
|
<> short 'k'
|
||
|
|
<> help "Dump all account keys/aliases"
|
||
|
|
)
|
||
|
|
|
||
|
|
sync :: Parser Options
|
||
|
|
sync = pure Sync
|
||
|
|
|
||
|
|
parse :: Options -> IO ()
|
||
|
|
parse Reset = migrate_ nukeTables
|
||
|
|
parse DumpAccounts = runDumpAccounts
|
||
|
|
parse DumpAccountKeys = runDumpAccountKeys
|
||
|
|
parse DumpCurrencies = runDumpCurrencies
|
||
|
|
parse Sync = runSync
|
||
|
|
|
||
|
|
runDumpCurrencies :: IO ()
|
||
|
|
runDumpCurrencies = do
|
||
|
|
cs <- currencies <$> readConfig "config/config.dhall"
|
||
|
|
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"
|
||
|
|
mapM_ (\(h, f) -> printTree h $ f ar) ps
|
||
|
|
where
|
||
|
|
ps = [ ("Assets", arAssets)
|
||
|
|
, ("Equity", arEquity)
|
||
|
|
, ("Expenses", arExpenses)
|
||
|
|
, ("Income", arIncome)
|
||
|
|
, ("Liabilities", arLiabilities)
|
||
|
|
]
|
||
|
|
printTree h ts = do
|
||
|
|
putStrLn h
|
||
|
|
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) " "
|
||
|
|
putStrLn $ T.unpack $ T.concat [ind, n, ": ", d]
|
||
|
|
|
||
|
|
runDumpAccountKeys :: IO ()
|
||
|
|
runDumpAccountKeys = do
|
||
|
|
ar <- accounts <$> readConfig "config/config.dhall"
|
||
|
|
let ks = paths2IDs
|
||
|
|
$ fmap (double . fst)
|
||
|
|
$ concatMap (t3 . uncurry tree2Records)
|
||
|
|
$ flattenAcntRoot ar
|
||
|
|
mapM_ (uncurry printPair) ks
|
||
|
|
where
|
||
|
|
printPair i p = do
|
||
|
|
putStrLn $ T.unpack $ T.concat [acntPath2Text p, ": ", i]
|
||
|
|
t3 (_, _, x) = x
|
||
|
|
double x = (x, x)
|
||
|
|
|
||
|
|
runSync :: IO ()
|
||
|
|
runSync = do
|
||
|
|
config <- readConfig "config/config.dhall"
|
||
|
|
migrate_ $ do
|
||
|
|
s <- getDBState config
|
||
|
|
flip runReaderT s $ do
|
||
|
|
insertBudget $ budget config
|
||
|
|
insertStatements config
|
||
|
|
showBalances
|