{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Prices (
pricesmode
,prices
)
where
import qualified Data.Map as M
import Data.List
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Hledger
import Hledger.Cli.CliOptions
import System.Console.CmdArgs.Explicit
pricesmode :: Mode RawOpts
pricesmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Prices.txt")
[forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"infer-reverse-prices"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"infer-reverse-prices") CommandDoc
"also show prices obtained by inverting transaction prices"
]
[(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
([Flag RawOpts]
hiddenflags forall a. [a] -> [a] -> [a]
++
[forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"costs"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"infer-market-prices") CommandDoc
"deprecated, use --infer-market-prices instead"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"inverted-costs"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"infer-reverse-prices") CommandDoc
"deprecated, use --infer-reverse-prices instead"
])
([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[QUERY]")
prices :: CliOpts -> Journal -> IO ()
prices CliOpts
opts Journal
j = do
let
styles :: Map Text AmountStyle
styles = Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j
q :: Query
q = ReportSpec -> Query
_rsQuery forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts
ps :: [Posting]
ps = forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
q) forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
allPostings Journal
j
mprices :: [PriceDirective]
mprices = Journal -> [PriceDirective]
jpricedirectives Journal
j
cprices :: [PriceDirective]
cprices =
forall a b. (a -> b) -> [a] -> [b]
map (Map Text AmountStyle -> PriceDirective -> PriceDirective
stylePriceDirectiveExceptPrecision Map Text AmountStyle
styles) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> [PriceDirective]
postingPriceDirectivesFromCost [Posting]
ps
rcprices :: [PriceDirective]
rcprices =
forall a b. (a -> b) -> [a] -> [b]
map (Map Text AmountStyle -> PriceDirective -> PriceDirective
stylePriceDirectiveExceptPrecision Map Text AmountStyle
styles) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Posting -> [PriceDirective]
postingPriceDirectivesFromCost forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount ((Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount Amount -> Amount
invertPrice))
[Posting]
ps
allprices :: [PriceDirective]
allprices =
[PriceDirective]
mprices
forall a. [a] -> [a] -> [a]
++ forall {a}. CommandDoc -> [a] -> [a]
ifBoolOpt CommandDoc
"infer-market-prices" [PriceDirective]
cprices
forall a. [a] -> [a] -> [a]
++ forall {a}. CommandDoc -> [a] -> [a]
ifBoolOpt CommandDoc
"infer-reverse-prices" [PriceDirective]
rcprices
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
T.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. PriceDirective -> Text
showPriceDirective) forall a b. (a -> b) -> a -> b
$
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn PriceDirective -> Day
pddate forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> PriceDirective -> Bool
matchesPriceDirective Query
q) forall a b. (a -> b) -> a -> b
$
[PriceDirective]
allprices
where
ifBoolOpt :: CommandDoc -> [a] -> [a]
ifBoolOpt CommandDoc
opt | CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
opt forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts = forall a. a -> a
id
| Bool
otherwise = forall a b. a -> b -> a
const []
showPriceDirective :: PriceDirective -> T.Text
showPriceDirective :: PriceDirective -> Text
showPriceDirective PriceDirective
mp = [Text] -> Text
T.unwords [Text
"P", CommandDoc -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> CommandDoc
show forall a b. (a -> b) -> a -> b
$ PriceDirective -> Day
pddate PriceDirective
mp, Text -> Text
quoteCommoditySymbolIfNeeded forall a b. (a -> b) -> a -> b
$ PriceDirective -> Text
pdcommodity PriceDirective
mp, WideBuilder -> Text
wbToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> Amount -> WideBuilder
showAmountB AmountDisplayOpts
noColour{displayZeroCommodity :: Bool
displayZeroCommodity=Bool
True} forall a b. (a -> b) -> a -> b
$ PriceDirective -> Amount
pdamount PriceDirective
mp]
invertPrice :: Amount -> Amount
invertPrice :: Amount -> Amount
invertPrice Amount
a =
case Amount -> Maybe AmountPrice
aprice Amount
a of
Maybe AmountPrice
Nothing -> Amount
a
Just (UnitPrice Amount
pa) -> Amount -> Amount
invertPrice
Amount
a { aprice :: Maybe AmountPrice
aprice = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
TotalPrice Amount
pa' } where
pa' :: Amount
pa' = ((Quantity
1 forall a. Fractional a => a -> a -> a
/ Amount -> Quantity
aquantity Amount
a) Quantity -> Amount -> Amount
`divideAmount` Amount
pa) { aprice :: Maybe AmountPrice
aprice = forall a. Maybe a
Nothing }
Just (TotalPrice Amount
pa) ->
Amount
a { aquantity :: Quantity
aquantity = Amount -> Quantity
aquantity Amount
pa forall a. Num a => a -> a -> a
* forall {a} {a}. (Ord a, Num a, Num a) => a -> a
nonZeroSignum (Amount -> Quantity
aquantity Amount
a), acommodity :: Text
acommodity = Amount -> Text
acommodity Amount
pa, aprice :: Maybe AmountPrice
aprice = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
TotalPrice Amount
pa' } where
pa' :: Amount
pa' = Amount
pa { aquantity :: Quantity
aquantity = forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
a, acommodity :: Text
acommodity = Amount -> Text
acommodity Amount
a, aprice :: Maybe AmountPrice
aprice = forall a. Maybe a
Nothing, astyle :: AmountStyle
astyle = Amount -> AmountStyle
astyle Amount
a }
where
nonZeroSignum :: a -> a
nonZeroSignum a
x = if a
x forall a. Ord a => a -> a -> Bool
< a
0 then -a
1 else a
1
stylePriceDirectiveExceptPrecision :: M.Map CommoditySymbol AmountStyle -> PriceDirective -> PriceDirective
stylePriceDirectiveExceptPrecision :: Map Text AmountStyle -> PriceDirective -> PriceDirective
stylePriceDirectiveExceptPrecision Map Text AmountStyle
styles pd :: PriceDirective
pd@PriceDirective{pdamount :: PriceDirective -> Amount
pdamount=Amount
a} =
PriceDirective
pd{pdamount :: Amount
pdamount = Map Text AmountStyle -> Amount -> Amount
styleAmountExceptPrecision Map Text AmountStyle
styles Amount
a}
allPostings :: Journal -> [Posting]
allPostings :: Journal -> [Posting]
allPostings = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns