    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TemplateHaskell   #-}
    {-# LANGUAGE NamedFieldPuns #-}

    module Hledger.Cli.Commands.Prices (
      pricesmode
     ,prices
    )
    where

    import Data.List
    import Data.Text qualified as T
    import Data.Text.IO qualified as T
    import Hledger
    import Hledger.Cli.CliOptions
    import System.Console.CmdArgs.Explicit
    import Data.Maybe (mapMaybe)
    import Data.Function ((&))

    pricesmode :: Mode RawOpts
    pricesmode = CommandHelpStr
    -> [Flag RawOpts]
    -> [(CommandHelpStr, [Flag RawOpts])]
    -> [Flag RawOpts]
    -> ([Arg RawOpts], Maybe (Arg RawOpts))
    -> Mode RawOpts
    hledgerCommandMode
      $(embedFileRelative "Hledger/Cli/Commands/Prices.txt")
      [[CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "show-reverse"] (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "show-reverse")
        CommandHelpStr
    "also show the prices inferred by reversing known prices"
      ]
      [(CommandHelpStr, [Flag RawOpts])]
    cligeneralflagsgroups1
      ([Flag RawOpts]
    hiddenflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
    forall a. [a] -> [a] -> [a]
    ++
      [[CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "costs"]                (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "infer-market-prices") CommandHelpStr
    "deprecated, use --infer-market-prices instead"
      ,[CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "inverted-costs"]       (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "show-reverse") CommandHelpStr
    "deprecated, use --show-reverse instead"
      ,[CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "infer-reverse-prices"] (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "show-reverse") CommandHelpStr
    "deprecated, use --show-reverse instead"
      ])
      ([], Arg RawOpts -> Maybe (Arg RawOpts)
    forall a. a -> Maybe a
    Just (Arg RawOpts -> Maybe (Arg RawOpts))
    -> Arg RawOpts -> Maybe (Arg RawOpts)
    forall a b. (a -> b) -> a -> b
    $ CommandHelpStr -> Arg RawOpts
    argsFlag CommandHelpStr
    "[QUERY]")

    instance HasAmounts PriceDirective where
      styleAmounts :: Map Text AmountStyle -> PriceDirective -> PriceDirective
    styleAmounts Map Text AmountStyle
    styles PriceDirective
    pd = PriceDirective
    pd{pdamount=styleAmounts styles $ pdamount pd}

    -- List market prices.
    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 (ReportSpec -> Query) -> ReportSpec -> Query
    forall a b. (a -> b) -> a -> b
    $ CliOpts -> ReportSpec
    reportspec_ CliOpts
    opts

        -- XXX duplicates logic in Hledger.Data.Valuation.makePriceGraph, keep synced

        declaredprices :: [PriceDirective]
    declaredprices =
          -- dbg0 "declaredprices" $
          Journal -> [PriceDirective]
    jpricedirectives Journal
    j

        pricesfromcosts :: [PriceDirective]
    pricesfromcosts =
          -- dbg0 "pricesfromcosts" $
          (Posting -> [PriceDirective]) -> [Posting] -> [PriceDirective]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Posting -> [PriceDirective]
    postingPriceDirectivesFromCost ([Posting] -> [PriceDirective]) -> [Posting] -> [PriceDirective]
    forall a b. (a -> b) -> a -> b
    $
          Journal -> [Posting]
    journalPostings Journal
    j

        forwardprices :: [PriceDirective]
    forwardprices =
          -- dbg0 "forwardprices" $
          if CommandHelpStr -> RawOpts -> Bool
    boolopt CommandHelpStr
    "infer-market-prices" (CliOpts -> RawOpts
    rawopts_ CliOpts
    opts)
          then [PriceDirective]
    declaredprices [PriceDirective] -> [PriceDirective] -> [PriceDirective]
    `mergePriceDirectives` [PriceDirective]
    pricesfromcosts
          else [PriceDirective]
    declaredprices

        reverseprices :: [PriceDirective]
    reverseprices =
          -- dbg0 "reverseprices" $
          (PriceDirective -> Maybe PriceDirective)
    -> [PriceDirective] -> [PriceDirective]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe PriceDirective -> Maybe PriceDirective
    reversePriceDirective [PriceDirective]
    forwardprices

        allprices :: [PriceDirective]
    allprices =
          -- dbg0 "allprices" $
          if CommandHelpStr -> RawOpts -> Bool
    boolopt CommandHelpStr
    "show-reverse" (CliOpts -> RawOpts
    rawopts_ CliOpts
    opts)
          then [PriceDirective]
    forwardprices [PriceDirective] -> [PriceDirective] -> [PriceDirective]
    `mergePriceDirectives` [PriceDirective]
    reverseprices
          else [PriceDirective]
    forwardprices

        filteredprices :: [PriceDirective]
    filteredprices =
          -- dbg0 "filtered unsorted" $
          (PriceDirective -> Bool) -> [PriceDirective] -> [PriceDirective]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Query -> PriceDirective -> Bool
    matchesPriceDirective Query
    q) [PriceDirective]
    allprices

      (PriceDirective -> IO ()) -> [PriceDirective] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Text -> IO ()
    T.putStrLn (Text -> IO ())
    -> (PriceDirective -> Text) -> PriceDirective -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PriceDirective -> Text
    showPriceDirective (PriceDirective -> Text)
    -> (PriceDirective -> PriceDirective) -> PriceDirective -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Text AmountStyle -> PriceDirective -> PriceDirective
    forall a. HasAmounts a => Map Text AmountStyle -> a -> a
    styleAmounts Map Text AmountStyle
    styles) ([PriceDirective] -> IO ()) -> [PriceDirective] -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        (PriceDirective -> Day) -> [PriceDirective] -> [PriceDirective]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn PriceDirective -> Day
    pddate [PriceDirective]
    filteredprices

    -- XXX performance
    -- | Append any new price directives (with different from commodity,
    -- to commodity, or date) from the second list to the first.
    -- (Does not remove redundant prices from the first; just avoids adding more.)
    mergePriceDirectives :: [PriceDirective] -> [PriceDirective] -> [PriceDirective]
    mergePriceDirectives :: [PriceDirective] -> [PriceDirective] -> [PriceDirective]
    mergePriceDirectives [PriceDirective]
    pds1 [PriceDirective]
    pds2 =
      [PriceDirective]
    pds1 [PriceDirective] -> [PriceDirective] -> [PriceDirective]
    forall a. [a] -> [a] -> [a]
    ++ [ PriceDirective
    pd | PriceDirective
    pd <- [PriceDirective]
    pds2 , PriceDirective -> (Day, Text, Text)
    pdid PriceDirective
    pd (Day, Text, Text) -> [(Day, Text, Text)] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [(Day, Text, Text)]
    pds1ids ]
      where
        pds1ids :: [(Day, Text, Text)]
    pds1ids = (PriceDirective -> (Day, Text, Text))
    -> [PriceDirective] -> [(Day, Text, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map PriceDirective -> (Day, Text, Text)
    pdid [PriceDirective]
    pds1
        pdid :: PriceDirective -> (Day, Text, Text)
    pdid PriceDirective{Day
    pddate :: PriceDirective -> Day
    pddate :: Day
    pddate,Text
    pdcommodity :: Text
    pdcommodity :: PriceDirective -> Text
    pdcommodity,Amount
    pdamount :: PriceDirective -> Amount
    pdamount :: 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",
      CommandHelpStr -> Text
    T.pack (CommandHelpStr -> Text) -> (Day -> CommandHelpStr) -> Day -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> CommandHelpStr
    forall a. Show a => a -> CommandHelpStr
    show (Day -> Text) -> Day -> Text
    forall a b. (a -> b) -> a -> b
    $ PriceDirective -> Day
    pddate PriceDirective
    mp,
      Text -> Text
    quoteCommoditySymbolIfNeeded (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ PriceDirective -> Text
    pdcommodity PriceDirective
    mp,
      WideBuilder -> Text
    wbToText (WideBuilder -> Text) -> (Amount -> WideBuilder) -> Amount -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AmountFormat -> Amount -> WideBuilder
    showAmountB AmountFormat
    defaultFmt{displayZeroCommodity=True} (Amount -> Text) -> Amount -> Text
    forall a b. (a -> b) -> a -> b
    $ PriceDirective -> Amount
    pdamount PriceDirective
    mp
      ]

    -- | Convert a market price directive to a corresponding one in the
    -- opposite direction, if possible. (A price directive with a zero
    -- price can't be reversed.)
    --
    -- The price's display precision will be set to show all significant
    -- decimal digits (or if they appear infinite, a smaller default precision (8).
    -- This is visible eg in the prices command's output.
    --
    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 = Maybe PriceDirective
    forall a. Maybe a
    Nothing
      | Bool
    otherwise      = PriceDirective -> Maybe PriceDirective
    forall a. a -> Maybe a
    Just PriceDirective
    pd{pdcommodity=acommodity a, pdamount=a'}
        where
          lbl :: CommandHelpStr -> CommandHelpStr -> CommandHelpStr
    lbl = CommandHelpStr
    -> CommandHelpStr -> CommandHelpStr -> CommandHelpStr
    lbl_ CommandHelpStr
    "reversePriceDirective"
          a' :: Amount
    a' =
            Maybe Word8 -> Amount -> Amount
    amountSetFullPrecisionUpTo (Word8 -> Maybe Word8
    forall a. a -> Maybe a
    Just Word8
    defaultMaxPrecision) (Amount -> Amount) -> Amount -> Amount
    forall a b. (a -> b) -> a -> b
    $
            Amount -> Amount
    invertAmount Amount
    a{acommodity=c}
            Amount -> (Amount -> Amount) -> Amount
    forall a b. a -> (a -> b) -> b
    & (Amount -> CommandHelpStr) -> Amount -> Amount
    forall a. (a -> CommandHelpStr) -> a -> a
    dbg9With (CommandHelpStr -> CommandHelpStr -> CommandHelpStr
    lbl CommandHelpStr
    "calculated reverse price"(CommandHelpStr -> CommandHelpStr)
    -> (Amount -> CommandHelpStr) -> Amount -> CommandHelpStr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Amount -> CommandHelpStr
    showAmount)
            -- & dbg9With (lbl "precision of reverse price".show.amountDisplayPrecision)