Skip to content

Instantly share code, notes, and snippets.

@simonmichael simonmichael/1-example
Last active Mar 10, 2019

Embed
What would you like to do?
finance scripts in a robust shake file
~/notes$ ./do.hs
Linking do ...
~/notes$ ./do
Usage:
./do.hs install deps & (re)compile this script
./do [help] show this help
./do time show time status
./do money show money status
./do lassets show liquid assets
./do incexp show monthly income & expenses
./do budget show monthly expense budget performance
./do tbudget show time budget performance
./do timelog show timelog status
#!/usr/bin/env stack
{- stack exec
--verbosity=info
--package base-prelude
--package directory
--package extra
--package filepath
--package regex
--package shake
--package time
ghc
-} -- sync this package list to: imports below, DO_PACKAGES in Makefile
{-
General personal management scripts - finance, time etc.
Some useful make rules when working on this:
make do, make ghci-do, make ghcid-do, make ghcid-do-CMD.
-}
-- {-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PackageImports #-}
-- {-# LANGUAGE ScopedTypeVariables #-}
import Prelude ()
import "base-prelude" BasePrelude
import "base" Control.Exception as C
import "directory" System.Directory
import "extra" Data.List.Extra
import "filepath" System.FilePath
-- import "process" System.Process
import "regex" Text.RE.TDFA.String
import "regex" Text.RE.Replace
-- import "safe" Safe
import "shake" Development.Shake
-- import "shake" Development.Shake.FilePath
import "time" Data.Time
dir = "/Users/simon/notes"
timelogFile = dir </> "time-2019.timedot"
cmds = [
-- command, help, shake action
("time" ,"show time status" , time)
,("money" ,"show money status" , money)
,("lassets" ,"show liquid assets" , liquidAssets True)
,("incexp" ,"show monthly income & expenses" , incomeExpenses True)
,("budget" ,"show monthly expense budget performance" , budget)
,("tbudget" ,"show time budget performance" , timeBudget)
,("timelog" ,"show timelog status" , timelog)
-- ,"-----------------------------------------------------------79-^
]
main :: IO ()
main = shakeArgs shakeOptions { shakeVerbosity=Quiet } $ do
want ["help"]
phony "help" $ io $ putStr $ unlines $
["Usage:"
,"./do.hs install deps & (re)compile this script"
,"./do [help] show this help"
] ++
[printf "./do %-10s %s" c h | (c,h,_) <- cmds]
forM_ cmds $ \(c,_,action) -> phony c action
time :: Action ()
time = do
t <- io getCurrentLocalTime
io $ printf "TIME (updated %s)\n\n" (showTime t)
timelog >> blankline
timeBudget >> blankline
sleepWake >> blankline
money :: Action ()
money = do
t <- io getCurrentLocalTime
io $ printf "MONEY (updated %s)\n\n" (showTime t)
liquidAssets True >> blankline
incomeExpenses False >> blankline
budget >> blankline
liquidAssets :: Bool -> Action ()
liquidAssets cleared = do
io $ printf "Liquid assets (%scleared):\n" (if cleared then "" else "un")
cmd_ Shell "hledger bal wf cash:wallet cash:emperors assets.*paypal" (if cleared then "-C" else "")
"| grep -vE '^$'"
incomeExpenses :: Bool -> Action ()
incomeExpenses cleared = do
-- io $ printf "Income & Expenses (%scleared):\n" (if cleared then "" else "un")
-- cmd_ Shell "hledger bal -M -V sm:'(rev|exp)' -2" (if cleared then "-C" else "") >> blankline
cmd_ Shell "hledger is -M -V sm:'(rev|exp)' -3" (if cleared then "-C" else "")
"| grep -vE '^$'"
budget :: Action ()
budget = do
ls <- filter (not . null) . lines . fromStdout <$> (cmd Shell "hledger bal --budget -V -E -M -blastmonth sm:exp -3 --flat --drop 2")
io $ putStr $ unlines $ take 3 ls ++ drop 5 ls
timeBudget :: Action ()
timeBudget = do
ls <- drop 1 . lines . fromStdout <$> (cmd "hledger -f time.journal -f time-daily.budget bal --budget -D -1 date:yesterday-tomorrow")
io $ printf "Daily time budget:%s" (unlines ls)
io $ putStrLn ""
ls <- drop 1 . lines . fromStdout <$> (cmd "hledger -f time.journal -f time-weekly.budget bal --budget -W -1 date:lastweek-nextweek")
io $ printf "Weekly time budget:%s" (unlines ls)
io $ putStrLn ""
ls <- drop 1 . lines . fromStdout <$> (cmd "hledger -f time.journal -f time-weekly.budget bal --budget -M -1 date:lastmonth-nextmonth")
io $ printf "Monthly time budget:%s" (unlines ls)
timelog :: Action ()
timelog = do
tz <- io $ getCurrentTimeZone
tmod <- (utcToLocalTime tz <$>) $ io $ getModificationTime timelogFile
tacc <- (utcToLocalTime tz <$>) $ io $ getAccessTime timelogFile
log <- io $ readFile timelogFile
let todaylog = last $ splitOn "\n\n" log
io $ printf "Today's timelog: (saved %s, accessed %s)\n%s"
(showTime tmod) (showTime tacc) (alphabetiseTimedotDay $ formatTimedot todaylog)
sleepWake :: Action ()
sleepWake = do
io $ printf "Recent sleep/wakes:\n"
cmd_ Shell
"( pmset -g log | grep -E '((Sleep|Wake) +\\t|Display is)' )"
"| tail"
"| cut -c 1-78"
"| sed -E"
"-e 's/(Notification|Sleep|Wake) *\t//'"
"-e 's/is turned //'"
"-e 's/Entering Sleep state/Sleep/'"
---------------
-- Utilities
type Timedot = String
-- Format one day's worth of timedot-format text: sort all but the first line
-- alphabetically. (Will sort blank and comment lines too.)
alphabetiseTimedotDay :: Timedot -> Timedot
alphabetiseTimedotDay s = unlines $ take 1 ls ++ sort (drop 1 ls)
where ls = lines s
-- Format some timedot-format text: align the dots based on widest account name.
formatTimedot :: Timedot -> Timedot
formatTimedot s = unlines $ map formatline $ lines s
where
ls = lines s
accts = concat [take 1 $ splitOn " " l | l <- ls, not $ isDate l]
acctwidth = maximum $ map length accts
isDate = isJust . parsedateM
isComment = (`elem` [";","#"]) . take 1 . strip
isBlank = null . strip
formatline l
| isDate l || isComment l || isBlank l = l
| otherwise = printf ("%-"++show acctwidth++"s %s") acct (intercalate " " rest)
where
acct:rest = splitOn " " l
showMD :: FormatTime t => t -> String
showMD = formatTime defaultTimeLocale "%b %-e"
showHM :: FormatTime t => t -> String
showHM = formatTime defaultTimeLocale "%H:%M" :: FormatTime t => t -> String
showTime :: FormatTime t => t -> String
showTime t = printf "%s %s" (showMD t) (showHM t)
blankline = io $ putStrLn ""
-- General utilities
io = liftIO
getCurrentDay :: IO Day
getCurrentDay = do
t <- getZonedTime
return $ localDay (zonedTimeToLocalTime t)
getCurrentLocalTime :: IO LocalTime
getCurrentLocalTime = do
t <- getCurrentTime
tz <- getCurrentTimeZone
return $ utcToLocalTime tz t
readFileStrictly :: FilePath -> IO String
readFileStrictly f = readFile f >>= \s -> C.evaluate (length s) >> return s
-- | Parse a couple of date string formats to a time type.
parsedateM :: String -> Maybe Day
parsedateM s = firstJust id [
parseTimeM True defaultTimeLocale "%Y/%m/%d" s,
parseTimeM True defaultTimeLocale "%Y-%m-%d" s
]
-- | Remove leading and trailing whitespace.
strip :: String -> String
strip = lstrip . rstrip
-- | Remove leading whitespace.
lstrip :: String -> String
lstrip = dropWhile isSpace
-- | Remove trailing whitespace.
rstrip :: String -> String
rstrip = reverse . lstrip . reverse
-- | Remove trailing newlines/carriage returns.
chomp :: String -> String
chomp = reverse . dropWhile (`elem` "\r\n") . reverse
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.