{-# 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 main :: IO () main = parse =<< execParser o where o = info (options <**> helper) ( fullDesc <> progDesc "Pwn your budget" <> header "pwncash - your budget, your life" ) data Options = Options FilePath Mode data Mode = Reset | DumpCurrencies | DumpAccounts | DumpAccountKeys | Sync configFile :: Parser FilePath configFile = strOption ( long "config" <> short 'c' <> metavar "CONFIG" <> value "main.dhall" <> help "config file to use" ) 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' <> help "Reset the database" ) dumpCurrencies :: Parser Mode dumpCurrencies = flag' DumpCurrencies ( long "currencies" <> short 'C' <> help "Dump all currencies in the configuration" ) dumpAccounts :: Parser Mode dumpAccounts = flag' DumpAccounts ( long "accounts" <> short 'A' <> help "Dump all accounts in the configuration" ) -- TODO 'alias' is a better name for these dumpAccountKeys :: Parser Mode dumpAccountKeys = flag' DumpAccountKeys ( long "account_keys" <> short 'K' <> help "Dump all account keys/aliases" ) sync :: Parser Mode sync = flag' Sync ( long "sync" <> short 'S' <> help "Sync config to database" ) parse :: Options -> IO () parse (Options c Reset) = do config <- readConfig c migrate_ (sqlConfig config) 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 :: MonadUnliftIO m => FilePath -> m () runDumpCurrencies c = do cs <- currencies <$> readConfig c liftIO $ putStrLn $ T.unpack $ T.unlines $ fmap fmt cs where fmt Currency {curSymbol = s, curFullname = f} = T.concat [s, ": ", f] runDumpAccounts :: MonadUnliftIO m => FilePath -> m () runDumpAccounts c = do ar <- accounts <$> readConfig c mapM_ (\(h, f) -> printTree h $ f ar) ps where ps = [ ("Assets", arAssets) , ("Equity", arEquity) , ("Expenses", arExpenses) , ("Income", arIncome) , ("Liabilities", arLiabilities) ] printTree h ts = do liftIO $ 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) " " liftIO $ putStrLn $ T.unpack $ T.concat [ind, n, ": ", d] runDumpAccountKeys :: MonadUnliftIO m => FilePath -> m () runDumpAccountKeys c = do ar <- accounts <$> readConfig c let ks = paths2IDs $ fmap (double . fst) $ concatMap (t3 . uncurry tree2Records) $ flattenAcntRoot ar mapM_ (uncurry printPair) ks where printPair i p = do liftIO $ putStrLn $ T.unpack $ T.concat [acntPath2Text p, ": ", i] t3 (_, _, x) = x double x = (x, x) runSync :: MonadUnliftIO m => FilePath -> m () runSync c = do config <- readConfig c migrate_ (sqlConfig config) $ do s <- getDBState config flip runReaderT (s $ takeDirectory c) $ do insertBudget $ budget config insertStatements config -- showBalances