module Penny.Cabin.Balance.Convert (
Opts(..)
, Sorter
, report
, cmdLineReport
, getSorter
) where
import Control.Applicative ((<$>), (<*>))
import qualified Control.Monad.Exception.Synchronous as Ex
import qualified Data.Tree as E
import qualified Data.Traversable as Tvbl
import qualified Penny.Cabin.Options as CO
import qualified Penny.Cabin.Parsers as CP
import qualified Penny.Cabin.Scheme as Scheme
import qualified Penny.Cabin.Balance.Util as U
import qualified Penny.Cabin.Balance.Convert.Chunker as K
import qualified Penny.Cabin.Balance.Convert.Options as O
import qualified Penny.Cabin.Balance.Convert.Parser as P
import qualified Penny.Cabin.Interface as I
import qualified Penny.Lincoln as L
import qualified Penny.Lincoln.Balance as Bal
import qualified Penny.Liberty as Ly
import qualified Penny.Shield as S
import qualified Data.Either as Ei
import qualified Data.Map as M
import qualified Data.Text as X
import Data.Monoid (mempty, mappend, mconcat)
import qualified System.Console.MultiArg as MA
data Opts = Opts
{ balanceFormat :: L.Commodity -> L.Qty -> X.Text
, showZeroBalances :: CO.ShowZeroBalances
, sorter :: Sorter
, target :: L.To
, dateTime :: L.DateTime
}
type Sorter =
(L.SubAccount, L.BottomLine)
-> (L.SubAccount, L.BottomLine)
-> Ordering
convertBalance ::
L.PriceDb
-> L.DateTime
-> L.To
-> L.Balance
-> Ex.Exceptional X.Text L.BottomLine
convertBalance db dt to bal = fmap mconcat r
where
r = mapM (convertOne db dt to) . M.assocs . L.unBalance $ bal
convertOne ::
L.PriceDb
-> L.DateTime
-> L.To
-> (L.Commodity, L.BottomLine)
-> Ex.Exceptional X.Text L.BottomLine
convertOne db dt to (cty, bl) =
case bl of
L.Zero -> return L.Zero
L.NonZero (L.Column dc qt) -> Ex.mapExceptional e g ex
where
ex = L.convert db dt to am
am = L.Amount qt cty Nothing Nothing
e = convertError to (L.From cty)
g r = L.NonZero (L.Column dc r)
convertError ::
L.To
-> L.From
-> L.PriceDbError
-> X.Text
convertError (L.To to) (L.From fr) e =
let fromErr = L.unCommodity fr
toErr = L.unCommodity to
in case e of
L.FromNotFound ->
X.pack "no data to convert from commodity "
`X.append` fromErr
L.ToNotFound ->
X.pack "no data to convert to commodity "
`X.append` toErr
L.CpuNotFound ->
X.pack "no data to convert from commodity "
`X.append` fromErr
`X.append` (X.pack " to commodity ")
`X.append` toErr
`X.append` (X.pack " at given date and time")
buildDb :: [L.PricePoint] -> L.PriceDb
buildDb = foldl f L.emptyDb where
f db pb = L.addPrice db pb
data ForestAndBL = ForestAndBL {
_tbForest :: E.Forest (L.SubAccount, L.BottomLine)
, _tbTotal :: L.BottomLine
, _tbTo :: L.To
}
rows :: ForestAndBL -> ([K.Row], L.To)
rows (ForestAndBL f tot to) = (first:second:rest, to)
where
first = K.ROneCol $ K.OneColRow 0 desc
desc = X.pack "All amounts reported in commodity: "
`X.append` (L.unCommodity
. L.unTo
$ to)
second = K.RMain $ K.MainRow 0 (X.pack "Total") tot
rest = map mainRow
. concatMap E.flatten
. map U.labelLevels
$ f
mainRow :: (Int, (L.SubAccount, L.BottomLine)) -> K.Row
mainRow (l, (a, b)) = K.RMain $ K.MainRow l x b
where
x = L.text a
report ::
Opts
-> [L.PricePoint]
-> [L.Box a]
-> Ex.Exceptional X.Text [Scheme.PreChunk]
report os@(Opts getFmt _ _ _ _) ps bs = do
fstBl <- sumConvertSort os ps bs
let (rs, L.To cy) = rows fstBl
fmt = getFmt cy
return $ K.rowsToChunks fmt rs
cmdLineReport
:: O.DefaultOpts
-> I.Report
cmdLineReport o rt = (help o, mkMode)
where
mkMode _ _ fsf = MA.Mode
{ MA.mName = "convert"
, MA.mIntersperse = MA.Intersperse
, MA.mOpts = map (fmap Right) P.allOptSpecs
, MA.mPosArgs = Left
, MA.mProcess = process rt o fsf }
process
:: S.Runtime
-> O.DefaultOpts
-> ([L.Transaction] -> [L.Box Ly.LibertyMeta])
-> [Either String (P.Opts -> Ex.Exceptional String P.Opts)]
-> Ex.Exceptional String (Either I.HelpStr I.ArgsAndReport)
process rt defaultOpts fsf ls = do
let (posArgs, parsed) = Ei.partitionEithers ls
op' = foldl (>>=) (return (O.toParserOpts defaultOpts rt)) parsed
case op' of
Ex.Exception s -> Ex.throw s
Ex.Success g -> return $
let noDefault = X.pack "no default price found"
in case fromParsedOpts g of
NeedsHelp -> Left $ help defaultOpts
DoReport f ->
let pr ts pps = do
rptOpts <- Ex.fromMaybe noDefault $
f pps (O.format defaultOpts)
let boxes = fsf ts
report rptOpts pps boxes
in Right (posArgs, pr)
sumConvertSort
:: Opts
-> [L.PricePoint]
-> [L.Box a]
-> Ex.Exceptional X.Text ForestAndBL
sumConvertSort os ps bs = mkResult <$> convertedFrst <*> convertedTot
where
(Opts _ szb str tgt dt) = os
bals = U.balances szb bs
(frst, tot) = U.sumForest mempty mappend bals
convertBal (a, bal) =
(\bl -> (a, bl)) <$> convertBalance db dt tgt bal
db = buildDb ps
convertedFrst = mapM (Tvbl.mapM convertBal) frst
convertedTot = convertBalance db dt tgt tot
mkResult f t = ForestAndBL (U.sortForest str f) t tgt
mostFrequent :: [L.PricePoint] -> Maybe L.To
mostFrequent = U.lastMode . map (L.to . L.price)
data HelpOrOpts
= NeedsHelp
| DoReport ( [L.PricePoint]
-> (L.Commodity -> L.Qty -> X.Text)
-> (Maybe Opts))
fromParsedOpts
:: P.Opts
-> HelpOrOpts
fromParsedOpts (P.Opts szb tgt dt so sb hlp) =
if hlp
then NeedsHelp
else DoReport $ \pps fmt -> case tgt of
P.ManualTarget to ->
Just $ Opts fmt szb (getSorter so sb) to dt
P.AutoTarget ->
case mostFrequent pps of
Nothing -> Nothing
Just to ->
Just $ Opts fmt szb (getSorter so sb) to dt
getSorter :: CP.SortOrder -> P.SortBy -> Sorter
getSorter o b = flipper f
where
flipper = case o of
CP.Ascending -> id
CP.Descending ->
\g p1 p2 -> case g p1 p2 of
LT -> GT
GT -> LT
EQ -> EQ
f p1@(a1, _) p2@(a2, _) = case b of
P.SortByName -> compare a1 a2
P.SortByQty -> cmpBottomLine p1 p2
cmpBottomLine :: Sorter
cmpBottomLine (n1, bl1) (n2, bl2) =
case (bl1, bl2) of
(L.Zero, L.Zero) -> EQ
(L.NonZero _, L.Zero) -> LT
(L.Zero, L.NonZero _) -> GT
(L.NonZero c1, L.NonZero c2) ->
mconcat [dc, qt, na]
where
dc = case (Bal.drCr c1, Bal.drCr c2) of
(L.Debit, L.Debit) -> EQ
(L.Debit, L.Credit) -> LT
(L.Credit, L.Debit) -> GT
(L.Credit, L.Credit) -> EQ
qt = compare (Bal.qty c1) (Bal.qty c2)
na = compare n1 n2
ifDefault :: Bool -> String
ifDefault b = if b then " (default)" else ""
help :: O.DefaultOpts -> String
help o = unlines $
[ "convert"
, " Show account balances, after converting all amounts"
, " to a single commodity. Accepts ONLY the following options:"
, ""
, "--show-zero-balances"
, " Show balances that are zero"
++ ifDefault (CO.unShowZeroBalances . O.showZeroBalances $ o)
, "--hide-zero-balances"
, " Hide balances that are zero"
++ ifDefault (not . CO.unShowZeroBalances . O.showZeroBalances $ o)
, ""
, "--commodity TARGET-COMMMODITY, -c TARGET-COMMODITY"
, " Convert all commodities to TARGET-COMMODITY."
] ++ case O.target o of
P.ManualTarget (L.To cy) ->
[ " default: " ++ (X.unpack . L.unCommodity $ cy) ]
_ -> []
++
[ "--auto-commodity"
, " convert all commodities to the commodity that appears most"
, " often as the target commodity in your price data. If"
, " there is a tie, the price closest to the end of your list"
, " of prices is used."
++ case O.target o of
P.AutoTarget -> " (default)"
_ -> ""
, ""
, "--date DATE-TIME, -d DATE-TIME"
, " Convert prices as of the date and time given"
, " (by default, the current date and time is used.)"
, ""
, "--sort qty|name, -s qty|name"
, " Sort balances by sub-account name"
++ ifDefault (O.sortBy o == P.SortByName)
++ " or by quantity"
++ ifDefault (O.sortBy o == P.SortByQty)
, "--ascending"
, " Sort in ascending order"
++ ifDefault (O.sortOrder o == CP.Ascending)
, "--descending"
, " Sort in descending order"
++ ifDefault (O.sortOrder o == CP.Descending)
, ""
, "--help, -h"
, " Show this help and exit"
]