{-|

Print some statistics for the journal.

-}

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

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

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

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils (writeOutputLazyText)


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

-- like Register.summarisePostings
-- | Print various statistics for the journal.
stats :: CliOpts -> Journal -> IO ()
stats :: CliOpts -> Journal -> IO ()
stats opts :: CliOpts
opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec, POSIXTime
progstarttime_ :: POSIXTime
progstarttime_ :: CliOpts -> POSIXTime
progstarttime_} Journal
j = do
  let today :: Day
today = ReportSpec -> Day
_rsDay ReportSpec
rspec
      verbose :: Bool
verbose = [Char] -> RawOpts -> Bool
boolopt [Char]
"verbose" RawOpts
rawopts
      q :: Query
q = ReportSpec -> Query
_rsQuery ReportSpec
rspec
      l :: Ledger
l = Query -> Journal -> Ledger
ledgerFromJournal Query
q Journal
j
      intervalspans :: [DateSpan]
intervalspans = (DateSpan, [DateSpan]) -> [DateSpan]
forall a b. (a, b) -> b
snd ((DateSpan, [DateSpan]) -> [DateSpan])
-> (DateSpan, [DateSpan]) -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpanBothDates Journal
j ReportSpec
rspec
      ismultiperiod :: Bool
ismultiperiod = [DateSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DateSpan]
intervalspans Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      ([Builder]
ls, [Int]
txncounts) = [(Builder, Int)] -> ([Builder], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Builder, Int)] -> ([Builder], [Int]))
-> [(Builder, Int)] -> ([Builder], [Int])
forall a b. (a -> b) -> a -> b
$ (DateSpan -> (Builder, Int)) -> [DateSpan] -> [(Builder, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Ledger -> Day -> DateSpan -> (Builder, Int)
showLedgerStats Bool
verbose Ledger
l Day
today) [DateSpan]
intervalspans
      numtxns :: Int
numtxns = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
txncounts
      txt :: Text
txt = (if Bool
ismultiperiod then Text -> Text
forall a. a -> a
id else HasCallStack => Text -> Text
Text -> Text
TL.init) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
unlinesB [Builder]
ls
  CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts Text
txt
  POSIXTime
t <- IO POSIXTime
getPOSIXTime
  let dt :: POSIXTime
dt = POSIXTime
t POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
progstarttime_
  Bool
rtsStatsEnabled <- IO Bool
getRTSStatsEnabled
  if Bool
rtsStatsEnabled
  then do
    -- do one last GC for most accurate memory stats; probably little effect, hopefully little wasted time
    IO ()
performMajorGC
    RTSStats{RtsTime
Word32
Word64
GCDetails
gcs :: Word32
major_gcs :: Word32
allocated_bytes :: Word64
max_live_bytes :: Word64
max_large_objects_bytes :: Word64
max_compact_bytes :: Word64
max_slop_bytes :: Word64
max_mem_in_use_bytes :: Word64
cumulative_live_bytes :: Word64
copied_bytes :: Word64
par_copied_bytes :: Word64
cumulative_par_max_copied_bytes :: Word64
cumulative_par_balanced_copied_bytes :: Word64
init_cpu_ns :: RtsTime
init_elapsed_ns :: RtsTime
mutator_cpu_ns :: RtsTime
mutator_elapsed_ns :: RtsTime
gc_cpu_ns :: RtsTime
gc_elapsed_ns :: RtsTime
cpu_ns :: RtsTime
elapsed_ns :: RtsTime
nonmoving_gc_sync_cpu_ns :: RtsTime
nonmoving_gc_sync_elapsed_ns :: RtsTime
nonmoving_gc_sync_max_elapsed_ns :: RtsTime
nonmoving_gc_cpu_ns :: RtsTime
nonmoving_gc_elapsed_ns :: RtsTime
nonmoving_gc_max_elapsed_ns :: RtsTime
gc :: GCDetails
gcs :: RTSStats -> Word32
major_gcs :: RTSStats -> Word32
allocated_bytes :: RTSStats -> Word64
max_live_bytes :: RTSStats -> Word64
max_large_objects_bytes :: RTSStats -> Word64
max_compact_bytes :: RTSStats -> Word64
max_slop_bytes :: RTSStats -> Word64
max_mem_in_use_bytes :: RTSStats -> Word64
cumulative_live_bytes :: RTSStats -> Word64
copied_bytes :: RTSStats -> Word64
par_copied_bytes :: RTSStats -> Word64
cumulative_par_max_copied_bytes :: RTSStats -> Word64
cumulative_par_balanced_copied_bytes :: RTSStats -> Word64
init_cpu_ns :: RTSStats -> RtsTime
init_elapsed_ns :: RTSStats -> RtsTime
mutator_cpu_ns :: RTSStats -> RtsTime
mutator_elapsed_ns :: RTSStats -> RtsTime
gc_cpu_ns :: RTSStats -> RtsTime
gc_elapsed_ns :: RTSStats -> RtsTime
cpu_ns :: RTSStats -> RtsTime
elapsed_ns :: RTSStats -> RtsTime
nonmoving_gc_sync_cpu_ns :: RTSStats -> RtsTime
nonmoving_gc_sync_elapsed_ns :: RTSStats -> RtsTime
nonmoving_gc_sync_max_elapsed_ns :: RTSStats -> RtsTime
nonmoving_gc_cpu_ns :: RTSStats -> RtsTime
nonmoving_gc_elapsed_ns :: RTSStats -> RtsTime
nonmoving_gc_max_elapsed_ns :: RTSStats -> RtsTime
gc :: RTSStats -> GCDetails
..} <- IO RTSStats
getRTSStats
    [Char] -> Float -> Float -> Float -> Float -> IO ()
forall r. PrintfType r => [Char] -> r
printf
      ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", "
        [[Char]
"Runtime stats       : %.2f s elapsed"  -- keep synced
        ,[Char]
"%.0f txns/s"                           --
        -- ,"%0.0f MB avg live"
        ,[Char]
"%0.0f MB live"
        ,[Char]
"%0.0f MB alloc"
        -- ,"(%0.0f MiB"
        -- ,"%0.0f MiB)"
        ] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n")
      (POSIXTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac POSIXTime
dt :: Float)
      (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numtxns Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ POSIXTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac POSIXTime
dt :: Float)
      -- (toMegabytes $ fromIntegral cumulative_live_bytes / fromIntegral major_gcs)
      (Word64 -> Float
forall {a}. Real a => a -> Float
toMegabytes Word64
max_live_bytes)
      (Word64 -> Float
forall {a}. Real a => a -> Float
toMegabytes Word64
max_mem_in_use_bytes)
  else
    [Char] -> Float -> Float -> IO ()
forall r. PrintfType r => [Char] -> r
printf
      ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", "
        [[Char]
"Runtime stats       : %.2f s elapsed"  -- keep
        ,[Char]
"%.0f txns/s"
        ] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n(add +RTS -T -RTS for more)\n")
      (POSIXTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac POSIXTime
dt :: Float)
      (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numtxns Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ POSIXTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac POSIXTime
dt :: Float)

toMegabytes :: a -> Float
toMegabytes a
n = a -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
n Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1000000 ::Float  -- SI preferred definition, 10^6
-- toMebibytes n = realToFrac n / 1048576 ::Float  -- traditional computing definition, 2^20

showLedgerStats :: Bool -> Ledger -> Day -> DateSpan -> (TB.Builder, Int)
showLedgerStats :: Bool -> Ledger -> Day -> DateSpan -> (Builder, Int)
showLedgerStats Bool
verbose Ledger
l Day
today DateSpan
spn =
    ([Builder] -> Builder
unlinesB ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ ((Text, [Char]) -> Builder) -> [(Text, [Char])] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (TableOpts -> Header Cell -> Builder
renderRowB TableOpts
forall a. Default a => a
def{tableBorders=False, borderSpaces=False} (Header Cell -> Builder)
-> ((Text, [Char]) -> Header Cell) -> (Text, [Char]) -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Char]) -> Header Cell
showRow) [(Text, [Char])]
stts
    ,Int
tnum)
  where
    showRow :: (Text, [Char]) -> Header Cell
showRow (Text
label, [Char]
val) = Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Cell] -> Header Cell) -> [Header Cell] -> Header Cell
forall a b. (a -> b) -> a -> b
$ (Text -> Header Cell) -> [Text] -> [Header Cell]
forall a b. (a -> b) -> [a] -> [b]
map (Cell -> Header Cell
forall h. h -> Header h
Header (Cell -> Header Cell) -> (Text -> Cell) -> Text -> Header Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Align -> Text -> Cell
textCell Align
TopLeft)
      [Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) Bool
False Bool
True Text
label Text -> Text -> Text
`T.append` Text
": ", [Char] -> Text
T.pack [Char]
val]
    w :: Int
w = Int
20  -- keep synced with labels above
    -- w = maximum $ map (T.length . fst) stts
    ([(Text, [Char])]
stts, Int
tnum) = ([
       (Text
"Main file", [Char]
path') -- ++ " (from " ++ source ++ ")")
      ,(Text
"Included files", if Bool
verbose then [[Char]] -> [Char]
unlines [[Char]]
includedpaths else Int -> [Char]
forall a. Show a => a -> [Char]
show ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
includedpaths))
      ,(Text
"Txns span", [Char] -> [Char] -> [Char] -> Integer -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s to %s (%d days)" (DateSpan -> [Char]
showstart DateSpan
spn) (DateSpan -> [Char]
showend DateSpan
spn) Integer
days)
      ,(Text
"Last txn", [Char] -> (Day -> [Char]) -> Maybe Day -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"none" Day -> [Char]
forall a. Show a => a -> [Char]
show Maybe Day
lastdate [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe Integer -> [Char]
forall {a} {t}.
(IsString a, PrintfArg t, PrintfType a, Ord t, Num t) =>
Maybe t -> a
showelapsed Maybe Integer
lastelapsed)
      ,(Text
"Txns", [Char] -> Int -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%d (%0.1f per day)" Int
tnum Double
txnrate)
      ,(Text
"Txns last 30 days", [Char] -> Int -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%d (%0.1f per day)" Int
tnum30 Double
txnrate30)
      ,(Text
"Txns last 7 days", [Char] -> Int -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%d (%0.1f per day)" Int
tnum7 Double
txnrate7)
      ,(Text
"Payees/descriptions", Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
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)
      ,(Text
"Accounts", [Char] -> Int -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%d (depth %d)" Int
acctnum Int
acctdepth)
      ,(Text
"Commodities",   [Char] -> [Char] -> Text -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s%s" (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
cs)        (if Bool
verbose then Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
cs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")" else Text
""))
      ,(Text
"Market prices", [Char] -> [Char] -> Text -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s%s" (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ [PriceDirective] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PriceDirective]
mktprices) (if Bool
verbose then Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
mktpricecommodities Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")" else Text
""))
    -- 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
     ] 
     ,Int
tnum1)
       where
         j :: Journal
j = Ledger -> Journal
ljournal Ledger
l
         path' :: [Char]
path' = if Bool
verbose then [Char]
path else [Char]
".../" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
takeFileName [Char]
path where path :: [Char]
path = Journal -> [Char]
journalFilePath Journal
j
         includedpaths :: [[Char]]
includedpaths = Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
1 ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Journal -> [[Char]]
journalFilePaths 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
spn (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 = ([Char] -> [Text])
-> (Map Text AmountStyle -> [Text])
-> Either [Char] (Map Text AmountStyle)
-> [Text]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Text]
forall a. [Char] -> a
error' Map Text AmountStyle -> [Text]
forall k a. Map k a -> [k]
Map.keys (Either [Char] (Map Text AmountStyle) -> [Text])
-> Either [Char] (Map Text AmountStyle) -> [Text]
forall a b. (a -> b) -> a -> b
$ [Amount] -> Either [Char] (Map Text AmountStyle)
commodityStylesFromAmounts ([Amount] -> Either [Char] (Map Text AmountStyle))
-> [Amount] -> Either [Char] (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]
amountsRaw (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 a. [a] -> 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. HasCallStack => [a] -> a
last [Transaction]
ts
         lastelapsed :: Maybe Integer
lastelapsed = (Day -> Integer) -> Maybe Day -> Maybe Integer
forall a b. (a -> b) -> Maybe a -> Maybe b
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 -> a
showelapsed Maybe t
Nothing = a
""
         showelapsed (Just t
dys) = [Char] -> t -> [Char] -> a
forall r. PrintfType r => [Char] -> r
printf [Char]
" (%d %s)" t
dys' [Char]
direction
                                   where dys' :: t
dys' = t -> t
forall a. Num a => a -> a
abs t
dys
                                         direction :: [Char]
direction | t
dys t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
0 = [Char]
"days ago" :: String
                                                   | Bool
otherwise = [Char]
"days from now"
         tnum1 :: Int
tnum1 = [Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
ts  -- Integer would be better
         showstart :: DateSpan -> [Char]
showstart (DateSpan (Just EFDay
efd) Maybe EFDay
_) = Day -> [Char]
forall a. Show a => a -> [Char]
show (Day -> [Char]) -> Day -> [Char]
forall a b. (a -> b) -> a -> b
$ EFDay -> Day
fromEFDay EFDay
efd
         showstart DateSpan
_ = [Char]
""
         showend :: DateSpan -> [Char]
showend (DateSpan Maybe EFDay
_ (Just EFDay
efd)) = Day -> [Char]
forall a. Show a => a -> [Char]
show (Day -> [Char]) -> Day -> [Char]
forall a b. (a -> b) -> a -> b
$ EFDay -> Day
fromEFDay EFDay
efd
         showend DateSpan
_ = [Char]
""
         days :: Integer
days = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Integer
daysInSpan DateSpan
spn
         txnrate :: Double
txnrate | Integer
daysInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
0 = Double
0
                 | Bool
otherwise = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tnum1 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 a. [a] -> 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 Transaction
t = Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Day -> Day
addDays (-Integer
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
/ Double
30 :: Double
         tnum7 :: Int
tnum7 = [Transaction] -> Int
forall a. [a] -> 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 Transaction
t = Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Day -> Day
addDays (-Integer
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
/ Double
7 :: Double
         acctnum :: Int
acctnum = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
as
         acctdepth :: Int
acctdepth | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
as = Int
0
                   | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
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