cli: begin merging addons, make check-dates a builtin command

This commit is contained in:
Simon Michael 2017-09-12 17:54:25 -07:00
parent a5d3f82054
commit 7f5985067d
4 changed files with 47 additions and 35 deletions

View File

@ -18,6 +18,7 @@ module Hledger.Cli.Commands (
,module Hledger.Cli.Commands.Balancesheet ,module Hledger.Cli.Commands.Balancesheet
,module Hledger.Cli.Commands.Balancesheetequity ,module Hledger.Cli.Commands.Balancesheetequity
,module Hledger.Cli.Commands.Cashflow ,module Hledger.Cli.Commands.Cashflow
,module Hledger.Cli.Commands.Checkdates
,module Hledger.Cli.Commands.Help ,module Hledger.Cli.Commands.Help
,module Hledger.Cli.Commands.Incomestatement ,module Hledger.Cli.Commands.Incomestatement
,module Hledger.Cli.Commands.Print ,module Hledger.Cli.Commands.Print
@ -47,6 +48,7 @@ import Hledger.Cli.Commands.Balance
import Hledger.Cli.Commands.Balancesheet import Hledger.Cli.Commands.Balancesheet
import Hledger.Cli.Commands.Balancesheetequity import Hledger.Cli.Commands.Balancesheetequity
import Hledger.Cli.Commands.Cashflow import Hledger.Cli.Commands.Cashflow
import Hledger.Cli.Commands.Checkdates
import Hledger.Cli.Commands.Help import Hledger.Cli.Commands.Help
import Hledger.Cli.Commands.Incomestatement import Hledger.Cli.Commands.Incomestatement
import Hledger.Cli.Commands.Print import Hledger.Cli.Commands.Print
@ -65,6 +67,7 @@ builtinCommands = [
,(balancesheetmode , balancesheet) ,(balancesheetmode , balancesheet)
,(balancesheetequitymode , balancesheetequity) ,(balancesheetequitymode , balancesheetequity)
,(cashflowmode , cashflow) ,(cashflowmode , cashflow)
,(checkdatesmode , checkdates)
,(helpmode , help') ,(helpmode , help')
,(incomestatementmode , incomestatement) ,(incomestatementmode , incomestatement)
,(printmode , print') ,(printmode , print')

View File

@ -5,16 +5,23 @@
--package here --package here
-} -}
{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Hledger.Cli.Commands.Checkdates (
checkdatesmode
,checkdates
,tests_Hledger_Cli_Commands_Checkdates
) where
import Data.String.Here import Data.String.Here
import Hledger import Hledger
import Hledger.Cli import Hledger.Cli.CliOptions
import System.Console.CmdArgs.Explicit
import Test.HUnit
import Text.Printf import Text.Printf
------------------------------------------------------------------------------ -- checkdatesmode :: Mode RawOpts
cmdmode = hledgerCommandMode checkdatesmode = hledgerCommandMode
[here| check-dates [here| check-dates
Check that transactions' dates are monotonically increasing. Check that transactions' dates are monotonically increasing.
With --date2, checks secondary dates instead. With --date2, checks secondary dates instead.
@ -27,38 +34,34 @@ FLAGS
[generalflagsgroup1] [generalflagsgroup1]
[] []
([], Just $ argsFlag "[QUERY]") ([], Just $ argsFlag "[QUERY]")
------------------------------------------------------------------------------
main :: IO () checkdates :: CliOpts -> Journal -> IO ()
main = do checkdates CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
opts <- getHledgerCliOpts cmdmode d <- getCurrentDay
withJournalDo opts $ let ropts_ = ropts{accountlistmode_=ALFlat}
\CliOpts{rawopts_=rawopts,reportopts_=ropts} j -> do let q = queryFromOpts d ropts_
d <- getCurrentDay let ts = filter (q `matchesTransaction`) $
let ropts_ = ropts{accountlistmode_=ALFlat} jtxns $ journalSelectingAmountFromOpts ropts j
let q = queryFromOpts d ropts_ let strict = boolopt "strict" rawopts
let ts = filter (q `matchesTransaction`) $ let date = transactionDateFn ropts
jtxns $ journalSelectingAmountFromOpts ropts j let compare a b =
let strict = boolopt "strict" rawopts if strict
let date = transactionDateFn ropts then date a < date b
let compare a b = else date a <= date b
if strict case checkTransactions compare ts of
then date a < date b FoldAcc{fa_previous=Nothing} -> putStrLn "ok (empty journal)"
else date a <= date b FoldAcc{fa_error=Nothing} -> putStrLn "ok"
case checkTransactions compare ts of FoldAcc{fa_error=Just error, fa_previous=Just previous} ->
FoldAcc{fa_previous=Nothing} -> putStrLn "ok (empty journal)" putStrLn $ printf ("ERROR: transaction out of%s date order"
FoldAcc{fa_error=Nothing} -> putStrLn "ok" ++ "\nPrevious date: %s"
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> ++ "\nDate: %s"
putStrLn $ printf ("ERROR: transaction out of%s date order" ++ "\nLocation: %s"
++ "\nPrevious date: %s" ++ "\nTransaction:\n\n%s")
++ "\nDate: %s" (if strict then " STRICT" else "")
++ "\nLocation: %s" (show $ date previous)
++ "\nTransaction:\n\n%s") (show $ date error)
(if strict then " STRICT" else "") (show $ tsourcepos error)
(show $ date previous) (showTransactionUnelided error)
(show $ date error)
(show $ tsourcepos error)
(showTransactionUnelided error)
data FoldAcc a b = FoldAcc data FoldAcc a b = FoldAcc
{ fa_error :: Maybe a { fa_error :: Maybe a
@ -83,3 +86,7 @@ checkTransactions compare ts =
then acc{fa_previous=Just current} then acc{fa_previous=Just current}
else acc{fa_error=Just current} else acc{fa_error=Just current}
tests_Hledger_Cli_Commands_Checkdates :: Test
tests_Hledger_Cli_Commands_Checkdates = TestList
[
]

View File

@ -129,6 +129,7 @@ library
Hledger.Cli.Commands.Balancesheet Hledger.Cli.Commands.Balancesheet
Hledger.Cli.Commands.Balancesheetequity Hledger.Cli.Commands.Balancesheetequity
Hledger.Cli.Commands.Cashflow Hledger.Cli.Commands.Cashflow
Hledger.Cli.Commands.Checkdates
Hledger.Cli.Commands.Help Hledger.Cli.Commands.Help
Hledger.Cli.Commands.Incomestatement Hledger.Cli.Commands.Incomestatement
Hledger.Cli.Commands.Print Hledger.Cli.Commands.Print

View File

@ -110,6 +110,7 @@ library:
- Hledger.Cli.Commands.Balancesheet - Hledger.Cli.Commands.Balancesheet
- Hledger.Cli.Commands.Balancesheetequity - Hledger.Cli.Commands.Balancesheetequity
- Hledger.Cli.Commands.Cashflow - Hledger.Cli.Commands.Cashflow
- Hledger.Cli.Commands.Checkdates
- Hledger.Cli.Commands.Help - Hledger.Cli.Commands.Help
- Hledger.Cli.Commands.Incomestatement - Hledger.Cli.Commands.Incomestatement
- Hledger.Cli.Commands.Print - Hledger.Cli.Commands.Print