    {-# LANGUAGE TemplateHaskell #-}

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

    import qualified Data.Map as M
    import Data.Maybe
    import Data.List
    import qualified Data.Text as T
    import Data.Time
    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")
      [[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
    forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
    flagNone ["costs"] (CommandDoc -> RawOpts -> RawOpts
    setboolopt "costs") "print transaction prices from postings"
      ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
    forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
    flagNone ["inverted-costs"] (CommandDoc -> RawOpts -> RawOpts
    setboolopt "inverted-costs") "print transaction inverted prices from postings also"]
      [(CommandDoc, [Flag RawOpts])
    generalflagsgroup1]
      [Flag RawOpts]
    hiddenflags
      ([], 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
    $ CommandDoc -> Arg RawOpts
    argsFlag "[QUERY]")

    -- XXX the original hledger-prices script always ignored assertions
    prices :: CliOpts -> Journal -> IO ()
    prices opts :: CliOpts
    opts j :: Journal
    j = do
      Day
    d <- IO Day
    getCurrentDay
      let
        styles :: Map CommoditySymbol AmountStyle
    styles     = Journal -> Map CommoditySymbol AmountStyle
    journalCommodityStyles Journal
    j
        q :: Query
    q          = Day -> ReportOpts -> Query
    queryFromOpts Day
    d (CliOpts -> ReportOpts
    reportopts_ CliOpts
    opts)
        ps :: [Posting]
    ps         = (Posting -> Bool) -> [Posting] -> [Posting]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Query -> Posting -> Bool
    matchesPosting Query
    q) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
    forall a b. (a -> b) -> a -> b
    $ Journal -> [Posting]
    allPostings Journal
    j
        mprices :: [PriceDirective]
    mprices    = Journal -> [PriceDirective]
    jpricedirectives Journal
    j
        cprices :: [PriceDirective]
    cprices    = (PriceDirective -> PriceDirective)
    -> [PriceDirective] -> [PriceDirective]
    forall a b. (a -> b) -> [a] -> [b]
    map (Map CommoditySymbol AmountStyle -> PriceDirective -> PriceDirective
    stylePriceDirectiveExceptPrecision Map CommoditySymbol AmountStyle
    styles) ([PriceDirective] -> [PriceDirective])
    -> [PriceDirective] -> [PriceDirective]
    forall a b. (a -> b) -> a -> b
    $ (Posting -> [PriceDirective]) -> [Posting] -> [PriceDirective]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Posting -> [PriceDirective]
    postingsPriceDirectivesFromCosts [Posting]
    ps
        icprices :: [PriceDirective]
    icprices   = (PriceDirective -> PriceDirective)
    -> [PriceDirective] -> [PriceDirective]
    forall a b. (a -> b) -> [a] -> [b]
    map (Map CommoditySymbol AmountStyle -> PriceDirective -> PriceDirective
    stylePriceDirectiveExceptPrecision Map CommoditySymbol AmountStyle
    styles) ([PriceDirective] -> [PriceDirective])
    -> [PriceDirective] -> [PriceDirective]
    forall a b. (a -> b) -> a -> b
    $ (Posting -> [PriceDirective]) -> [Posting] -> [PriceDirective]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Posting -> [PriceDirective]
    postingsPriceDirectivesFromCosts ([Posting] -> [PriceDirective]) -> [Posting] -> [PriceDirective]
    forall a b. (a -> b) -> a -> b
    $ (Amount -> Amount) -> [Posting] -> [Posting]
    mapAmount Amount -> Amount
    invertPrice [Posting]
    ps
        allprices :: [PriceDirective]
    allprices  = [PriceDirective]
    mprices [PriceDirective] -> [PriceDirective] -> [PriceDirective]
    forall a. [a] -> [a] -> [a]
    ++ CommandDoc -> [PriceDirective] -> [PriceDirective]
    forall a. CommandDoc -> [a] -> [a]
    ifBoolOpt "costs" [PriceDirective]
    cprices [PriceDirective] -> [PriceDirective] -> [PriceDirective]
    forall a. [a] -> [a] -> [a]
    ++ CommandDoc -> [PriceDirective] -> [PriceDirective]
    forall a. CommandDoc -> [a] -> [a]
    ifBoolOpt "inverted-costs" [PriceDirective]
    icprices
      (PriceDirective -> IO ()) -> [PriceDirective] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (CommandDoc -> IO ()
    putStrLn (CommandDoc -> IO ())
    -> (PriceDirective -> CommandDoc) -> PriceDirective -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PriceDirective -> CommandDoc
    showPriceDirective) ([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] -> [PriceDirective])
    -> [PriceDirective] -> [PriceDirective]
    forall a b. (a -> b) -> a -> b
    $
        (PriceDirective -> Bool) -> [PriceDirective] -> [PriceDirective]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Query -> PriceDirective -> Bool
    matchesPriceDirective Query
    q) ([PriceDirective] -> [PriceDirective])
    -> [PriceDirective] -> [PriceDirective]
    forall a b. (a -> b) -> a -> b
    $
        [PriceDirective]
    allprices
      where
        ifBoolOpt :: CommandDoc -> [a] -> [a]
    ifBoolOpt opt :: CommandDoc
    opt | CommandDoc -> RawOpts -> Bool
    boolopt CommandDoc
    opt (RawOpts -> Bool) -> RawOpts -> Bool
    forall a b. (a -> b) -> a -> b
    $ CliOpts -> RawOpts
    rawopts_ CliOpts
    opts = [a] -> [a]
    forall a. a -> a
    id
                      | Bool
    otherwise = [a] -> [a] -> [a]
    forall a b. a -> b -> a
    const []

    showPriceDirective :: PriceDirective -> String
    showPriceDirective :: PriceDirective -> CommandDoc
    showPriceDirective mp :: PriceDirective
    mp = [CommandDoc] -> CommandDoc
    unwords ["P", Day -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show (Day -> CommandDoc) -> Day -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ PriceDirective -> Day
    pddate PriceDirective
    mp, CommoditySymbol -> CommandDoc
    T.unpack (CommoditySymbol -> CommandDoc)
    -> (CommoditySymbol -> CommoditySymbol)
    -> CommoditySymbol
    -> CommandDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommoditySymbol -> CommoditySymbol
    quoteCommoditySymbolIfNeeded (CommoditySymbol -> CommandDoc) -> CommoditySymbol -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ PriceDirective -> CommoditySymbol
    pdcommodity PriceDirective
    mp, Amount -> CommandDoc
    showAmountWithZeroCommodity (Amount -> CommandDoc) -> Amount -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ PriceDirective -> Amount
    pdamount PriceDirective
    mp]

    divideAmount' :: Quantity -> Amount -> Amount
    divideAmount' :: Quantity -> Amount -> Amount
    divideAmount' n :: Quantity
    n a :: Amount
    a = Amount
    a' where
        a' :: Amount
    a' = (Quantity
    n Quantity -> Amount -> Amount
    `divideAmount` Amount
    a) { astyle :: AmountStyle
    astyle = AmountStyle
    style' }
        style' :: AmountStyle
    style' = (Amount -> AmountStyle
    astyle Amount
    a) { asprecision :: AmountPrecision
    asprecision = AmountPrecision
    precision' }
        extPrecision :: Word8
    extPrecision = (1Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    +) (Word8 -> Word8) -> (Double -> Word8) -> Double -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Double -> Word8
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Word8) -> (Double -> Double) -> Double -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Double -> Double -> Double
    forall a. Floating a => a -> a -> a
    logBase 10 (Double -> Word8) -> Double -> Word8
    forall a b. (a -> b) -> a -> b
    $ (Quantity -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac Quantity
    n :: Double)
        precision' :: AmountPrecision
    precision' = case AmountStyle -> AmountPrecision
    asprecision (Amount -> AmountStyle
    astyle Amount
    a) of
                          NaturalPrecision -> AmountPrecision
    NaturalPrecision
                          Precision p :: Word8
    p      -> Word8 -> AmountPrecision
    Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
    forall a b. (a -> b) -> a -> b
    $ Word8
    extPrecision Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    p

    -- XXX

    -- | Invert an amount's price for --invert-cost, somehow ? Unclear.
    invertPrice :: Amount -> Amount
    invertPrice :: Amount -> Amount
    invertPrice a :: Amount
    a =
        case Amount -> Maybe AmountPrice
    aprice Amount
    a of
            Nothing -> Amount
    a
            Just (UnitPrice pa :: Amount
    pa) -> Amount -> Amount
    invertPrice
                -- normalize to TotalPrice
                Amount
    a { aprice :: Maybe AmountPrice
    aprice = AmountPrice -> Maybe AmountPrice
    forall a. a -> Maybe a
    Just (AmountPrice -> Maybe AmountPrice)
    -> AmountPrice -> Maybe AmountPrice
    forall a b. (a -> b) -> a -> b
    $ Amount -> AmountPrice
    TotalPrice Amount
    pa' } where
                    pa' :: Amount
    pa' = ((1 Quantity -> Quantity -> Quantity
    forall a. Fractional a => a -> a -> a
    / Amount -> Quantity
    aquantity Amount
    a) Quantity -> Amount -> Amount
    `divideAmount` Amount
    pa) { aprice :: Maybe AmountPrice
    aprice = Maybe AmountPrice
    forall a. Maybe a
    Nothing }
            Just (TotalPrice pa :: Amount
    pa) ->
                Amount
    a { aquantity :: Quantity
    aquantity = Amount -> Quantity
    aquantity Amount
    pa Quantity -> Quantity -> Quantity
    forall a. Num a => a -> a -> a
    * Quantity -> Quantity
    forall a. Num a => a -> a
    signum (Amount -> Quantity
    aquantity Amount
    a), acommodity :: CommoditySymbol
    acommodity = Amount -> CommoditySymbol
    acommodity Amount
    pa, aprice :: Maybe AmountPrice
    aprice = AmountPrice -> Maybe AmountPrice
    forall a. a -> Maybe a
    Just (AmountPrice -> Maybe AmountPrice)
    -> AmountPrice -> Maybe AmountPrice
    forall a b. (a -> b) -> a -> b
    $ Amount -> AmountPrice
    TotalPrice Amount
    pa' } where
                    pa' :: Amount
    pa' = Amount
    pa { aquantity :: Quantity
    aquantity = Quantity -> Quantity
    forall a. Num a => a -> a
    abs (Quantity -> Quantity) -> Quantity -> Quantity
    forall a b. (a -> b) -> a -> b
    $ Amount -> Quantity
    aquantity Amount
    a, acommodity :: CommoditySymbol
    acommodity = Amount -> CommoditySymbol
    acommodity Amount
    a, aprice :: Maybe AmountPrice
    aprice = Maybe AmountPrice
    forall a. Maybe a
    Nothing, astyle :: AmountStyle
    astyle = Amount -> AmountStyle
    astyle Amount
    a }

    postingsPriceDirectivesFromCosts :: Posting -> [PriceDirective]
    postingsPriceDirectivesFromCosts :: Posting -> [PriceDirective]
    postingsPriceDirectivesFromCosts p :: Posting
    p = (Amount -> Maybe PriceDirective) -> [Amount] -> [PriceDirective]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Day -> Amount -> Maybe PriceDirective
    amountPriceDirectiveFromCost Day
    date) ([Amount] -> [PriceDirective])
    -> (MixedAmount -> [Amount]) -> MixedAmount -> [PriceDirective]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MixedAmount -> [Amount]
    amounts (MixedAmount -> [PriceDirective])
    -> MixedAmount -> [PriceDirective]
    forall a b. (a -> b) -> a -> b
    $ Posting -> MixedAmount
    pamount Posting
    p  where
       date :: Day
    date = Day -> Maybe Day -> Day
    forall a. a -> Maybe a -> a
    fromMaybe (Transaction -> Day
    tdate (Transaction -> Day)
    -> (Maybe Transaction -> Transaction) -> Maybe Transaction -> Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Transaction -> Transaction
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Transaction -> Day) -> Maybe Transaction -> Day
    forall a b. (a -> b) -> a -> b
    $ Posting -> Maybe Transaction
    ptransaction Posting
    p) (Maybe Day -> Day) -> Maybe Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Posting -> Maybe Day
    pdate Posting
    p

    amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective
    amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective
    amountPriceDirectiveFromCost d :: Day
    d a :: Amount
    a =
        case Amount -> Maybe AmountPrice
    aprice Amount
    a of
            Nothing -> Maybe PriceDirective
    forall a. Maybe a
    Nothing
            Just (UnitPrice pa :: Amount
    pa) -> PriceDirective -> Maybe PriceDirective
    forall a. a -> Maybe a
    Just
                PriceDirective :: Day -> CommoditySymbol -> Amount -> PriceDirective
    PriceDirective { pddate :: Day
    pddate = Day
    d, pdcommodity :: CommoditySymbol
    pdcommodity = Amount -> CommoditySymbol
    acommodity Amount
    a, pdamount :: Amount
    pdamount = Amount
    pa }
            Just (TotalPrice pa :: Amount
    pa) -> PriceDirective -> Maybe PriceDirective
    forall a. a -> Maybe a
    Just
                PriceDirective :: Day -> CommoditySymbol -> Amount -> PriceDirective
    PriceDirective { pddate :: Day
    pddate = Day
    d, pdcommodity :: CommoditySymbol
    pdcommodity = Amount -> CommoditySymbol
    acommodity Amount
    a, pdamount :: Amount
    pdamount = Quantity -> Quantity
    forall a. Num a => a -> a
    abs (Amount -> Quantity
    aquantity Amount
    a) Quantity -> Amount -> Amount
    `divideAmount'` Amount
    pa }

    -- | Given a map of standard amount display styles, apply the
    -- appropriate one, if any, to this price directive's amount.
    -- But keep the number of decimal places unchanged.
    stylePriceDirectiveExceptPrecision :: M.Map CommoditySymbol AmountStyle -> PriceDirective -> PriceDirective
    stylePriceDirectiveExceptPrecision :: Map CommoditySymbol AmountStyle -> PriceDirective -> PriceDirective
    stylePriceDirectiveExceptPrecision styles :: Map CommoditySymbol AmountStyle
    styles pd :: PriceDirective
    pd@PriceDirective{pdamount :: PriceDirective -> Amount
    pdamount=Amount
    a} =
      PriceDirective
    pd{pdamount :: Amount
    pdamount = Map CommoditySymbol AmountStyle -> Amount -> Amount
    styleAmountExceptPrecision Map CommoditySymbol AmountStyle
    styles Amount
    a}

    allPostings :: Journal -> [Posting]
    allPostings :: Journal -> [Posting]
    allPostings = (Transaction -> [Posting]) -> [Transaction] -> [Posting]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Transaction -> [Posting]
    tpostings ([Transaction] -> [Posting])
    -> (Journal -> [Transaction]) -> Journal -> [Posting]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Journal -> [Transaction]
    jtxns

    mapAmount :: (Amount -> Amount) -> [Posting] -> [Posting]
    mapAmount :: (Amount -> Amount) -> [Posting] -> [Posting]
    mapAmount f :: Amount -> Amount
    f = (Posting -> Posting) -> [Posting] -> [Posting]
    forall a b. (a -> b) -> [a] -> [b]
    map Posting -> Posting
    pf where
        pf :: Posting -> Posting
    pf p :: Posting
    p = Posting
    p { pamount :: MixedAmount
    pamount = MixedAmount -> MixedAmount
    mf (Posting -> MixedAmount
    pamount Posting
    p) }
        mf :: MixedAmount -> MixedAmount
    mf = [Amount] -> MixedAmount
    mixed ([Amount] -> MixedAmount)
    -> (MixedAmount -> [Amount]) -> MixedAmount -> MixedAmount
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Amount -> Amount) -> [Amount] -> [Amount]
    forall a b. (a -> b) -> [a] -> [b]
    map Amount -> Amount
    f ([Amount] -> [Amount])
    -> (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MixedAmount -> [Amount]
    amounts