{-|
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 (
   commands
  ,testcmd
  ,builtinCommands
  ,builtinCommandNames
  ,addonCommandNames
  ,knownAddonCommandNames
  ,findBuiltinCommand
  ,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.Run
  ,module Hledger.Cli.Commands.Setup
  ,module Hledger.Cli.Commands.Stats
  ,module Hledger.Cli.Commands.Tags
) 
where

import Data.Char (isAlphaNum, isSpace, toLower)
import Data.Either (isRight)
import Data.List
import Data.List.Extra (groupSortOn, nubSort)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import Safe (headErr)
import String.ANSI
import System.Console.CmdArgs.Explicit as C
import System.Environment (withArgs)
import System.FilePath (dropExtension, takeBaseName, takeExtension)
import Test.Tasty (defaultMain)
import Text.Megaparsec
import Text.Megaparsec.Char

import Hledger
import Hledger.Cli.CliOptions
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.Run
import Hledger.Cli.Commands.Setup
import Hledger.Cli.Commands.Stats
import Hledger.Cli.Commands.Tags
import Hledger.Cli.Utils (tests_Cli_Utils)
import Data.Functor ((<&>))

-- | 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
commandsmode           , CliOpts -> Journal -> IO ()
commands)
  ,(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
runmode                , CliOpts -> Journal -> IO ()
runOrReplStub)
  ,(Mode RawOpts
replmode               , CliOpts -> Journal -> IO ()
runOrReplStub)
  ,(Mode RawOpts
setupmode              , CliOpts -> Journal -> IO ()
setup)
  ,(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 = Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
1 [[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char]
"    __    __         __               "
  ,[Char]
"   / /_  / /__  ____/ /___ ____  _____"
  ,[Char]
"  / __ \\/ / _ \\/ __  / __ `/ _ \\/ ___/"
  ,[Char]
" / / / / /  __/ /_/ / /_/ /  __/ /    "
  ,[Char]
"/_/ /_/_/\\___/\\__,_/\\__, /\\___/_/     "
  ,[Char]
"                   /____/             "
  ]

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

_banner_speed :: [[Char]]
_banner_speed = Int -> [[Char]] -> [[Char]]
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
useColorOnStdoutUnsafe    = [Char] -> [Char]
forall a. a -> a
id  -- XXX unsafe accenting the title banner - seems to work, even respecting config file
  | Maybe Bool
terminalIsLight Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False = [Char] -> [Char]
brightWhite
  | Maybe Bool
terminalIsLight Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True  = [Char] -> [Char]
brightBlack
  | Bool
otherwise                     = [Char] -> [Char]
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 =
  ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
bold'([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Char] -> [Char]
accent) [[Char]]
_banner_smslant [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++   -- XXX not showing bold, why ?
  [
  -- Keep the following synced with:
  --  commands.m4
  --  hledger.m4.md -> Commands
  --  commandsFromCommandsList. Only commands should begin with space or plus.
  -- IN PARTICULAR KEEP SYNCED WITH commandsListExtractCommands, 
  -- it needs checking/updating after any wording/layout changes here
   [Char]
"-------------------------------------------------------------------------------"
  ,[Char]
progversion
  ,[Char]
"Usage: hledger COMMAND [OPTIONS] [-- ADDONOPTIONS]"
  -- ,"Commands (builtins + addons):"  -- XXX adapt for commands --builtin
  ,[Char]
"Commands:"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"HELP (docs, demos..)"
  ,[Char]
" commands                 show the commands list (default)"
  ,[Char]
" demo [DEMO]              show brief demos in the terminal"
  ,[Char]
" help [-i|-m|-p] [TOPIC]  show the hledger manual with info/man/pager"
  ,[Char]
" --tldr    [COMMAND]      show command examples   [for command] with tldr"
  ,[Char]
" --help/-h [COMMAND]      show command line help  [for command]"
  ,[Char]
" --info    [COMMAND]      show the hledger manual [for command] with info"
  ,[Char]
" --man     [COMMAND]      show the hledger manual [for command] with man"
  ,[Char]
"                          more help: https://hledger.org"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"USER INTERFACES (alternate UIs)"
  ,[Char]
" repl                     run commands from an interactive prompt"
  ,[Char]
" run                      run command scripts from files or arguments"
  ,[Char]
"+ui                       run a terminal UI (hledger-ui)"
  ,[Char]
"+web                      run a web UI (hledger-web)"
                                                                                     -- see also: MoLe, https://hledger.org/mobile.html
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"ENTERING DATA (add or edit transactions)"
  ,[Char]
" add                      add transactions using interactive prompts"
  ,[Char]
"+iadd                     add transactions using a TUI (hledger-iadd)"
  ,[Char]
" import                   add new transactions from other files, eg CSV files"
  ,[Char]
"+edit                     edit specific transactions with $EDITOR"               -- hledger-utils
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"BASIC REPORTS (simple lists)"
  ,[Char]
" accounts                 show account names"
  ,[Char]
" codes                    show transaction codes"
  ,[Char]
" commodities              show commodity/currency symbols"
  ,[Char]
" descriptions             show transaction descriptions"
  ,[Char]
" files                    show data files in use"
  ,[Char]
" notes                    show note part of transaction descriptions"
  ,[Char]
" payees                   show payee part of transaction descriptions"
  ,[Char]
" prices                   show historical market prices"
  ,[Char]
" stats                    show journal statistics"
  ,[Char]
" tags                     show tag names"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"STANDARD REPORTS (the most useful financial reports)"
  ,[Char]
" print                    show full transaction entries, or export journal data"
  ,[Char]
" aregister (areg)         show transactions & running balance in one account"
  ,[Char]
" register (reg)           show postings & running total in one or more accounts"
  ,[Char]
" balancesheet (bs)        show assets and liabilities"
  ,[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]
"ADVANCED REPORTS (more versatile/advanced reports)"
  ,[Char]
" balance (bal)            show balance changes, end balances, gains, budgets.."
  ,[Char]
"+lots                     show a commodity's lots"                               -- hledger-lots
  ,[Char]
" roi                      show return on investments"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"CHARTS (bar charts, line graphs..)"
  ,[Char]
" activity                 show posting counts as a bar chart"
  ,[Char]
"+bar                      show balances or changes as a bar chart"               -- hledger-bar
  ,[Char]
"+plot                     show advanced matplotlib charts as gui/svg/png/pdf.."  -- hledger-utils
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"GENERATING DATA (generate or download journal entries; less common)"
  ,[Char]
"+autosync                 download/deduplicate/show OFX data as transactions"    -- ledger-autosync
  ,[Char]
" close                    generate transactions to zero/restore/assert balances"
  ,[Char]
"+interest                 generate transactions transferring accrued interest"   -- hledger-interest
  ,[Char]
"+lots sell                generate a lot-selling transaction"                    -- hledger-lots
  ,[Char]
"+pricehist                download historical market prices"                     -- pricehist
  ,[Char]
" rewrite                  add postings to transactions, like print --auto"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"MAINTENANCE (error checking, data management..)"
  ,[Char]
" check                    run any of hledger's built-in correctness checks"
  ,[Char]
"+check-fancyassertions    check more powerful balance assertions"                -- hledger-check-fancyassertions
  ,[Char]
"+check-tagfiles           check that files referenced in tag values exist"       -- hledger-check-tagfiles
  ,[Char]
" diff                     compare an account's transactions in two journals"
  ,[Char]
"+git                      save or view journal file history simply in git"       -- hledger-git
  ,[Char]
"+pijul                    save or view journal file history simply in pijul"     -- hledger-pijul
  ,[Char]
" setup                    check and show the status of the hledger installation"
  ,[Char]
" test                     run some self tests"
  ,[Char]
""
    -----------------------------------------80-------------------------------------
  ,[Char] -> [Char]
bold' [Char]
"OTHER ADDONS (more hledger-* commands found in PATH):"
  ]
  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Char
' 'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Int -> [[Char]] -> [Char]
multicol Int
79 [[Char]]
othercmds)
  [[Char]] -> [[Char]] -> [[Char]]
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 "OTHER" beginning with a space or plus sign),
-- in the order they occur. With a true first argument, extracts only the addon command names.
commandsListExtractCommands :: Bool -> [String] -> [String]
commandsListExtractCommands :: Bool -> [[Char]] -> [[Char]]
commandsListExtractCommands Bool
addonsonly [[Char]]
l =
  [ [Char]
cmdname | Char
prefixchar:line :: [Char]
line@(Char
firstchar:[Char]
_) <- 
      ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [Char]
"OTHER") ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [Char]
"Usage:") [[Char]]
l
  , Char
prefixchar Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Char
'+'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char
' '|Bool -> Bool
not Bool
addonsonly]
  , Char -> Bool
isAlphaNum Char
firstchar
  , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"https://" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
line
  , let [Char]
cmdname:[[Char]]
_ = [Char] -> [[Char]]
words [Char]
line
  ]
  -- Keep synced with commandsList.

commandsmode :: Mode RawOpts
commandsmode =
  [Char]
-> [Flag RawOpts]
-> [([Char], [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
    $(embedFileRelative "Hledger/Cli/Commands/Commands.txt")
    [[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"builtin"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"builtin")  [Char]
"show only builtin commands, not addons"
    ]
    [([Char]
helpflagstitle, [Flag RawOpts]
helpflags)]
    []
    -- flagReq  ["debug"]    (\s opts -> Right $ setopt "debug" s opts) "[N]" "show debug output (levels 1-9, default: 1)"

    ([], Maybe (Arg RawOpts)
forall a. Maybe a
Nothing)

-- | Display the commands list.
commands :: CliOpts -> Journal -> IO ()
commands :: CliOpts -> Journal -> IO ()
commands CliOpts
opts Journal
_ = do
  [[Char]]
addons <- if [Char] -> RawOpts -> Bool
boolopt [Char]
"builtin" (CliOpts -> RawOpts
rawopts_ CliOpts
opts) then [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [] else IO [[Char]]
addonCommandNames
  [Char] -> [[Char]] -> IO ()
printCommandsList [Char]
prognameandversion [[Char]]
addons

{- | 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 =
  Int -> IO () -> IO ()
forall a b. a -> b -> b
seq ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Char]] -> Int) -> [[Char]] -> Int
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. Show a => [Char] -> a -> a
dbg8 [Char]
"uninstalledknownaddons" [[Char]]
uninstalledknownaddons) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ -- for debug output
    Int -> IO () -> IO ()
forall a b. a -> b -> b
seq ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Char]] -> Int) -> [[Char]] -> Int
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. Show a => [Char] -> a -> a
dbg8 [Char]
"installedknownaddons" [[Char]]
installedknownaddons) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Int -> IO () -> IO ()
forall a b. a -> b -> b
seq ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Char]] -> Int) -> [[Char]] -> Int
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. Show a => [Char] -> a -> a
dbg8 [Char]
"installedunknownaddons" [[Char]]
installedunknownaddons) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
runPager ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
          [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
            ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
unplus ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
              ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
isuninstalledaddon) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
                [Char] -> [[Char]] -> [[Char]]
commandsList [Char]
progversion [[Char]]
installedunknownaddons
 where
  knownaddons :: [[Char]]
knownaddons = [[Char]]
knownAddonCommandNames
  uninstalledknownaddons :: [[Char]]
uninstalledknownaddons = [[Char]]
knownaddons [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]]
installedaddons
  installedknownaddons :: [[Char]]
installedknownaddons = [[Char]]
knownaddons [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [[Char]]
installedaddons
  installedunknownaddons :: [[Char]]
installedunknownaddons = [[Char]]
installedaddons [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]]
knownaddons
  unplus :: [Char] -> [Char]
unplus (Char
'+' : [Char]
cs) = Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs
  unplus [Char]
s = [Char]
s
  isuninstalledaddon :: [Char] -> Bool
isuninstalledaddon =
    \case
      (Char
'+' : [Char]
l)
        | [Char]
cmd [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]]
installedaddons ->
            (Bool -> [Char]) -> Bool -> Bool
forall a. (a -> [Char]) -> a -> a
dbg9With ([Char] -> Bool -> [Char]
forall a b. a -> b -> a
const ([Char] -> Bool -> [Char]) -> [Char] -> Bool -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"hiding uninstalled addon: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
cmd) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
              Bool
True
       where
        cmd :: [Char]
cmd = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) [Char]
l
      [Char]
_ -> Bool
False

-- | 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 = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
nubSort ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [[Char]] -> [[Char]]
commandsListExtractCommands Bool
False ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
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 = ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> [[Char]])
-> [(Mode RawOpts, CliOpts -> Journal -> IO ())] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Mode RawOpts -> [[Char]]
forall a. Mode a -> [[Char]]
modeNames (Mode RawOpts -> [[Char]])
-> ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts)
-> (Mode RawOpts, CliOpts -> Journal -> IO ())
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts
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 = ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> Bool)
-> [(Mode RawOpts, CliOpts -> Journal -> IO ())]
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
cmdname ([[Char]] -> Bool)
-> ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> [[Char]])
-> (Mode RawOpts, CliOpts -> Journal -> IO ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode RawOpts -> [[Char]]
forall a. Mode a -> [[Char]]
modeNames (Mode RawOpts -> [[Char]])
-> ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts)
-> (Mode RawOpts, CliOpts -> Journal -> IO ())
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts
forall a b. (a, b) -> a
fst) [(Mode RawOpts, CliOpts -> Journal -> IO ())]
builtinCommands 

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

-- Search PATH for names of addon commands, that aren't shadowed by builtin commands.
addonCommandNames :: IO [String]
addonCommandNames :: IO [[Char]]
addonCommandNames = IO [[Char]]
installedAddonCommandNames IO [[Char]] -> ([[Char]] -> [[Char]]) -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
builtinCommandNames) ([Char] -> Bool) -> ([Char] -> [Char]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
dropExtension)

-- | Get the sorted unique canonical names of hledger addon commands
-- found in the current user's PATH. These are used in command line
-- parsing and to display the commands list.
--
-- Canonical addon names are the filenames of hledger-* executables in
-- PATH, without the "hledger-" prefix, and without the file extension
-- except when it's needed for disambiguation (see below).
--
-- When there are exactly two versions of an executable (same base
-- name, different extensions) that look like a source and compiled
-- pair (one has .exe, .com, or no extension), the source version will
-- be excluded (even if it happens to be newer). When there are three
-- or more versions (or two versions that don't look like a
-- source/compiled pair), they are all included, with file extensions
-- intact.
--
installedAddonCommandNames :: IO [String]
installedAddonCommandNames :: IO [[Char]]
installedAddonCommandNames = do
  -- past bug generator
  [[Char]]
as1 <- IO [[Char]]
hledgerExecutablesInPath                     -- ["hledger-check","hledger-check-dates","hledger-check-dates.hs","hledger-check.hs","hledger-check.py"]
  let as2 :: [[Char]]
as2 = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
forall {a}. [a] -> [a]
stripPrognamePrefix [[Char]]
as1               -- ["check","check-dates","check-dates.hs","check.hs","check.py"]
  let as3 :: [[[Char]]]
as3 = ([Char] -> [Char]) -> [[Char]] -> [[[Char]]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortOn [Char] -> [Char]
takeBaseName [[Char]]
as2              -- [["check","check.hs","check.py"],["check-dates","check-dates.hs"]]
  let as4 :: [[Char]]
as4 = ([[Char]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [[Char]] -> [[Char]]
dropRedundantSourceVersion [[[Char]]]
as3  -- ["check","check.hs","check.py","check-dates"]
  [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
as4

stripPrognamePrefix :: [a] -> [a]
stripPrognamePrefix = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
progname Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

dropRedundantSourceVersion :: [[Char]] -> [[Char]]
dropRedundantSourceVersion [[Char]
f,[Char]
g]
  | (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char]
takeExtension [Char]
f) [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
compiledExts = [[Char]
f]
  | (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char]
takeExtension [Char]
g) [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
compiledExts = [[Char]
g]
dropRedundantSourceVersion [[Char]]
fs = [[Char]]
fs

compiledExts :: [[Char]]
compiledExts = [[Char]
"",[Char]
".com",[Char]
".exe"]

-- | Get the sorted unique filenames of all hledger-* executables in
-- the current user's PATH. These are files in any of the PATH directories,
-- named hledger-*, with either no extension (and no periods in the name)
-- or one of the addonExtensions.
-- We do not currently filter out non-file objects or files without execute permission.
hledgerExecutablesInPath :: IO [String]
hledgerExecutablesInPath :: IO [[Char]]
hledgerExecutablesInPath = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
isHledgerExeName ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [[Char]]
likelyExecutablesInPath

isHledgerExeName :: String -> Bool
isHledgerExeName :: [Char] -> Bool
isHledgerExeName = Either (ParseErrorBundle Text HledgerParseErrorData) () -> Bool
forall a b. Either a b -> Bool
isRight (Either (ParseErrorBundle Text HledgerParseErrorData) () -> Bool)
-> ([Char]
    -> Either (ParseErrorBundle Text HledgerParseErrorData) ())
-> [Char]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec HledgerParseErrorData Text ()
-> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) ()
forall e a.
Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
parsewith Parsec HledgerParseErrorData Text ()
forall {m :: * -> *}. ParsecT HledgerParseErrorData Text m ()
hledgerexenamep (Text -> Either (ParseErrorBundle Text HledgerParseErrorData) ())
-> ([Char] -> Text)
-> [Char]
-> Either (ParseErrorBundle Text HledgerParseErrorData) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
 where
  hledgerexenamep :: ParsecT HledgerParseErrorData Text m ()
hledgerexenamep = do
    Tokens Text
_ <- Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text))
-> Tokens Text
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
progname
    Char
_ <- Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-'
    [Token Text]
_ <- ParsecT HledgerParseErrorData Text m (Token Text)
-> ParsecT HledgerParseErrorData Text m [Token Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT HledgerParseErrorData Text m (Token Text)
 -> ParsecT HledgerParseErrorData Text m [Token Text])
-> ParsecT HledgerParseErrorData Text m (Token Text)
-> ParsecT HledgerParseErrorData Text m [Token Text]
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT HledgerParseErrorData Text m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'.']
    ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"." ParsecT HledgerParseErrorData Text m (Tokens Text)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ParsecT HledgerParseErrorData Text m Text]
-> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' (([Char] -> ParsecT HledgerParseErrorData Text m Text)
-> [[Char]] -> [ParsecT HledgerParseErrorData Text m Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ParsecT HledgerParseErrorData Text m Text
Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ParsecT HledgerParseErrorData Text m Text)
-> ([Char] -> Text)
-> [Char]
-> ParsecT HledgerParseErrorData Text m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) [[Char]]
addonExtensions))
    ParsecT HledgerParseErrorData Text m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

-- stripAddonExtension :: String -> String
-- stripAddonExtension = regexReplace re "" where re = "\\.(" ++ intercalate "|" addonExtensions ++ ")$"

addonExtensions :: [String]
addonExtensions :: [[Char]]
addonExtensions =
  [[Char]
"bat"
  ,[Char]
"com"
  ,[Char]
"exe"
  ,[Char]
"hs"
  ,[Char]
"js"
  ,[Char]
"lhs"
  ,[Char]
"lua"
  ,[Char]
"php"
  ,[Char]
"pl"
  ,[Char]
"py"
  ,[Char]
"rb"
  ,[Char]
"rkt"
  ,[Char]
"sh"
  ,[Char]
"osh"
  ,[Char]
"ysh"
  ]

-- The test command is also 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]
  []
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
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.
-- Arguments following a -- argument will be passed to the tasty test runner,
-- and any arguments before -- will be passed as test-selecting -p patterns.
--
-- 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
  let
    args :: [[Char]]
args = [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"args" (RawOpts -> [[Char]]) -> RawOpts -> [[Char]]
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
    ([[Char]]
hledgerargs, [[Char]]
tastyargs0) = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"--") [[Char]]
args
    tastyargs :: [[Char]]
tastyargs = [Char] -> [[Char]] -> [[Char]]
forall a. Show a => [Char] -> a -> a
dbg1 [Char]
"tastyargs" ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]
"-p " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
a | [Char]
a <- [[Char]]
hledgerargs] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
1 [[Char]]
tastyargs0
  [[Char]] -> IO () -> IO ()
forall a. [[Char]] -> IO a -> IO a
withArgs [[Char]]
tastyargs (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    TestTree -> IO ()
Test.Tasty.defaultMain (TestTree -> IO ()) -> TestTree -> IO ()
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" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let
          ignoresourcepos :: Journal -> Journal
ignoresourcepos Journal
j = Journal
j{jtxns=map (\Transaction
t -> Transaction
t{tsourcepos=nullsourcepospair}) (jtxns j)}
          sameParse :: Text -> Text -> IO ()
sameParse Text
str1 Text
str2 = do
            Journal
j1 <- Journal -> Journal
ignoresourcepos (Journal -> Journal) -> IO Journal -> IO Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Journal
readJournal'' Text
str1  -- PARTIAL:
            Journal
j2 <- Journal -> Journal
ignoresourcepos (Journal -> Journal) -> IO Journal -> IO Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Journal
readJournal'' Text
str2  -- PARTIAL:
            Journal
j1 Journal -> Journal -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Journal
j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1}
        Text -> Text -> IO ()
sameParse
           (Text
"2008/12/07 One\n  alpha  $-1\n  beta  $1\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"apply account outer\n2008/12/07 Two\n  aigh  $-2\n  bee  $2\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"apply account inner\n2008/12/07 Three\n  gamma  $-3\n  delta  $3\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"end apply account\n2008/12/07 Four\n  why  $-4\n  zed  $4\n" Text -> Text -> Text
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"2008/12/07 Two\n  outer:aigh  $-2\n  outer:bee  $2\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"2008/12/07 Three\n  outer:inner:gamma  $-3\n  outer:inner:delta  $3\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"2008/12/07 Four\n  outer:why  $-4\n  outer:zed  $4\n" Text -> Text -> Text
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" (IO () -> TestTree) -> IO () -> TestTree
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 = [Posting] -> Posting
forall a. HasCallStack => [a] -> a
headErr ([Posting] -> Posting) -> [Posting] -> Posting
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings (Transaction -> [Posting]) -> Transaction -> [Posting]
forall a b. (a -> b) -> a -> b
$ [Transaction] -> Transaction
forall a. HasCallStack => [a] -> a
headErr ([Transaction] -> Transaction) -> [Transaction] -> Transaction
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j  -- PARTIAL headErrs succeed because txns & postings provided
      Posting -> Text
paccount Posting
p Text -> Text -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Text
"test:from"
      Posting -> PostingType
ptype Posting
p PostingType -> PostingType -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= PostingType
VirtualPosting
    ]

  ,[Char] -> IO () -> TestTree
testCase [Char]
"alias directive" (IO () -> TestTree) -> IO () -> TestTree
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 = [Posting] -> Posting
forall a. HasCallStack => [a] -> a
headErr ([Posting] -> Posting) -> [Posting] -> Posting
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings (Transaction -> [Posting]) -> Transaction -> [Posting]
forall a b. (a -> b) -> a -> b
$ [Transaction] -> Transaction
forall a. HasCallStack => [a] -> a
headErr ([Transaction] -> Transaction) -> [Transaction] -> Transaction
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j  -- PARTIAL headErrs succeed because txns & postings provided
    Posting -> Text
paccount Posting
p Text -> Text -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Text
"equity:draw:personal:food"

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

  ,[Char] -> IO () -> TestTree
testCase [Char]
"ledgerAccountNames" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
    (Ledger -> [Text]
ledgerAccountNames Ledger
ledger7)
    [Text] -> [Text] -> IO ()
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" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ Amount -> [Char]
showAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1) [Char] -> [Char] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [Char]
"$1.00"

  ,[Char] -> IO () -> TestTree
testCase [Char]
"show hours" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ Amount -> [Char]
showAmount (DecimalRaw Integer -> Amount
hrs DecimalRaw Integer
1) [Char] -> [Char] -> IO ()
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 =
          [
           txnTieKnot Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 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)
                 ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 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)
                 ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 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)
                 ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 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)
                 ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 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)
                 ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 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)
                 ],
             tprecedingcomment=""
           }
          ]
         }

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