slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cli: refactor: move commands to a subdirectory, reinstate test command

Browse Source
This commit is contained in:
Simon Michael 2017-09-12 09:12:45 -07:00
parent 5fcd4b35ad
commit 55cebad0d5
24 changed files with 528 additions and 550 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
hledger-lib/Hledger/Data/StringFormat.hs
View File

@ -10,7 +10,7 @@ module Hledger.Data.StringFormat (
, StringFormat(..)
, StringFormatComponent(..)
, ReportItemField(..)
, tests
, tests_Hledger_Data_StringFormat
) where
import Prelude ()
@ -147,7 +147,7 @@ testParser s expected = case (parseStringFormat s) of
Left error -> assertFailure $ show error
Right actual -> assertEqual ("Input: " ++ s) expected actual
tests = test [ formattingTests ++ parserTests ]
tests_Hledger_Data_StringFormat = test [ formattingTests ++ parserTests ]
formattingTests = [
testFormat (FormatLiteral " ") "" " "

2
hledger-lib/Hledger/Reports/MultiBalanceReports.hs
View File

@ -54,7 +54,7 @@ import Hledger.Reports.BalanceReport
--
-- The meaning of the amounts depends on the type of multi balance
-- report, of which there are three: periodic, cumulative and historical
-- (see 'BalanceType' and "Hledger.Cli.Balance").
-- (see 'BalanceType' and "Hledger.Cli.Commands.Balance").
newtype MultiBalanceReport =
MultiBalanceReport ([DateSpan]
,[MultiBalanceReportRow]

2
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -30,7 +30,7 @@ import System.FilePath (takeFileName)
import Hledger
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Cli.Add (add)
import Hledger.Cli.Commands.Add (add)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState

2
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -31,7 +31,7 @@ import System.Console.ANSI
import Hledger
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Cli.Add (add)
import Hledger.Cli.Commands.Add (add)
import Hledger.UI.UIOptions
-- import Hledger.UI.Theme
import Hledger.UI.UITypes

2
hledger-web/Handler/AddForm.hs
View File

@ -22,7 +22,7 @@ import Text.Megaparsec.Compat (digitChar, eof, some, string, runParser, ParseErr
import Hledger.Utils
import Hledger.Data
import Hledger.Read
import Hledger.Cli.Add (appendToJournalFileOrStdout)
import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout)
-- Part of the data required from the add form.

385
hledger/Hledger/Cli.hs
View File

@ -20,12 +20,7 @@ module Hledger.Cli (
module System.Console.CmdArgs.Explicit
)
where
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import System.Console.CmdArgs.Explicit hiding (Name) -- don't clash with hledger-ui
import Test.HUnit
import Hledger
import Hledger.Cli.CliOptions
@ -34,382 +29,4 @@ import Hledger.Cli.DocFiles
import Hledger.Cli.Utils
import Hledger.Cli.Version
tests_Hledger_Cli :: Test
tests_Hledger_Cli = TestList
[
tests_Hledger
,tests_Hledger_Cli_CliOptions
,tests_Hledger_Cli_Commands
,"apply account directive" ~:
let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in
let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing True Nothing str1 >>= either error' (return . ignoresourcepos)
j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' (return . ignoresourcepos)
j1 `is` j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1}
in sameParse
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
"apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <>
"apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <>
"end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <>
"end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n"
)
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
"2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <>
"2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <>
"2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <>
"2008/12/07 Five\n foo $-5\n bar $5\n"
)
,"apply account directive should preserve \"virtual\" posting type" ~: do
j <- readJournal Nothing Nothing True Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return
let p = head $ tpostings $ head $ jtxns j
assertBool "" $ paccount p == "test:from"
assertBool "" $ ptype p == VirtualPosting
,"account aliases" ~: do
j <- readJournal Nothing Nothing True Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return
let p = head $ tpostings $ head $ jtxns j
assertBool "" $ paccount p == "equity:draw:personal:food"
,"ledgerAccountNames" ~:
ledgerAccountNames ledger7 `is`
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
-- ,"journalCanonicaliseAmounts" ~:
-- "use the greatest precision" ~:
-- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2]
-- don't know what this should do
-- ,"elideAccountName" ~: do
-- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
-- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aa:aaaaaaaaaaaaaa")
,"default year" ~: do
j <- readJournal Nothing Nothing True Nothing defaultyear_journal_txt >>= either error' return
tdate (head $ jtxns j) `is` fromGregorian 2009 1 1
return ()
,"show dollars" ~: showAmount (usd 1) ~?= "$1.00"
,"show hours" ~: showAmount (hrs 1) ~?= "1.00h"
]
-- fixtures/test data
-- date1 = parsedate "2008/11/26"
-- t1 = LocalTime date1 midday
{-
samplejournal = readJournal' sample_journal_str
sample_journal_str = unlines
["; A sample journal file."
,";"
,"; Sets up this account tree:"
,"; assets"
,"; bank"
,"; checking"
,"; saving"
,"; cash"
,"; expenses"
,"; food"
,"; supplies"
,"; income"
,"; gifts"
,"; salary"
,"; liabilities"
,"; debts"
,""
,"2008/01/01 income"
," assets:bank:checking $1"
," income:salary"
,""
,"2008/06/01 gift"
," assets:bank:checking $1"
," income:gifts"
,""
,"2008/06/02 save"
," assets:bank:saving $1"
," assets:bank:checking"
,""
,"2008/06/03 * eat & shop"
," expenses:food $1"
," expenses:supplies $1"
," assets:cash"
,""
,"2008/12/31 * pay off"
," liabilities:debts $1"
," assets:bank:checking"
,""
,""
,";final comment"
]
-}
defaultyear_journal_txt :: Text
defaultyear_journal_txt = T.unlines
["Y2009"
,""
,"01/01 A"
," a $1"
," b"
]
-- write_sample_journal = writeFile "sample.journal" sample_journal_str
-- entry2_str = unlines
-- ["2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ," expenses:gifts $10.00"
-- ," assets:checking $-20.00"
-- ,""
-- ]
-- entry3_str = unlines
-- ["2007/01/01 * opening balance"
-- ," assets:cash $4.82"
-- ," equity:opening balances"
-- ,""
-- ,"2007/01/01 * opening balance"
-- ," assets:cash $4.82"
-- ," equity:opening balances"
-- ,""
-- ,"2007/01/28 coopportunity"
-- ," expenses:food:groceries $47.18"
-- ," assets:checking"
-- ,""
-- ]
-- periodic_entry1_str = unlines
-- ["~ monthly from 2007/2/2"
-- ," assets:saving $200.00"
-- ," assets:checking"
-- ,""
-- ]
-- periodic_entry2_str = unlines
-- ["~ monthly from 2007/2/2"
-- ," assets:saving $200.00 ;auto savings"
-- ," assets:checking"
-- ,""
-- ]
-- periodic_entry3_str = unlines
-- ["~ monthly from 2007/01/01"
-- ," assets:cash $4.82"
-- ," equity:opening balances"
-- ,""
-- ,"~ monthly from 2007/01/01"
-- ," assets:cash $4.82"
-- ," equity:opening balances"
-- ,""
-- ]
-- journal1_str = unlines
-- [""
-- ,"2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ," expenses:gifts $10.00"
-- ," assets:checking $-20.00"
-- ,""
-- ,""
-- ,"2007/01/28 coopportunity"
-- ," expenses:food:groceries $47.18"
-- ," assets:checking $-47.18"
-- ,""
-- ,""
-- ]
-- journal2_str = unlines
-- [";comment"
-- ,"2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ," assets:checking $-47.18"
-- ,""
-- ]
-- journal3_str = unlines
-- ["2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ,";intra-entry comment"
-- ," assets:checking $-47.18"
-- ,""
-- ]
-- journal4_str = unlines
-- ["!include \"somefile\""
-- ,"2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ," assets:checking $-47.18"
-- ,""
-- ]
-- journal5_str = ""
-- journal6_str = unlines
-- ["~ monthly from 2007/1/21"
-- ," expenses:entertainment $16.23 ;netflix"
-- ," assets:checking"
-- ,""
-- ,"; 2007/01/01 * opening balance"
-- ,"; assets:saving $200.04"
-- ,"; equity:opening balances "
-- ,""
-- ]
-- journal7_str = unlines
-- ["2007/01/01 * opening balance"
-- ," assets:cash $4.82"
-- ," equity:opening balances "
-- ,""
-- ,"2007/01/01 * opening balance"
-- ," income:interest $-4.82"
-- ," equity:opening balances "
-- ,""
-- ,"2007/01/02 * ayres suites"
-- ," expenses:vacation $179.92"
-- ," assets:checking "
-- ,""
-- ,"2007/01/02 * auto transfer to savings"
-- ," assets:saving $200.00"
-- ," assets:checking "
-- ,""
-- ,"2007/01/03 * poquito mas"
-- ," expenses:food:dining $4.82"
-- ," assets:cash "
-- ,""
-- ,"2007/01/03 * verizon"
-- ," expenses:phone $95.11"
-- ," assets:checking "
-- ,""
-- ,"2007/01/03 * discover"
-- ," liabilities:credit cards:discover $80.00"
-- ," assets:checking "
-- ,""
-- ,"2007/01/04 * blue cross"
-- ," expenses:health:insurance $90.00"
-- ," assets:checking "
-- ,""
-- ,"2007/01/05 * village market liquor"
-- ," expenses:food:dining $6.48"
-- ," assets:checking "
-- ,""
-- ]
journal7 :: Journal
journal7 = nulljournal {jtxns =
[
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/01",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="opening balance",
tcomment="",
ttags=[],
tpostings=
["assets:cash" `post` usd 4.82
,"equity:opening balances" `post` usd (-4.82)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/02/01",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="ayres suites",
tcomment="",
ttags=[],
tpostings=
["expenses:vacation" `post` usd 179.92
,"assets:checking" `post` usd (-179.92)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/02",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="auto transfer to savings",
tcomment="",
ttags=[],
tpostings=
["assets:saving" `post` usd 200
,"assets:checking" `post` usd (-200)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/03",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="poquito mas",
tcomment="",
ttags=[],
tpostings=
["expenses:food:dining" `post` usd 4.82
,"assets:cash" `post` usd (-4.82)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/03",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="verizon",
tcomment="",
ttags=[],
tpostings=
["expenses:phone" `post` usd 95.11
,"assets:checking" `post` usd (-95.11)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/03",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="discover",
tcomment="",
ttags=[],
tpostings=
["liabilities:credit cards:discover" `post` usd 80
,"assets:checking" `post` usd (-80)
],
tpreceding_comment_lines=""
}
]
}
ledger7 :: Ledger
ledger7 = ledgerFromJournal Any journal7
tests_Hledger_Cli = tests_Hledger_Cli_Commands

485
hledger/Hledger/Cli/Commands.hs
View File

@ -2,6 +2,7 @@
hledger's built-in commands, and helpers for printing the commands list.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Hledger.Cli.Commands (
@ -10,30 +11,47 @@ module Hledger.Cli.Commands (
,builtinCommandNames
,printCommandsList
,tests_Hledger_Cli_Commands
,module Hledger.Cli.Commands.Accounts
,module Hledger.Cli.Commands.Activity
,module Hledger.Cli.Commands.Add
,module Hledger.Cli.Commands.Balance
,module Hledger.Cli.Commands.Balancesheet
,module Hledger.Cli.Commands.Balancesheetequity
,module Hledger.Cli.Commands.Cashflow
,module Hledger.Cli.Commands.Help
,module Hledger.Cli.Commands.Incomestatement
,module Hledger.Cli.Commands.Print
,module Hledger.Cli.Commands.Register
,module Hledger.Cli.Commands.Stats
)
where
import Data.String.Here
import Control.Monad
import Data.List
import Data.List.Split (splitOn)
import Data.Monoid ((<>))
import Data.String.Here
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import System.Console.CmdArgs.Explicit as C
import System.Exit
import Test.HUnit
import Hledger.Cli.Accounts
import Hledger.Cli.Activity
import Hledger.Cli.Add
import Hledger.Cli.Balance
import Hledger.Cli.Balancesheet
import Hledger.Cli.Balancesheetequity
import Hledger.Cli.Cashflow
import Hledger.Cli.Help
import Hledger.Cli.Incomestatement
import Hledger.Cli.Print
import Hledger.Cli.Register
import Hledger.Cli.Stats
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Data
import Hledger.Utils (regexReplace)
import Hledger.Cli.Commands.Accounts
import Hledger.Cli.Commands.Activity
import Hledger.Cli.Commands.Add
import Hledger.Cli.Commands.Balance
import Hledger.Cli.Commands.Balancesheet
import Hledger.Cli.Commands.Balancesheetequity
import Hledger.Cli.Commands.Cashflow
import Hledger.Cli.Commands.Help
import Hledger.Cli.Commands.Incomestatement
import Hledger.Cli.Commands.Print
import Hledger.Cli.Commands.Register
import Hledger.Cli.Commands.Stats
-- | The cmdargs subcommand mode and IO action for each builtin command.
@ -52,6 +70,7 @@ builtinCommands = [
,(printmode , print')
,(registermode , register)
,(statsmode , stats)
,(testmode , testcmd)
]
-- | All names and aliases of builtin commands.
@ -130,7 +149,7 @@ printCommandsList addonsFound = putStr commandsList
adjustline l | " hledger " `isPrefixOf` l = [l]
adjustline (' ':l) | not $ w `elem` commandsFound = []
where w = takeWhile (not . (`elem` "| ")) l
where w = takeWhile (not . (`elem` ['|',' '])) l
adjustline l = [l]
commandsList1 =
@ -149,15 +168,429 @@ knownCommands = sort $ commandsFromCommandsList commandsListTemplate
commandsFromCommandsList :: String -> [String]
commandsFromCommandsList s = concatMap (splitOn "|") [w | ' ':l <- lines s, let w:_ = words l]
-- The test command, defined here so it can access other commands' tests.
testmode = (defCommandMode ["test"]) {
modeHelp = "run built-in self-tests"
,modeArgs = ([], Just $ argsFlag "[REGEXPS]")
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = [
flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show tests hierarchically"
,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show tests as a flat list"
]
,groupNamed = [generalflagsgroup3]
}
}
-- | Run some or all hledger-lib and hledger unit tests, and exit with success or failure.
testcmd :: CliOpts -> Journal -> IO ()
testcmd opts _ = do
let ts =
(if tree_ $ reportopts_ opts then matchedTestsTree else matchedTestsFlat)
opts tests_Hledger_Cli_Commands
results <- liftM (fst . flip (,) 0) $ runTestTT ts
if errors results > 0 || failures results > 0
then exitFailure
else exitWith ExitSuccess
-- | All or pattern-matched tests, as a flat list to show simple names.
matchedTestsFlat opts = TestList .
filter (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . T.pack . testName) .
flattenTests
-- | All or pattern-matched tests, in the original suites to show hierarchical names.
matchedTestsTree opts =
filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . T.pack . testName)
-- collected hledger-lib + hledger unit tests
tests_Hledger_Cli_Commands :: Test
tests_Hledger_Cli_Commands = TestList [
-- ,tests_Hledger_Cli_Add
tests_Hledger_Cli_Balance
,tests_Hledger_Cli_Balancesheet
,tests_Hledger_Cli_Cashflow
-- ,tests_Hledger_Cli_Histogram
,tests_Hledger_Cli_Incomestatement
-- ,tests_Hledger_Cli_Print
,tests_Hledger_Cli_Register
-- ,tests_Hledger_Cli_Stats
]
tests_Hledger
,tests_Hledger_Cli_CliOptions
-- ,tests_Hledger_Cli_Commands_Activity
-- ,tests_Hledger_Cli_Commands_Add
,tests_Hledger_Cli_Commands_Balance
,tests_Hledger_Cli_Commands_Balancesheet
,tests_Hledger_Cli_Commands_Cashflow
,tests_Hledger_Cli_Commands_Incomestatement
,tests_Hledger_Cli_Commands_Print
,tests_Hledger_Cli_Commands_Register
-- ,tests_Hledger_Cli_Commands_Stats
-- some more tests easiest to define here:
,"apply account directive" ~:
let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in
let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing True Nothing str1 >>= either error' (return . ignoresourcepos)
j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' (return . ignoresourcepos)
j1 `is` j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1}
in sameParse
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
"apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <>
"apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <>
"end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <>
"end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n"
)
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
"2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <>
"2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <>
"2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <>
"2008/12/07 Five\n foo $-5\n bar $5\n"
)
,"apply account directive should preserve \"virtual\" posting type" ~: do
j <- readJournal Nothing Nothing True Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return
let p = head $ tpostings $ head $ jtxns j
assertBool "" $ paccount p == "test:from"
assertBool "" $ ptype p == VirtualPosting
,"account aliases" ~: do
j <- readJournal Nothing Nothing True Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return
let p = head $ tpostings $ head $ jtxns j
assertBool "" $ paccount p == "equity:draw:personal:food"
,"ledgerAccountNames" ~:
ledgerAccountNames ledger7 `is`
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
-- ,"journalCanonicaliseAmounts" ~:
-- "use the greatest precision" ~:
-- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2]
-- don't know what this should do
-- ,"elideAccountName" ~: do
-- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
-- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aa:aaaaaaaaaaaaaa")
,"default year" ~: do
j <- readJournal Nothing Nothing True Nothing defaultyear_journal_txt >>= either error' return
tdate (head $ jtxns j) `is` fromGregorian 2009 1 1
return ()
,"show dollars" ~: showAmount (usd 1) ~?= "$1.00"
,"show hours" ~: showAmount (hrs 1) ~?= "1.00h"
]
-- test data
-- date1 = parsedate "2008/11/26"
-- t1 = LocalTime date1 midday
{-
samplejournal = readJournal' sample_journal_str
sample_journal_str = unlines
["; A sample journal file."
,";"
,"; Sets up this account tree:"
,"; assets"
,"; bank"
,"; checking"
,"; saving"
,"; cash"
,"; expenses"
,"; food"
,"; supplies"
,"; income"
,"; gifts"
,"; salary"
,"; liabilities"
,"; debts"
,""
,"2008/01/01 income"
," assets:bank:checking $1"
," income:salary"
,""
,"2008/06/01 gift"
," assets:bank:checking $1"
," income:gifts"
,""
,"2008/06/02 save"
," assets:bank:saving $1"
," assets:bank:checking"
,""
,"2008/06/03 * eat & shop"
," expenses:food $1"
," expenses:supplies $1"
," assets:cash"
,""
,"2008/12/31 * pay off"
," liabilities:debts $1"
," assets:bank:checking"
,""
,""
,";final comment"
]
-}
defaultyear_journal_txt :: Text
defaultyear_journal_txt = T.unlines
["Y2009"
,""
,"01/01 A"
," a $1"
," b"
]
-- write_sample_journal = writeFile "sample.journal" sample_journal_str
-- entry2_str = unlines
-- ["2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ," expenses:gifts $10.00"
-- ," assets:checking $-20.00"
-- ,""
-- ]
-- entry3_str = unlines
-- ["2007/01/01 * opening balance"
-- ," assets:cash $4.82"
-- ," equity:opening balances"
-- ,""
-- ,"2007/01/01 * opening balance"
-- ," assets:cash $4.82"
-- ," equity:opening balances"
-- ,""
-- ,"2007/01/28 coopportunity"
-- ," expenses:food:groceries $47.18"
-- ," assets:checking"
-- ,""
-- ]
-- periodic_entry1_str = unlines
-- ["~ monthly from 2007/2/2"
-- ," assets:saving $200.00"
-- ," assets:checking"
-- ,""
-- ]
-- periodic_entry2_str = unlines
-- ["~ monthly from 2007/2/2"
-- ," assets:saving $200.00 ;auto savings"
-- ," assets:checking"
-- ,""
-- ]
-- periodic_entry3_str = unlines
-- ["~ monthly from 2007/01/01"
-- ," assets:cash $4.82"
-- ," equity:opening balances"
-- ,""
-- ,"~ monthly from 2007/01/01"
-- ," assets:cash $4.82"
-- ," equity:opening balances"
-- ,""
-- ]
-- journal1_str = unlines
-- [""
-- ,"2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ," expenses:gifts $10.00"
-- ," assets:checking $-20.00"
-- ,""
-- ,""
-- ,"2007/01/28 coopportunity"
-- ," expenses:food:groceries $47.18"
-- ," assets:checking $-47.18"
-- ,""
-- ,""
-- ]
-- journal2_str = unlines
-- [";comment"
-- ,"2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ," assets:checking $-47.18"
-- ,""
-- ]
-- journal3_str = unlines
-- ["2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ,";intra-entry comment"
-- ," assets:checking $-47.18"
-- ,""
-- ]
-- journal4_str = unlines
-- ["!include \"somefile\""
-- ,"2007/01/27 * joes diner"
-- ," expenses:food:dining $10.00"
-- ," assets:checking $-47.18"
-- ,""
-- ]
-- journal5_str = ""
-- journal6_str = unlines
-- ["~ monthly from 2007/1/21"
-- ," expenses:entertainment $16.23 ;netflix"
-- ," assets:checking"
-- ,""
-- ,"; 2007/01/01 * opening balance"
-- ,"; assets:saving $200.04"
-- ,"; equity:opening balances "
-- ,""
-- ]
-- journal7_str = unlines
-- ["2007/01/01 * opening balance"
-- ," assets:cash $4.82"
-- ," equity:opening balances "
-- ,""
-- ,"2007/01/01 * opening balance"
-- ," income:interest $-4.82"
-- ," equity:opening balances "
-- ,""
-- ,"2007/01/02 * ayres suites"
-- ," expenses:vacation $179.92"
-- ," assets:checking "
-- ,""
-- ,"2007/01/02 * auto transfer to savings"
-- ," assets:saving $200.00"
-- ," assets:checking "
-- ,""
-- ,"2007/01/03 * poquito mas"
-- ," expenses:food:dining $4.82"
-- ," assets:cash "
-- ,""
-- ,"2007/01/03 * verizon"
-- ," expenses:phone $95.11"
-- ," assets:checking "
-- ,""
-- ,"2007/01/03 * discover"
-- ," liabilities:credit cards:discover $80.00"
-- ," assets:checking "
-- ,""
-- ,"2007/01/04 * blue cross"
-- ," expenses:health:insurance $90.00"
-- ," assets:checking "
-- ,""
-- ,"2007/01/05 * village market liquor"
-- ," expenses:food:dining $6.48"
-- ," assets:checking "
-- ,""
-- ]
journal7 :: Journal
journal7 = nulljournal {jtxns =
[
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/01",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="opening balance",
tcomment="",
ttags=[],
tpostings=
["assets:cash" `post` usd 4.82
,"equity:opening balances" `post` usd (-4.82)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/02/01",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="ayres suites",
tcomment="",
ttags=[],
tpostings=
["expenses:vacation" `post` usd 179.92
,"assets:checking" `post` usd (-179.92)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/02",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="auto transfer to savings",
tcomment="",
ttags=[],
tpostings=
["assets:saving" `post` usd 200
,"assets:checking" `post` usd (-200)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/03",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="poquito mas",
tcomment="",
ttags=[],
tpostings=
["expenses:food:dining" `post` usd 4.82
,"assets:cash" `post` usd (-4.82)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/03",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="verizon",
tcomment="",
ttags=[],
tpostings=
["expenses:phone" `post` usd 95.11
,"assets:checking" `post` usd (-95.11)
],
tpreceding_comment_lines=""
}
,
txnTieKnot Transaction {
tindex=0,
tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/03",
tdate2=Nothing,
tstatus=Unmarked,
tcode="*",
tdescription="discover",
tcomment="",
ttags=[],
tpostings=
["liabilities:credit cards:discover" `post` usd 80
,"assets:checking" `post` usd (-80)
],
tpreceding_comment_lines=""
}
]
}
ledger7 :: Ledger
ledger7 = ledgerFromJournal Any journal7

6
hledger/Hledger/Cli/Accounts.hs → hledger/Hledger/Cli/Commands/Accounts.hs
View File

@ -12,10 +12,10 @@ The @accounts@ command lists account names:
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Cli.Accounts (
module Hledger.Cli.Commands.Accounts (
accountsmode
,accounts
,tests_Hledger_Cli_Accounts
,tests_Hledger_Cli_Commands_Accounts
) where
import Data.List
@ -64,4 +64,4 @@ accounts CliOpts{reportopts_=ropts} j = do
| otherwise = maybeAccountNameDrop ropts a
mapM_ (putStrLn . T.unpack . render) as'
tests_Hledger_Cli_Accounts = TestList []
tests_Hledger_Cli_Commands_Accounts = TestList []

2
hledger/Hledger/Cli/Activity.hs → hledger/Hledger/Cli/Commands/Activity.hs
View File

@ -4,7 +4,7 @@ Print a bar chart of posting activity per day, or other report interval.
-}
module Hledger.Cli.Activity
module Hledger.Cli.Commands.Activity
where
import Data.List

5
hledger/Hledger/Cli/Add.hs → hledger/Hledger/Cli/Commands/Add.hs
View File

@ -5,10 +5,11 @@ A history-aware add command to help with data entry.
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts, OverloadedStrings #-}
module Hledger.Cli.Add (
module Hledger.Cli.Commands.Add (
addmode
,add
,appendToJournalFileOrStdout
,journalAddTransaction
,transactionsSimilarTo
)
where
@ -41,7 +42,7 @@ import Text.Printf
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Register (postingsReportAsText)
import Hledger.Cli.Commands.Register (postingsReportAsText)
addmode = (defCommandMode ["add"]) {

6
hledger/Hledger/Cli/Balance.hs → hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -234,7 +234,7 @@ Currently, empty cells show 0.
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Cli.Balance (
module Hledger.Cli.Commands.Balance (
balancemode
,balance
,balanceReportAsText
@ -243,7 +243,7 @@ module Hledger.Cli.Balance (
,multiBalanceReportAsCsv
,renderBalanceReportTable
,balanceReportAsTable
,tests_Hledger_Cli_Balance
,tests_Hledger_Cli_Commands_Balance
) where
import Data.List (intercalate)
@ -548,5 +548,5 @@ multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing
multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
tests_Hledger_Cli_Balance = TestList
tests_Hledger_Cli_Commands_Balance = TestList
tests_balanceReportAsText

8
hledger/Hledger/Cli/Balancesheet.hs → hledger/Hledger/Cli/Commands/Balancesheet.hs
View File

@ -5,10 +5,10 @@ The @balancesheet@ command prints a simple balance sheet.
-}
module Hledger.Cli.Balancesheet (
module Hledger.Cli.Commands.Balancesheet (
balancesheetmode
,balancesheet
,tests_Hledger_Cli_Balancesheet
,tests_Hledger_Cli_Commands_Balancesheet
) where
import Data.String.Here
@ -41,7 +41,7 @@ balancesheetmode = compoundBalanceCommandMode balancesheetSpec
balancesheet :: CliOpts -> Journal -> IO ()
balancesheet = compoundBalanceCommand balancesheetSpec
tests_Hledger_Cli_Balancesheet :: Test
tests_Hledger_Cli_Balancesheet = TestList
tests_Hledger_Cli_Commands_Balancesheet :: Test
tests_Hledger_Cli_Commands_Balancesheet = TestList
[
]

2
hledger/Hledger/Cli/Balancesheetequity.hs → hledger/Hledger/Cli/Commands/Balancesheetequity.hs
View File

@ -5,7 +5,7 @@ The @balancesheetequity@ command prints a simple balance sheet.
-}
module Hledger.Cli.Balancesheetequity (
module Hledger.Cli.Commands.Balancesheetequity (
balancesheetequitymode
,balancesheetequity
) where

8
hledger/Hledger/Cli/Cashflow.hs → hledger/Hledger/Cli/Commands/Cashflow.hs
View File

@ -8,10 +8,10 @@ cash flows.)
-}
module Hledger.Cli.Cashflow (
module Hledger.Cli.Commands.Cashflow (
cashflowmode
,cashflow
,tests_Hledger_Cli_Cashflow
,tests_Hledger_Cli_Commands_Cashflow
) where
import Data.String.Here
@ -42,7 +42,7 @@ cashflowmode = compoundBalanceCommandMode cashflowSpec
cashflow :: CliOpts -> Journal -> IO ()
cashflow = compoundBalanceCommand cashflowSpec
tests_Hledger_Cli_Cashflow :: Test
tests_Hledger_Cli_Cashflow = TestList
tests_Hledger_Cli_Commands_Cashflow :: Test
tests_Hledger_Cli_Commands_Cashflow = TestList
[
]

2
hledger/Hledger/Cli/Help.hs → hledger/Hledger/Cli/Commands/Help.hs
View File

@ -8,7 +8,7 @@ The help command.
{-# LANGUAGE QuasiQuotes #-}
module Hledger.Cli.Help (
module Hledger.Cli.Commands.Help (
helpmode
,help'

8
hledger/Hledger/Cli/Incomestatement.hs → hledger/Hledger/Cli/Commands/Incomestatement.hs
View File

@ -5,10 +5,10 @@ The @incomestatement@ command prints a simple income statement (profit & loss re
-}
module Hledger.Cli.Incomestatement (
module Hledger.Cli.Commands.Incomestatement (
incomestatementmode
,incomestatement
,tests_Hledger_Cli_Incomestatement
,tests_Hledger_Cli_Commands_Incomestatement
) where
import Data.String.Here
@ -41,7 +41,7 @@ incomestatementmode = compoundBalanceCommandMode incomestatementSpec
incomestatement :: CliOpts -> Journal -> IO ()
incomestatement = compoundBalanceCommand incomestatementSpec
tests_Hledger_Cli_Incomestatement :: Test
tests_Hledger_Cli_Incomestatement = TestList
tests_Hledger_Cli_Commands_Incomestatement :: Test
tests_Hledger_Cli_Commands_Incomestatement = TestList
[
]

8
hledger/Hledger/Cli/Print.hs → hledger/Hledger/Cli/Commands/Print.hs
View File

@ -6,12 +6,12 @@ A ledger-compatible @print@ command.
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Cli.Print (
module Hledger.Cli.Commands.Print (
printmode
,print'
-- ,entriesReportAsText
,originalTransaction
,tests_Hledger_Cli_Print
,tests_Hledger_Cli_Commands_Print
)
where
@ -24,7 +24,7 @@ import Text.CSV
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Cli.Add ( transactionsSimilarTo )
import Hledger.Cli.Commands.Add ( transactionsSimilarTo )
printmode = (defCommandMode $ ["print"] ++ aliases) {
@ -176,5 +176,5 @@ printMatch CliOpts{reportopts_=ropts} j desc = do
-- tests
tests_Hledger_Cli_Print = TestList []
tests_Hledger_Cli_Commands_Print = TestList []
-- tests_showTransactions

8
hledger/Hledger/Cli/Register.hs → hledger/Hledger/Cli/Commands/Register.hs
View File

@ -6,13 +6,13 @@ A ledger-compatible @register@ command.
{-# LANGUAGE CPP, OverloadedStrings #-}
module Hledger.Cli.Register (
module Hledger.Cli.Commands.Register (
registermode
,register
,postingsReportAsText
,postingsReportItemAsText
-- ,showPostingWithBalanceForVty
,tests_Hledger_Cli_Register
,tests_Hledger_Cli_Commands_Register
) where
import Data.List
@ -199,6 +199,6 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
(balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines -- balance amount is bottom-aligned
spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' '
tests_Hledger_Cli_Register :: Test
tests_Hledger_Cli_Register = TestList
tests_Hledger_Cli_Commands_Register :: Test
tests_Hledger_Cli_Commands_Register = TestList
tests_postingsReportAsText

2
hledger/Hledger/Cli/Stats.hs → hledger/Hledger/Cli/Commands/Stats.hs
View File

@ -6,7 +6,7 @@ Print some statistics for the journal.
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Cli.Stats (
module Hledger.Cli.Commands.Stats (
statsmode
,stats
)

2
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

@ -20,7 +20,7 @@ import Text.CSV
import Text.Tabular as T
import Hledger
import Hledger.Cli.Balance
import Hledger.Cli.Commands.Balance
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils (writeOutput)

71
hledger/Hledger/Cli/Tests.hs
View File

@ -1,71 +0,0 @@
-- {-# OPTIONS_GHC -F -pgmF htfpp #-}
{-# LANGUAGE CPP #-}
{- |
A simple test runner for hledger's built-in unit tests.
-}
module Hledger.Cli.Tests (
testmode
,test'
)
where
import Control.Monad
-- import Data.Text (Text)
import qualified Data.Text as T
import System.Exit
import Test.HUnit
import Hledger
import Hledger.Cli
#ifdef TESTS
import Test.Framework
import {-@ HTF_TESTS @-} Hledger.Read.JournalReader
-- | Run HTF unit tests and exit with success or failure.
test' :: CliOpts -> IO ()
test' _opts = htfMain htf_importedTests
#else
-- | Run HUnit unit tests and exit with success or failure.
test' :: CliOpts -> IO ()
test' opts = do
results <- runTests opts
if errors results > 0 || failures results > 0
then exitFailure
else exitWith ExitSuccess
testmode = (defCommandMode ["test"]) {
modeHelp = "run built-in self-tests"
,modeArgs = ([], Just $ argsFlag "[REGEXPS]")
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [generalflagsgroup3]
}
}
-- | Run all or just the matched unit tests and return their HUnit result counts.
runTests :: CliOpts -> IO Counts
runTests = liftM (fst . flip (,) 0) . runTestTT . flatTests
-- -- | Run all or just the matched unit tests until the first failure or
-- -- error, returning the name of the problem test if any.
-- runTestsTillFailure :: CliOpts -> IO (Maybe String)
-- runTestsTillFailure _ = undefined -- do
-- -- let ts = flatTests opts
-- -- results = liftM (fst . flip (,) 0) $ runTestTT $
-- -- firstproblem = find (\counts -> )
-- | All or pattern-matched tests, as a flat list to show simple names.
flatTests opts = TestList $ filter (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . T.pack . testName) $ flattenTests tests_Hledger_Cli
-- -- | All or pattern-matched tests, in the original suites to show hierarchical names.
-- hierarchicalTests opts = filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) tests_Hledger_Cli
#endif

8
hledger/bench/bench.hs
View File

@ -9,10 +9,10 @@ import System.Environment (getArgs, withArgs)
import System.TimeIt (timeItT)
import Text.Printf
import Hledger.Cli
import Hledger.Cli.Balance
import Hledger.Cli.Print
import Hledger.Cli.Register
import Hledger.Cli.Stats
import Hledger.Cli.Commands.Balance
import Hledger.Cli.Commands.Print
import Hledger.Cli.Commands.Register
import Hledger.Cli.Commands.Stats
-- sample journal file to use for benchmarks
inputfile = "bench/10000x1000x10.journal"

25
hledger/hledger.cabal
View File

@ -119,23 +119,22 @@ library
Hledger.Cli.Main
Hledger.Cli.CliOptions
Hledger.Cli.DocFiles
Hledger.Cli.Tests
Hledger.Cli.Utils
Hledger.Cli.Version
Hledger.Cli.Accounts
Hledger.Cli.Activity
Hledger.Cli.Add
Hledger.Cli.Balance
Hledger.Cli.Balancesheet
Hledger.Cli.Balancesheetequity
Hledger.Cli.Commands
Hledger.Cli.Commands.Accounts
Hledger.Cli.Commands.Activity
Hledger.Cli.Commands.Add
Hledger.Cli.Commands.Balance
Hledger.Cli.Commands.Balancesheet
Hledger.Cli.Commands.Balancesheetequity
Hledger.Cli.Commands.Cashflow
Hledger.Cli.Commands.Help
Hledger.Cli.Commands.Incomestatement
Hledger.Cli.Commands.Print
Hledger.Cli.Commands.Register
Hledger.Cli.Commands.Stats
Hledger.Cli.CompoundBalanceCommand
Hledger.Cli.Cashflow
Hledger.Cli.Help
Hledger.Cli.Incomestatement
Hledger.Cli.Print
Hledger.Cli.Register
Hledger.Cli.Stats
Text.Tabular.AsciiWide
other-modules:
Paths_hledger

25
hledger/package.yaml
View File

@ -100,23 +100,22 @@ library:
- Hledger.Cli.Main
- Hledger.Cli.CliOptions
- Hledger.Cli.DocFiles
- Hledger.Cli.Tests
- Hledger.Cli.Utils
- Hledger.Cli.Version
- Hledger.Cli.Accounts
- Hledger.Cli.Activity
- Hledger.Cli.Add
- Hledger.Cli.Balance
- Hledger.Cli.Balancesheet
- Hledger.Cli.Balancesheetequity
- Hledger.Cli.Commands
- Hledger.Cli.Commands.Accounts
- Hledger.Cli.Commands.Activity
- Hledger.Cli.Commands.Add
- Hledger.Cli.Commands.Balance
- Hledger.Cli.Commands.Balancesheet
- Hledger.Cli.Commands.Balancesheetequity
- Hledger.Cli.Commands.Cashflow
- Hledger.Cli.Commands.Help
- Hledger.Cli.Commands.Incomestatement
- Hledger.Cli.Commands.Print
- Hledger.Cli.Commands.Register
- Hledger.Cli.Commands.Stats
- Hledger.Cli.CompoundBalanceCommand
- Hledger.Cli.Cashflow
- Hledger.Cli.Help
- Hledger.Cli.Incomestatement
- Hledger.Cli.Print
- Hledger.Cli.Register
- Hledger.Cli.Stats
- Text.Tabular.AsciiWide
dependencies:
- bytestring