mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-07 21:15:19 +03:00
cli: begin merging addons, make check-dates a builtin command
This commit is contained in:
parent
a5d3f82054
commit
7f5985067d
@ -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')
|
||||
|
@ -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
|
||||
[
|
||||
]
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user