module Penny.Cabin.Posts (
postsReport
, parseReport
, makeReport
, defaultOptions
, ZincOpts(..)
, ymd
, qtyAsIs
, balanceAsIs
, defaultWidth
, columnsVarToWidth
, widthFromRuntime
, defaultFields
, defaultSpacerWidth
) where
import qualified Control.Monad.Exception.Synchronous as Ex
import qualified Data.Text as X
import qualified Data.Text.Lazy as XL
import qualified Penny.Cabin.Chunk as CC
import qualified Penny.Cabin.Colors as PC
import qualified Penny.Cabin.Colors.DarkBackground as Dark
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.Allocate as Alc
import qualified Penny.Cabin.Posts.Chunk as C
import qualified Penny.Cabin.Posts.Fields as F
import qualified Penny.Cabin.Posts.Help as H
import qualified Penny.Cabin.Posts.Meta as M
import Penny.Cabin.Posts.Meta (Box)
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.Copper as Cop
import qualified Penny.Lincoln as L
import qualified Penny.Lincoln.Balance as Bal
import qualified Penny.Lincoln.Queries as Q
import qualified Penny.Liberty as Ly
import qualified Penny.Shield as Sh
import Data.Time as Time
import System.Console.MultiArg.Prim (Parser)
import System.Locale (defaultTimeLocale)
import Text.Matchers.Text (CaseSensitive)
postsReport ::
CC.Colors
-> CO.ShowZeroBalances
-> (L.Box Ly.LibertyMeta -> Bool)
-> [Ly.PostFilterFn]
-> C.ChunkOpts
-> [L.Box Ly.LibertyMeta]
-> XL.Text
postsReport col szb pdct pff co =
CC.chunksToText col
. C.makeChunk co
. M.toBoxList szb pdct pff
parseReport ::
(Sh.Runtime -> ZincOpts)
-> Parser I.ReportFunc
parseReport frt = do
getState <- P.parseOptions
let rf rt cs fty ps _ = do
let zo = frt rt
maySt' = getState rt dtz rg st
where
dtz = defaultTimeZone zo
rg = radGroup zo
st = newParseState cs fty zo
st' <- Ex.mapException showParserError maySt'
pdct <- getPredicate . P.tokens $ st'
return $ postsReport (P.colorPref st')
(P.showZeroBalances st') pdct
(P.postFilter st') (chunkOpts st' zo) ps
return rf
makeReport ::
(Sh.Runtime -> ZincOpts)
-> I.Report
makeReport frt = I.Report {
I.help = H.help
, I.name = "postings"
, I.parseReport = parseReport frt }
defaultOptions ::
Cop.DefaultTimeZone
-> Cop.RadGroup
-> Sh.Runtime
-> ZincOpts
defaultOptions dtz rg rt = ZincOpts {
defaultTimeZone = dtz
, radGroup = rg
, fields = defaultFields
, colorPref = CO.maxCapableColors rt
, drCrColors = Dark.drCrColors
, baseColors = Dark.baseColors
, width = widthFromRuntime rt
, showZeroBalances = CO.ShowZeroBalances False
, dateFormat = ymd
, qtyFormat = qtyAsIs
, balanceFormat = balanceAsIs
, subAccountLength = A.SubAccountLength 2
, payeeAllocation = Alc.allocation 60
, accountAllocation = Alc.allocation 40
, spacers = defaultSpacerWidth }
showParserError :: P.Error -> X.Text
showParserError = X.pack . show
getPredicate ::
[Ly.Token (L.Box Ly.LibertyMeta -> Bool)]
-> Ex.Exceptional X.Text (L.Box Ly.LibertyMeta -> Bool)
getPredicate ts =
case ts of
[] -> return $ const True
ls ->
Ex.fromMaybe
(X.pack "posts report: bad posting filter expression")
(Ly.parseTokenList ls)
data ZincOpts = ZincOpts {
defaultTimeZone :: Cop.DefaultTimeZone
, radGroup :: Cop.RadGroup
, fields :: F.Fields Bool
, colorPref :: CC.Colors
, drCrColors :: PC.DrCrColors
, baseColors :: PC.BaseColors
, width :: T.ReportWidth
, showZeroBalances :: CO.ShowZeroBalances
, dateFormat :: Box -> X.Text
, qtyFormat :: Box -> X.Text
, balanceFormat :: L.Commodity -> L.BottomLine -> X.Text
, subAccountLength :: A.SubAccountLength
, payeeAllocation :: Alc.Allocation
, accountAllocation :: Alc.Allocation
, spacers :: S.Spacers Int
}
chunkOpts ::
P.State
-> ZincOpts
-> C.ChunkOpts
chunkOpts s z = C.ChunkOpts {
C.baseColors = P.baseColors s
, C.drCrColors = P.drCrColors s
, C.dateFormat = dateFormat z
, C.qtyFormat = qtyFormat z
, C.balanceFormat = balanceFormat z
, 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
-> ZincOpts
-> P.State
newParseState cs fty o = P.State {
P.sensitive = cs
, P.factory = fty
, P.tokens = []
, P.postFilter = []
, P.fields = fields o
, P.colorPref = colorPref o
, P.drCrColors = drCrColors o
, P.baseColors = baseColors o
, P.width = width o
, P.showZeroBalances = showZeroBalances o
}
ymd :: Box -> X.Text
ymd p = X.pack (Time.formatTime defaultTimeLocale fmt d) where
d = Time.localDay
. L.localTime
. Q.dateTime
. L.boxPostFam
$ p
fmt = "%Y-%m-%d"
qtyAsIs :: Box -> X.Text
qtyAsIs p = X.pack . show . L.unQty . Q.qty . L.boxPostFam $ p
balanceAsIs :: a -> L.BottomLine -> X.Text
balanceAsIs _ n = case n of
L.Zero -> X.pack "--"
L.NonZero c -> X.pack . show . L.unQty . Bal.qty $ c
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 }