    {-|

    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.Default (def)
    import Data.Maybe (fromMaybe, isJust)
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import qualified Data.Text.Lazy.IO as TL
    import qualified Data.Text.Lazy.Builder as TB
    import System.Console.CmdArgs.Explicit (flagNone, flagReq)

    import Hledger hiding (per)
    import Hledger.Read.CsvUtils (CSV, CsvRecord, printCSV)
    import Hledger.Cli.CliOptions
    import Hledger.Cli.Utils
    import Text.Tabular.AsciiWide hiding (render)
    import Data.List (sortBy)
    import Data.Char (toUpper)
    import Data.List.Extra (intersect)
    import System.Exit (exitFailure)

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

    -- | Print a (posting) register report.
    register :: CliOpts -> Journal -> IO ()
    register :: CliOpts -> Journal -> IO ()
    register opts :: CliOpts
    opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
    rawopts_=RawOpts
    rawopts, reportspec_ :: CliOpts -> ReportSpec
    reportspec_=ReportSpec
    rspec} Journal
    j
      -- match mode, print one recent posting most similar to given description, if any
      -- XXX should match similarly to print --match
      | Just String
    desc <- String -> RawOpts -> Maybe String
    maybestringopt String
    "match" RawOpts
    rawopts = do
          let ps :: [Posting]
    ps = [Posting
    p | (Maybe Day
    _,Maybe Period
    _,Maybe CsvValue
    _,Posting
    p,MixedAmount
    _) <- PostingsReport
    rpt]
          case [Posting] -> String -> Maybe Posting
    similarPosting [Posting]
    ps String
    desc of
            Maybe Posting
    Nothing -> String -> IO ()
    putStrLn String
    "no matches found." IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    forall a. IO a
    exitFailure
            Just Posting
    p  -> Text -> IO ()
    TL.putStr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CliOpts -> PostingsReport -> Text
    postingsReportAsText CliOpts
    opts [(Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
    forall {a}.
    (Maybe Day, Maybe a, Maybe CsvValue, Posting, MixedAmount)
    pri]
                      where pri :: (Maybe Day, Maybe a, Maybe CsvValue, Posting, MixedAmount)
    pri = (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Posting -> Day
    postingDate Posting
    p)
                                  ,Maybe a
    forall a. Maybe a
    Nothing
                                  ,Transaction -> CsvValue
    tdescription (Transaction -> CsvValue) -> Maybe Transaction -> Maybe CsvValue
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Posting -> Maybe Transaction
    ptransaction Posting
    p
                                  ,Posting
    p
                                  ,MixedAmount
    nullmixedamt)
      -- normal register report, list postings
      | Bool
    otherwise = CliOpts -> Text -> IO ()
    writeOutputLazyText CliOpts
    opts (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ PostingsReport -> Text
    render PostingsReport
    rpt
      where
        rpt :: PostingsReport
    rpt = ReportSpec -> Journal -> PostingsReport
    postingsReport ReportSpec
    rspec Journal
    j
        render :: PostingsReport -> Text
    render | String
    fmtString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    "txt"  = CliOpts -> PostingsReport -> Text
    postingsReportAsText CliOpts
    opts
               | String
    fmtString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    "csv"  = [CsvRecord] -> Text
    printCSV ([CsvRecord] -> Text)
    -> (PostingsReport -> [CsvRecord]) -> PostingsReport -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PostingsReport -> [CsvRecord]
    postingsReportAsCsv
               | String
    fmtString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    "json" = PostingsReport -> Text
    forall a. ToJSON a => a -> Text
    toJsonText
               | Bool
    otherwise   = String -> PostingsReport -> Text
    forall a. String -> a
    error' (String -> PostingsReport -> Text)
    -> String -> PostingsReport -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> String
    unsupportedOutputFormatError String
    fmt  -- PARTIAL:
          where fmt :: String
    fmt = CliOpts -> String
    outputFormatFromOpts CliOpts
    opts

    postingsReportAsCsv :: PostingsReport -> CSV
    postingsReportAsCsv :: PostingsReport -> [CsvRecord]
    postingsReportAsCsv PostingsReport
    is =
      [CsvValue
    "txnidx",CsvValue
    "date",CsvValue
    "code",CsvValue
    "description",CsvValue
    "account",CsvValue
    "amount",CsvValue
    "total"]
      CsvRecord -> [CsvRecord] -> [CsvRecord]
    forall a. a -> [a] -> [a]
    :
      ((Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
     -> CsvRecord)
    -> PostingsReport -> [CsvRecord]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
    -> CsvRecord
    postingsReportItemAsCsvRecord PostingsReport
    is

    postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord
    postingsReportItemAsCsvRecord :: (Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
    -> CsvRecord
    postingsReportItemAsCsvRecord (Maybe Day
    _, Maybe Period
    _, Maybe CsvValue
    _, Posting
    p, MixedAmount
    b) = [CsvValue
    idx,CsvValue
    date,CsvValue
    code,CsvValue
    desc,CsvValue
    acct,CsvValue
    amt,CsvValue
    bal]
      where
        idx :: CsvValue
    idx  = String -> CsvValue
    T.pack (String -> CsvValue)
    -> (Maybe Transaction -> String) -> Maybe Transaction -> CsvValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> String
    forall a. Show a => a -> String
    show (Integer -> String)
    -> (Maybe Transaction -> Integer) -> Maybe Transaction -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> (Transaction -> Integer) -> Maybe Transaction -> Integer
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Integer
    0 Transaction -> Integer
    tindex (Maybe Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
    forall a b. (a -> b) -> a -> b
    $ Posting -> Maybe Transaction
    ptransaction Posting
    p
        date :: CsvValue
    date = Day -> CsvValue
    showDate (Day -> CsvValue) -> Day -> CsvValue
    forall a b. (a -> b) -> a -> b
    $ Posting -> Day
    postingDate Posting
    p -- XXX csv should show date2 with --date2
        code :: CsvValue
    code = CsvValue
    -> (Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe CsvValue
    "" Transaction -> CsvValue
    tcode (Maybe Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
    forall a b. (a -> b) -> a -> b
    $ Posting -> Maybe Transaction
    ptransaction Posting
    p
        desc :: CsvValue
    desc = CsvValue
    -> (Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe CsvValue
    "" Transaction -> CsvValue
    tdescription (Maybe Transaction -> CsvValue) -> Maybe Transaction -> CsvValue
    forall a b. (a -> b) -> a -> b
    $ Posting -> Maybe Transaction
    ptransaction Posting
    p
        acct :: CsvValue
    acct = CsvValue -> CsvValue
    bracket (CsvValue -> CsvValue) -> CsvValue -> CsvValue
    forall a b. (a -> b) -> a -> b
    $ Posting -> CsvValue
    paccount Posting
    p
          where
            bracket :: CsvValue -> CsvValue
    bracket = case Posting -> PostingType
    ptype Posting
    p of
                                 PostingType
    BalancedVirtualPosting -> CsvValue -> CsvValue -> CsvValue -> CsvValue
    wrap CsvValue
    "[" CsvValue
    "]"
                                 PostingType
    VirtualPosting -> CsvValue -> CsvValue -> CsvValue -> CsvValue
    wrap CsvValue
    "(" CsvValue
    ")"
                                 PostingType
    _ -> CsvValue -> CsvValue
    forall a. a -> a
    id
        -- Since postingsReport strips prices from all Amounts when not used, we can display prices.
        amt :: CsvValue
    amt = WideBuilder -> CsvValue
    wbToText (WideBuilder -> CsvValue)
    -> (MixedAmount -> WideBuilder) -> MixedAmount -> CsvValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AmountDisplayOpts -> MixedAmount -> WideBuilder
    showMixedAmountB AmountDisplayOpts
    csvDisplay (MixedAmount -> CsvValue) -> MixedAmount -> CsvValue
    forall a b. (a -> b) -> a -> b
    $ Posting -> MixedAmount
    pamount Posting
    p
        bal :: CsvValue
    bal = WideBuilder -> CsvValue
    wbToText (WideBuilder -> CsvValue) -> WideBuilder -> CsvValue
    forall a b. (a -> b) -> a -> b
    $ AmountDisplayOpts -> MixedAmount -> WideBuilder
    showMixedAmountB AmountDisplayOpts
    csvDisplay MixedAmount
    b

    -- | Render a register report as plain text suitable for console output.
    postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text
    postingsReportAsText :: CliOpts -> PostingsReport -> Text
    postingsReportAsText CliOpts
    opts = Builder -> Text
    TB.toLazyText (Builder -> Text)
    -> (PostingsReport -> Builder) -> PostingsReport -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        Bool
    -> CliOpts
    -> (Int
        -> Int
        -> ((Maybe Day, Maybe Period, Maybe CsvValue, Posting,
             MixedAmount),
            [WideBuilder], [WideBuilder])
        -> Builder)
    -> ((Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
        -> MixedAmount)
    -> ((Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
        -> MixedAmount)
    -> PostingsReport
    -> Builder
    forall a.
    Bool
    -> CliOpts
    -> (Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> Builder)
    -> (a -> MixedAmount)
    -> (a -> MixedAmount)
    -> [a]
    -> Builder
    postingsOrTransactionsReportAsText Bool
    alignAll CliOpts
    opts (CliOpts
    -> Int
    -> Int
    -> ((Maybe Day, Maybe Period, Maybe CsvValue, Posting,
         MixedAmount),
        [WideBuilder], [WideBuilder])
    -> Builder
    postingsReportItemAsText CliOpts
    opts) (Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
    -> MixedAmount
    forall {a} {b} {c} {e}. (a, b, c, Posting, e) -> MixedAmount
    itemamt (Maybe Day, Maybe Period, Maybe CsvValue, Posting, MixedAmount)
    -> MixedAmount
    forall {a} {b} {c} {d} {e}. (a, b, c, d, e) -> e
    itembal
      where
        alignAll :: Bool
    alignAll = String -> RawOpts -> Bool
    boolopt String
    "align-all" (RawOpts -> Bool) -> RawOpts -> Bool
    forall a b. (a -> b) -> a -> b
    $ CliOpts -> RawOpts
    rawopts_ CliOpts
    opts
        itemamt :: (a, b, c, Posting, e) -> MixedAmount
    itemamt (a
    _,b
    _,c
    _,Posting{pamount :: Posting -> MixedAmount
    pamount=MixedAmount
    a},e
    _) = MixedAmount
    a
        itembal :: (a, b, c, d, e) -> e
    itembal (a
    _,b
    _,c
    _,d
    _,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.
    --
    -- Also returns the natural width (without padding) of the amount and balance
    -- fields.
    postingsReportItemAsText :: CliOpts -> Int -> Int
                             -> (PostingsReportItem, [WideBuilder], [WideBuilder])
                             -> TB.Builder
    postingsReportItemAsText :: CliOpts
    -> Int
    -> Int
    -> ((Maybe Day, Maybe Period, Maybe CsvValue, Posting,
         MixedAmount),
        [WideBuilder], [WideBuilder])
    -> Builder
    postingsReportItemAsText CliOpts
    opts Int
    preferredamtwidth Int
    preferredbalwidth ((Maybe Day
    mdate, Maybe Period
    mperiod, Maybe CsvValue
    mdesc, Posting
    p, MixedAmount
    _), [WideBuilder]
    amt, [WideBuilder]
    bal) =
        Builder
    table Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    TB.singleton Char
    '\n'
      where
        table :: Builder
    table = TableOpts -> Header Cell -> Builder
    renderRowB TableOpts
    forall a. Default a => a
    def{tableBorders :: Bool
    tableBorders=Bool
    False, borderSpaces :: Bool
    borderSpaces=Bool
    False} (Header Cell -> Builder)
    -> ([Header Cell] -> Header Cell) -> [Header Cell] -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Properties -> [Header Cell] -> Header Cell
    forall h. Properties -> [Header h] -> Header h
    Group Properties
    NoLine ([Header Cell] -> Builder) -> [Header Cell] -> Builder
    forall a b. (a -> b) -> a -> b
    $ (Cell -> Header Cell) -> [Cell] -> [Header Cell]
    forall a b. (a -> b) -> [a] -> [b]
    map Cell -> Header Cell
    forall h. h -> Header h
    Header
          [ Align -> CsvValue -> Cell
    textCell Align
    TopLeft (CsvValue -> Cell) -> CsvValue -> Cell
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Maybe Int -> Bool -> Bool -> CsvValue -> CsvValue
    fitText (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 CsvValue
    date
          , Cell
    spacerCell
          , Align -> CsvValue -> Cell
    textCell Align
    TopLeft (CsvValue -> Cell) -> CsvValue -> Cell
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Maybe Int -> Bool -> Bool -> CsvValue -> CsvValue
    fitText (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 CsvValue
    desc
          , Cell
    spacerCell2
          , Align -> CsvValue -> Cell
    textCell Align
    TopLeft (CsvValue -> Cell) -> CsvValue -> Cell
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Maybe Int -> Bool -> Bool -> CsvValue -> CsvValue
    fitText (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 CsvValue
    acct
          , Cell
    spacerCell2
          , Align -> [WideBuilder] -> Cell
    Cell Align
    TopRight ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
    forall a b. (a -> b) -> a -> b
    $ (WideBuilder -> WideBuilder) -> [WideBuilder] -> [WideBuilder]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> WideBuilder -> WideBuilder
    pad Int
    amtwidth) [WideBuilder]
    amt
          , Cell
    spacerCell2
          , Align -> [WideBuilder] -> Cell
    Cell Align
    BottomRight ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
    forall a b. (a -> b) -> a -> b
    $ (WideBuilder -> WideBuilder) -> [WideBuilder] -> [WideBuilder]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> WideBuilder -> WideBuilder
    pad Int
    balwidth) [WideBuilder]
    bal
          ]
        spacerCell :: Cell
    spacerCell  = Align -> [WideBuilder] -> Cell
    Cell Align
    BottomLeft [Builder -> Int -> WideBuilder
    WideBuilder (Char -> Builder
    TB.singleton Char
    ' ') Int
    1]
        spacerCell2 :: Cell
    spacerCell2 = Align -> [WideBuilder] -> Cell
    Cell Align
    BottomLeft [Builder -> Int -> WideBuilder
    WideBuilder (String -> Builder
    TB.fromString String
    "  ") Int
    2]
        pad :: Int -> WideBuilder -> WideBuilder
    pad Int
    fullwidth WideBuilder
    amt' = Builder -> Int -> WideBuilder
    WideBuilder (CsvValue -> Builder
    TB.fromText (CsvValue -> Builder) -> CsvValue -> Builder
    forall a b. (a -> b) -> a -> b
    $ Int -> CsvValue -> CsvValue
    T.replicate Int
    w CsvValue
    " ") Int
    w WideBuilder -> WideBuilder -> WideBuilder
    forall a. Semigroup a => a -> a -> a
    <> WideBuilder
    amt'
          where w :: Int
    w = Int
    fullwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - WideBuilder -> Int
    wbWidth WideBuilder
    amt'
        -- calculate widths
        (Int
    totalwidth,Maybe Int
    mdescwidth) = CliOpts -> (Int, Maybe Int)
    registerWidthsFromOpts CliOpts
    opts
        datewidth :: Int
    datewidth = Int -> (Period -> Int) -> Maybe Period -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    10 Period -> Int
    periodTextWidth Maybe Period
    mperiod
        date :: CsvValue
    date = case Maybe Period
    mperiod of
                 Just Period
    per -> if Maybe Day -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Day
    mdate then Period -> CsvValue
    showPeriod Period
    per else CsvValue
    ""
                 Maybe Period
    Nothing  -> CsvValue -> (Day -> CsvValue) -> Maybe Day -> CsvValue
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe CsvValue
    "" Day -> CsvValue
    showDate Maybe Day
    mdate
        (Int
    amtwidth, Int
    balwidth)
          | Int
    shortfall Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 = (Int
    preferredamtwidth, Int
    preferredbalwidth)
          | Bool
    otherwise      = (Int
    adjustedamtwidth, Int
    adjustedbalwidth)
          where
            mincolwidth :: Int
    mincolwidth = Int
    2 -- columns always show at least an ellipsis
            maxamtswidth :: Int
    maxamtswidth = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    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
    + Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    mincolwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    mincolwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    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 b. Integral b => Double -> b
    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
    + Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    amtwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    balwidth)
        (Int
    descwidth, Int
    acctwidth)
          | Maybe Period -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Period
    mperiod = (Int
    0, Int
    remaining Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2)
          | Bool
    otherwise      = (Int
    w, Int
    remaining Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    w)
          where
            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
    - Int
    2) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2) Maybe Int
    mdescwidth

        -- gather content
        desc :: CsvValue
    desc = CsvValue -> Maybe CsvValue -> CsvValue
    forall a. a -> Maybe a -> a
    fromMaybe CsvValue
    "" Maybe CsvValue
    mdesc
        acct :: CsvValue
    acct = CsvValue -> CsvValue
    parenthesise (CsvValue -> CsvValue)
    -> (CsvValue -> CsvValue) -> CsvValue -> CsvValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> CsvValue -> CsvValue
    elideAccountName Int
    awidth (CsvValue -> CsvValue) -> CsvValue -> CsvValue
    forall a b. (a -> b) -> a -> b
    $ Posting -> CsvValue
    paccount Posting
    p
          where
            (CsvValue -> CsvValue
    parenthesise, Int
    awidth) = case Posting -> PostingType
    ptype Posting
    p of
                PostingType
    BalancedVirtualPosting -> (CsvValue -> CsvValue -> CsvValue -> CsvValue
    wrap CsvValue
    "[" CsvValue
    "]", Int
    acctwidthInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    2)
                PostingType
    VirtualPosting         -> (CsvValue -> CsvValue -> CsvValue -> CsvValue
    wrap CsvValue
    "(" CsvValue
    ")", Int
    acctwidthInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    2)
                PostingType
    _                      -> (CsvValue -> CsvValue
    forall a. a -> a
    id,Int
    acctwidth)

    -- for register --match:

    -- Identify the closest recent match for this description in the given date-sorted postings.
    similarPosting :: [Posting] -> String -> Maybe Posting
    similarPosting :: [Posting] -> String -> Maybe Posting
    similarPosting [Posting]
    ps String
    desc =
      let matches :: [(Double, Posting)]
    matches =
              ((Double, Posting) -> (Double, Posting) -> Ordering)
    -> [(Double, Posting)] -> [(Double, Posting)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Double, Posting) -> (Double, Posting) -> Ordering
    forall {a}. Ord a => (a, Posting) -> (a, Posting) -> Ordering
    compareRelevanceAndRecency
                         ([(Double, Posting)] -> [(Double, Posting)])
    -> [(Double, Posting)] -> [(Double, Posting)]
    forall a b. (a -> b) -> a -> b
    $ ((Double, Posting) -> Bool)
    -> [(Double, Posting)] -> [(Double, Posting)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    threshold)(Double -> Bool)
    -> ((Double, Posting) -> Double) -> (Double, Posting) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Double, Posting) -> Double
    forall a b. (a, b) -> a
    fst)
                         [(Double -> (Transaction -> Double) -> Maybe Transaction -> Double
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Double
    0 (\Transaction
    t -> String -> String -> Double
    compareDescriptions String
    desc (CsvValue -> String
    T.unpack (CsvValue -> String) -> CsvValue -> String
    forall a b. (a -> b) -> a -> b
    $ Transaction -> CsvValue
    tdescription Transaction
    t)) (Posting -> Maybe Transaction
    ptransaction Posting
    p), Posting
    p) | Posting
    p <- [Posting]
    ps]
                  where
                    compareRelevanceAndRecency :: (a, Posting) -> (a, Posting) -> Ordering
    compareRelevanceAndRecency (a
    n1,Posting
    p1) (a
    n2,Posting
    p2) = (a, Day) -> (a, Day) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (a
    n2,Posting -> Day
    postingDate Posting
    p2) (a
    n1,Posting -> Day
    postingDate Posting
    p1)
                    threshold :: Double
    threshold = Double
    0
      in case [(Double, Posting)]
    matches of []  -> Maybe Posting
    forall a. Maybe a
    Nothing
                         (Double, Posting)
    m:[(Double, Posting)]
    _ -> Posting -> Maybe Posting
    forall a. a -> Maybe a
    Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
    forall a b. (a -> b) -> a -> b
    $ (Double, Posting) -> Posting
    forall a b. (a, b) -> b
    snd (Double, Posting)
    m

    -- -- Identify the closest recent match for this description in past transactions.
    -- similarTransaction :: Journal -> Query -> String -> Maybe Transaction
    -- similarTransaction j q desc =
    --   case historymatches = transactionsSimilarTo j q desc of
    --     ((,t):_) = Just t
    --     []       = Nothing

    compareDescriptions :: String -> String -> Double
    compareDescriptions :: String -> String -> Double
    compareDescriptions String
    s String
    t = String -> String -> Double
    compareStrings String
    s' String
    t'
        where s' :: String
    s' = String -> String
    simplify String
    s
              t' :: String
    t' = String -> String
    simplify String
    t
              simplify :: String -> String
    simplify = (Char -> Bool) -> String -> String
    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 -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (String
    "0123456789"::String)))

    -- | Return a similarity measure, from 0 to 1, for two strings.
    -- This is Simon White's letter pairs algorithm from
    -- http://www.catalysoft.com/articles/StrikeAMatch.html
    -- with a modification for short strings.
    compareStrings :: String -> String -> Double
    compareStrings :: String -> String -> Double
    compareStrings String
    "" String
    "" = Double
    1
    compareStrings [Char
    _] String
    "" = Double
    0
    compareStrings String
    "" [Char
    _] = Double
    0
    compareStrings [Char
    a] [Char
    b] = if Char -> Char
    toUpper Char
    a Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Char
    toUpper Char
    b then Double
    1 else Double
    0
    compareStrings String
    s1 String
    s2 = Double
    2.0 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    u
        where
          i :: Int
    i = [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([String] -> Int) -> [String] -> Int
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String] -> [String]
    forall a. Eq a => [a] -> [a] -> [a]
    intersect [String]
    pairs1 [String]
    pairs2
          u :: Int
    u = [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    pairs1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    pairs2
          pairs1 :: [String]
    pairs1 = String -> [String]
    wordLetterPairs (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> String
    uppercase String
    s1
          pairs2 :: [String]
    pairs2 = String -> [String]
    wordLetterPairs (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> String
    uppercase String
    s2

    wordLetterPairs :: String -> [String]
    wordLetterPairs = (String -> [String]) -> [String] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap String -> [String]
    forall {a}. [a] -> [[a]]
    letterPairs ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    words

    letterPairs :: [a] -> [[a]]
    letterPairs (a
    a:a
    b:[a]
    rest) = [a
    a,a
    b] [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [a] -> [[a]]
    letterPairs (a
    ba -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    rest)
    letterPairs [a]
    _ = []

    -- tests

    tests_Register :: TestTree
    tests_Register = String -> [TestTree] -> TestTree
    testGroup String
    "Register" [

       String -> [TestTree] -> TestTree
    testGroup String
    "postingsReportAsText" [
        String -> IO () -> TestTree
    testCase String
    "unicode in register layout" (IO () -> TestTree) -> IO () -> TestTree
    forall a b. (a -> b) -> a -> b
    $ do
          Journal
    j <- CsvValue -> IO Journal
    readJournal' CsvValue
    "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
          let rspec :: ReportSpec
    rspec = ReportSpec
    defreportspec
          (Text -> String
    TL.unpack (Text -> String)
    -> (PostingsReport -> Text) -> PostingsReport -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CliOpts -> PostingsReport -> Text
    postingsReportAsText CliOpts
    defcliopts (PostingsReport -> String) -> PostingsReport -> String
    forall a b. (a -> b) -> a -> b
    $ ReportSpec -> Journal -> PostingsReport
    postingsReport ReportSpec
    rspec Journal
    j)
            String -> String -> IO ()
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
    @?=
            [String] -> String
    unlines
            [String
    "2009-01-01 медвежья шкура       расходы:покупки                100           100"
            ,String
    "                                актив:наличные                -100             0"]
       ]

     ]