{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NamedFieldPuns #-}
module Hledger.Cli.Commands.Prices (
pricesmode
,prices
)
where
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
import Data.Maybe (mapMaybe)
import Data.Function ((&))
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
"show-reverse"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"show-reverse")
CommandDoc
"also show the prices inferred by reversing known 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
"show-reverse") CommandDoc
"deprecated, use --show-reverse instead"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"infer-reverse-prices"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"show-reverse") CommandDoc
"deprecated, use --show-reverse instead"
])
([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[QUERY]")
instance HasAmounts PriceDirective where
styleAmounts :: Map Text AmountStyle -> PriceDirective -> PriceDirective
styleAmounts Map Text AmountStyle
styles PriceDirective
pd = PriceDirective
pd{pdamount :: Amount
pdamount=forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles forall a b. (a -> b) -> a -> b
$ PriceDirective -> Amount
pdamount PriceDirective
pd}
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
declaredprices :: [PriceDirective]
declaredprices =
Journal -> [PriceDirective]
jpricedirectives Journal
j
pricesfromcosts :: [PriceDirective]
pricesfromcosts =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> [PriceDirective]
postingPriceDirectivesFromCost forall a b. (a -> b) -> a -> b
$
Journal -> [Posting]
journalPostings Journal
j
forwardprices :: [PriceDirective]
forwardprices =
if CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"infer-market-prices" (CliOpts -> RawOpts
rawopts_ CliOpts
opts)
then [PriceDirective]
declaredprices [PriceDirective] -> [PriceDirective] -> [PriceDirective]
`mergePriceDirectives` [PriceDirective]
pricesfromcosts
else [PriceDirective]
declaredprices
reverseprices :: [PriceDirective]
reverseprices =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PriceDirective -> Maybe PriceDirective
reversePriceDirective [PriceDirective]
forwardprices
allprices :: [PriceDirective]
allprices =
if CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"show-reverse" (CliOpts -> RawOpts
rawopts_ CliOpts
opts)
then [PriceDirective]
forwardprices [PriceDirective] -> [PriceDirective] -> [PriceDirective]
`mergePriceDirectives` [PriceDirective]
reverseprices
else [PriceDirective]
forwardprices
filteredprices :: [PriceDirective]
filteredprices =
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> PriceDirective -> Bool
matchesPriceDirective Query
q) [PriceDirective]
allprices
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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles) forall a b. (a -> b) -> a -> b
$
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn PriceDirective -> Day
pddate [PriceDirective]
filteredprices
mergePriceDirectives :: [PriceDirective] -> [PriceDirective] -> [PriceDirective]
mergePriceDirectives :: [PriceDirective] -> [PriceDirective] -> [PriceDirective]
mergePriceDirectives [PriceDirective]
pds1 [PriceDirective]
pds2 =
[PriceDirective]
pds1 forall a. [a] -> [a] -> [a]
++ [ PriceDirective
pd | PriceDirective
pd <- [PriceDirective]
pds2 , PriceDirective -> (Day, Text, Text)
pdid PriceDirective
pd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [(Day, Text, Text)]
pds1ids ]
where
pds1ids :: [(Day, Text, Text)]
pds1ids = forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> (Day, Text, Text)
pdid [PriceDirective]
pds1
pdid :: PriceDirective -> (Day, Text, Text)
pdid PriceDirective{Day
pddate :: Day
pddate :: PriceDirective -> Day
pddate,Text
pdcommodity :: PriceDirective -> Text
pdcommodity :: Text
pdcommodity,Amount
pdamount :: Amount
pdamount :: PriceDirective -> Amount
pdamount} = (Day
pddate, Text
pdcommodity, Amount -> Text
acommodity Amount
pdamount)
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
]
reversePriceDirective :: PriceDirective -> Maybe PriceDirective
reversePriceDirective :: PriceDirective -> Maybe PriceDirective
reversePriceDirective pd :: PriceDirective
pd@PriceDirective{pdcommodity :: PriceDirective -> Text
pdcommodity=Text
c, pdamount :: PriceDirective -> Amount
pdamount=Amount
a}
| Amount -> Bool
amountIsZero Amount
a = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just PriceDirective
pd{pdcommodity :: Text
pdcommodity=Amount -> Text
acommodity Amount
a, pdamount :: Amount
pdamount=Amount
a'}
where
lbl :: CommandDoc -> CommandDoc -> CommandDoc
lbl = CommandDoc -> CommandDoc -> CommandDoc -> CommandDoc
lbl_ CommandDoc
"reversePriceDirective"
a' :: Amount
a' =
Maybe Word8 -> Amount -> Amount
amountSetFullPrecisionOr (forall a. a -> Maybe a
Just Word8
defaultMaxPrecision) forall a b. (a -> b) -> a -> b
$
Amount -> Amount
invertAmount Amount
a{acommodity :: Text
acommodity=Text
c}
forall a b. a -> (a -> b) -> b
& forall a. Show a => (a -> CommandDoc) -> a -> a
dbg9With (CommandDoc -> CommandDoc -> CommandDoc
lbl CommandDoc
"calculated reverse price"forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> CommandDoc
showAmount)