    {-|

    Print some statistics for the journal.

    -}

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

    module Hledger.Cli.Commands.Stats (
      statsmode
     ,stats
    )
    where

    import Data.List
    import Data.List.Extra (nubSort)
    import Data.Maybe
    import Data.Ord
    import Data.HashSet (size, fromList)
    -- import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Time.Calendar
    import System.Console.CmdArgs.Explicit
    import Text.Printf
    import qualified Data.Map as Map

    import Hledger
    import Hledger.Cli.CliOptions
    import Prelude hiding (putStr)
    import Hledger.Cli.Utils (writeOutput)

    statsmode :: Mode RawOpts
    statsmode = CommandDoc
    -> [Flag RawOpts]
    -> [(CommandDoc, [Flag RawOpts])]
    -> [Flag RawOpts]
    -> ([Arg RawOpts], Maybe (Arg RawOpts))
    -> Mode RawOpts
    hledgerCommandMode
      $(embedFileRelative "Hledger/Cli/Commands/Stats.txt")
      [[CommandDoc]
    -> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
    forall a.
    [CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
    flagReq  ["output-file","o"]   (\s :: CommandDoc
    s opts :: RawOpts
    opts -> RawOpts -> Either CommandDoc RawOpts
    forall a b. b -> Either a b
    Right (RawOpts -> Either CommandDoc RawOpts)
    -> RawOpts -> Either CommandDoc RawOpts
    forall a b. (a -> b) -> a -> b
    $ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
    setopt "output-file" CommandDoc
    s RawOpts
    opts) "FILE" "write output to FILE."
      ]
      [(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]")

    -- like Register.summarisePostings
    -- | Print various statistics for the journal.
    stats :: CliOpts -> Journal -> IO ()
    stats :: CliOpts -> Journal -> IO ()
    stats opts :: CliOpts
    opts@CliOpts{reportopts_ :: CliOpts -> ReportOpts
    reportopts_=ReportOpts
    reportopts_} j :: Journal
    j = do
      Day
    d <- IO Day
    getCurrentDay
      let q :: Query
    q = Day -> ReportOpts -> Query
    queryFromOpts Day
    d ReportOpts
    reportopts_
          l :: Ledger
    l = Query -> Journal -> Ledger
    ledgerFromJournal Query
    q Journal
    j
          reportspan :: DateSpan
    reportspan = (Ledger -> DateSpan
    ledgerDateSpan Ledger
    l) DateSpan -> DateSpan -> DateSpan
    `spanDefaultsFrom` (Bool -> Query -> DateSpan
    queryDateSpan Bool
    False Query
    q)
          intervalspans :: [DateSpan]
    intervalspans = Interval -> DateSpan -> [DateSpan]
    splitSpan (ReportOpts -> Interval
    interval_ ReportOpts
    reportopts_) DateSpan
    reportspan
          showstats :: DateSpan -> CommandDoc
    showstats = Ledger -> Day -> DateSpan -> CommandDoc
    showLedgerStats Ledger
    l Day
    d
          s :: CommandDoc
    s = CommandDoc -> [CommandDoc] -> CommandDoc
    forall a. [a] -> [[a]] -> [a]
    intercalate "\n" ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ (DateSpan -> CommandDoc) -> [DateSpan] -> [CommandDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map DateSpan -> CommandDoc
    showstats [DateSpan]
    intervalspans
      CliOpts -> CommandDoc -> IO ()
    writeOutput CliOpts
    opts CommandDoc
    s

    showLedgerStats :: Ledger -> Day -> DateSpan -> String
    showLedgerStats :: Ledger -> Day -> DateSpan -> CommandDoc
    showLedgerStats l :: Ledger
    l today :: Day
    today span :: DateSpan
    span =
        [CommandDoc] -> CommandDoc
    unlines ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ ((CommandDoc, CommandDoc) -> CommandDoc)
    -> [(CommandDoc, CommandDoc)] -> [CommandDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(label :: CommandDoc
    label,value :: CommandDoc
    value) -> [CommandDoc] -> CommandDoc
    concatBottomPadded [CommandDoc -> CommandDoc -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf CommandDoc
    fmt1 CommandDoc
    label, CommandDoc
    value]) [(CommandDoc, CommandDoc)]
    stats
        where
          fmt1 :: CommandDoc
    fmt1 = "%-" CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ Int -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show Int
    w1 CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ "s: "
          -- fmt2 = "%-" ++ show w2 ++ "s"
          w1 :: Int
    w1 = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ ((CommandDoc, CommandDoc) -> Int)
    -> [(CommandDoc, CommandDoc)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (CommandDoc -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (CommandDoc -> Int)
    -> ((CommandDoc, CommandDoc) -> CommandDoc)
    -> (CommandDoc, CommandDoc)
    -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CommandDoc, CommandDoc) -> CommandDoc
    forall a b. (a, b) -> a
    fst) [(CommandDoc, CommandDoc)]
    stats
          -- w2 = maximum $ map (length . show . snd) stats
          stats :: [(CommandDoc, CommandDoc)]
    stats = [
             ("Main file" :: String, CommandDoc
    path) -- ++ " (from " ++ source ++ ")")
            ,("Included files", [CommandDoc] -> CommandDoc
    unlines ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ Int -> [CommandDoc] -> [CommandDoc]
    forall a. Int -> [a] -> [a]
    drop 1 ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
    forall a b. (a -> b) -> a -> b
    $ Journal -> [CommandDoc]
    journalFilePaths Journal
    j)
            ,("Transactions span", CommandDoc -> CommandDoc -> CommandDoc -> Integer -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "%s to %s (%d days)" (DateSpan -> CommandDoc
    start DateSpan
    span) (DateSpan -> CommandDoc
    end DateSpan
    span) Integer
    days)
            ,("Last transaction", CommandDoc -> (Day -> CommandDoc) -> Maybe Day -> CommandDoc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "none" Day -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show Maybe Day
    lastdate CommandDoc -> CommandDoc -> CommandDoc
    forall a. [a] -> [a] -> [a]
    ++ Maybe Integer -> CommandDoc
    forall p t.
    (IsString p, PrintfArg t, PrintfType p, Ord t, Num t) =>
    Maybe t -> p
    showelapsed Maybe Integer
    lastelapsed)
            ,("Transactions", CommandDoc -> Int -> Double -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "%d (%0.1f per day)" Int
    tnum Double
    txnrate)
            ,("Transactions last 30 days", CommandDoc -> Int -> Double -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "%d (%0.1f per day)" Int
    tnum30 Double
    txnrate30)
            ,("Transactions last 7 days", CommandDoc -> Int -> Double -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "%d (%0.1f per day)" Int
    tnum7 Double
    txnrate7)
            ,("Payees/descriptions", Int -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show (Int -> CommandDoc) -> Int -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ HashSet Text -> Int
    forall a. HashSet a -> Int
    size (HashSet Text -> Int) -> HashSet Text -> Int
    forall a b. (a -> b) -> a -> b
    $ [Text] -> HashSet Text
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
    forall a b. (a -> b) -> a -> b
    $ (Transaction -> Text) -> [Transaction] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Transaction -> Text
    tdescription) [Transaction]
    ts)
            ,("Accounts", CommandDoc -> Int -> Int -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "%d (depth %d)" Int
    acctnum Int
    acctdepth)
            ,("Commodities", CommandDoc -> CommandDoc -> Text -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "%s (%s)" (Int -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show (Int -> CommandDoc) -> Int -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    cs) (Text -> [Text] -> Text
    T.intercalate ", " [Text]
    cs))
            ,("Market prices", CommandDoc -> CommandDoc -> Text -> CommandDoc
    forall r. PrintfType r => CommandDoc -> r
    printf "%s (%s)" (Int -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show (Int -> CommandDoc) -> Int -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ [PriceDirective] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [PriceDirective]
    mktprices) (Text -> [Text] -> Text
    T.intercalate ", " [Text]
    mktpricecommodities))
          -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)
          -- Unmarked transactions      : %(unmarked)s
          -- Days since reconciliation   : %(reconcileelapsed)s
          -- Days since last transaction : %(recentelapsed)s
           ]
               where
                 j :: Journal
    j = Ledger -> Journal
    ljournal Ledger
    l
                 path :: CommandDoc
    path = Journal -> CommandDoc
    journalFilePath Journal
    j
                 ts :: [Transaction]
    ts = (Transaction -> Day) -> [Transaction] -> [Transaction]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn Transaction -> Day
    tdate ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
    forall a b. (a -> b) -> a -> b
    $ (Transaction -> Bool) -> [Transaction] -> [Transaction]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (DateSpan -> Day -> Bool
    spanContainsDate DateSpan
    span (Day -> Bool) -> (Transaction -> Day) -> Transaction -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transaction -> Day
    tdate) ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
    forall a b. (a -> b) -> a -> b
    $ Journal -> [Transaction]
    jtxns Journal
    j
                 as :: [Text]
    as = [Text] -> [Text]
    forall a. Eq a => [a] -> [a]
    nub ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ (Posting -> Text) -> [Posting] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Posting -> Text
    paccount ([Posting] -> [Text]) -> [Posting] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ (Transaction -> [Posting]) -> [Transaction] -> [Posting]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Transaction -> [Posting]
    tpostings [Transaction]
    ts
                 cs :: [Text]
    cs = (CommandDoc -> [Text])
    -> (Map Text AmountStyle -> [Text])
    -> Either CommandDoc (Map Text AmountStyle)
    -> [Text]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either CommandDoc -> [Text]
    forall a. CommandDoc -> a
    error' Map Text AmountStyle -> [Text]
    forall k a. Map k a -> [k]
    Map.keys (Either CommandDoc (Map Text AmountStyle) -> [Text])
    -> Either CommandDoc (Map Text AmountStyle) -> [Text]
    forall a b. (a -> b) -> a -> b
    $ [Amount] -> Either CommandDoc (Map Text AmountStyle)
    commodityStylesFromAmounts ([Amount] -> Either CommandDoc (Map Text AmountStyle))
    -> [Amount] -> Either CommandDoc (Map Text AmountStyle)
    forall a b. (a -> b) -> a -> b
    $ (Posting -> [Amount]) -> [Posting] -> [Amount]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (MixedAmount -> [Amount]
    amounts (MixedAmount -> [Amount])
    -> (Posting -> MixedAmount) -> Posting -> [Amount]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Posting -> MixedAmount
    pamount) ([Posting] -> [Amount]) -> [Posting] -> [Amount]
    forall a b. (a -> b) -> a -> b
    $ (Transaction -> [Posting]) -> [Transaction] -> [Posting]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Transaction -> [Posting]
    tpostings [Transaction]
    ts  -- PARTIAL:
                 lastdate :: Maybe Day
    lastdate | [Transaction] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Transaction]
    ts = Maybe Day
    forall a. Maybe a
    Nothing
                          | Bool
    otherwise = Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Transaction -> Day
    tdate (Transaction -> Day) -> Transaction -> Day
    forall a b. (a -> b) -> a -> b
    $ [Transaction] -> Transaction
    forall a. [a] -> a
    last [Transaction]
    ts
                 lastelapsed :: Maybe Integer
    lastelapsed = (Day -> Integer) -> Maybe Day -> Maybe Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Day -> Day -> Integer
    diffDays Day
    today) Maybe Day
    lastdate
                 showelapsed :: Maybe t -> p
    showelapsed Nothing = ""
                 showelapsed (Just days :: t
    days) = CommandDoc -> t -> CommandDoc -> p
    forall r. PrintfType r => CommandDoc -> r
    printf " (%d %s)" t
    days' CommandDoc
    direction
                                           where days' :: t
    days' = t -> t
    forall a. Num a => a -> a
    abs t
    days
                                                 direction :: CommandDoc
    direction | t
    days t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 0 = "days ago" :: String
                                                           | Bool
    otherwise = "days from now"
                 tnum :: Int
    tnum = [Transaction] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Transaction]
    ts
                 start :: DateSpan -> CommandDoc
    start (DateSpan (Just d :: Day
    d) _) = Day -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show Day
    d
                 start _ = ""
                 end :: DateSpan -> CommandDoc
    end (DateSpan _ (Just d :: Day
    d)) = Day -> CommandDoc
    forall a. Show a => a -> CommandDoc
    show Day
    d
                 end _ = ""
                 days :: Integer
    days = Integer -> Maybe Integer -> Integer
    forall a. a -> Maybe a -> a
    fromMaybe 0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
    forall a b. (a -> b) -> a -> b
    $ DateSpan -> Maybe Integer
    daysInSpan DateSpan
    span
                 txnrate :: Double
    txnrate | Integer
    daysInteger -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==0 = 0
                         | Bool
    otherwise = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    tnum Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    days :: Double
                 tnum30 :: Int
    tnum30 = [Transaction] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Transaction] -> Int) -> [Transaction] -> Int
    forall a b. (a -> b) -> a -> b
    $ (Transaction -> Bool) -> [Transaction] -> [Transaction]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Transaction -> Bool
    withinlast30 [Transaction]
    ts
                 withinlast30 :: Transaction -> Bool
    withinlast30 t :: Transaction
    t = Day
    d Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer -> Day -> Day
    addDays (-30) Day
    today Bool -> Bool -> Bool
    && (Day
    dDay -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <=Day
    today) where d :: Day
    d = Transaction -> Day
    tdate Transaction
    t
                 txnrate30 :: Double
    txnrate30 = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    tnum30 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / 30 :: Double
                 tnum7 :: Int
    tnum7 = [Transaction] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Transaction] -> Int) -> [Transaction] -> Int
    forall a b. (a -> b) -> a -> b
    $ (Transaction -> Bool) -> [Transaction] -> [Transaction]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Transaction -> Bool
    withinlast7 [Transaction]
    ts
                 withinlast7 :: Transaction -> Bool
    withinlast7 t :: Transaction
    t = Day
    d Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer -> Day -> Day
    addDays (-7) Day
    today Bool -> Bool -> Bool
    && (Day
    dDay -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    <=Day
    today) where d :: Day
    d = Transaction -> Day
    tdate Transaction
    t
                 txnrate7 :: Double
    txnrate7 = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    tnum7 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / 7 :: Double
                 acctnum :: Int
    acctnum = [Text] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    as
                 acctdepth :: Int
    acctdepth | [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    as = 0
                           | Bool
    otherwise = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (Text -> Int) -> [Text] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Int
    accountNameLevel [Text]
    as
                 mktprices :: [PriceDirective]
    mktprices = Journal -> [PriceDirective]
    jpricedirectives Journal
    j
                 mktpricecommodities :: [Text]
    mktpricecommodities = [Text] -> [Text]
    forall a. Ord a => [a] -> [a]
    nubSort ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ (PriceDirective -> Text) -> [PriceDirective] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map PriceDirective -> Text
    pdcommodity [PriceDirective]
    mktprices