{-|

Print some statistics for the journal.

-}

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

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

import Control.Monad (when)
import Data.Default (def)
import Data.List (intercalate, nub, sortOn)
import Data.List.Extra (nubSort)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.HashSet (size, fromList)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Time.Calendar (Day, addDays, diffDays)
import Data.Time.Clock.POSIX (getPOSIXTime)
import GHC.Stats
import GitHash (tGitInfoCwdTry)
import System.Console.CmdArgs.Explicit hiding (Group)
import System.FilePath (takeFileName)
import System.Mem (performMajorGC)
import Text.Printf (printf)
import Text.Tabular.AsciiWide

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils (writeOutput)
import Hledger.Cli.Version (packageversion, versionStringWith)


statsmode = hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Stats.txt")
  [ flagNone ["1"] (setboolopt "") "show a single line of output"
      -- Cli.hs converts -1 to --depth=1, no point giving it another name here
  , flagNone ["verbose","v"] (setboolopt "verbose") "show more detailed output"
  ,flagReq  ["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE" "write output to FILE."
  ]
  cligeneralflagsgroups1
  hiddenflags
  ([], Just $ argsFlag "[QUERY]")

-- like Register.summarisePostings
-- | Print various statistics for the journal.
stats :: CliOpts -> Journal -> IO ()
stats opts@CliOpts{rawopts_=rawopts, reportspec_=rspec, progstarttime_} j = do
  t <- getPOSIXTime
  -- the first lines - general journal stats for one or more periods
  let
    today = _rsDay rspec
    oneline = intopt "depth" rawopts == 1
    verbose = boolopt "verbose" rawopts
    q = _rsQuery rspec
    l = ledgerFromJournal q j
    intervalspans = snd $ reportSpanBothDates j rspec
    ismultiperiod = length intervalspans > 1
    (txts, tnums) = unzip . map (showLedgerStats verbose l today) $ maybeDayPartitionToDateSpans intervalspans
    out1 = (if ismultiperiod then id else init) $ unlines txts

  -- the last line - overall performance stats, with memory info if available,
  -- in human-friendly or machine-friendly format
  -- normal:
  --  Runtime stats       : 0.14 s elapsed, 7606 txns/s
  --  Runtime stats       : 0.14 s elapsed, 7606 txns/s, 6 MB live, 18 MB alloc
  -- oneline:
  --  SHORTVERSION(<SPC><TAB>VALUE[<SPC>DESC])+
  --  1.50.99<SPC><TAB>hledger 1.50.99-g0835a2485-20251119, mac-aarch64<SPC><TAB>2025.journal<SPC><TAB>1.99 s elapsed<SPC><TAB>524 txns/s
  --  1.50.99<SPC><TAB>hledger 1.50.99-g0835a2485-20251119, mac-aarch64<SPC><TAB>2025.journal<SPC><TAB>1.99 s elapsed<SPC><TAB>524 txns/s<SPC><TAB>788 MB live<SPC><TAB>2172 MB alloc
  -- 
  rtsstats <- getRTSStatsEnabled
  (maxlivemb, maxinusemb) <- if rtsstats
  then do
    -- do one last garbage collection; probably little effect, hopefully little wasted time
    performMajorGC
    RTSStats{..} <- getRTSStats
    return (toMegabytes max_live_bytes, toMegabytes max_mem_in_use_bytes)
  else
    return (0,0)
  let
    (label, sep)
      | oneline   = (lstrip $ versionStringWith $$tGitInfoCwdTry False "" packageversion <> "\t", "\t")
      | otherwise = ("Runtime stats       : ", ", ")
    dt = t - progstarttime_
    tnum = sum tnums
    ss =
      [ takeFileName $ journalFilePath j | oneline ]
      <> [
       printf "%.2f s elapsed" (realToFrac dt :: Float)
      ,printf "%.0f txns/s" (fromIntegral tnum / realToFrac dt :: Float)
      ]
      <> if rtsstats then [
       printf "%0.0f MB live" maxlivemb
      ,printf "%0.0f MB alloc" maxinusemb
      -- printf "%0.0f MB avg live" (toMegabytes $ fromIntegral cumulative_live_bytes / fromIntegral major_gcs)
      ]
      else [
       "(add +RTS -T -RTS for more)"
      ]
    out2 = label <> intercalate sep ss <> "\n"

  when (not oneline) $ writeOutput opts out1
  when (oneline && debugLevel>0) $ do
    let tabstops = intercalate (replicate 7 ' ') (replicate 21 ".") <> "\n"
    writeOutput opts tabstops
  writeOutput opts $ (if ismultiperiod then "\n" else "") <> out2

toMegabytes n = realToFrac n / 1000000 ::Float  -- SI preferred definition, 10^6
-- toMebibytes n = realToFrac n / 1048576 ::Float  -- traditional computing definition, 2^20

-- | Generate multiline stats output, possibly verbose,
-- for the given ledger and date period and current date.
-- Also return the number of transactions in the period.
showLedgerStats :: Bool -> Ledger -> Day -> DateSpan -> (String, Int)
showLedgerStats verbose l today spn =
    (unlines $ map (TL.unpack . renderRow def{tableBorders=False, borderSpaces=False} . showRow) stts
    ,tnum)
  where
    showRow (label, val) = Group NoLine $ map (Header . textCell TopLeft)
      [fitText (Just w) (Just w) False True label `T.append` ": ", T.pack val]
    w = 20  -- keep synced with labels above
    -- w = maximum $ map (T.length . fst) stts
    (stts, tnum) = ([
       ("Main file", path' :: String) -- ++ " (from " ++ source ++ ")")
      ,("Included files", if verbose then unlines includedpaths else show (length includedpaths))
      ,("Txns span", printf "%s to %s (%d days)" (showstart spn) (showend spn) days)
      ,("Last txn", maybe "none" show lastdate ++ showelapsed lastelapsed)
      ,("Txns", printf "%d (%0.1f per day)" tnum txnrate)
      ,("Txns last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30)
      ,("Txns last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7)
      ,("Payees/descriptions", show $ size $ fromList $ map (tdescription) ts)
      ,("Accounts", printf "%d (depth %d)" acctnum acctdepth)
      ,("Commodities",   printf "%s%s" (show $ length cs)        (if verbose then " (" <> T.intercalate ", " cs <> ")" else ""))
      ,("Market prices", printf "%s%s" (show $ length mktprices) (if verbose then " (" <> T.intercalate ", " mktpricecommodities <> ")" else ""))
    -- Txns this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)
    -- Unmarked txns      : %(unmarked)s
    -- Days since reconciliation   : %(reconcileelapsed)s
    -- Days since last txn : %(recentelapsed)s
     ]
     ,tnum1)
       where
         j = ljournal l
         path' = if verbose then path else ".../" <> takeFileName path where path = journalFilePath j
         includedpaths = drop 1 $ journalFilePaths j
         ts = sortOn tdate $ filter (spanContainsDate spn . tdate) $ jtxns j
         as = nub $ map paccount $ concatMap tpostings ts
         cs = either error' Map.keys $ commodityStylesFromAmounts $ concatMap (amountsRaw . pamount) $ concatMap tpostings ts  -- PARTIAL:
         lastdate | null ts = Nothing
                  | otherwise = Just $ tdate $ last ts
         lastelapsed = fmap (diffDays today) lastdate
         showelapsed Nothing = ""
         showelapsed (Just dys) = printf " (%d %s)" dys' direction
                                   where dys' = abs dys
                                         direction | dys >= 0 = "days ago" :: String
                                                   | otherwise = "days from now"
         tnum1 = length ts  -- Integer would be better
         showstart (DateSpan (Just efd) _) = show $ fromEFDay efd
         showstart _ = ""
         showend (DateSpan _ (Just efd)) = show $ fromEFDay efd
         showend _ = ""
         days = fromMaybe 0 $ daysInSpan spn
         txnrate | days==0 = 0
                 | otherwise = fromIntegral tnum1 / fromIntegral days :: Double
         tnum30 = length $ filter withinlast30 ts
         withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t
         txnrate30 = fromIntegral tnum30 / 30 :: Double
         tnum7 = length $ filter withinlast7 ts
         withinlast7 t = d >= addDays (-7) today && (d<=today) where d = tdate t
         txnrate7 = fromIntegral tnum7 / 7 :: Double
         acctnum = length as
         acctdepth | null as = 0
                   | otherwise = maximum $ map accountNameLevel as
         mktprices = jpricedirectives j
         mktpricecommodities = nubSort $ map pdcommodity mktprices