{-|
hledger's built-in commands, and helpers for printing the commands list.

New built-in commands should be added in four places below:
the export list, the import list, builtinCommands, commandsList.

-}

-- Note: commands list rendering is intensely sensitive to change,
-- very easy to break in ways that tests currently do not catch.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Hledger.Cli.Commands (
   testcmd
  ,builtinCommands
  ,builtinCommandNames
  ,findBuiltinCommand
  ,knownAddonCommands
  ,knownCommands
  ,printCommandsList
  ,tests_Hledger_Cli
  ,module Hledger.Cli.Commands.Accounts
  ,module Hledger.Cli.Commands.Activity
  ,module Hledger.Cli.Commands.Add
  ,module Hledger.Cli.Commands.Aregister
  ,module Hledger.Cli.Commands.Balance
  ,module Hledger.Cli.Commands.Balancesheet
  ,module Hledger.Cli.Commands.Balancesheetequity
  ,module Hledger.Cli.Commands.Cashflow
  ,module Hledger.Cli.Commands.Close
  ,module Hledger.Cli.Commands.Codes
  ,module Hledger.Cli.Commands.Commodities
  ,module Hledger.Cli.Commands.Demo
  ,module Hledger.Cli.Commands.Descriptions
  ,module Hledger.Cli.Commands.Diff
  ,module Hledger.Cli.Commands.Help
  ,module Hledger.Cli.Commands.Import
  ,module Hledger.Cli.Commands.Incomestatement
  ,module Hledger.Cli.Commands.Notes
  ,module Hledger.Cli.Commands.Payees
  ,module Hledger.Cli.Commands.Prices
  ,module Hledger.Cli.Commands.Print
  ,module Hledger.Cli.Commands.Register
  ,module Hledger.Cli.Commands.Rewrite
  ,module Hledger.Cli.Commands.Stats
  ,module Hledger.Cli.Commands.Tags
) 
where

import Data.Char (isAlphaNum, isSpace)
import Data.List
import Data.List.Extra (nubSort)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import String.ANSI
import System.Environment (withArgs)
import System.Console.CmdArgs.Explicit as C
import Test.Tasty (defaultMain)

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Version
import Hledger.Cli.Commands.Accounts
import Hledger.Cli.Commands.Activity
import Hledger.Cli.Commands.Add
import Hledger.Cli.Commands.Aregister
import Hledger.Cli.Commands.Balance
import Hledger.Cli.Commands.Balancesheet
import Hledger.Cli.Commands.Balancesheetequity
import Hledger.Cli.Commands.Cashflow
import Hledger.Cli.Commands.Check
import Hledger.Cli.Commands.Close
import Hledger.Cli.Commands.Codes
import Hledger.Cli.Commands.Commodities
import Hledger.Cli.Commands.Demo
import Hledger.Cli.Commands.Descriptions
import Hledger.Cli.Commands.Diff
import Hledger.Cli.Commands.Files
import Hledger.Cli.Commands.Help
import Hledger.Cli.Commands.Import
import Hledger.Cli.Commands.Incomestatement
import Hledger.Cli.Commands.Notes
import Hledger.Cli.Commands.Payees
import Hledger.Cli.Commands.Prices
import Hledger.Cli.Commands.Print
import Hledger.Cli.Commands.Register
import Hledger.Cli.Commands.Rewrite
import Hledger.Cli.Commands.Roi
import Hledger.Cli.Commands.Stats
import Hledger.Cli.Commands.Tags
import Hledger.Cli.Utils (tests_Cli_Utils)

-- | The cmdargs subcommand mode (for command-line parsing)
-- and IO action (for doing the command's work) for each builtin command.
-- Command actions take parsed CLI options and a (lazy) finalised journal.
builtinCommands :: [(Mode RawOpts, CliOpts -> Journal -> IO ())]
builtinCommands :: [(Mode RawOpts, CliOpts -> Journal -> IO ())]
builtinCommands = [
   (Mode RawOpts
accountsmode           , CliOpts -> Journal -> IO ()
accounts)
  ,(Mode RawOpts
activitymode           , CliOpts -> Journal -> IO ()
activity)
  ,(Mode RawOpts
addmode                , CliOpts -> Journal -> IO ()
add)
  ,(Mode RawOpts
aregistermode          , CliOpts -> Journal -> IO ()
aregister)
  ,(Mode RawOpts
balancemode            , CliOpts -> Journal -> IO ()
balance)
  ,(Mode RawOpts
balancesheetequitymode , CliOpts -> Journal -> IO ()
balancesheetequity)
  ,(Mode RawOpts
balancesheetmode       , CliOpts -> Journal -> IO ()
balancesheet)
  ,(Mode RawOpts
cashflowmode           , CliOpts -> Journal -> IO ()
cashflow)
  ,(Mode RawOpts
checkmode              , CliOpts -> Journal -> IO ()
check)
  ,(Mode RawOpts
closemode              , CliOpts -> Journal -> IO ()
close)
  ,(Mode RawOpts
codesmode              , CliOpts -> Journal -> IO ()
codes)
  ,(Mode RawOpts
commoditiesmode        , CliOpts -> Journal -> IO ()
commodities)
  ,(Mode RawOpts
demomode               , CliOpts -> Journal -> IO ()
demo)
  ,(Mode RawOpts
descriptionsmode       , CliOpts -> Journal -> IO ()
descriptions)
  ,(Mode RawOpts
diffmode               , CliOpts -> Journal -> IO ()
diff)
  ,(Mode RawOpts
filesmode              , CliOpts -> Journal -> IO ()
files)
  ,(Mode RawOpts
helpmode               , CliOpts -> Journal -> IO ()
help')
  ,(Mode RawOpts
importmode             , CliOpts -> Journal -> IO ()
importcmd)
  ,(Mode RawOpts
incomestatementmode    , CliOpts -> Journal -> IO ()
incomestatement)
  ,(Mode RawOpts
notesmode              , CliOpts -> Journal -> IO ()
notes)
  ,(Mode RawOpts
payeesmode             , CliOpts -> Journal -> IO ()
payees)
  ,(Mode RawOpts
pricesmode             , CliOpts -> Journal -> IO ()
prices)
  ,(Mode RawOpts
printmode              , CliOpts -> Journal -> IO ()
print')
  ,(Mode RawOpts
registermode           , CliOpts -> Journal -> IO ()
register)
  ,(Mode RawOpts
rewritemode            , CliOpts -> Journal -> IO ()
rewrite)
  ,(Mode RawOpts
roimode                , CliOpts -> Journal -> IO ()
roi)
  ,(Mode RawOpts
statsmode              , CliOpts -> Journal -> IO ()
stats)
  ,(Mode RawOpts
tagsmode               , CliOpts -> Journal -> IO ()
tags)
  ,(Mode RawOpts
testmode               , CliOpts -> Journal -> IO ()
testcmd)
  ]

-- figlet -f FONTNAME hledger, then escape backslashes
_banner_slant :: [[Char]]
_banner_slant = forall a. Int -> [a] -> [a]
drop Int
1 [[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char]
"    __    __         __               "
  ,[Char]
"   / /_  / /__  ____/ /___ ____  _____"
  ,[Char]
"  / __ \\/ / _ \\/ __  / __ `/ _ \\/ ___/"
  ,[Char]
" / / / / /  __/ /_/ / /_/ /  __/ /    "
  ,[Char]
"/_/ /_/_/\\___/\\__,_/\\__, /\\___/_/     "
  ,[Char]
"                   /____/             "
  ]

_banner_smslant :: [[Char]]
_banner_smslant = forall a. Int -> [a] -> [a]
drop Int
1 [[Char]
""
  ,[Char]
"   __   __       __            "
  ,[Char]
"  / /  / /__ ___/ /__ ____ ____"
  ,[Char]
" / _ \\/ / -_) _  / _ `/ -_) __/"
  ,[Char]
"/_//_/_/\\__/\\_,_/\\_, /\\__/_/   "
  ,[Char]
"                /___/          "
  ]

_banner_speed :: [[Char]]
_banner_speed = forall a. Int -> [a] -> [a]
drop Int
1 [[Char]
""
  ,[Char]
"______ ______    _________                    "
  ,[Char]
"___  /____  /__________  /______ _____________"
  ,[Char]
"__  __ \\_  /_  _ \\  __  /__  __ `/  _ \\_  ___/"
  ,[Char]
"_  / / /  / /  __/ /_/ / _  /_/ //  __/  /    "
  ,[Char]
"/_/ /_//_/  \\___/\\__,_/  _\\__, / \\___//_/     "
  ,[Char]
"                         /____/               "
  ]

-- | Choose and apply an accent color for hledger output, if possible
-- picking one that will contrast with the current terminal background colour.
accent :: String -> String
accent :: [Char] -> [Char]
accent
  | Bool -> Bool
not Bool
useColorOnStdout          = forall a. a -> a
id
  | Maybe Bool
terminalIsLight forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
False = [Char] -> [Char]
brightWhite
  | Maybe Bool
terminalIsLight forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True  = [Char] -> [Char]
brightBlack
  | Bool
otherwise                     = forall a. a -> a
id

-- | The commands list, showing command names, standard aliases,
-- and short descriptions. This is modified at runtime, as follows:
--
-- progversion is the program name and version.
--
-- Lines beginning with a space represent builtin commands, with format:
--  COMMAND (ALIASES) DESCRIPTION
-- These should be kept synced with builtinCommands above, and
-- their docs (Commands/\*.md).
--
-- Lines beginning with + represent known addon commands. These lines
-- will be suppressed if hledger-CMD is not found in $PATH at runtime.
--
-- OTHER is replaced with additional command lines (without descriptions)
-- for any unknown addon commands found in $PATH at runtime.
--
-- TODO: generate more of this automatically.
-- 
commandsList :: String -> [String] -> [String]
commandsList :: [Char] -> [[Char]] -> [[Char]]
commandsList [Char]
progversion [[Char]]
othercmds =
  forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
bold'forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Char] -> [Char]
accent) [[Char]]
_banner_smslant forall a. [a] -> [a] -> [a]
++ 
  [
  -- Keep the following synced with:
  --  commands.m4
  --  hledger.m4.md -> Commands
  --  commandsFromCommandsList. Only commands should begin with space or plus.
   [Char]
"-------------------------------------------------------------------------------"
  ,[Char]
progversion
  ,[Char]
"Usage: hledger CMD [OPTS] [-- ADDONCMDOPTS]"
  ,[Char]
"Commands (builtins + addons):"
  ,[Char]
""
  ,[Char] -> [Char]
bold' [Char]
"ENTERING DATA (add or edit transactions, updating the journal file)"
  ,[Char]
" add                      add transactions using terminal prompts"
  ,[Char]
"+edit                     edit a subset of transactions"
  ,[Char]
"+iadd                     add transactions using a TUI"
  ,[Char]
" import                   add new transactions from other files, eg CSV files"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"GENERATING DATA (generate entries to be added to the journal file)"
  ,[Char]
"+autosync                 download/deduplicate/convert OFX data"
  ,[Char]
" close                    generate balance-zeroing/restoring transactions"
  ,[Char]
"+interest                 generate interest transactions"
  ,[Char]
"+lots sell                generate a lot-selling transaction"
  ,[Char]
" rewrite                  generate auto postings, like print --auto"
  ,[Char]
"+stockquotes              download market prices from AlphaVantage"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"MANAGING DATA (error checking, file management, version control..)"
  ,[Char]
" check                    check for various kinds of error in the data"
  ,[Char]
"+check-fancyassertions    check more powerful balance assertions"
  ,[Char]
"+check-tagfiles           check file paths in tag values exist"
  ,[Char]
" diff                     compare account transactions in two journal files"
  ,[Char]
" files                    show data files in use"
  ,[Char]
"+git                      simple version management with git"
  ,[Char]
"+pijul                    simple version management with pijul"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"FINANCIAL REPORTS (standard financial statements)"
  ,[Char]
" aregister (areg)         show transactions in a particular account"
  ,[Char]
" balancesheet (bs)        show assets, liabilities and net worth"
  ,[Char]
" balancesheetequity (bse) show assets, liabilities and equity"
  ,[Char]
" cashflow (cf)            show changes in liquid assets"
  ,[Char]
" incomestatement (is)     show revenues and expenses"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"VERSATILE REPORTS (more complex/versatile reporting commands)"
  ,[Char]
" activity                 show a simple bar chart of posting counts per period"
  ,[Char]
" balance (bal)            show balance changes, end balances, budgets, gains.."
  ,[Char]
" bar                      show a balance report as a simple bar chart"
  ,[Char]
"+lots                     show a commodity's lots"
  ,[Char]
"+plot                     create charts from balance reports, in terminal or GUI"
  ,[Char]
" print                    show transactions or export journal data"
  ,[Char]
" register (reg)           show postings in one or more accounts & running total"
  ,[Char]
" roi                      show return on investments"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"BASIC REPORTS (lists and stats)"
  ,[Char]
" accounts                 show account names"
  ,[Char]
" codes                    show transaction codes"
  ,[Char]
" commodities              show commodity/currency symbols"
  ,[Char]
" descriptions             show full transaction descriptions (payee and note)"
  ,[Char]
" notes                    show note part of transaction descriptions"
  ,[Char]
" payees                   show payee names"
  ,[Char]
" prices                   show historical market prices"
  ,[Char]
" stats                    show journal statistics"
  ,[Char]
" tags                     show tag names"
  ,[Char]
" test                     run self tests"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"UIS (other user interfaces)"
  ,[Char]
"+ui                       run terminal UI"
  ,[Char]
"+web                      run web UI"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"HELP (show help and docs)"
  ,[Char]
" hledger                          show this commands list"
  ,[Char]
" hledger -h                       show hledger's command-line help"
  ,[Char]
" hledger CMD -h                   show CMD's command-line help and manual"
  ,[Char]
" hledger help [-i|-m|-p] [TOPIC]  show hledger's manual with info, man, or pager"
  ,[Char]
" hledger demo [DEMO] -- [ASCOPTS] show brief demos on various topics"
  ,[Char]
" https://hledger.org              html manuals, tutorials, support.."
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"OTHER (more hledger-* addon commands found in PATH)"
  ]
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Char
' 'forall a. a -> [a] -> [a]
:) ([Char] -> [[Char]]
lines forall a b. (a -> b) -> a -> b
$ Int -> [[Char]] -> [Char]
multicol Int
79 [[Char]]
othercmds)
  forall a. [a] -> [a] -> [a]
++ [[Char]
""]

-- | Extract just the command names from the default commands list above,
-- (the first word of lines between "Usage:" and "HELP" beginning with a space or plus sign),
-- in the order they occur. With a true first argument, extracts only the addon command names.
-- Needs to be kept synced with commandsList.
commandsListExtractCommands :: Bool -> [String] -> [String]
commandsListExtractCommands :: Bool -> [[Char]] -> [[Char]]
commandsListExtractCommands Bool
addonsonly [[Char]]
l =
  [ [Char]
w | Char
c:ws :: [Char]
ws@(Char
d:[Char]
_) <- forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [Char]
"HELP") forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [Char]
"Usage:") [[Char]]
l
  , Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Char
'+'forall a. a -> [a] -> [a]
:[Char
' '|Bool -> Bool
not Bool
addonsonly]
  , Char -> Bool
isAlphaNum Char
d
  , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ [Char]
"://" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
ws
  , let [Char]
w:[[Char]]
_ = [Char] -> [[Char]]
words [Char]
ws
  ]

-- | Canonical names of all commands which have a slot in the commands list, in alphabetical order.
-- These include the builtin commands and the known addon commands.
knownCommands :: [String]
knownCommands :: [[Char]]
knownCommands = forall a. Ord a => [a] -> [a]
nubSort forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [[Char]] -> [[Char]]
commandsListExtractCommands Bool
False forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
commandsList [Char]
progname []

-- | Canonical names of the known addon commands which have a slot in the commands list,
-- in alphabetical order.
knownAddonCommands :: [String]
knownAddonCommands :: [[Char]]
knownAddonCommands = forall a. Ord a => [a] -> [a]
nubSort forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [[Char]] -> [[Char]]
commandsListExtractCommands Bool
True forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
commandsList [Char]
progname []

-- | All names and aliases of the builtin commands.
builtinCommandNames :: [String]
builtinCommandNames :: [[Char]]
builtinCommandNames = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Mode a -> [[Char]]
modeNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Mode RawOpts, CliOpts -> Journal -> IO ())]
builtinCommands

-- | Look up a builtin command's mode and action by exact command name or alias. 
findBuiltinCommand :: String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()) 
findBuiltinCommand :: [Char] -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand [Char]
cmdname = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
cmdname forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Mode a -> [[Char]]
modeNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Mode RawOpts, CliOpts -> Journal -> IO ())]
builtinCommands 

-- | Print the commands list, with a pager if appropriate, customising the
-- commandsList template above with the given version string and the installed addons.
-- Uninstalled known addons will be removed from the list,
-- installed known addons will have the + prefix removed,
-- and installed unknown addons will be added under Misc.
printCommandsList :: String -> [String] -> IO ()
printCommandsList :: [Char] -> [[Char]] -> IO ()
printCommandsList [Char]
progversion [[Char]]
installedaddons =
  seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Show a => [Char] -> a -> a
dbg8 [Char]
"uninstalledknownaddons" [[Char]]
uninstalledknownaddons) forall a b. (a -> b) -> a -> b
$  -- for debug output
  seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Show a => [Char] -> a -> a
dbg8 [Char]
"installedknownaddons"   [[Char]]
installedknownaddons)   forall a b. (a -> b) -> a -> b
$
  seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Show a => [Char] -> a -> a
dbg8 [Char]
"installedunknownaddons" [[Char]]
installedunknownaddons) forall a b. (a -> b) -> a -> b
$
  [Char] -> IO ()
pager forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
unplus forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.[Char] -> Bool
isuninstalledaddon) forall a b. (a -> b) -> a -> b
$
  [Char] -> [[Char]] -> [[Char]]
commandsList [Char]
progversion [[Char]]
installedunknownaddons
  where
    knownaddons :: [[Char]]
knownaddons = [[Char]]
knownAddonCommands
    uninstalledknownaddons :: [[Char]]
uninstalledknownaddons  = [[Char]]
knownaddons forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]]
installedaddons
    installedknownaddons :: [[Char]]
installedknownaddons    = [[Char]]
knownaddons forall a. Eq a => [a] -> [a] -> [a]
`intersect` [[Char]]
installedaddons
    installedunknownaddons :: [[Char]]
installedunknownaddons  = [[Char]]
installedaddons forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]]
knownaddons
    unplus :: [Char] -> [Char]
unplus (Char
'+':[Char]
cs) = Char
' 'forall a. a -> [a] -> [a]
:[Char]
cs
    unplus [Char]
s = [Char]
s
    isuninstalledaddon :: [Char] -> Bool
isuninstalledaddon =
      \case
        (Char
'+':[Char]
l) | [Char]
cmd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]]
installedaddons ->
                  forall a. Show a => (a -> [Char]) -> a -> a
dbg9With (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ [Char]
"hiding uninstalled addon: "forall a. Semigroup a => a -> a -> a
<>[Char]
cmd) forall a b. (a -> b) -> a -> b
$
                  Bool
True where cmd :: [Char]
cmd = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) [Char]
l
        [Char]
_ -> Bool
False

-- The test command is defined here for easy access to other modules' tests.

testmode :: Mode RawOpts
testmode = [Char]
-> [Flag RawOpts]
-> [([Char], [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Test.txt")
  []
  [([Char], [Flag RawOpts])
generalflagsgroup3]
  []
  ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char] -> Arg RawOpts
argsFlag [Char]
"[-- TASTYOPTS]")

-- | The test command, which runs the hledger and hledger-lib
-- packages' unit tests. This command also accepts tasty test runner
-- options, written after a -- (double hyphen).
--
-- Unlike most hledger commands, this one does not read the user's journal.
-- A 'Journal' argument remains in the type signature, but it should
-- not be used (and would raise an error).
--
testcmd :: CliOpts -> Journal -> IO ()
testcmd :: CliOpts -> Journal -> IO ()
testcmd CliOpts
opts Journal
_undefined = do
  forall a. [[Char]] -> IO a -> IO a
withArgs ([Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"args" forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts) forall a b. (a -> b) -> a -> b
$
    TestTree -> IO ()
Test.Tasty.defaultMain forall a b. (a -> b) -> a -> b
$ [Char] -> [TestTree] -> TestTree
testGroup [Char]
"hledger" [
       TestTree
tests_Hledger
      ,TestTree
tests_Hledger_Cli
      ]

-- All unit tests for Hledger.Cli, defined here rather than
-- Hledger.Cli so testcmd can use them.
tests_Hledger_Cli :: TestTree
tests_Hledger_Cli = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Hledger.Cli" [
   TestTree
tests_Cli_Utils
  ,TestTree
tests_Commands
  ]

tests_Commands :: TestTree
tests_Commands = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Commands" [
   TestTree
tests_Balance
  ,TestTree
tests_Register
  ,TestTree
tests_Aregister

  -- some more tests easiest to define here:

  ,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"apply account directive" [
     [Char] -> IO () -> TestTree
testCase [Char]
"works" forall a b. (a -> b) -> a -> b
$ do
        let
          ignoresourcepos :: Journal -> Journal
ignoresourcepos Journal
j = Journal
j{jtxns :: [Transaction]
jtxns=forall a b. (a -> b) -> [a] -> [b]
map (\Transaction
t -> Transaction
t{tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos}) (Journal -> [Transaction]
jtxns Journal
j)}
          sameParse :: Text -> Text -> IO ()
sameParse Text
str1 Text
str2 = do
            Journal
j1 <- Journal -> Journal
ignoresourcepos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Journal
readJournal' Text
str1  -- PARTIAL:
            Journal
j2 <- Journal -> Journal
ignoresourcepos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Journal
readJournal' Text
str2  -- PARTIAL:
            Journal
j1 forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Journal
j2{jlastreadtime :: POSIXTime
jlastreadtime=Journal -> POSIXTime
jlastreadtime Journal
j1, jfiles :: [([Char], Text)]
jfiles=Journal -> [([Char], Text)]
jfiles Journal
j1} --, jparsestate=jparsestate j1}
        Text -> Text -> IO ()
sameParse
           (Text
"2008/12/07 One\n  alpha  $-1\n  beta  $1\n" forall a. Semigroup a => a -> a -> a
<>
            Text
"apply account outer\n2008/12/07 Two\n  aigh  $-2\n  bee  $2\n" forall a. Semigroup a => a -> a -> a
<>
            Text
"apply account inner\n2008/12/07 Three\n  gamma  $-3\n  delta  $3\n" forall a. Semigroup a => a -> a -> a
<>
            Text
"end apply account\n2008/12/07 Four\n  why  $-4\n  zed  $4\n" forall a. Semigroup a => a -> a -> a
<>
            Text
"end apply account\n2008/12/07 Five\n  foo  $-5\n  bar  $5\n"
           )
           (Text
"2008/12/07 One\n  alpha  $-1\n  beta  $1\n" forall a. Semigroup a => a -> a -> a
<>
            Text
"2008/12/07 Two\n  outer:aigh  $-2\n  outer:bee  $2\n" forall a. Semigroup a => a -> a -> a
<>
            Text
"2008/12/07 Three\n  outer:inner:gamma  $-3\n  outer:inner:delta  $3\n" forall a. Semigroup a => a -> a -> a
<>
            Text
"2008/12/07 Four\n  outer:why  $-4\n  outer:zed  $4\n" forall a. Semigroup a => a -> a -> a
<>
            Text
"2008/12/07 Five\n  foo  $-5\n  bar  $5\n"
           )

    ,[Char] -> IO () -> TestTree
testCase [Char]
"preserves \"virtual\" posting type" forall a b. (a -> b) -> a -> b
$ do
      Journal
j <- Text -> IO Journal
readJournal' Text
"apply account test\n2008/12/07 One\n  (from)  $-1\n  (to)  $1\n"  -- PARTIAL:
      let p :: Posting
p = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
      Posting -> Text
paccount Posting
p forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Text
"test:from"
      Posting -> PostingType
ptype Posting
p forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= PostingType
VirtualPosting
    ]

  ,[Char] -> IO () -> TestTree
testCase [Char]
"alias directive" forall a b. (a -> b) -> a -> b
$ do
    Journal
j <- Text -> IO Journal
readJournal' Text
"!alias expenses = equity:draw:personal\n1/1\n (expenses:food)  1\n"  -- PARTIAL:
    let p :: Posting
p = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
    Posting -> Text
paccount Posting
p forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Text
"equity:draw:personal:food"

  ,[Char] -> IO () -> TestTree
testCase [Char]
"Y default year directive" forall a b. (a -> b) -> a -> b
$ do
    Journal
j <- Text -> IO Journal
readJournal' Text
defaultyear_journal_txt  -- PARTIAL:
    Transaction -> Day
tdate (forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j) forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
1 Int
1

  ,[Char] -> IO () -> TestTree
testCase [Char]
"ledgerAccountNames" forall a b. (a -> b) -> a -> b
$
    (Ledger -> [Text]
ledgerAccountNames Ledger
ledger7)
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
    [Text
"assets",Text
"assets:cash",Text
"assets:checking",Text
"assets:saving",Text
"equity",Text
"equity:opening balances",
     Text
"expenses",Text
"expenses:food",Text
"expenses:food:dining",Text
"expenses:phone",Text
"expenses:vacation",
     Text
"liabilities",Text
"liabilities:credit cards",Text
"liabilities:credit cards:discover"]

  -- ,testCase "journalCanonicaliseAmounts" ~:
  --  "use the greatest precision" ~:
  --   (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) @?= [2,2]

  -- don't know what this should do
  -- ,testCase "elideAccountName" ~: do
  --    (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
  --     @?= "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
  --    (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
  --     @?= "aa:aa:aaaaaaaaaaaaaa")

  ,[Char] -> IO () -> TestTree
testCase [Char]
"show dollars" forall a b. (a -> b) -> a -> b
$ Amount -> [Char]
showAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1) forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [Char]
"$1.00"

  ,[Char] -> IO () -> TestTree
testCase [Char]
"show hours" forall a b. (a -> b) -> a -> b
$ Amount -> [Char]
showAmount (DecimalRaw Integer -> Amount
hrs DecimalRaw Integer
1) forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [Char]
"1.00h"

  ]

-- test data

-- date1 = fromGregorian 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 :: Text
defaultyear_journal_txt = [Text] -> Text
T.unlines
 [Text
"Y2009"
 ,Text
""
 ,Text
"01/01 A"
 ,Text
"    a  $1"
 ,Text
"    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 :: Journal
journal7 = Journal
nulljournal {jtxns :: [Transaction]
jtxns =
          [
           Transaction -> Transaction
txnTieKnot Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
01,
             tdate2 :: Maybe Day
tdate2=forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: Text
tcode=Text
"*",
             tdescription :: Text
tdescription=Text
"opening balance",
             tcomment :: Text
tcomment=Text
"",
             ttags :: [Tag]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 [Text
"assets:cash" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
4.82
                 ,Text
"equity:opening balances" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
4.82)
                 ],
             tprecedingcomment :: Text
tprecedingcomment=Text
""
           }
          ,
           Transaction -> Transaction
txnTieKnot Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
02 Int
01,
             tdate2 :: Maybe Day
tdate2=forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: Text
tcode=Text
"*",
             tdescription :: Text
tdescription=Text
"ayres suites",
             tcomment :: Text
tcomment=Text
"",
             ttags :: [Tag]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 [Text
"expenses:vacation" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
179.92
                 ,Text
"assets:checking" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
179.92)
                 ],
             tprecedingcomment :: Text
tprecedingcomment=Text
""
           }
          ,
           Transaction -> Transaction
txnTieKnot Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
02,
             tdate2 :: Maybe Day
tdate2=forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: Text
tcode=Text
"*",
             tdescription :: Text
tdescription=Text
"auto transfer to savings",
             tcomment :: Text
tcomment=Text
"",
             ttags :: [Tag]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 [Text
"assets:saving" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
200
                 ,Text
"assets:checking" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
200)
                 ],
             tprecedingcomment :: Text
tprecedingcomment=Text
""
           }
          ,
           Transaction -> Transaction
txnTieKnot Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
03,
             tdate2 :: Maybe Day
tdate2=forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: Text
tcode=Text
"*",
             tdescription :: Text
tdescription=Text
"poquito mas",
             tcomment :: Text
tcomment=Text
"",
             ttags :: [Tag]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 [Text
"expenses:food:dining" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
4.82
                 ,Text
"assets:cash" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
4.82)
                 ],
             tprecedingcomment :: Text
tprecedingcomment=Text
""
           }
          ,
           Transaction -> Transaction
txnTieKnot Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
03,
             tdate2 :: Maybe Day
tdate2=forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: Text
tcode=Text
"*",
             tdescription :: Text
tdescription=Text
"verizon",
             tcomment :: Text
tcomment=Text
"",
             ttags :: [Tag]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 [Text
"expenses:phone" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
95.11
                 ,Text
"assets:checking" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
95.11)
                 ],
             tprecedingcomment :: Text
tprecedingcomment=Text
""
           }
          ,
           Transaction -> Transaction
txnTieKnot Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
03,
             tdate2 :: Maybe Day
tdate2=forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: Text
tcode=Text
"*",
             tdescription :: Text
tdescription=Text
"discover",
             tcomment :: Text
tcomment=Text
"",
             ttags :: [Tag]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 [Text
"liabilities:credit cards:discover" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
80
                 ,Text
"assets:checking" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
80)
                 ],
             tprecedingcomment :: Text
tprecedingcomment=Text
""
           }
          ]
         }

ledger7 :: Ledger
ledger7 :: Ledger
ledger7 = Query -> Journal -> Ledger
ledgerFromJournal Query
Any Journal
journal7