module Penny
(
Version(..)
, Defaults(..)
, Z.Matcher(..)
, E.Scheme(..)
, E.Changers
, E.Labels(..)
, E.EvenAndOdd(..)
, module System.Console.Rainbow
, Z.SortField(..)
, CabP.SortOrder(..)
, Exp.ExprDesc(..)
, Target(..)
, CP.SortBy(..)
, Fields(..)
, Spacers(..)
, widthFromRuntime
, Ps.yearMonthDay
, S3(..)
, FormatQty
, qtyFormatter
, getQtyFormat
, L.Radix(..)
, L.PeriodGrp(..)
, L.CommaGrp(..)
, S.Runtime
, S.environment
, X.Text
, X.pack
, runPenny
) where
import Data.Ord (comparing)
import Data.List (sortBy, groupBy)
import Data.Maybe (mapMaybe, fromMaybe)
import qualified Data.Text as X
import qualified Data.Map as Map
import Data.Version (Version(..))
import qualified Penny.Cabin.Balance.Convert as Conv
import qualified Penny.Cabin.Balance.Convert.Parser as CP
import qualified Penny.Cabin.Balance.Convert.Options as ConvOpts
import qualified Penny.Cabin.Balance.MultiCommodity as MC
import qualified Penny.Cabin.Balance.MultiCommodity.Parser as MP
import System.Console.Rainbow
import qualified Penny.Cabin.Interface as I
import qualified Penny.Cabin.Options as CO
import qualified Penny.Cabin.Parsers as CabP
import qualified Penny.Cabin.Posts as Ps
import qualified Penny.Cabin.Posts.Fields as PF
import qualified Penny.Cabin.Posts.Spacers as PS
import qualified Penny.Cabin.Posts.Meta as M
import qualified Penny.Cabin.Scheme as E
import qualified Penny.Copper as Cop
import Data.Sums
import qualified Data.Sums as Su
import qualified Penny.Lincoln as L
import qualified Data.Prednote.Expressions as Exp
import qualified Penny.Zinc as Z
import qualified Penny.Shield as S
import qualified Text.Matchers as Mr
type FormatQty
= [Cop.LedgerItem]
-> L.Amount L.Qty
-> X.Text
data Defaults = Defaults
{ caseSensitive :: Bool
, matcher :: Z.Matcher
, colorToFile :: Bool
, expressionType :: Exp.ExprDesc
, defaultScheme :: Maybe E.Scheme
, additionalSchemes :: [E.Scheme]
, sorter :: [(Z.SortField, CabP.SortOrder)]
, formatQty :: FormatQty
, balanceShowZeroBalances :: Bool
, balanceOrder :: CabP.SortOrder
, convertShowZeroBalances :: Bool
, convertTarget :: Target
, convertOrder :: CabP.SortOrder
, convertSortBy :: CP.SortBy
, postingsFields :: Fields Bool
, postingsWidth :: Int
, postingsShowZeroBalances :: Bool
, postingsDateFormat :: (M.PostMeta, L.Posting) -> X.Text
, postingsSubAccountLength :: Int
, postingsPayeeAllocation :: Int
, postingsAccountAllocation :: Int
, postingsSpacers :: Spacers Int
}
qtyFormatter
:: Su.S3 L.Radix L.PeriodGrp L.CommaGrp
-> FormatQty
qtyFormatter df ls =
let getFmt = getQtyFormat df ls
in \a -> L.showQtyRep . L.qtyToRep (getFmt a) . L.qty $ a
getQtyFormat
:: Su.S3 L.Radix L.PeriodGrp L.CommaGrp
-> [Cop.LedgerItem]
-> L.Amount L.Qty
-> Su.S3 L.Radix L.PeriodGrp L.CommaGrp
getQtyFormat df ls =
let m = formattingMap ls
in \a -> fromMaybe df (Map.lookup (L.commodity a) m)
formattingMap
:: [Cop.LedgerItem]
-> Map.Map L.Commodity (Su.S3 L.Radix L.PeriodGrp L.CommaGrp)
formattingMap
= Map.fromList
. mapMaybe formatCmdty
. groupBy (\x y -> fst x == fst y)
. sortBy (comparing fst)
. allQtyRep
formatCmdty
:: [(L.Commodity, L.QtyRep)]
-> Maybe (L.Commodity, Su.S3 L.Radix L.PeriodGrp L.CommaGrp)
formatCmdty ls = case L.bestRadGroup . map snd $ ls of
Nothing -> Nothing
Just r -> Just (fst . head $ ls, r)
allQtyRep :: [Cop.LedgerItem] -> [(L.Commodity, L.QtyRep)]
allQtyRep = concatMap toPairs
where
toPairs i = case i of
Su.S4a t ->
mapMaybe toEntPair
. L.unEnts
. snd
. L.unTransaction
$ t
Su.S4b p ->
[( L.unTo . L.to . L.price $ p
, L.unCountPerUnit . L.countPerUnit . L.price $ p)]
_ -> []
toEntPair :: L.Ent m -> Maybe (L.Commodity, L.QtyRep)
toEntPair e = case L.entry e of
Left en -> Just (L.commodity . L.amount $ en, L.qty . L.amount $ en)
Right _ -> Nothing
runPenny
:: Version
-> (S.Runtime -> Defaults)
-> IO ()
runPenny ver getDefaults = do
rt <- S.runtime
let df = getDefaults rt
rs = allReports df
Z.runZinc ver (toZincDefaults df) rt rs
data Target
= AutoTarget
| ManualTarget String
deriving Show
widthFromRuntime :: S.Runtime -> Int
widthFromRuntime rt = case S.screenWidth rt of
Nothing -> 80
Just sw -> S.unScreenWidth sw
convTarget :: Target -> CP.Target
convTarget t = case t of
AutoTarget -> CP.AutoTarget
ManualTarget s -> CP.ManualTarget . L.To . L.Commodity . X.pack $ s
allReports
:: Defaults
-> [I.Report]
allReports df =
let bd = toBalanceDefaults df
cd = toConvertDefaults df
pd = toPostingsDefaults df
in [ Ps.zincReport pd
, MC.parseReport bd
, Conv.cmdLineReport cd
]
toZincDefaults :: Defaults -> Z.Defaults
toZincDefaults d = Z.Defaults
{ Z.sensitive =
if caseSensitive d then Mr.Sensitive else Mr.Insensitive
, Z.matcher = matcher d
, Z.colorToFile = Z.ColorToFile . colorToFile $ d
, Z.defaultScheme = defaultScheme d
, Z.moreSchemes = additionalSchemes d
, Z.sorter = sorter d
, Z.exprDesc = expressionType d
, Z.formatQty = formatQty d
}
toBalanceDefaults :: Defaults -> MP.ParseOpts
toBalanceDefaults d = MP.ParseOpts
{ MP.showZeroBalances =
CO.ShowZeroBalances . balanceShowZeroBalances $ d
, MP.order = balanceOrder d
}
toConvertDefaults :: Defaults -> ConvOpts.DefaultOpts
toConvertDefaults d = ConvOpts.DefaultOpts
{ ConvOpts.showZeroBalances =
CO.ShowZeroBalances . convertShowZeroBalances $ d
, ConvOpts.target = convTarget . convertTarget $ d
, ConvOpts.sortOrder = convertOrder d
, ConvOpts.sortBy = convertSortBy d
}
toPostingsDefaults :: Defaults -> Ps.ZincOpts
toPostingsDefaults d = Ps.ZincOpts
{ Ps.fields = convFields . postingsFields $ d
, Ps.width = Ps.ReportWidth . postingsWidth $ d
, Ps.showZeroBalances =
CO.ShowZeroBalances . postingsShowZeroBalances $ d
, Ps.dateFormat = postingsDateFormat d
, Ps.subAccountLength =
Ps.SubAccountLength . postingsSubAccountLength $ d
, Ps.payeeAllocation =
Ps.alloc . postingsPayeeAllocation $ d
, Ps.accountAllocation =
Ps.alloc . postingsAccountAllocation $ d
, Ps.spacers = convSpacers . postingsSpacers $ d
}
data Spacers a = Spacers
{ sGlobalTransaction :: a
, sRevGlobalTransaction :: a
, sGlobalPosting :: a
, sRevGlobalPosting :: a
, sFileTransaction :: a
, sRevFileTransaction :: a
, sFilePosting :: a
, sRevFilePosting :: a
, sFiltered :: a
, sRevFiltered :: a
, sSorted :: a
, sRevSorted :: a
, sVisible :: a
, sRevVisible :: a
, sLineNum :: a
, sDate :: a
, sFlag :: a
, sNumber :: a
, sPayee :: a
, sAccount :: a
, sPostingDrCr :: a
, sPostingCmdty :: a
, sPostingQty :: a
, sTotalDrCr :: a
, sTotalCmdty :: a
} deriving (Show, Eq)
data Fields a = Fields
{ fGlobalTransaction :: a
, fRevGlobalTransaction :: a
, fGlobalPosting :: a
, fRevGlobalPosting :: a
, fFileTransaction :: a
, fRevFileTransaction :: a
, fFilePosting :: a
, fRevFilePosting :: a
, fFiltered :: a
, fRevFiltered :: a
, fSorted :: a
, fRevSorted :: a
, fVisible :: a
, fRevVisible :: a
, fLineNum :: a
, fDate :: a
, fFlag :: a
, fNumber :: a
, fPayee :: a
, fAccount :: a
, fPostingDrCr :: a
, fPostingCmdty :: a
, fPostingQty :: a
, fTotalDrCr :: a
, fTotalCmdty :: a
, fTotalQty :: a
, fTags :: a
, fMemo :: a
, fFilename :: a
} deriving (Show, Eq)
convSpacers :: Spacers a -> PS.Spacers a
convSpacers s = PS.Spacers
{ PS.globalTransaction = sGlobalTransaction s
, PS.revGlobalTransaction = sRevGlobalTransaction s
, PS.globalPosting = sGlobalPosting s
, PS.revGlobalPosting = sRevGlobalPosting s
, PS.fileTransaction = sFileTransaction s
, PS.revFileTransaction = sRevFileTransaction s
, PS.filePosting = sFilePosting s
, PS.revFilePosting = sRevFilePosting s
, PS.filtered = sFiltered s
, PS.revFiltered = sRevFiltered s
, PS.sorted = sSorted s
, PS.revSorted = sRevSorted s
, PS.visible = sVisible s
, PS.revVisible = sRevVisible s
, PS.lineNum = sLineNum s
, PS.date = sDate s
, PS.flag = sFlag s
, PS.number = sNumber s
, PS.payee = sPayee s
, PS.account = sAccount s
, PS.postingDrCr = sPostingDrCr s
, PS.postingCmdty = sPostingCmdty s
, PS.postingQty = sPostingQty s
, PS.totalDrCr = sTotalDrCr s
, PS.totalCmdty = sTotalCmdty s
}
convFields :: Fields a -> PF.Fields a
convFields f = PF.Fields
{ PF.globalTransaction = fGlobalTransaction f
, PF.revGlobalTransaction = fRevGlobalTransaction f
, PF.globalPosting = fGlobalPosting f
, PF.revGlobalPosting = fRevGlobalPosting f
, PF.fileTransaction = fFileTransaction f
, PF.revFileTransaction = fRevFileTransaction f
, PF.filePosting = fFilePosting f
, PF.revFilePosting = fRevFilePosting f
, PF.filtered = fFiltered f
, PF.revFiltered = fRevFiltered f
, PF.sorted = fSorted f
, PF.revSorted = fRevSorted f
, PF.visible = fVisible f
, PF.revVisible = fRevVisible f
, PF.lineNum = fLineNum f
, PF.date = fDate f
, PF.flag = fFlag f
, PF.number = fNumber f
, PF.payee = fPayee f
, PF.account = fAccount f
, PF.postingDrCr = fPostingDrCr f
, PF.postingCmdty = fPostingCmdty f
, PF.postingQty = fPostingQty f
, PF.totalDrCr = fTotalDrCr f
, PF.totalCmdty = fTotalCmdty f
, PF.totalQty = fTotalQty f
, PF.tags = fTags f
, PF.memo = fMemo f
, PF.filename = fFilename f
}