From 02bdd2f3b9b6c7c98bf2a2904054b73e460b223e Mon Sep 17 00:00:00 2001
From: Bas van Dijk <bas@van.dijk.ch>
Date: Sun, 5 Feb 2023 14:10:52 +0100
Subject: [PATCH 1/2] Add the --until=YYYY-MM-DD option

This option is similar to the option `--today` except that instead of
computing interest until today it computes interest until the
specified day.

Fixes #18.
---
 Main.hs | 28 ++++++++++++++++++++++------
 1 file changed, 22 insertions(+), 6 deletions(-)

diff --git a/Main.hs b/Main.hs
index f2f49f9..37ea614 100644
--- a/Main.hs
+++ b/Main.hs
@@ -10,6 +10,7 @@ import Control.Monad
 import Data.List ( sortOn )
 import Data.Maybe
 import qualified Data.Text as T
+import Data.Time
 import Data.Version
 import System.Console.GetOpt
 import System.Environment
@@ -28,6 +29,7 @@ data Options = Options
   , optDCC              :: Maybe DayCountConvention
   , optRate             :: Maybe Rate
   , optBalanceToday     :: Bool
+  , optBalanceUntil     :: Maybe String
   , optIgnoreAssertions :: Bool
   }
 
@@ -42,6 +44,7 @@ defaultOptions = Options
   , optDCC              = Nothing
   , optRate             = Nothing
   , optBalanceToday     = False
+  , optBalanceUntil     = Nothing
   , optIgnoreAssertions = False
   }
 
@@ -52,7 +55,8 @@ options =
  , Option ['v'] ["verbose"]           (NoArg (\o -> o { optVerbose = True }))                              "echo input ledger to stdout (default)"
  , Option ['q'] ["quiet"]             (NoArg (\o -> o { optVerbose = False }))                             "don't echo input ledger to stdout"
  , Option []    ["today"]             (NoArg (\o -> o { optBalanceToday = True }))                         "compute interest up until today"
- , Option ['f'] ["file"]              (ReqArg (\f o -> o { optInput = f : optInput o }) "FILE")          "input ledger file (pass '-' for stdin)"
+ , Option []    ["until"]             (ReqArg (\d o -> o { optBalanceUntil = Just d}) "YYYY-MM-DD")        "compute interest up until the given date"
+ , Option ['f'] ["file"]              (ReqArg (\f o -> o { optInput = f : optInput o }) "FILE")            "input ledger file (pass '-' for stdin)"
  , Option ['s'] ["source"]            (ReqArg (\a o -> o { optSourceAcc = a }) "ACCOUNT")                  "interest source account"
  , Option ['t'] ["target"]            (ReqArg (\a o -> o { optTargetAcc = a }) "ACCOUNT")                  "interest target account"
  , Option ['I'] ["ignore-assertions"] (NoArg (\o -> o { optIgnoreAssertions = True }))                     "ignore any failing balance assertions"
@@ -91,6 +95,20 @@ main = bracket (return ()) (\() -> hFlush stdout >> hFlush stderr) $ \() -> do
   when (null (optTargetAcc opts)) (commandLineError "required --target option is missing\n")
   when (isNothing (optDCC opts)) (commandLineError "no day counting convention specified\n")
   when (isNothing (optRate opts)) (commandLineError "no interest rate specified\n")
+  mbComputeInterestUntil <-
+    case optBalanceUntil opts of
+      Just untilStr
+        | optBalanceToday opts ->
+            commandLineError "Specify either --today or --until=YYYY-MM-DD.\n"
+        | otherwise -> do
+            let fmt = "%Y-%-m-%-d"
+            case parseTimeM True defaultTimeLocale fmt untilStr :: Maybe Day of
+              Nothing -> commandLineError $ "Can't parse the specified --until date." ++
+                " Make sure it has the format " ++ fmt ++ ".\n"
+              Just day -> pure $ Just day
+      Nothing
+        | optBalanceToday opts -> Just <$> getCurrentDay
+        | otherwise -> return Nothing
   let ledgerInputOptions = definputopts { balancingopts_ = (balancingopts_ definputopts) { ignore_assertions_ = optIgnoreAssertions opts } }
   jnl' <- runExceptT (readJournalFiles ledgerInputOptions (reverse (optInput opts))) >>= either fail return
   interestAcc <- case args of
@@ -106,11 +124,9 @@ main = bracket (return ()) (\() -> hFlush stdout >> hFlush stderr) $ \() -> do
             , dayCountConvention = fromJust (optDCC opts)
             , interestRate = fromJust (optRate opts)
             }
-  thisDay <- getCurrentDay
-  let finalize
-        | optBalanceToday opts = computeInterest thisDay
-        | otherwise            = return ()
-      ts' = runComputer cfg (mapM_ processTransaction ts >> finalize)
+  let ts' = runComputer cfg $ do
+        mapM_ processTransaction ts
+        mapM_ computeInterest mbComputeInterestUntil
       result
         | optVerbose opts = ts' ++ ts
         | otherwise       = ts'

From 87a3357934f266763ca3d896a76b48e63d1a1f85 Mon Sep 17 00:00:00 2001
From: Bas van Dijk <bas@van.dijk.ch>
Date: Sat, 2 Nov 2024 14:35:29 +0100
Subject: [PATCH 2/2] =?UTF-8?q?Fix=20ambiguous=20occurrence=20=E2=80=98get?=
 =?UTF-8?q?Opt=E2=80=99?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 Main.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Main.hs b/Main.hs
index 37ea614..826ce85 100644
--- a/Main.hs
+++ b/Main.hs
@@ -82,7 +82,7 @@ commandLineError err = do hPutStrLn stderr (err ++ usageMessage)
 
 parseOpts :: [String] -> IO (Options, [String])
 parseOpts argv =
-   case getOpt Permute options argv of
+   case System.Console.GetOpt.getOpt Permute options argv of
       (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)
       (_,_,errs) -> commandLineError (concat errs)