diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index ce209e8c0..3274655ae 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -18,6 +18,7 @@ module Hledger.Cli.Commands ( ,module Hledger.Cli.Commands.Balancesheet ,module Hledger.Cli.Commands.Balancesheetequity ,module Hledger.Cli.Commands.Cashflow + ,module Hledger.Cli.Commands.Checkdates ,module Hledger.Cli.Commands.Help ,module Hledger.Cli.Commands.Incomestatement ,module Hledger.Cli.Commands.Print @@ -47,6 +48,7 @@ import Hledger.Cli.Commands.Balance import Hledger.Cli.Commands.Balancesheet import Hledger.Cli.Commands.Balancesheetequity import Hledger.Cli.Commands.Cashflow +import Hledger.Cli.Commands.Checkdates import Hledger.Cli.Commands.Help import Hledger.Cli.Commands.Incomestatement import Hledger.Cli.Commands.Print @@ -65,6 +67,7 @@ builtinCommands = [ ,(balancesheetmode , balancesheet) ,(balancesheetequitymode , balancesheetequity) ,(cashflowmode , cashflow) + ,(checkdatesmode , checkdates) ,(helpmode , help') ,(incomestatementmode , incomestatement) ,(printmode , print') diff --git a/bin/hledger-check-dates.hs b/hledger/Hledger/Cli/Commands/Checkdates.hs similarity index 50% rename from bin/hledger-check-dates.hs rename to hledger/Hledger/Cli/Commands/Checkdates.hs index 3d01f25bc..81ebd96e0 100755 --- a/bin/hledger-check-dates.hs +++ b/hledger/Hledger/Cli/Commands/Checkdates.hs @@ -5,16 +5,23 @@ --package here -} -{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-} {-# LANGUAGE QuasiQuotes #-} +module Hledger.Cli.Commands.Checkdates ( + checkdatesmode + ,checkdates + ,tests_Hledger_Cli_Commands_Checkdates +) where + import Data.String.Here import Hledger -import Hledger.Cli +import Hledger.Cli.CliOptions +import System.Console.CmdArgs.Explicit +import Test.HUnit import Text.Printf ------------------------------------------------------------------------------- -cmdmode = hledgerCommandMode +-- checkdatesmode :: Mode RawOpts +checkdatesmode = hledgerCommandMode [here| check-dates Check that transactions' dates are monotonically increasing. With --date2, checks secondary dates instead. @@ -27,38 +34,34 @@ FLAGS [generalflagsgroup1] [] ([], Just $ argsFlag "[QUERY]") ------------------------------------------------------------------------------- -main :: IO () -main = do - opts <- getHledgerCliOpts cmdmode - withJournalDo opts $ - \CliOpts{rawopts_=rawopts,reportopts_=ropts} j -> do - d <- getCurrentDay - let ropts_ = ropts{accountlistmode_=ALFlat} - let q = queryFromOpts d ropts_ - let ts = filter (q `matchesTransaction`) $ - jtxns $ journalSelectingAmountFromOpts ropts j - let strict = boolopt "strict" rawopts - let date = transactionDateFn ropts - let compare a b = - if strict - then date a < date b - else date a <= date b - case checkTransactions compare ts of - FoldAcc{fa_previous=Nothing} -> putStrLn "ok (empty journal)" - FoldAcc{fa_error=Nothing} -> putStrLn "ok" - FoldAcc{fa_error=Just error, fa_previous=Just previous} -> - putStrLn $ printf ("ERROR: transaction out of%s date order" - ++ "\nPrevious date: %s" - ++ "\nDate: %s" - ++ "\nLocation: %s" - ++ "\nTransaction:\n\n%s") - (if strict then " STRICT" else "") - (show $ date previous) - (show $ date error) - (show $ tsourcepos error) - (showTransactionUnelided error) +checkdates :: CliOpts -> Journal -> IO () +checkdates CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do + d <- getCurrentDay + let ropts_ = ropts{accountlistmode_=ALFlat} + let q = queryFromOpts d ropts_ + let ts = filter (q `matchesTransaction`) $ + jtxns $ journalSelectingAmountFromOpts ropts j + let strict = boolopt "strict" rawopts + let date = transactionDateFn ropts + let compare a b = + if strict + then date a < date b + else date a <= date b + case checkTransactions compare ts of + FoldAcc{fa_previous=Nothing} -> putStrLn "ok (empty journal)" + FoldAcc{fa_error=Nothing} -> putStrLn "ok" + FoldAcc{fa_error=Just error, fa_previous=Just previous} -> + putStrLn $ printf ("ERROR: transaction out of%s date order" + ++ "\nPrevious date: %s" + ++ "\nDate: %s" + ++ "\nLocation: %s" + ++ "\nTransaction:\n\n%s") + (if strict then " STRICT" else "") + (show $ date previous) + (show $ date error) + (show $ tsourcepos error) + (showTransactionUnelided error) data FoldAcc a b = FoldAcc { fa_error :: Maybe a @@ -83,3 +86,7 @@ checkTransactions compare ts = then acc{fa_previous=Just current} else acc{fa_error=Just current} +tests_Hledger_Cli_Commands_Checkdates :: Test +tests_Hledger_Cli_Commands_Checkdates = TestList + [ + ] diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 80a53d840..455e85d0b 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -129,6 +129,7 @@ library Hledger.Cli.Commands.Balancesheet Hledger.Cli.Commands.Balancesheetequity Hledger.Cli.Commands.Cashflow + Hledger.Cli.Commands.Checkdates Hledger.Cli.Commands.Help Hledger.Cli.Commands.Incomestatement Hledger.Cli.Commands.Print diff --git a/hledger/package.yaml b/hledger/package.yaml index c2d88d6e6..4c3e585bd 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -110,6 +110,7 @@ library: - Hledger.Cli.Commands.Balancesheet - Hledger.Cli.Commands.Balancesheetequity - Hledger.Cli.Commands.Cashflow + - Hledger.Cli.Commands.Checkdates - Hledger.Cli.Commands.Help - Hledger.Cli.Commands.Incomestatement - Hledger.Cli.Commands.Print