summaryrefslogtreecommitdiff
path: root/hledger-overview.hs
diff options
context:
space:
mode:
Diffstat (limited to 'hledger-overview.hs')
-rwxr-xr-xhledger-overview.hs144
1 files changed, 85 insertions, 59 deletions
diff --git a/hledger-overview.hs b/hledger-overview.hs
index f8de24c..652e852 100755
--- a/hledger-overview.hs
+++ b/hledger-overview.hs
@@ -1,6 +1,8 @@
#!/usr/bin/env runhaskell
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
-- | Calculates and displays an overview of my finances.
module Main where
@@ -15,6 +17,7 @@ import qualified Data.Text.IO as IO
import Data.Time.Calendar (Day, fromGregorian, toGregorian)
import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, diffUTCTime, getCurrentTime)
import Hledger
+import Rainbow
today :: IO Day
today = getCurrentTime >>= return . utctDay
@@ -32,30 +35,29 @@ main = do
let bal = getTotal j t $ defreportopts
let balVal = getTotal j t $ defreportopts {value_ = inUsdNow}
sec "cash balances"
- row "simple" (prn $ bal "^as:me:cash:simple status:! status:*") Nothing
- row "cashap" (prn $ bal "^as:me:cash:cashapp status:! status:*") Nothing
- row "wallet" (prn $ bal "^as:me:cash:wallet") Nothing
- row " disc" (prn $ bal "^li:me:cred:discover status:*") Nothing
- row " citi" (prn $ bal "^li:me:cred:citi status:*") Nothing
+ row "simple" (bal "^as:me:cash:simple status:! status:*") Nothing
+ row "cashap" (bal "^as:me:cash:cashapp status:! status:*") Nothing
+ row "wallet" (bal "^as:me:cash:wallet") Nothing
+ row " disc" (bal "^li:me:cred:discover status:*") Nothing
+ row " citi" (bal "^li:me:cred:citi status:*") Nothing
let btcBal q = sum . map aquantity $ getTotalAmounts j t defreportopts q
let btcBalUSD q = sum . map aquantity $ getTotalAmounts j t (defreportopts {value_ = inUsdNow}) q
- row " btc" (prn $ btcBal "^as cur:BTC") (Just $ prn $ btcBalUSD "^as cur:BTC")
+ row " btc" (Target 4 $ btcBal "^as cur:BTC") (Just $ display $ btcBalUSD "^as cur:BTC")
- -- TODO: these metrics should have targets. if >target, print red, else print
- -- green. Or limit: if <limit, print green, else print red
sec "metrics"
let netCash = bal "^as:me:cash ^li:me:cred cur:USD"
let netWorth = balVal "^as ^li"
- row " in - ex" (prn $ bal "^in ^ex" / monthsSinceBeginning t) $ Just "keep this negative to make progress"
- row "cred load" (prn netCash) $ Just "net cash: credit spending minus USD cash assets. keep it positive"
- -- TODO: current month expenses should be lower than average month expenses
- row "month exp" ("hledger bal ^ex:me -p thismonth") Nothing
- row "net worth" (prn netWorth) Nothing
- row " level" (pr $ level netWorth) (Just $ "+" <> (prn $ netWorth - (unlevel $ roundTo' floor 1 $ level netWorth)))
+ row " in - ex" (Limit 0 $ bal "^in ^ex" / monthsSinceBeginning t) $ Just "keep this negative to make progress"
+ row "cred load" (Target 0 netCash) $ Just "net cash: credit spending minus USD cash assets. keep it positive"
+ let monthlyNut = nut t $ balVal "^ex"
+ let thisMonth = balVal "^ex date:thismonth"
+ row "month exp" (Limit monthlyNut thisMonth) $ Just $ display $ monthlyNut - thisMonth
+ row "net worth" netWorth Nothing
+ row " level" (level netWorth) (Just $ "+" <> (display $ netWorth - (unlevel $ roundTo' floor 1 $ level netWorth)))
let levelup n = level netWorth & (+ n) & roundTo' floor 1 & unlevel & \target -> target - netWorth
- row " next" (prn $ levelup 0.1) (Just $ prn $ roundTo' floor 1 $ level netWorth + 0.1)
- row " nnext" (prn $ levelup 0.2) (Just $ prn $ roundTo' floor 1 $ level netWorth + 0.2)
- row " nnnext" (prn $ levelup 0.3) (Just $ prn $ roundTo' floor 1 $ level netWorth + 0.3)
+ row " next" (levelup 0.1) (Just $ display $ roundTo' floor 1 $ level netWorth + 0.1)
+ row " nnext" (levelup 0.2) (Just $ display $ roundTo' floor 1 $ level netWorth + 0.2)
+ row " nnnext" (levelup 0.3) (Just $ display $ roundTo' floor 1 $ level netWorth + 0.3)
sec "trivials"
let trivialWorth = roundTo 2 $ trivial * netWorth
@@ -68,46 +70,75 @@ main = do
let age = (fromInteger thisyear) - 1992
let n = whenFreedom j t
let ageFree = roundTo 1 $ (n / 12) + age :: Decimal
- row "savings rate" (pr $ savingsRate j t) Nothing
- row " target fund" (prn $ targetFund j t) Nothing
- row " when free" ((pr n) <> " months") $ Just $ "I'll be " <> pr ageFree <> " years old"
+ row "savings rate" (Percent_ $ savingsRate j t) Nothing
+ row " target fund" (targetFund j t) Nothing
+ row " when free" (Months_ n) $ Just $ "I'll be " <> pr ageFree <> " years old"
sec "runway"
let (nut, cash, months) = runway j t
- row " nut" (prn nut) Nothing
- row " cash" (prn cash) Nothing
- row "months" (prn months) Nothing
+ row " nut" nut Nothing
+ row " cash" cash Nothing
+ row "months" (Target 24 months) Nothing
sec "ramen"
let (nut, cash, months) = ramen j t
- row " nut" (prn nut) Nothing
- row " cash" (prn cash) Nothing
- row "months" (prn months) Nothing
+ row " nut" nut Nothing
+ row " cash" cash Nothing
+ row "months" (Target 3 months) Nothing
+
+-- | <type> <expected> <actual>
+data Metric
+ = Target Quantity Quantity
+ | Limit Quantity Quantity
+
+-- | Tag displayable things so I can change how things print, e.g. add a percent
+-- sign, or some coloring, etc.
+class Display a where
+ display :: a -> Chunk
+
+instance Display Chunk where
+ display c = c
+
+instance Display Metric where
+ display (Target expected actual) = color $ display actual
+ where color = if actual >= expected then fore green else fore red
+ display (Limit expected actual) = color $ display actual
+ where color = if actual <= expected then fore green else fore red
+
+-- | Tag numbers for different kinds of displays
+data Number = Months_ Quantity | Percent_ Quantity
+
+instance Display Number where
+ display (Months_ q) = display q <> " months"
+ display (Percent_ p) = display p <> "%"
+
+instance Display Text where
+ display t = chunk t
+
+-- | Pretty-print a number. From https://stackoverflow.com/a/61070523/1146898
+instance Display Quantity where
+ display d = chunk $ T.intercalate "." $ case T.splitOn "." $ T.pack $ show $ roundTo 2 d of
+ x : xs -> (T.pack . reverse . go . reverse . T.unpack) x : xs
+ xs -> xs
+ where
+ go (x : y : z : []) = x : y : z : []
+ go (x : y : z : ['-']) = x : y : z : ['-']
+ go (x : y : z : xs) = x : y : z : ',' : go xs
+ go xs = xs
sec :: String -> IO ()
sec label = putStrLn $ "\n" <> label <> ":"
-pr :: Show s => s -> Text
-pr = pack . show
+pr :: Show s => s -> Chunk
+pr = chunk . pack . show
-row :: Text -> Text -> Maybe Text -> IO ()
-row label value Nothing = IO.putStrLn $ gap <> label <> ":" <> gap <> value
-row label value (Just nb) = IO.putStrLn $ gap <> label <> ":" <> gap <> value <> gap <> "\t(" <> nb <> ")"
+row :: Display a => Chunk -> a -> Maybe Chunk -> IO ()
+row label value Nothing = putChunkLn $ gap <> label <> ":" <> gap <> display value
+row label value (Just nb) = putChunkLn $ gap <> label <> ":" <> gap <> display value <> gap <> "\t(" <> nb <> ")"
-gap :: Text
+gap :: Chunk
gap = " "
--- | Pretty-print a number. From https://stackoverflow.com/a/61070523/1146898
-prn :: Quantity -> Text
-prn d = T.intercalate "." $ case T.splitOn "." $ T.pack $ show $ roundTo 2 d of
- x : xs -> (T.pack . reverse . go . reverse . T.unpack) x : xs
- xs -> xs
- where
- go (x : y : z : []) = x : y : z : []
- go (x : y : z : ['-']) = x : y : z : ['-']
- go (x : y : z : xs) = x : y : z : ',' : go xs
- go xs = xs
-
-- | There's levels to life, a proxy metric for what level you're at is your net
-- worth rounded down to the nearest power of 10.
level :: Decimal -> Decimal
@@ -142,12 +173,6 @@ getTotalAmounts j d opts q = totals
(_, (Mixed totals)) = balanceReport opts' query j
Right (query, _) = parseQuery d $ pack q
-monthlyBalance :: Journal -> Day -> Text -> BalanceReport
-monthlyBalance j d q = balanceReport opts query j
- where
- opts = defreportopts {average_ = True, today_ = Just d, period_ = MonthPeriod 2020 10, interval_ = Months 6}
- Right (query, _) = parseQuery d q
-
-- | These are the accounts that I consider a part of my savings and not my
-- cash-spending accounts.
savingsAccounts :: [String]
@@ -220,23 +245,24 @@ monthlySavings j d =
-- | How many months I could sustain myself with my cash and savings, given my
-- current expenses.
runway :: Journal -> Day -> (Quantity, Quantity, Quantity)
-runway j d = (nut, cash, cash / nut)
+runway j d = (nut d total, cash, cash / nut d total)
where
- nut = (sum $ map aquantity $ filter (\a -> acommodity a == "USD") total) / monthsSinceBeginning d
- (_, (Mixed total)) = monthlyBalance j d "^ex:me"
-
- cash =
- getTotal j d (defreportopts {value_ = inUsdNow}) "^as:me:save ^as:me:cash ^li:me:cred"
+ opts = defreportopts {value_ = inUsdNow}
+ total = getTotal j d opts "^ex:me"
+ cash = getTotal j d opts "^as:me:save ^as:me:cash ^li:me:cred"
-- | Ramen profitability. Like 'runway', except let's say I live on /only/ the
-- necessities, and don't spend my bitcoin. So cash flow in my checking account
-- is primary.
ramen :: Journal -> Day -> (Quantity, Quantity, Quantity)
-ramen j d = (nut, cash, cash / nut)
+ramen j d = (nut d total, cash, cash / nut d total)
where
- nut = (sum $ map aquantity $ filter (\a -> acommodity a == "USD") total) / monthsSinceBeginning d
- (_, (Mixed total)) = monthlyBalance j d "^ex:me:need"
- cash = getTotal j d (defreportopts {value_ = inUsdNow}) "^as:me:cash ^li:me:cred"
+ opts = defreportopts {value_ = inUsdNow}
+ total = getTotal j d opts "^ex:me:need"
+ cash = getTotal j d opts "^as:me:cash ^li:me:cred"
+
+nut :: Day -> Quantity -> Quantity
+nut d total = total / monthsSinceBeginning d
-- | Escape velocity:
--