refactor: cli: commands: hlint clean

This commit is contained in:
Simon Michael 2019-02-14 04:09:26 -08:00
parent b7d0724b70
commit 03877057fb
24 changed files with 92 additions and 99 deletions

View File

@ -34,7 +34,7 @@ import Hledger.Utils.Debug
-- | Apply all the given transaction modifiers, in turn, to each transaction. -- | Apply all the given transaction modifiers, in turn, to each transaction.
modifyTransactions :: [TransactionModifier] -> [Transaction] -> [Transaction] modifyTransactions :: [TransactionModifier] -> [Transaction] -> [Transaction]
modifyTransactions tmods ts = map applymods ts modifyTransactions tmods = map applymods
where where
applymods = foldr (flip (.) . transactionModifierToFunction) id tmods applymods = foldr (flip (.) . transactionModifierToFunction) id tmods

View File

@ -230,7 +230,7 @@ printCommandsList addonsFound =
unknownCommandsFound = addonsFound \\ knownCommands unknownCommandsFound = addonsFound \\ knownCommands
adjustline l | " hledger " `isPrefixOf` l = [l] adjustline l | " hledger " `isPrefixOf` l = [l]
adjustline l@('+':_) | not $ cmd `elem` commandsFound = [] adjustline l@('+':_) | cmd `notElem` commandsFound = []
where where
cmd = takeWhile (not . isSpace) l cmd = takeWhile (not . isSpace) l
adjustline l = [l] adjustline l = [l]

View File

@ -11,7 +11,6 @@ where
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Ord
import Text.Printf import Text.Printf
import Hledger import Hledger
@ -47,7 +46,7 @@ showHistogram opts q j = concatMap (printDayWith countBar) spanps
-- same as Register -- same as Register
-- should count transactions, not postings ? -- should count transactions, not postings ?
-- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j -- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j
ps = sortBy (comparing postingDate) $ filter (q `matchesPosting`) $ journalPostings j ps = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j
printDayWith f (DateSpan b _, ps) = printf "%s %s\n" (show $ fromJust b) (f ps) printDayWith f (DateSpan b _, ps) = printf "%s %s\n" (show $ fromJust b) (f ps)

View File

@ -235,7 +235,7 @@ postingsBalanced ps = isRight $ balanceTransaction Nothing nulltransaction{tpost
accountWizard EntryState{..} = do accountWizard EntryState{..} = do
let pnum = length esPostings + 1 let pnum = length esPostings + 1
historicalp = maybe Nothing (Just . (!! (pnum-1)) . (++ (repeat nullposting)) . tpostings) esSimilarTransaction historicalp = fmap ((!! (pnum - 1)) . (++ (repeat nullposting)) . tpostings) esSimilarTransaction
historicalacct = case historicalp of Just p -> showAccountName Nothing (ptype p) (paccount p) historicalacct = case historicalp of Just p -> showAccountName Nothing (ptype p) (paccount p)
Nothing -> "" Nothing -> ""
def = headDef historicalacct esArgs def = headDef historicalacct esArgs
@ -259,7 +259,7 @@ accountWizard EntryState{..} = do
flip evalState esJournal $ runParserT (accountnamep <* eof) "" (T.pack s) -- otherwise, try to parse the input as an accountname flip evalState esJournal $ runParserT (accountnamep <* eof) "" (T.pack s) -- otherwise, try to parse the input as an accountname
where where
validateAccount :: Text -> Maybe Text validateAccount :: Text -> Maybe Text
validateAccount t | no_new_accounts_ esOpts && not (t `elem` journalAccountNamesDeclaredOrImplied esJournal) = Nothing validateAccount t | no_new_accounts_ esOpts && notElem t (journalAccountNamesDeclaredOrImplied esJournal) = Nothing
| otherwise = Just t | otherwise = Just t
dbg1 = id -- strace dbg1 = id -- strace
@ -436,9 +436,9 @@ compareDescriptions s t = compareStrings s' t'
-- Todo: check out http://nlp.fi.muni.cz/raslan/2008/raslan08.pdf#page=14 . -- Todo: check out http://nlp.fi.muni.cz/raslan/2008/raslan08.pdf#page=14 .
compareStrings :: String -> String -> Double compareStrings :: String -> String -> Double
compareStrings "" "" = 1 compareStrings "" "" = 1
compareStrings (_:[]) "" = 0 compareStrings [_] "" = 0
compareStrings "" (_:[]) = 0 compareStrings "" [_] = 0
compareStrings (a:[]) (b:[]) = if toUpper a == toUpper b then 1 else 0 compareStrings [a] [b] = if toUpper a == toUpper b then 1 else 0
compareStrings s1 s2 = 2 * commonpairs / totalpairs compareStrings s1 s2 = 2 * commonpairs / totalpairs
where where
pairs1 = S.fromList $ wordLetterPairs $ uppercase s1 pairs1 = S.fromList $ wordLetterPairs $ uppercase s1

View File

@ -236,6 +236,7 @@ Currently, empty cells show 0.
{-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NamedFieldPuns #-}
module Hledger.Cli.Commands.Balance ( module Hledger.Cli.Commands.Balance (
balancemode balancemode
@ -465,27 +466,27 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field)
-- The CSV will always include the initial headings row, -- The CSV will always include the initial headings row,
-- and will include the final totals row unless --no-total is set. -- and will include the final totals row unless --no-total is set.
multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) = multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_} (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
maybetranspose $ maybetranspose $
("Account" : map showDateSpan colspans ("Account" : map showDateSpan colspans
++ (if row_total_ opts then ["Total"] else []) ++ ["Total" | row_total_]
++ (if average_ opts then ["Average"] else []) ++ ["Average" | average_]
) : ) :
[T.unpack (maybeAccountNameDrop opts a) : [T.unpack (maybeAccountNameDrop opts a) :
map showMixedAmountOneLineWithoutPrice map showMixedAmountOneLineWithoutPrice
(amts (amts
++ (if row_total_ opts then [rowtot] else []) ++ [rowtot | row_total_]
++ (if average_ opts then [rowavg] else [])) ++ [rowavg | average_])
| (a, _, _, amts, rowtot, rowavg) <- items] | (a, _, _, amts, rowtot, rowavg) <- items]
++ ++
if no_total_ opts if no_total_ opts
then [] then []
else [["Total:"] else ["Total:" :
++ map showMixedAmountOneLineWithoutPrice ( map showMixedAmountOneLineWithoutPrice (
coltotals coltotals
++ (if row_total_ opts then [tot] else []) ++ [tot | row_total_]
++ (if average_ opts then [avg] else []) ++ [avg | average_]
)] )]
where where
maybetranspose | transpose_ opts = transpose maybetranspose | transpose_ opts = transpose
| otherwise = id | otherwise = id
@ -499,7 +500,7 @@ multiBalanceReportAsHtml ropts mbr =
table_ $ mconcat $ table_ $ mconcat $
[headingsrow] [headingsrow]
++ bodyrows ++ bodyrows
++ maybe [] (:[]) mtotalsrow ++ maybeToList mtotalsrow
-- | Render the HTML table rows for a MultiBalanceReport. -- | Render the HTML table rows for a MultiBalanceReport.
-- Returns the heading row, 0 or more body rows, and the totals row if enabled. -- Returns the heading row, 0 or more body rows, and the totals row if enabled.
@ -593,7 +594,7 @@ multiBalanceReportAsText opts r =
-- | Build a 'Table' from a multi-column balance report. -- | Build a 'Table' from a multi-column balance report.
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
balanceReportAsTable opts (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) = balanceReportAsTable opts@ReportOpts{average_, row_total_} (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
maybetranspose $ maybetranspose $
addtotalrow $ addtotalrow $
Table Table
@ -605,20 +606,20 @@ balanceReportAsTable opts (MultiBalanceReport (colspans, items, (coltotals,tot,a
PeriodChange -> showDateSpanMonthAbbrev PeriodChange -> showDateSpanMonthAbbrev
_ -> maybe "" (showDate . prevday) . spanEnd _ -> maybe "" (showDate . prevday) . spanEnd
colheadings = map mkDate colspans colheadings = map mkDate colspans
++ (if row_total_ opts then [" Total"] else []) ++ [" Total" | row_total_]
++ (if average_ opts then ["Average"] else []) ++ ["Average" | average_]
accts = map renderacct items accts = map renderacct items
renderacct (a,a',i,_,_,_) renderacct (a,a',i,_,_,_)
| tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a' | tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a'
| otherwise = T.unpack $ maybeAccountNameDrop opts a | otherwise = T.unpack $ maybeAccountNameDrop opts a
rowvals (_,_,_,as,rowtot,rowavg) = as rowvals (_,_,_,as,rowtot,rowavg) = as
++ (if row_total_ opts then [rowtot] else []) ++ [rowtot | row_total_]
++ (if average_ opts then [rowavg] else []) ++ [rowavg | average_]
addtotalrow | no_total_ opts = id addtotalrow | no_total_ opts = id
| otherwise = (+----+ (row "" $ | otherwise = (+----+ (row "" $
coltotals coltotals
++ (if row_total_ opts && not (null coltotals) then [tot] else []) ++ [tot | row_total_ && not (null coltotals)]
++ (if average_ opts && not (null coltotals) then [avg] else []) ++ [avg | average_ && not (null coltotals)]
)) ))
maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals) maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals)
| otherwise = id | otherwise = id

View File

@ -18,7 +18,7 @@ import Hledger.Cli.CliOptions
import Hledger.Cli.CompoundBalanceCommand import Hledger.Cli.CompoundBalanceCommand
balancesheetSpec = CompoundBalanceCommandSpec { balancesheetSpec = CompoundBalanceCommandSpec {
cbcdoc = ($(embedFileRelative "Hledger/Cli/Commands/Balancesheet.txt")), cbcdoc = $(embedFileRelative "Hledger/Cli/Commands/Balancesheet.txt"),
cbctitle = "Balance Sheet", cbctitle = "Balance Sheet",
cbcqueries = [ cbcqueries = [
CBCSubreportSpec{ CBCSubreportSpec{

View File

@ -18,7 +18,7 @@ import Hledger.Cli.CliOptions
import Hledger.Cli.CompoundBalanceCommand import Hledger.Cli.CompoundBalanceCommand
balancesheetequitySpec = CompoundBalanceCommandSpec { balancesheetequitySpec = CompoundBalanceCommandSpec {
cbcdoc = ($(embedFileRelative "Hledger/Cli/Commands/Balancesheetequity.txt")), cbcdoc = $(embedFileRelative "Hledger/Cli/Commands/Balancesheetequity.txt"),
cbctitle = "Balance Sheet With Equity", cbctitle = "Balance Sheet With Equity",
cbcqueries = [ cbcqueries = [
CBCSubreportSpec{ CBCSubreportSpec{

View File

@ -21,7 +21,7 @@ import Hledger.Cli.CliOptions
import Hledger.Cli.CompoundBalanceCommand import Hledger.Cli.CompoundBalanceCommand
cashflowSpec = CompoundBalanceCommandSpec { cashflowSpec = CompoundBalanceCommandSpec {
cbcdoc = ($(embedFileRelative "Hledger/Cli/Commands/Cashflow.txt")), cbcdoc = $(embedFileRelative "Hledger/Cli/Commands/Cashflow.txt"),
cbctitle = "Cashflow Statement", cbctitle = "Cashflow Statement",
cbcqueries = [ cbcqueries = [
CBCSubreportSpec{ CBCSubreportSpec{

View File

@ -13,7 +13,7 @@ import Text.Printf
checkdatesmode :: Mode RawOpts checkdatesmode :: Mode RawOpts
checkdatesmode = hledgerCommandMode checkdatesmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Checkdates.txt")) $(embedFileRelative "Hledger/Cli/Commands/Checkdates.txt")
[flagNone ["strict"] (setboolopt "strict") "makes date comparing strict"] [flagNone ["strict"] (setboolopt "strict") "makes date comparing strict"]
[generalflagsgroup1] [generalflagsgroup1]
[] []
@ -61,11 +61,10 @@ foldWhile fold acc (a:as) =
checkTransactions :: (Transaction -> Transaction -> Bool) checkTransactions :: (Transaction -> Transaction -> Bool)
-> [Transaction] -> FoldAcc Transaction Transaction -> [Transaction] -> FoldAcc Transaction Transaction
checkTransactions compare ts = checkTransactions compare = foldWhile f FoldAcc{fa_error=Nothing, fa_previous=Nothing}
foldWhile fold FoldAcc{fa_error=Nothing, fa_previous=Nothing} ts
where where
fold current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current} f current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current}
fold current acc@FoldAcc{fa_previous=Just previous} = f current acc@FoldAcc{fa_previous=Just previous} =
if compare previous current if compare previous current
then acc{fa_previous=Just current} then acc{fa_previous=Just current}
else acc{fa_error=Just current} else acc{fa_error=Just current}

View File

@ -16,7 +16,7 @@ import Text.Printf
checkdupesmode :: Mode RawOpts checkdupesmode :: Mode RawOpts
checkdupesmode = hledgerCommandMode checkdupesmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Checkdupes.txt")) $(embedFileRelative "Hledger/Cli/Commands/Checkdupes.txt")
[] []
[generalflagsgroup1] [generalflagsgroup1]
[] []
@ -40,4 +40,4 @@ checkdupes' l = zip dupLeafs dupAccountNames
. sortBy (compare `on` fst) . sortBy (compare `on` fst)
render :: (String, [AccountName]) -> IO () render :: (String, [AccountName]) -> IO ()
render (leafName, accountNameL) = printf "%s as %s\n" leafName (concat $ intersperse ", " (map T.unpack accountNameL)) render (leafName, accountNameL) = printf "%s as %s\n" leafName (intercalate ", " (map T.unpack accountNameL))

View File

@ -23,7 +23,7 @@ import Hledger.Cli.CliOptions
-- | Command line options for this command. -- | Command line options for this command.
commoditiesmode = hledgerCommandMode commoditiesmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Commodities.txt")) $(embedFileRelative "Hledger/Cli/Commands/Commodities.txt")
[] []
[generalflagsgroup2] [generalflagsgroup2]
[] []

View File

@ -23,7 +23,7 @@ import Hledger.Cli.CliOptions
-- | Command line options for this command. -- | Command line options for this command.
filesmode = hledgerCommandMode filesmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Files.txt")) $(embedFileRelative "Hledger/Cli/Commands/Files.txt")
[] []
[generalflagsgroup2] [generalflagsgroup2]
[] []
@ -34,7 +34,7 @@ files :: CliOpts -> Journal -> IO ()
files CliOpts{rawopts_=rawopts} j = do files CliOpts{rawopts_=rawopts} j = do
let args = listofstringopt "args" rawopts let args = listofstringopt "args" rawopts
regex = headMay args regex = headMay args
files = (maybe id (filter . regexMatches) regex) files = maybe id (filter . regexMatches) regex
$ map fst $ map fst
$ jfiles j $ jfiles j
mapM_ putStrLn files mapM_ putStrLn files

View File

@ -35,7 +35,7 @@ import Hledger.Cli.DocFiles
--import Hledger.Utils.Debug --import Hledger.Utils.Debug
helpmode = hledgerCommandMode helpmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Help.txt")) $(embedFileRelative "Hledger/Cli/Commands/Help.txt")
[flagNone ["info"] (setboolopt "info") "show the manual with info" [flagNone ["info"] (setboolopt "info") "show the manual with info"
,flagNone ["man"] (setboolopt "man") "show the manual with man" ,flagNone ["man"] (setboolopt "man") "show the manual with man"
,flagNone ["pager"] (setboolopt "pager") "show the manual with $PAGER or less" ,flagNone ["pager"] (setboolopt "pager") "show the manual with $PAGER or less"
@ -78,5 +78,5 @@ help' opts _ = do
,"A viewer (info, man, a pager, or stdout) will be auto-selected," ,"A viewer (info, man, a pager, or stdout) will be auto-selected,"
,"or type \"hledger help -h\" to see options. Manuals available:" ,"or type \"hledger help -h\" to see options. Manuals available:"
] ]
++ "\n " ++ intercalate " " docTopics ++ "\n " ++ unwords docTopics
Just t -> viewer t Just t -> viewer t

View File

@ -9,7 +9,6 @@ where
import Control.Monad import Control.Monad
import Data.List import Data.List
import Data.Ord
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Add (journalAddTransaction) import Hledger.Cli.Commands.Add (journalAddTransaction)
@ -18,7 +17,7 @@ import System.Console.CmdArgs.Explicit
import Text.Printf import Text.Printf
importmode = hledgerCommandMode importmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Import.txt")) $(embedFileRelative "Hledger/Cli/Commands/Import.txt")
[flagNone ["dry-run"] (setboolopt "dry-run") "just show the transactions to be imported"] [flagNone ["dry-run"] (setboolopt "dry-run") "just show the transactions to be imported"]
[generalflagsgroup1] [generalflagsgroup1]
[] []
@ -36,7 +35,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do
case enewj of case enewj of
Left e -> error' e Left e -> error' e
Right newj -> Right newj ->
case sortBy (comparing tdate) $ jtxns newj of case sortOn tdate $ jtxns newj of
[] -> return () [] -> return ()
newts | dryrun -> do newts | dryrun -> do
printf "; would import %d new transactions:\n\n" (length newts) printf "; would import %d new transactions:\n\n" (length newts)
@ -44,5 +43,5 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do
-- length (jtxns newj) `seq` print' opts{rawopts_=("explicit",""):rawopts} newj -- length (jtxns newj) `seq` print' opts{rawopts_=("explicit",""):rawopts} newj
mapM_ (putStr . showTransactionUnelided) newts mapM_ (putStr . showTransactionUnelided) newts
newts -> do newts -> do
foldM (flip journalAddTransaction opts) j newts -- gets forced somehow.. (how ?) foldM_ (`journalAddTransaction` opts) j newts -- gets forced somehow.. (how ?)
printf "imported %d new transactions\n" (length newts) printf "imported %d new transactions\n" (length newts)

View File

@ -17,7 +17,7 @@ import Hledger.Cli.CliOptions
import Hledger.Cli.CompoundBalanceCommand import Hledger.Cli.CompoundBalanceCommand
incomestatementSpec = CompoundBalanceCommandSpec { incomestatementSpec = CompoundBalanceCommandSpec {
cbcdoc = ($(embedFileRelative "Hledger/Cli/Commands/Incomestatement.txt")), cbcdoc = $(embedFileRelative "Hledger/Cli/Commands/Incomestatement.txt"),
cbctitle = "Income Statement", cbctitle = "Income Statement",
cbcqueries = [ cbcqueries = [
CBCSubreportSpec{ CBCSubreportSpec{

View File

@ -15,7 +15,7 @@ import Hledger.Cli.CliOptions
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
pricesmode = hledgerCommandMode pricesmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Prices.txt")) $(embedFileRelative "Hledger/Cli/Commands/Prices.txt")
[flagNone ["costs"] (setboolopt "costs") "print transaction prices from postings" [flagNone ["costs"] (setboolopt "costs") "print transaction prices from postings"
,flagNone ["inverted-costs"] (setboolopt "inverted-costs") "print transaction inverted prices from postings also"] ,flagNone ["inverted-costs"] (setboolopt "inverted-costs") "print transaction inverted prices from postings also"]
[generalflagsgroup1] [generalflagsgroup1]

View File

@ -27,7 +27,7 @@ import Hledger.Cli.Commands.Add ( transactionsSimilarTo )
printmode = hledgerCommandMode printmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Print.txt")) $(embedFileRelative "Hledger/Cli/Commands/Print.txt")
([let arg = "STR" in ([let arg = "STR" in
flagReq ["match","m"] (\s opts -> Right $ setopt "match" s opts) arg flagReq ["match","m"] (\s opts -> Right $ setopt "match" s opts) arg
("show the transaction whose description is most similar to "++arg++", and is most recent") ("show the transaction whose description is most similar to "++arg++", and is most recent")
@ -66,10 +66,7 @@ entriesReportAsText opts = concatMap (showTransactionUnelided . gettxn)
-- Original vs inferred transactions/postings were causing problems here, disabling -B (#551). -- Original vs inferred transactions/postings were causing problems here, disabling -B (#551).
-- Use the explicit one if -B or -x are active. -- Use the explicit one if -B or -x are active.
-- This passes tests; does it also mean -B sometimes shows missing amounts unnecessarily ? -- This passes tests; does it also mean -B sometimes shows missing amounts unnecessarily ?
useexplicittxn = or useexplicittxn = boolopt "explicit" (rawopts_ opts) || cost_ (reportopts_ opts)
[ boolopt "explicit" $ rawopts_ opts
, cost_ $ reportopts_ opts
]
-- Replace this transaction's postings with the original postings if any, but keep the -- Replace this transaction's postings with the original postings if any, but keep the
-- current possibly rewritten account names. -- current possibly rewritten account names.
@ -147,7 +144,7 @@ postingToCSV p =
let commodity = T.unpack c in let commodity = T.unpack c in
let credit = if q < 0 then showAmount $ negate a_ else "" in let credit = if q < 0 then showAmount $ negate a_ else "" in
let debit = if q >= 0 then showAmount a_ else "" in let debit = if q >= 0 then showAmount a_ else "" in
account:amount:commodity:credit:debit:status:comment:[]) [account, amount, commodity, credit, debit, status, comment])
amounts amounts
where where
Mixed amounts = pamount p Mixed amounts = pamount p

View File

@ -7,13 +7,12 @@ module Hledger.Cli.Commands.Printunique (
where where
import Data.List import Data.List
import Data.Ord
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Print import Hledger.Cli.Commands.Print
printuniquemode = hledgerCommandMode printuniquemode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Printunique.txt")) $(embedFileRelative "Hledger/Cli/Commands/Printunique.txt")
[] []
[generalflagsgroup1] [generalflagsgroup1]
[] []
@ -22,6 +21,6 @@ printuniquemode = hledgerCommandMode
printunique opts j@Journal{jtxns=ts} = do printunique opts j@Journal{jtxns=ts} = do
print' opts j{jtxns=uniquify ts} print' opts j{jtxns=uniquify ts}
where where
uniquify = nubBy (\t1 t2 -> thingToCompare t1 == thingToCompare t2) . sortBy (comparing thingToCompare) uniquify = nubBy (\t1 t2 -> thingToCompare t1 == thingToCompare t2) . sortOn thingToCompare
thingToCompare = tdescription thingToCompare = tdescription
-- thingToCompare = tdate -- thingToCompare = tdate

View File

@ -28,7 +28,7 @@ import Hledger.Cli.CliOptions
import Hledger.Cli.Utils import Hledger.Cli.Utils
registermode = hledgerCommandMode registermode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Register.txt")) $(embedFileRelative "Hledger/Cli/Commands/Register.txt")
([flagNone ["cumulative"] (setboolopt "change") ([flagNone ["cumulative"] (setboolopt "change")
"show running total from report start date (default)" "show running total from report start date (default)"
,flagNone ["historical","H"] (setboolopt "historical") ,flagNone ["historical","H"] (setboolopt "historical")
@ -119,17 +119,17 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
-- use elide*Width to be wide-char-aware -- use elide*Width to be wide-char-aware
-- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $ -- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $
intercalate "\n" $ intercalate "\n" $
[concat [fitString (Just datewidth) (Just datewidth) True True date concat [fitString (Just datewidth) (Just datewidth) True True date
," " ," "
,fitString (Just descwidth) (Just descwidth) True True desc ,fitString (Just descwidth) (Just descwidth) True True desc
," " ," "
,fitString (Just acctwidth) (Just acctwidth) True True acct ,fitString (Just acctwidth) (Just acctwidth) True True acct
," " ," "
,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline ,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline
," " ," "
,fitString (Just balwidth) (Just balwidth) True False balfirstline ,fitString (Just balwidth) (Just balwidth) True False balfirstline
]] ]
++ :
[concat [spacer [concat [spacer
,fitString (Just amtwidth) (Just amtwidth) True False a ,fitString (Just amtwidth) (Just amtwidth) True False a
," " ," "

View File

@ -15,7 +15,7 @@ import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Register import Hledger.Cli.Commands.Register
registermatchmode = hledgerCommandMode registermatchmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Registermatch.txt")) $(embedFileRelative "Hledger/Cli/Commands/Registermatch.txt")
[] []
[generalflagsgroup1] [generalflagsgroup1]
[] []
@ -60,7 +60,7 @@ similarPosting ps desc =
-- ((,t):_) = Just t -- ((,t):_) = Just t
-- [] = Nothing -- [] = Nothing
compareDescriptions :: [Char] -> [Char] -> Double compareDescriptions :: String -> String -> Double
compareDescriptions s t = compareStrings s' t' compareDescriptions s t = compareStrings s' t'
where s' = simplify s where s' = simplify s
t' = simplify t t' = simplify t
@ -72,9 +72,9 @@ compareDescriptions s t = compareStrings s' t'
-- with a modification for short strings. -- with a modification for short strings.
compareStrings :: String -> String -> Double compareStrings :: String -> String -> Double
compareStrings "" "" = 1 compareStrings "" "" = 1
compareStrings (_:[]) "" = 0 compareStrings [_] "" = 0
compareStrings "" (_:[]) = 0 compareStrings "" [_] = 0
compareStrings (a:[]) (b:[]) = if toUpper a == toUpper b then 1 else 0 compareStrings [a] [b] = if toUpper a == toUpper b then 1 else 0
compareStrings s1 s2 = 2.0 * fromIntegral i / fromIntegral u compareStrings s1 s2 = 2.0 * fromIntegral i / fromIntegral u
where where
i = length $ intersect pairs1 pairs2 i = length $ intersect pairs1 pairs2

View File

@ -23,7 +23,7 @@ import Text.Megaparsec
import qualified Data.Algorithm.Diff as D import qualified Data.Algorithm.Diff as D
rewritemode = hledgerCommandMode rewritemode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Rewrite.txt")) $(embedFileRelative "Hledger/Cli/Commands/Rewrite.txt")
[flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'" [flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'"
"add a posting to ACCT, which may be parenthesised. AMTEXPR is either a literal amount, or *N which means the transaction's first matched amount multiplied by N (a decimal number). Two spaces separate ACCT and AMTEXPR." "add a posting to ACCT, which may be parenthesised. AMTEXPR is either a literal amount, or *N which means the transaction's first matched amount multiplied by N (a decimal number). Two spaces separate ACCT and AMTEXPR."
,flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool" ,flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool"

View File

@ -17,7 +17,6 @@ import Data.Time.Calendar
import Text.Printf import Text.Printf
import Data.Function (on) import Data.Function (on)
import Data.List import Data.List
import Data.Ord
import Numeric.RootFinding import Numeric.RootFinding
import Data.Decimal import Data.Decimal
import System.Console.CmdArgs.Explicit as CmdArgs import System.Console.CmdArgs.Explicit as CmdArgs
@ -30,7 +29,7 @@ import Hledger.Cli.CliOptions
roimode = hledgerCommandMode roimode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Roi.txt")) $(embedFileRelative "Hledger/Cli/Commands/Roi.txt")
[flagNone ["cashflow"] (setboolopt "cashflow") "show all amounts that were used to compute returns" [flagNone ["cashflow"] (setboolopt "cashflow") "show all amounts that were used to compute returns"
,flagReq ["investment"] (\s opts -> Right $ setopt "investment" s opts) "QUERY" ,flagReq ["investment"] (\s opts -> Right $ setopt "investment" s opts) "QUERY"
"query to select your investment transactions" "query to select your investment transactions"
@ -81,7 +80,7 @@ roi CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
splitSpan interval $ splitSpan interval $
spanIntersect journalSpan wholeSpan spanIntersect journalSpan wholeSpan
tableBody <- (flip mapM) spans $ \(DateSpan (Just spanBegin) (Just spanEnd)) -> do tableBody <- forM spans $ \(DateSpan (Just spanBegin) (Just spanEnd)) -> do
-- Spans are [spanBegin,spanEnd), and spanEnd is 1 day after then actual end date we are interested in -- Spans are [spanBegin,spanEnd), and spanEnd is 1 day after then actual end date we are interested in
let let
valueBefore = valueBefore =
@ -130,28 +129,28 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans (OneSpan spa
-- Aggregate all entries for a single day, assuming that intraday interest is negligible -- Aggregate all entries for a single day, assuming that intraday interest is negligible
map (\date_cash -> let (dates, cash) = unzip date_cash in (head dates, sum cash)) map (\date_cash -> let (dates, cash) = unzip date_cash in (head dates, sum cash))
$ groupBy ((==) `on` fst) $ groupBy ((==) `on` fst)
$ sortBy (comparing fst) $ sortOn fst
$ map (\(d,a) -> (d, negate a)) $ map (\(d,a) -> (d, negate a))
$ filter ((/=0).snd) cashFlow $ filter ((/=0).snd) cashFlow
let units = let units =
tail $ tail $
(flip scanl) scanl
(0,0,0,initialUnits) (\(_, _, _, unitBalance) (date, amt) ->
(\(_,_,_,unitBalance) (date, amt) -> let valueOnDate = total trans (And [investmentsQuery, Date (DateSpan Nothing (Just date))])
let valueOnDate = unitPrice =
total trans (And [investmentsQuery, Date (DateSpan Nothing (Just date))]) if unitBalance == 0.0
unitPrice = if unitBalance == 0.0 then initialUnitPrice else valueOnDate / unitBalance then initialUnitPrice
unitsBoughtOrSold = amt / unitPrice else valueOnDate / unitBalance
in unitsBoughtOrSold = amt / unitPrice
(valueOnDate, unitsBoughtOrSold, unitPrice, unitBalance + unitsBoughtOrSold) in (valueOnDate, unitsBoughtOrSold, unitPrice, unitBalance + unitsBoughtOrSold))
) (0, 0, 0, initialUnits)
cashflow cashflow
let finalUnitBalance = if null units then initialUnits else let (_,_,_,u) = last units in u let finalUnitBalance = if null units then initialUnits else let (_,_,_,u) = last units in u
finalUnitPrice = valueAfter / finalUnitBalance finalUnitPrice = valueAfter / finalUnitBalance
totalTWR = roundTo 2 $ (finalUnitPrice - initialUnitPrice) totalTWR = roundTo 2 $ (finalUnitPrice - initialUnitPrice)
years = (fromIntegral $ diffDays spanEnd spanBegin)/365 :: Double years = fromIntegral (diffDays spanEnd spanBegin) / 365 :: Double
annualizedTWR = 100*((1+(realToFrac totalTWR/100))**(1/years)-1) :: Double annualizedTWR = 100*((1+(realToFrac totalTWR/100))**(1/years)-1) :: Double
let s d = show $ roundTo 2 d let s d = show $ roundTo 2 d
@ -191,7 +190,7 @@ internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueB
postfix = (spanEnd, valueAfter) postfix = (spanEnd, valueAfter)
totalCF = filter ((/=0) . snd) $ prefix : (sortBy (comparing fst) cashFlow) ++ [postfix] totalCF = filter ((/=0) . snd) $ prefix : (sortOn fst cashFlow) ++ [postfix]
when showCashFlow $ do when showCashFlow $ do
printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd)) printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
@ -218,7 +217,7 @@ type CashFlow = [(Day, Quantity)]
interestSum :: Day -> CashFlow -> Double -> Double interestSum :: Day -> CashFlow -> Double -> Double
interestSum referenceDay cf rate = sum $ map go cf interestSum referenceDay cf rate = sum $ map go cf
where go (t,m) = (fromRational $ toRational m) * (rate ** (fromIntegral (referenceDay `diffDays` t) / 365)) where go (t,m) = fromRational (toRational m) * (rate ** (fromIntegral (referenceDay `diffDays` t) / 365))
calculateCashFlow :: [Transaction] -> Query -> CashFlow calculateCashFlow :: [Transaction] -> Query -> CashFlow

View File

@ -31,7 +31,7 @@ import Hledger.Cli.Utils (writeOutput)
statsmode = hledgerCommandMode statsmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Stats.txt")) $(embedFileRelative "Hledger/Cli/Commands/Stats.txt")
[flagReq ["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE" "write output to FILE." [flagReq ["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE" "write output to FILE."
] ]
[generalflagsgroup1] [generalflagsgroup1]
@ -78,12 +78,12 @@ showLedgerStats l today span =
where where
j = ljournal l j = ljournal l
path = journalFilePath j path = journalFilePath j
ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns j ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j
as = nub $ map paccount $ concatMap tpostings ts as = nub $ map paccount $ concatMap tpostings ts
cs = Map.keys $ commodityStylesFromAmounts $ concatMap amounts $ map pamount $ concatMap tpostings ts cs = Map.keys $ commodityStylesFromAmounts $ concatMap (amounts . pamount) $ concatMap tpostings ts
lastdate | null ts = Nothing lastdate | null ts = Nothing
| otherwise = Just $ tdate $ last ts | otherwise = Just $ tdate $ last ts
lastelapsed = maybe Nothing (Just . diffDays today) lastdate lastelapsed = fmap (diffDays today) lastdate
showelapsed Nothing = "" showelapsed Nothing = ""
showelapsed (Just days) = printf " (%d %s)" days' direction showelapsed (Just days) = printf " (%d %s)" days' direction
where days' = abs days where days' = abs days

View File

@ -14,7 +14,7 @@ import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
tagsmode = hledgerCommandMode tagsmode = hledgerCommandMode
($(embedFileRelative "Hledger/Cli/Commands/Tags.txt")) $(embedFileRelative "Hledger/Cli/Commands/Tags.txt")
[] -- [flagNone ["strict"] (setboolopt "strict") "makes date comparing strict"] -- [] -- [flagNone ["strict"] (setboolopt "strict") "makes date comparing strict"] --
[generalflagsgroup1] [generalflagsgroup1]
[] []