module Penny.Cabin.Posts
( postsReport
, zincReport
, defaultOptions
, ZincOpts(..)
, A.Alloc
, A.SubAccountLength(..)
, A.alloc
, yearMonthDay
, defaultWidth
, columnsVarToWidth
, widthFromRuntime
, defaultFields
, defaultSpacerWidth
, T.ReportWidth(..)
) where
import Control.Applicative ((<$>), (<*>))
import Data.List.Split (chunksOf)
import qualified Data.Either as Ei
import qualified Data.Text as X
import qualified Penny.Cabin.Interface as I
import qualified Penny.Cabin.Options as CO
import qualified Penny.Cabin.Posts.Allocated as A
import qualified Penny.Cabin.Posts.Chunk as C
import qualified Penny.Cabin.Posts.Fields as F
import qualified Penny.Cabin.Posts.Meta as M
import qualified Penny.Cabin.Posts.Parser as P
import qualified Penny.Cabin.Posts.Spacers as S
import qualified Penny.Cabin.Posts.Types as T
import qualified Penny.Cabin.Scheme as E
import qualified Penny.Lincoln as L
import qualified Penny.Lincoln.Queries as Q
import qualified Penny.Liberty as Ly
import qualified Penny.Shield as Sh
import qualified Data.Prednote as Pd
import qualified System.Console.Rainbow as Rb
import Data.List (intersperse)
import Data.Maybe (catMaybes)
import qualified Data.Foldable as Fdbl
import Data.Time as Time
import qualified System.Console.MultiArg as MA
import System.Locale (defaultTimeLocale)
import Text.Matchers (CaseSensitive)
postsReport
:: E.Changers
-> CO.ShowZeroBalances
-> (Pd.Predbox (Ly.LibertyMeta, L.Posting))
-> [Ly.PostFilterFn]
-> C.ChunkOpts
-> [(Ly.LibertyMeta, L.Posting)]
-> [Rb.Chunk]
postsReport ch szb pdct pff co =
C.makeChunk ch co
. M.toBoxList szb pdct pff
zincReport :: ZincOpts -> I.Report
zincReport opts rt = (helpStr opts, md)
where
md cs fty ch expr fsf = MA.modeHelp
"postings"
(const (helpStr opts))
(process opts cs fty ch expr fsf)
(specs rt)
MA.Intersperse
(return . Left)
specs
:: Sh.Runtime
-> [MA.OptSpec (Either String (P.State -> Either X.Text P.State))]
specs = map (fmap Right) . P.allSpecs
process
:: ZincOpts
-> CaseSensitive
-> L.Factory
-> E.Changers
-> Pd.ExprDesc
-> ([L.Transaction] -> [(Ly.LibertyMeta, L.Posting)])
-> [Either String (P.State -> Either X.Text P.State)]
-> Either X.Text I.ArgsAndReport
process os cs fty ch expr fsf ls =
let (posArgs, clOpts) = Ei.partitionEithers ls
pState = newParseState cs fty expr os
exState' = foldl (>>=) (return pState) clOpts
in fmap (mkPrintReport posArgs os ch fsf) exState'
mkPrintReport
:: [String]
-> ZincOpts
-> E.Changers
-> ([L.Transaction] -> [(Ly.LibertyMeta, L.Posting)])
-> P.State
-> I.ArgsAndReport
mkPrintReport posArgs zo ch fsf st = (posArgs, f)
where
f fmt txns _ = do
pdct <- getPredicate (P.exprDesc st) (P.tokens st)
let boxes = fsf txns
rptChks = postsReport ch (P.showZeroBalances st) pdct
(P.postFilter st) (chunkOpts fmt st zo) boxes
expChks = showExpression (P.showExpression st) pdct
verbChks = showVerboseFilter fmt (P.verboseFilter st)
pdct boxes
chks = expChks
++ verbChks
++ rptChks
return chks
indentAmt :: Pd.IndentAmt
indentAmt = 4
blankLine :: Rb.Chunk
blankLine = "\n"
showExpression
:: P.ShowExpression
-> Pd.Predbox ((Ly.LibertyMeta, L.Posting))
-> [Rb.Chunk]
showExpression (P.ShowExpression b) pdct =
if not b then [] else info : blankLine : (chks ++ [blankLine])
where
info = "Postings filter expression:\n"
chks = Pd.showPredbox indentAmt 0 pdct
showVerboseFilter
:: (L.Amount L.Qty -> X.Text)
-> P.VerboseFilter
-> Pd.Predbox (Ly.LibertyMeta, L.Posting)
-> [(Ly.LibertyMeta, L.Posting)]
-> [Rb.Chunk]
showVerboseFilter fmt (P.VerboseFilter b) pdct bs =
if not b then [] else info : blankLine : (chks ++ [blankLine])
where
chks =
fst
$ Pd.verboseFilter ((L.display fmt) . snd) indentAmt False pdct bs
info = "Postings report filter:\n"
defaultOptions
:: Sh.Runtime
-> ZincOpts
defaultOptions rt = ZincOpts
{ fields = defaultFields
, width = widthFromRuntime rt
, showZeroBalances = CO.ShowZeroBalances False
, dateFormat = yearMonthDay
, subAccountLength = A.SubAccountLength 2
, payeeAllocation = A.alloc 60
, accountAllocation = A.alloc 40
, spacers = defaultSpacerWidth
}
type Error = X.Text
getPredicate
:: Pd.ExprDesc
-> [Pd.Token ((Ly.LibertyMeta, L.Posting))]
-> Either Error (Pd.Predbox ((Ly.LibertyMeta, L.Posting)))
getPredicate d ts =
case ts of
[] -> return $ Pd.always
_ -> Pd.parseExpression d ts
data ZincOpts = ZincOpts
{ fields :: F.Fields Bool
, width :: T.ReportWidth
, showZeroBalances :: CO.ShowZeroBalances
, dateFormat :: (M.PostMeta, L.Posting) -> X.Text
, subAccountLength :: A.SubAccountLength
, payeeAllocation :: A.Alloc
, accountAllocation :: A.Alloc
, spacers :: S.Spacers Int
}
chunkOpts
:: (L.Amount L.Qty -> X.Text)
-> P.State
-> ZincOpts
-> C.ChunkOpts
chunkOpts fmt s z = C.ChunkOpts
{ C.dateFormat = dateFormat z
, C.qtyFormat = fmt
, C.fields = P.fields s
, C.subAccountLength = subAccountLength z
, C.payeeAllocation = payeeAllocation z
, C.accountAllocation = accountAllocation z
, C.spacers = spacers z
, C.reportWidth = P.width s
}
newParseState ::
CaseSensitive
-> L.Factory
-> Pd.ExprDesc
-> ZincOpts
-> P.State
newParseState cs fty expr o = P.State
{ P.sensitive = cs
, P.factory = fty
, P.tokens = []
, P.postFilter = []
, P.fields = fields o
, P.width = width o
, P.showZeroBalances = showZeroBalances o
, P.exprDesc = expr
, P.verboseFilter = P.VerboseFilter False
, P.showExpression = P.ShowExpression False
}
yearMonthDay :: (M.PostMeta, L.Posting) -> X.Text
yearMonthDay p = X.pack (Time.formatTime defaultTimeLocale fmt d)
where
d = L.day
. Q.dateTime
. snd
$ p
fmt = "%Y-%m-%d"
defaultWidth :: T.ReportWidth
defaultWidth = T.ReportWidth 80
columnsVarToWidth :: Maybe String -> T.ReportWidth
columnsVarToWidth ms = case ms of
Nothing -> defaultWidth
Just str -> case reads str of
[] -> defaultWidth
(i, []):[] -> if i > 0 then T.ReportWidth i else defaultWidth
_ -> defaultWidth
widthFromRuntime :: Sh.Runtime -> T.ReportWidth
widthFromRuntime rt = case Sh.screenWidth rt of
Nothing -> defaultWidth
Just w -> T.ReportWidth . Sh.unScreenWidth $ w
defaultFields :: F.Fields Bool
defaultFields =
F.Fields { F.globalTransaction = False
, F.revGlobalTransaction = False
, F.globalPosting = False
, F.revGlobalPosting = False
, F.fileTransaction = False
, F.revFileTransaction = False
, F.filePosting = False
, F.revFilePosting = False
, F.filtered = False
, F.revFiltered = False
, F.sorted = False
, F.revSorted = False
, F.visible = False
, F.revVisible = False
, F.lineNum = False
, F.date = True
, F.flag = False
, F.number = False
, F.payee = True
, F.account = True
, F.postingDrCr = True
, F.postingCmdty = True
, F.postingQty = True
, F.totalDrCr = True
, F.totalCmdty = True
, F.totalQty = True
, F.tags = False
, F.memo = False
, F.filename = False }
defaultSpacerWidth :: S.Spacers Int
defaultSpacerWidth =
S.Spacers { S.globalTransaction = 1
, S.revGlobalTransaction = 1
, S.globalPosting = 1
, S.revGlobalPosting = 1
, S.fileTransaction = 1
, S.revFileTransaction = 1
, S.filePosting = 1
, S.revFilePosting = 1
, S.filtered = 1
, S.revFiltered = 1
, S.sorted = 1
, S.revSorted = 1
, S.visible = 1
, S.revVisible = 1
, S.lineNum = 1
, S.date = 1
, S.flag = 1
, S.number = 1
, S.payee = 4
, S.account = 1
, S.postingDrCr = 1
, S.postingCmdty = 1
, S.postingQty = 1
, S.totalDrCr = 1
, S.totalCmdty = 1 }
ifDefault :: Bool -> String
ifDefault b = if b then " (default)" else ""
helpStr :: ZincOpts -> String
helpStr o = unlines $
[ "postings"
, " Show postings in order with a running balance."
, " Accepts the following options:"
, ""
, "Posting filters"
, "==============="
, "These options affect which postings are shown in the report."
, "Postings not shown still affect the running balance."
, ""
, "Dates"
, "-----"
, ""
, "--date cmp timespec, -d cmp timespec"
, " Date must be within the time frame given. timespec"
, " is a day or a day and a time. Valid values for cmp:"
, " <, >, <=, >=, ==, /=, !="
, "--current"
, " Same as \"--date <= (right now) \""
, ""
, "Serials"
, "-------"
, "These options take the form --option cmp num; the given"
, "sequence number must fall within the given range. \"rev\""
, "in the option name indicates numbering is from end to beginning."
, ""
, "--globalTransaction, --revGlobalTransaction"
, " All transactions, after reading the ledger files"
, "--globalPosting, --revGlobalPosting"
, " All postings, after reading the leder files"
, "--fileTransaction, --revFileTransaction"
, " Transactions in each ledger file, after reading the files"
, " (numbering restarts with each file)"
, "--filePosting, --revFilePosting"
, " Postings in each ledger file, after reading the files"
, " (numbering restarts with each file)"
, "--filtered, --revFiltered"
, " All postings, after filters given in the filter"
, " specification portion of the command line are"
, " applied"
, "--sorted, --revSorted"
, " All postings remaining after filtering and after"
, " postings have been sorted"
, ""
, "Pattern matching"
, "----------------"
, ""
, "-a pattern, --account pattern"
, " Pattern must match colon-separated account name"
, "--account-level num pat"
, " Pattern must match sub account at given level"
, "--account-any pat"
, " Pattern must match sub account at any level"
, "-p pattern, --payee pattern"
, " Payee must match pattern"
, "-t pattern, --tag pattern"
, " Tag must match pattern"
, "--number pattern"
, " Number must match pattern"
, "--flag pattern"
, " Flag must match pattern"
, "--commodity pattern"
, " Pattern must match colon-separated commodity name"
, "--posting-memo pattern"
, " Posting memo must match pattern"
, "--transaction-memo pattern"
, " Transaction memo must match pattern"
, ""
, "Other posting characteristics"
, "-----------------------------"
, "--debit"
, " Entry must be a debit"
, "--credit"
, " Entry must be a credit"
, "--qty cmp number"
, " Entry quantity must fall within given range"
, ""
, "Infix or RPN selection"
, "----------------------"
, "--infix - use infix notation"
, "--rpn - use reverse polish notation"
, " (default: use what was used in the filtering options)"
, ""
, "Infix Operators - from highest to lowest precedence"
, "(all are left associative)"
, "--------------------------"
, "--open expr --close"
, " Force precedence (as in \"open\" and \"close\" parentheses)"
, "--not expr"
, " True if expr is false"
, "expr1 --and expr2 "
, " True if expr and expr2 are both true"
, "expr1 --or expr2"
, " True if either expr1 or expr2 is true"
, ""
, "RPN Operators"
, "-------------"
, "expr --not"
, " True if expr is false"
, "expr1 expr2 --and"
, " True if expr and expr2 are both true"
, "expr1 expr2 --or"
, " True if either expr1 or expr2 is true"
, ""
, "Options affecting patterns"
, "=========================="
, ""
, "-i, --case-insensitive"
, " Be case insensitive"
, "-I, --case-sensitive"
, " Be case sensitive"
, ""
, "--within"
, " Use \"within\" matcher"
, "--pcre"
, " Use \"pcre\" matcher"
, "--exact"
, " Use \"exact\" matcher"
, ""
, "Removing postings after sorting and filtering"
, "============================================="
, "--head n"
, " Keep only the first n postings"
, "--tail n"
, " Keep only the last n postings"
, ""
, "Other options"
, "============="
, "--width num"
, " Hint for roughly how wide the report should be in columns"
, " (currently: " ++ (show . T.unReportWidth . width $ o) ++ ")"
, "--show field, --hide field"
, " show or hide this field, where field is one of:"
, " globalTransaction, revGlobalTransaction,"
, " globalPosting, revGlobalPosting,"
, " fileTransaction, revFileTransaction,"
, " filePosting, revFilePosting,"
, " filtered, revFiltered,"
, " sorted, revSorted,"
, " visible, revVisible,"
, " lineNum,"
, " date, flag, number, payee, account,"
, " postingDrCr, postingCommodity, postingQty,"
, " totalDrCr, totalCommodity, totalQty,"
, " tags, memo, filename"
, "--show-all"
, " Show all fields"
, "--hide-all"
, " Hide all fields"
, ""
] ++ showDefaultFields (fields o) ++
[ ""
, "--show-zero-balances"
, " Show balances that are zero"
++ ifDefault (CO.unShowZeroBalances . showZeroBalances $ o)
, "--hide-zero-balances"
, " Hide balances that are zero"
++ ifDefault (not . CO.unShowZeroBalances . showZeroBalances $ o)
, ""
, "--help, -h"
, " Show this help and exit"
]
showDefaultFields :: F.Fields Bool -> [String]
showDefaultFields i = hdr : rest
where
hdr = "Fields shown by default:"
++ if null rest then " (none)" else ""
rest =
map (" " ++)
. map concat
. map (intersperse ", ")
. chunksOf 3
. catMaybes
. Fdbl.toList
. toMaybes
$ i
toMaybes flds = f <$> flds <*> F.fieldNames
f b n = if b then Just n else Nothing