{-|

A ledger-compatible @register@ command.

-}

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

module Hledger.Cli.Commands.Register (
  registermode
 ,register
 ,postingsReportAsText
 ,postingsReportItemAsText
 -- ,showPostingWithBalanceForVty
 ,tests_Register
) where

import Data.List
import Data.Maybe
-- import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time (fromGregorian)
import System.Console.CmdArgs.Explicit
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils

registermode :: Mode RawOpts
registermode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Register.txt")
  ([[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["cumulative"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "change")
     "show running total from report start date (default)"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["historical","H"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "historical")
     "show historical running total/balance (includes postings before report start date)\n "
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["average","A"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "average")
     "show running average of posting amounts instead of total (implies --empty)"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["related","r"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "related") "show postings' siblings instead"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["invert"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "invert") "display all amounts with reversed sign"
  ,[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq  ["width","w"] (\s :: CommandDoc
s opts :: RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt "width" CommandDoc
s RawOpts
opts) "N"
     ("set output width (default: " CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++
#ifdef mingw32_HOST_OS
      show defaultWidth
#else
      "terminal width"
#endif
      CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ " or $COLUMNS). -wN,M sets description width as well."
     )
  ,[CommandDoc] -> Flag RawOpts
outputFormatFlag ["txt","csv","json"]
  ,Flag RawOpts
outputFileFlag
  ])
  [(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
  [Flag RawOpts]
hiddenflags
  ([], 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
$ CommandDoc -> Arg RawOpts
argsFlag "[QUERY]")

-- | Print a (posting) register report.
register :: CliOpts -> Journal -> IO ()
register :: CliOpts -> Journal -> IO ()
register opts :: CliOpts
opts@CliOpts{reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} j :: Journal
j = do
  Day
d <- IO Day
getCurrentDay
  let fmt :: CommandDoc
fmt = CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts
      render :: CliOpts -> PostingsReport -> CommandDoc
render | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
=="txt"  = CliOpts -> PostingsReport -> CommandDoc
postingsReportAsText
             | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
=="csv"  = (PostingsReport -> CommandDoc)
-> CliOpts -> PostingsReport -> CommandDoc
forall a b. a -> b -> a
const ((CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++"\n") (CommandDoc -> CommandDoc)
-> (PostingsReport -> CommandDoc) -> PostingsReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> CommandDoc
printCSV (CSV -> CommandDoc)
-> (PostingsReport -> CSV) -> PostingsReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> CSV
postingsReportAsCsv)
             | CommandDoc
fmtCommandDoc -> CommandDoc -> Bool
forall a. Eq a => a -> a -> Bool
=="json" = (PostingsReport -> CommandDoc)
-> CliOpts -> PostingsReport -> CommandDoc
forall a b. a -> b -> a
const ((CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++"\n") (CommandDoc -> CommandDoc)
-> (PostingsReport -> CommandDoc) -> PostingsReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CommandDoc
TL.unpack (Text -> CommandDoc)
-> (PostingsReport -> Text) -> PostingsReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReport -> Text
forall a. ToJSON a => a -> Text
toJsonText)
             | Bool
otherwise   = (PostingsReport -> CommandDoc)
-> CliOpts -> PostingsReport -> CommandDoc
forall a b. a -> b -> a
const ((PostingsReport -> CommandDoc)
 -> CliOpts -> PostingsReport -> CommandDoc)
-> (PostingsReport -> CommandDoc)
-> CliOpts
-> PostingsReport
-> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> PostingsReport -> CommandDoc
forall a. CommandDoc -> a
error' (CommandDoc -> PostingsReport -> CommandDoc)
-> CommandDoc -> PostingsReport -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
unsupportedOutputFormatError CommandDoc
fmt  -- PARTIAL:
  CliOpts -> CommandDoc -> IO ()
writeOutput CliOpts
opts (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ CliOpts -> PostingsReport -> CommandDoc
render CliOpts
opts (PostingsReport -> CommandDoc) -> PostingsReport -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query -> Journal -> PostingsReport
postingsReport ReportOpts
ropts (Day -> ReportOpts -> Query
queryFromOpts Day
d ReportOpts
ropts) Journal
j

postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv (_,is :: [PostingsReportItem]
is) =
  ["txnidx","date","code","description","account","amount","total"]
  [CommandDoc] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
  (PostingsReportItem -> [CommandDoc]) -> [PostingsReportItem] -> CSV
forall a b. (a -> b) -> [a] -> [b]
map PostingsReportItem -> [CommandDoc]
postingsReportItemAsCsvRecord [PostingsReportItem]
is

postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord
postingsReportItemAsCsvRecord :: PostingsReportItem -> [CommandDoc]
postingsReportItemAsCsvRecord (_, _, _, p :: Posting
p, b :: MixedAmount
b) = [CommandDoc
idx,CommandDoc
date,CommandDoc
code,CommandDoc
desc,CommandDoc
acct,CommandDoc
amt,CommandDoc
bal]
  where
    idx :: CommandDoc
idx  = Integer -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Integer -> CommandDoc) -> Integer -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Integer -> (Transaction -> Integer) -> Maybe Transaction -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 Transaction -> Integer
tindex (Maybe Transaction -> Integer) -> Maybe Transaction -> Integer
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    date :: CommandDoc
date = Day -> CommandDoc
showDate (Day -> CommandDoc) -> Day -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Posting -> Day
postingDate Posting
p -- XXX csv should show date2 with --date2
    code :: CommandDoc
code = CommandDoc
-> (Transaction -> CommandDoc) -> Maybe Transaction -> CommandDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (Text -> CommandDoc
T.unpack (Text -> CommandDoc)
-> (Transaction -> Text) -> Transaction -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
tcode) (Maybe Transaction -> CommandDoc)
-> Maybe Transaction -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    desc :: CommandDoc
desc = Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Text -> (Transaction -> Text) -> Maybe Transaction -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" Transaction -> Text
tdescription (Maybe Transaction -> Text) -> Maybe Transaction -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
    acct :: CommandDoc
acct = CommandDoc -> CommandDoc
bracket (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Posting -> Text
paccount Posting
p
      where
        bracket :: CommandDoc -> CommandDoc
bracket = case Posting -> PostingType
ptype Posting
p of
                             BalancedVirtualPosting -> (\s :: CommandDoc
s -> "["CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
sCommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++"]")
                             VirtualPosting -> (\s :: CommandDoc
s -> "("CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
sCommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++")")
                             _ -> CommandDoc -> CommandDoc
forall a. a -> a
id
    amt :: CommandDoc
amt = Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
False (MixedAmount -> CommandDoc) -> MixedAmount -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
    bal :: CommandDoc
bal = Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
False MixedAmount
b

-- | Render a register report as plain text suitable for console output.
postingsReportAsText :: CliOpts -> PostingsReport -> String
postingsReportAsText :: CliOpts -> PostingsReport -> CommandDoc
postingsReportAsText opts :: CliOpts
opts (_,items :: [PostingsReportItem]
items) = [CommandDoc] -> CommandDoc
unlines ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ (PostingsReportItem -> CommandDoc)
-> [PostingsReportItem] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map (CliOpts -> Int -> Int -> PostingsReportItem -> CommandDoc
postingsReportItemAsText CliOpts
opts Int
amtwidth Int
balwidth) [PostingsReportItem]
items
  where
    amtwidth :: Int
amtwidth = [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ 12 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (PostingsReportItem -> Int) -> [PostingsReportItem] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CommandDoc -> Int
strWidth (CommandDoc -> Int)
-> (PostingsReportItem -> CommandDoc) -> PostingsReportItem -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> CommandDoc
showMixedAmount (MixedAmount -> CommandDoc)
-> (PostingsReportItem -> MixedAmount)
-> PostingsReportItem
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReportItem -> MixedAmount
forall a b c e. (a, b, c, Posting, e) -> MixedAmount
itemamt) [PostingsReportItem]
items
    balwidth :: Int
balwidth = [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ 12 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (PostingsReportItem -> Int) -> [PostingsReportItem] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CommandDoc -> Int
strWidth (CommandDoc -> Int)
-> (PostingsReportItem -> CommandDoc) -> PostingsReportItem -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> CommandDoc
showMixedAmount (MixedAmount -> CommandDoc)
-> (PostingsReportItem -> MixedAmount)
-> PostingsReportItem
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingsReportItem -> MixedAmount
forall a b c d e. (a, b, c, d, e) -> e
itembal) [PostingsReportItem]
items
    itemamt :: (a, b, c, Posting, e) -> MixedAmount
itemamt (_,_,_,Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
a},_) = MixedAmount
a
    itembal :: (a, b, c, d, e) -> e
itembal (_,_,_,_,a :: e
a) = e
a

-- | Render one register report line item as plain text. Layout is like so:
-- @
-- <---------------- width (specified, terminal width, or 80) -------------------->
-- date (10)  description           account              amount (12)   balance (12)
-- DDDDDDDDDD dddddddddddddddddddd  aaaaaaaaaaaaaaaaaaa  AAAAAAAAAAAA  AAAAAAAAAAAA
-- @
-- If description's width is specified, account will use the remaining space.
-- Otherwise, description and account divide up the space equally.
--
-- With a report interval, the layout is like so:
-- @
-- <---------------- width (specified, terminal width, or 80) -------------------->
-- date (21)              account                        amount (12)   balance (12)
-- DDDDDDDDDDDDDDDDDDDDD  aaaaaaaaaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAAA  AAAAAAAAAAAA
-- @
--
-- date and description are shown for the first posting of a transaction only.
--
-- Returns a string which can be multi-line, eg if the running balance
-- has multiple commodities. Does not yet support formatting control
-- like balance reports.
--
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> String
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> CommandDoc
postingsReportItemAsText opts :: CliOpts
opts preferredamtwidth :: Int
preferredamtwidth preferredbalwidth :: Int
preferredbalwidth (mdate :: Maybe Day
mdate, menddate :: Maybe Day
menddate, mdesc :: Maybe CommandDoc
mdesc, p :: Posting
p, b :: MixedAmount
b) =
  -- use elide*Width to be wide-char-aware
  -- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $
  CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$
    [CommandDoc] -> CommandDoc
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
datewidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
datewidth) Bool
True Bool
True CommandDoc
date
           ," "
           ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
descwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
descwidth) Bool
True Bool
True CommandDoc
desc
           ,"  "
           ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctwidth) Bool
True Bool
True CommandDoc
acct
           ,"  "
           ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) Bool
True Bool
False CommandDoc
amtfirstline
           ,"  "
           ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
balwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
balwidth) Bool
True Bool
False CommandDoc
balfirstline
           ]
    CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:
    [[CommandDoc] -> CommandDoc
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [CommandDoc
spacer
            ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtwidth) Bool
True Bool
False CommandDoc
a
            ,"  "
            ,Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
balwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
balwidth) Bool
True Bool
False CommandDoc
b
            ]
     | (a :: CommandDoc
a,b :: CommandDoc
b) <- [CommandDoc] -> [CommandDoc] -> [(CommandDoc, CommandDoc)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CommandDoc]
amtrest [CommandDoc]
balrest
     ]
    where
      -- calculate widths
      (totalwidth :: Int
totalwidth,mdescwidth :: Maybe Int
mdescwidth) = CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts
opts
      (datewidth :: Int
datewidth, date :: CommandDoc
date) = case (Maybe Day
mdate,Maybe Day
menddate) of
                            (Just _, Just _)   -> (21, DateSpan -> CommandDoc
showDateSpan (Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
mdate Maybe Day
menddate))
                            (Nothing, Just _)  -> (21, "")
                            (Just d :: Day
d, Nothing)  -> (10, Day -> CommandDoc
showDate Day
d)
                            _                  -> (10, "")
      (amtwidth :: Int
amtwidth, balwidth :: Int
balwidth)
        | Int
shortfall Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = (Int
preferredamtwidth, Int
preferredbalwidth)
        | Bool
otherwise      = (Int
adjustedamtwidth, Int
adjustedbalwidth)
        where
          mincolwidth :: Int
mincolwidth = 2 -- columns always show at least an ellipsis
          maxamtswidth :: Int
maxamtswidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int
totalwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
datewidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mincolwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mincolwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2))
          shortfall :: Int
shortfall = (Int
preferredamtwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
preferredbalwidth) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxamtswidth
          amtwidthproportion :: Double
amtwidthproportion = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
preferredamtwidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
preferredamtwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
preferredbalwidth)
          adjustedamtwidth :: Int
adjustedamtwidth = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
amtwidthproportion Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxamtswidth
          adjustedbalwidth :: Int
adjustedbalwidth = Int
maxamtswidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
adjustedamtwidth

      remaining :: Int
remaining = Int
totalwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
datewidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amtwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
balwidth)
      (descwidth :: Int
descwidth, acctwidth :: Int
acctwidth)
        | Bool
hasinterval = (0, Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
        | Bool
otherwise   = (Int
w, Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)
        where
            hasinterval :: Bool
hasinterval = Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust Maybe Day
menddate
            w :: Int
w = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ((Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) Maybe Int
mdescwidth

      -- gather content
      desc :: CommandDoc
desc = CommandDoc -> Maybe CommandDoc -> CommandDoc
forall a. a -> Maybe a -> a
fromMaybe "" Maybe CommandDoc
mdesc
      acct :: CommandDoc
acct = CommandDoc -> CommandDoc
parenthesise (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
elideAccountName Int
awidth (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Text
paccount Posting
p
         where
          (parenthesise :: CommandDoc -> CommandDoc
parenthesise, awidth :: Int
awidth) =
            case Posting -> PostingType
ptype Posting
p of
              BalancedVirtualPosting -> (\s :: CommandDoc
s -> "["CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
sCommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++"]", Int
acctwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-2)
              VirtualPosting         -> (\s :: CommandDoc
s -> "("CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++CommandDoc
sCommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++")", Int
acctwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-2)
              _                      -> (CommandDoc -> CommandDoc
forall a. a -> a
id,Int
acctwidth)
      showamt :: MixedAmount -> CommandDoc
showamt = Bool -> MixedAmount -> CommandDoc
showMixedAmountWithoutPrice (ReportOpts -> Bool
color_ (ReportOpts -> Bool) -> ReportOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportOpts
reportopts_ CliOpts
opts)
      amt :: CommandDoc
amt = MixedAmount -> CommandDoc
showamt (MixedAmount -> CommandDoc) -> MixedAmount -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
      bal :: CommandDoc
bal = MixedAmount -> CommandDoc
showamt MixedAmount
b
      -- alternate behaviour, show null amounts as 0 instead of blank
      -- amt = if null amt' then "0" else amt'
      -- bal = if null bal' then "0" else bal'
      (amtlines :: [CommandDoc]
amtlines, ballines :: [CommandDoc]
ballines) = (CommandDoc -> [CommandDoc]
lines CommandDoc
amt, CommandDoc -> [CommandDoc]
lines CommandDoc
bal)
      (amtlen :: Int
amtlen, ballen :: Int
ballen) = ([CommandDoc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CommandDoc]
amtlines, [CommandDoc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CommandDoc]
ballines)
      numlines :: Int
numlines = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
amtlen Int
ballen)
      (amtfirstline :: CommandDoc
amtfirstline:amtrest :: [CommandDoc]
amtrest) = Int -> [CommandDoc] -> [CommandDoc]
forall a. Int -> [a] -> [a]
take Int
numlines ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ [CommandDoc]
amtlines [CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ CommandDoc -> [CommandDoc]
forall a. a -> [a]
repeat "" -- posting amount is top-aligned
      (balfirstline :: CommandDoc
balfirstline:balrest :: [CommandDoc]
balrest) = Int -> [CommandDoc] -> [CommandDoc]
forall a. Int -> [a] -> [a]
take Int
numlines ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ Int -> CommandDoc -> [CommandDoc]
forall a. Int -> a -> [a]
replicate (Int
numlines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ballen) "" [CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ [CommandDoc]
ballines -- balance amount is bottom-aligned
      spacer :: CommandDoc
spacer = Int -> Char -> CommandDoc
forall a. Int -> a -> [a]
replicate (Int
totalwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
amtwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
balwidth)) ' '

-- tests

tests_Register :: TestTree
tests_Register = CommandDoc -> [TestTree] -> TestTree
tests "Register" [

   CommandDoc -> [TestTree] -> TestTree
tests "postingsReportAsText" [
    CommandDoc -> IO () -> TestTree
test "unicode in register layout" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Journal
j <- Text -> IO Journal
readJournal' "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
      let opts :: ReportOpts
opts = ReportOpts
defreportopts
      (CliOpts -> PostingsReport -> CommandDoc
postingsReportAsText CliOpts
defcliopts (PostingsReport -> CommandDoc) -> PostingsReport -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query -> Journal -> PostingsReport
postingsReport ReportOpts
opts (Day -> ReportOpts -> Query
queryFromOpts (Integer -> Int -> Int -> Day
fromGregorian 2008 11 26) ReportOpts
opts) Journal
j)
        CommandDoc -> CommandDoc -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        [CommandDoc] -> CommandDoc
unlines
        ["2009-01-01 медвежья шкура       расходы:покупки                100           100"
        ,"                                актив:наличные                -100             0"]
   ]

 ]