{-|
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.
-}

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

module Hledger.Cli.Commands (
   findCommand
  ,testcmd
  ,builtinCommands
  ,builtinCommandNames
  ,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.Checkdates
  ,module Hledger.Cli.Commands.Checkdupes
  ,module Hledger.Cli.Commands.Close
  ,module Hledger.Cli.Commands.Codes
  ,module Hledger.Cli.Commands.Commodities
  ,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.Printunique
  ,module Hledger.Cli.Commands.Register
  ,module Hledger.Cli.Commands.Registermatch
  ,module Hledger.Cli.Commands.Rewrite
  ,module Hledger.Cli.Commands.Stats
  ,module Hledger.Cli.Commands.Tags
) 
where

import Data.Char (isSpace)
import Data.Default
import Data.List
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
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.Checkdates
import Hledger.Cli.Commands.Checkdupes
import Hledger.Cli.Commands.Close
import Hledger.Cli.Commands.Codes
import Hledger.Cli.Commands.Commodities
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.Printunique
import Hledger.Cli.Commands.Register
import Hledger.Cli.Commands.Registermatch
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
checkdatesmode         , CliOpts -> Journal -> IO ()
checkdates)
  ,(Mode RawOpts
checkdupesmode         , CliOpts -> Journal -> IO ()
forall p. p -> Journal -> IO ()
checkdupes)
  ,(Mode RawOpts
closemode              , CliOpts -> Journal -> IO ()
close)
  ,(Mode RawOpts
codesmode              , CliOpts -> Journal -> IO ()
codes)
  ,(Mode RawOpts
commoditiesmode        , CliOpts -> Journal -> IO ()
commodities)
  ,(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
printuniquemode        , CliOpts -> Journal -> IO ()
printunique)
  ,(Mode RawOpts
registermatchmode      , CliOpts -> Journal -> IO ()
registermatch)
  ,(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)
  ]

-- | 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 :: String -> [String] -> [String]
commandsList String
progversion [String]
othercmds = [
  -- keep synced with hledger.m4.md -> Commands -->
   String
"-------------------------------------------------------------------------------"
  ,String
progversion
  ,String
"Usage: hledger COMMAND [OPTIONS] [-- ADDONCMDOPTIONS]"
  ,String
"Commands (+ addons found in $PATH):"
  ,String
""
  ,String
"Data entry (these commands modify the journal file):"
  ,String
" add                      add transactions using guided prompts"
  ,String
"+iadd                     add transactions using curses ui"
  ,String
" import                   add any new transactions from other files (eg csv)"
  ,String
""
  ,String
"Data management:"
  ,String
"+autosync                 download/deduplicate/convert OFX data"
  ,String
" check                    check for various kinds of issue in the data"
  ,String
"+check-fancyassertions    check more powerful balance assertions"
  ,String
"+check-tagfiles           check file paths in tag values exist"
  ,String
" close (equity)           generate balance-resetting transactions"
  ,String
" diff                     compare account transactions in two journal files"
  ,String
"+interest                 generate interest transactions"
  ,String
" rewrite                  generate extra postings, similar to print --auto"
  ,String
""
  ,String
"Financial reports:"
  ,String
" aregister (areg)         show transactions in a particular account"
  ,String
" balancesheet (bs)        show assets, liabilities and net worth"
  ,String
" balancesheetequity (bse) show assets, liabilities and equity"
  ,String
" cashflow (cf)            show changes in liquid assets"
  ,String
" incomestatement (is)     show revenues and expenses"
  ,String
" roi                      show return on investments"
  ,String
""
  ,String
"Low-level reports:"
  ,String
" accounts (a)             show account names"
  ,String
" activity                 show postings-per-interval bar charts"
  ,String
" balance (b, bal)         show balance changes/end balances/budgets in accounts"
  ,String
" codes                    show transaction codes"
  ,String
" commodities              show commodity/currency symbols"
  ,String
" descriptions             show unique transaction descriptions"
  ,String
" files                    show input file paths"
  ,String
" notes                    show unique note segments of transaction descriptions"
  ,String
" payees                   show unique payee segments of transaction descriptions"
  ,String
" prices                   show market price records"
  ,String
" print (p, txns)          show transactions (journal entries)"
  ,String
" print-unique             show only transactions with unique descriptions"
  ,String
" register (r, reg)        show postings in one or more accounts & running total"
  ,String
" register-match           show a recent posting that best matches a description"
  ,String
" stats                    show journal statistics"
  ,String
" tags                     show tag names"
  ,String
" test                     run self tests"
  ,String
""
  ,String
"Alternate user interfaces:"
  ,String
"+ui                       run curses ui"
  ,String
"+web                      run web ui"
  ,String
""
  ,String
"Other:"
  ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  [String]
othercmds
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  [String
"Help:"
  ,String
" (no arguments)           show this commands list"
  ,String
" -h                       show general flags"
  ,String
" COMMAND -h               show flags & docs for COMMAND"
  ,String
" help [MANUAL]            show hledger manuals in various formats"
  ,String
""
  ]
-- commands                 show brief commands list
-- edit                     open a text editor on some part of the journal
-- aregister (ar, areg)     show transactions in a single account


-- | All names and aliases of builtin commands.
builtinCommandNames :: [String]
builtinCommandNames :: [String]
builtinCommandNames = ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> [String])
-> [(Mode RawOpts, CliOpts -> Journal -> IO ())] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Mode RawOpts -> [String]
forall a. Mode a -> [String]
modeNames (Mode RawOpts -> [String])
-> ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts)
-> (Mode RawOpts, CliOpts -> Journal -> IO ())
-> [String]
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. 
findCommand :: String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()) 
findCommand :: String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findCommand String
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 (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
cmdname ([String] -> Bool)
-> ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> [String])
-> (Mode RawOpts, CliOpts -> Journal -> IO ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode RawOpts -> [String]
forall a. Mode a -> [String]
modeNames (Mode RawOpts -> [String])
-> ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts)
-> (Mode RawOpts, CliOpts -> Journal -> IO ())
-> [String]
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 

-- | Extract the command names from commandsList: the first word
-- of lines beginning with a space or + sign.
commandsFromCommandsList :: [String] -> [String]
commandsFromCommandsList :: [String] -> [String]
commandsFromCommandsList [String]
s =
  [String
w | Char
c:String
l <- [String]
s, Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ',Char
'+'], let String
w:[String]
_ = String -> [String]
words String
l]

knownCommands :: [String]
knownCommands :: [String]
knownCommands = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
commandsFromCommandsList ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
commandsList String
prognameandversion []

-- | Print the commands list, modifying the template above based on
-- the currently available addons. Missing addons will be removed, and
-- extra addons will be added under Misc.
printCommandsList :: [String] -> IO ()
printCommandsList :: [String] -> IO ()
printCommandsList [String]
addonsFound =
    String -> IO ()
putStr (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
adjustline ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> [String] -> [String]
commandsList String
prognameandversion ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char
'+'Char -> String -> String
forall a. a -> [a] -> [a]
:) [String]
unknownCommandsFound)
  where
    commandsFound :: [String]
commandsFound = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) [String]
builtinCommandNames [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char
'+'Char -> String -> String
forall a. a -> [a] -> [a]
:) [String]
addonsFound
    unknownCommandsFound :: [String]
unknownCommandsFound = [String]
addonsFound [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
knownCommands

    adjustline :: String -> [String]
adjustline String
l         | String
" hledger " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l     = [String
l]
    adjustline l :: String
l@(Char
'+':String
_) | String
cmd String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
commandsFound = []
      where
        cmd :: String
cmd = (Char -> Bool) -> String -> String
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) String
l
    adjustline String
l = [String
l]


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

testmode :: Mode RawOpts
testmode = String
-> [Flag RawOpts]
-> [(String, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Test.txt")
  []
  [(String, [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
$ String -> Arg RawOpts
argsFlag String
"[-- 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
  [String] -> IO () -> IO ()
forall a. [String] -> IO a -> IO a
withArgs (String -> RawOpts -> [String]
listofstringopt String
"args" (RawOpts -> [String]) -> RawOpts -> [String]
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts) (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
$ String -> [TestTree] -> TestTree
tests String
"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 = String -> [TestTree] -> TestTree
tests String
"Hledger.Cli" [
   TestTree
tests_Cli_Utils
  ,TestTree
tests_Commands
  ]

tests_Commands :: TestTree
tests_Commands = String -> [TestTree] -> TestTree
tests String
"Commands" [
   TestTree
tests_Balance
  ,TestTree
tests_Register
  ,TestTree
tests_Aregister

  -- some more tests easiest to define here:

  ,String -> [TestTree] -> TestTree
tests String
"apply account directive" [
     String -> IO () -> TestTree
test String
"works" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        let
          ignoresourcepos :: Journal -> Journal
ignoresourcepos Journal
j = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (\Transaction
t -> Transaction
t{tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos}) (Journal -> [Transaction]
jtxns Journal
j)}
          sameParse :: Text -> Text -> IO ()
sameParse Text
str1 Text
str2 = do
            Journal
j1 <- InputOpts -> Maybe String -> Text -> IO (Either String Journal)
readJournal InputOpts
forall a. Default a => a
def Maybe String
forall a. Maybe a
Nothing Text
str1 IO (Either String Journal)
-> (Either String Journal -> IO Journal) -> IO Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Journal)
-> (Journal -> IO Journal) -> Either String Journal -> IO Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Journal
forall a. String -> a
error' (Journal -> IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal -> IO Journal)
-> (Journal -> Journal) -> Journal -> IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Journal
ignoresourcepos)  -- PARTIAL:
            Journal
j2 <- InputOpts -> Maybe String -> Text -> IO (Either String Journal)
readJournal InputOpts
forall a. Default a => a
def Maybe String
forall a. Maybe a
Nothing Text
str2 IO (Either String Journal)
-> (Either String Journal -> IO Journal) -> IO Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Journal)
-> (Journal -> IO Journal) -> Either String Journal -> IO Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Journal
forall a. String -> a
error' (Journal -> IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal -> IO Journal)
-> (Journal -> Journal) -> Journal -> IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Journal
ignoresourcepos)
            Journal
j1 Journal -> Journal -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Journal
j2{jlastreadtime :: ClockTime
jlastreadtime=Journal -> ClockTime
jlastreadtime Journal
j1, jfiles :: [(String, Text)]
jfiles=Journal -> [(String, Text)]
jfiles Journal
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"
           )

    ,String -> IO () -> TestTree
test String
"preserves \"virtual\" posting type" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Journal
j <- InputOpts -> Maybe String -> Text -> IO (Either String Journal)
readJournal InputOpts
forall a. Default a => a
def Maybe String
forall a. Maybe a
Nothing Text
"apply account test\n2008/12/07 One\n  (from)  $-1\n  (to)  $1\n" IO (Either String Journal)
-> (Either String Journal -> IO Journal) -> IO Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Journal)
-> (Journal -> IO Journal) -> Either String Journal -> IO Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Journal
forall a. String -> a
error' Journal -> IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return  -- PARTIAL:
      let p :: Posting
p = [Posting] -> Posting
forall a. [a] -> a
head ([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. [a] -> a
head ([Transaction] -> Transaction) -> [Transaction] -> Transaction
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
      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
    ]

  ,String -> IO () -> TestTree
test String
"alias directive" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    Journal
j <- InputOpts -> Maybe String -> Text -> IO (Either String Journal)
readJournal InputOpts
forall a. Default a => a
def Maybe String
forall a. Maybe a
Nothing Text
"!alias expenses = equity:draw:personal\n1/1\n (expenses:food)  1\n" IO (Either String Journal)
-> (Either String Journal -> IO Journal) -> IO Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Journal)
-> (Journal -> IO Journal) -> Either String Journal -> IO Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Journal
forall a. String -> a
error' Journal -> IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return  -- PARTIAL:
    let p :: Posting
p = [Posting] -> Posting
forall a. [a] -> a
head ([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. [a] -> a
head ([Transaction] -> Transaction) -> [Transaction] -> Transaction
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
    Posting -> Text
paccount Posting
p Text -> Text -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Text
"equity:draw:personal:food"

  ,String -> IO () -> TestTree
test String
"Y default year directive" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    Journal
j <- InputOpts -> Maybe String -> Text -> IO (Either String Journal)
readJournal InputOpts
forall a. Default a => a
def Maybe String
forall a. Maybe a
Nothing Text
defaultyear_journal_txt IO (Either String Journal)
-> (Either String Journal -> IO Journal) -> IO Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Journal)
-> (Journal -> IO Journal) -> Either String Journal -> IO Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Journal
forall a. String -> a
error' Journal -> IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return  -- PARTIAL:
    Transaction -> Day
tdate ([Transaction] -> Transaction
forall a. [a] -> a
head ([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

  ,String -> IO () -> TestTree
test String
"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"]

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

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

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

  ,String -> IO () -> TestTree
test String
"show hours" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ Amount -> String
showAmount (DecimalRaw Integer -> Amount
hrs DecimalRaw Integer
1) String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= String
"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 :: Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
01,
             tdate2 :: Maybe Day
tdate2=Maybe Day
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 :: Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
02 Int
01,
             tdate2 :: Maybe Day
tdate2=Maybe Day
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 :: Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
02,
             tdate2 :: Maybe Day
tdate2=Maybe Day
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 :: Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
03,
             tdate2 :: Maybe Day
tdate2=Maybe Day
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 :: Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
03,
             tdate2 :: Maybe Day
tdate2=Maybe Day
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 :: Integer
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Integer
tindex=Integer
0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
03,
             tdate2 :: Maybe Day
tdate2=Maybe Day
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