From 03877057fb6672298ea1fb8cce3e7d0e586c32be Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 14 Feb 2019 04:09:26 -0800 Subject: [PATCH] refactor: cli: commands: hlint clean --- .../Hledger/Data/TransactionModifier.hs | 2 +- hledger/Hledger/Cli/Commands.hs | 2 +- hledger/Hledger/Cli/Commands/Activity.hs | 3 +- hledger/Hledger/Cli/Commands/Add.hs | 10 ++--- hledger/Hledger/Cli/Commands/Balance.hs | 39 ++++++++++--------- hledger/Hledger/Cli/Commands/Balancesheet.hs | 2 +- .../Cli/Commands/Balancesheetequity.hs | 2 +- hledger/Hledger/Cli/Commands/Cashflow.hs | 2 +- hledger/Hledger/Cli/Commands/Checkdates.hs | 9 ++--- hledger/Hledger/Cli/Commands/Checkdupes.hs | 4 +- hledger/Hledger/Cli/Commands/Commodities.hs | 2 +- hledger/Hledger/Cli/Commands/Files.hs | 4 +- hledger/Hledger/Cli/Commands/Help.hs | 4 +- hledger/Hledger/Cli/Commands/Import.hs | 7 ++-- .../Hledger/Cli/Commands/Incomestatement.hs | 2 +- hledger/Hledger/Cli/Commands/Prices.hs | 2 +- hledger/Hledger/Cli/Commands/Print.hs | 9 ++--- hledger/Hledger/Cli/Commands/Printunique.hs | 5 +-- hledger/Hledger/Cli/Commands/Register.hs | 24 ++++++------ hledger/Hledger/Cli/Commands/Registermatch.hs | 10 ++--- hledger/Hledger/Cli/Commands/Rewrite.hs | 2 +- hledger/Hledger/Cli/Commands/Roi.hs | 35 ++++++++--------- hledger/Hledger/Cli/Commands/Stats.hs | 8 ++-- hledger/Hledger/Cli/Commands/Tags.hs | 2 +- 24 files changed, 92 insertions(+), 99 deletions(-) diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index f236559fb..e11c330ee 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -34,7 +34,7 @@ import Hledger.Utils.Debug -- | Apply all the given transaction modifiers, in turn, to each transaction. modifyTransactions :: [TransactionModifier] -> [Transaction] -> [Transaction] -modifyTransactions tmods ts = map applymods ts +modifyTransactions tmods = map applymods where applymods = foldr (flip (.) . transactionModifierToFunction) id tmods diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index bb01fbc7e..41bfb624b 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -230,7 +230,7 @@ printCommandsList addonsFound = unknownCommandsFound = addonsFound \\ knownCommands adjustline l | " hledger " `isPrefixOf` l = [l] - adjustline l@('+':_) | not $ cmd `elem` commandsFound = [] + adjustline l@('+':_) | cmd `notElem` commandsFound = [] where cmd = takeWhile (not . isSpace) l adjustline l = [l] diff --git a/hledger/Hledger/Cli/Commands/Activity.hs b/hledger/Hledger/Cli/Commands/Activity.hs index 5ba092454..7b4342070 100644 --- a/hledger/Hledger/Cli/Commands/Activity.hs +++ b/hledger/Hledger/Cli/Commands/Activity.hs @@ -11,7 +11,6 @@ where import Data.List import Data.Maybe -import Data.Ord import Text.Printf import Hledger @@ -47,7 +46,7 @@ showHistogram opts q j = concatMap (printDayWith countBar) spanps -- same as Register -- should count transactions, not postings ? -- 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) diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index aa77691f4..8f48a899a 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -235,7 +235,7 @@ postingsBalanced ps = isRight $ balanceTransaction Nothing nulltransaction{tpost accountWizard EntryState{..} = do 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) Nothing -> "" 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 where 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 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 . compareStrings :: String -> String -> Double compareStrings "" "" = 1 -compareStrings (_:[]) "" = 0 -compareStrings "" (_:[]) = 0 -compareStrings (a:[]) (b:[]) = if toUpper a == toUpper b then 1 else 0 +compareStrings [_] "" = 0 +compareStrings "" [_] = 0 +compareStrings [a] [b] = if toUpper a == toUpper b then 1 else 0 compareStrings s1 s2 = 2 * commonpairs / totalpairs where pairs1 = S.fromList $ wordLetterPairs $ uppercase s1 diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 1ee0e662b..9a34080c2 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -236,6 +236,7 @@ Currently, empty cells show 0. {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NamedFieldPuns #-} module Hledger.Cli.Commands.Balance ( balancemode @@ -465,27 +466,27 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field) -- The CSV will always include the initial headings row, -- and will include the final totals row unless --no-total is set. 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 $ ("Account" : map showDateSpan colspans - ++ (if row_total_ opts then ["Total"] else []) - ++ (if average_ opts then ["Average"] else []) + ++ ["Total" | row_total_] + ++ ["Average" | average_] ) : [T.unpack (maybeAccountNameDrop opts a) : map showMixedAmountOneLineWithoutPrice (amts - ++ (if row_total_ opts then [rowtot] else []) - ++ (if average_ opts then [rowavg] else [])) + ++ [rowtot | row_total_] + ++ [rowavg | average_]) | (a, _, _, amts, rowtot, rowavg) <- items] ++ if no_total_ opts then [] - else [["Total:"] - ++ map showMixedAmountOneLineWithoutPrice ( - coltotals - ++ (if row_total_ opts then [tot] else []) - ++ (if average_ opts then [avg] else []) - )] + else ["Total:" : + map showMixedAmountOneLineWithoutPrice ( + coltotals + ++ [tot | row_total_] + ++ [avg | average_] + )] where maybetranspose | transpose_ opts = transpose | otherwise = id @@ -499,7 +500,7 @@ multiBalanceReportAsHtml ropts mbr = table_ $ mconcat $ [headingsrow] ++ bodyrows - ++ maybe [] (:[]) mtotalsrow + ++ maybeToList mtotalsrow -- | Render the HTML table rows for a MultiBalanceReport. -- 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. 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 $ addtotalrow $ Table @@ -605,20 +606,20 @@ balanceReportAsTable opts (MultiBalanceReport (colspans, items, (coltotals,tot,a PeriodChange -> showDateSpanMonthAbbrev _ -> maybe "" (showDate . prevday) . spanEnd colheadings = map mkDate colspans - ++ (if row_total_ opts then [" Total"] else []) - ++ (if average_ opts then ["Average"] else []) + ++ [" Total" | row_total_] + ++ ["Average" | average_] accts = map renderacct items renderacct (a,a',i,_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a' | otherwise = T.unpack $ maybeAccountNameDrop opts a rowvals (_,_,_,as,rowtot,rowavg) = as - ++ (if row_total_ opts then [rowtot] else []) - ++ (if average_ opts then [rowavg] else []) + ++ [rowtot | row_total_] + ++ [rowavg | average_] addtotalrow | no_total_ opts = id | otherwise = (+----+ (row "" $ coltotals - ++ (if row_total_ opts && not (null coltotals) then [tot] else []) - ++ (if average_ opts && not (null coltotals) then [avg] else []) + ++ [tot | row_total_ && not (null coltotals)] + ++ [avg | average_ && not (null coltotals)] )) maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals) | otherwise = id diff --git a/hledger/Hledger/Cli/Commands/Balancesheet.hs b/hledger/Hledger/Cli/Commands/Balancesheet.hs index 6c2ddccbf..dc618930c 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheet.hs +++ b/hledger/Hledger/Cli/Commands/Balancesheet.hs @@ -18,7 +18,7 @@ import Hledger.Cli.CliOptions import Hledger.Cli.CompoundBalanceCommand balancesheetSpec = CompoundBalanceCommandSpec { - cbcdoc = ($(embedFileRelative "Hledger/Cli/Commands/Balancesheet.txt")), + cbcdoc = $(embedFileRelative "Hledger/Cli/Commands/Balancesheet.txt"), cbctitle = "Balance Sheet", cbcqueries = [ CBCSubreportSpec{ diff --git a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs b/hledger/Hledger/Cli/Commands/Balancesheetequity.hs index b20e42f7b..f7d359691 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs +++ b/hledger/Hledger/Cli/Commands/Balancesheetequity.hs @@ -18,7 +18,7 @@ import Hledger.Cli.CliOptions import Hledger.Cli.CompoundBalanceCommand balancesheetequitySpec = CompoundBalanceCommandSpec { - cbcdoc = ($(embedFileRelative "Hledger/Cli/Commands/Balancesheetequity.txt")), + cbcdoc = $(embedFileRelative "Hledger/Cli/Commands/Balancesheetequity.txt"), cbctitle = "Balance Sheet With Equity", cbcqueries = [ CBCSubreportSpec{ diff --git a/hledger/Hledger/Cli/Commands/Cashflow.hs b/hledger/Hledger/Cli/Commands/Cashflow.hs index 0925242b8..3cabe61af 100644 --- a/hledger/Hledger/Cli/Commands/Cashflow.hs +++ b/hledger/Hledger/Cli/Commands/Cashflow.hs @@ -21,7 +21,7 @@ import Hledger.Cli.CliOptions import Hledger.Cli.CompoundBalanceCommand cashflowSpec = CompoundBalanceCommandSpec { - cbcdoc = ($(embedFileRelative "Hledger/Cli/Commands/Cashflow.txt")), + cbcdoc = $(embedFileRelative "Hledger/Cli/Commands/Cashflow.txt"), cbctitle = "Cashflow Statement", cbcqueries = [ CBCSubreportSpec{ diff --git a/hledger/Hledger/Cli/Commands/Checkdates.hs b/hledger/Hledger/Cli/Commands/Checkdates.hs index 825fce819..2107a8f8c 100755 --- a/hledger/Hledger/Cli/Commands/Checkdates.hs +++ b/hledger/Hledger/Cli/Commands/Checkdates.hs @@ -13,7 +13,7 @@ import Text.Printf checkdatesmode :: Mode RawOpts checkdatesmode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Checkdates.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Checkdates.txt") [flagNone ["strict"] (setboolopt "strict") "makes date comparing strict"] [generalflagsgroup1] [] @@ -61,11 +61,10 @@ foldWhile fold acc (a:as) = checkTransactions :: (Transaction -> Transaction -> Bool) -> [Transaction] -> FoldAcc Transaction Transaction -checkTransactions compare ts = - foldWhile fold FoldAcc{fa_error=Nothing, fa_previous=Nothing} ts +checkTransactions compare = foldWhile f FoldAcc{fa_error=Nothing, fa_previous=Nothing} where - fold 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=Nothing} = acc{fa_previous=Just current} + f current acc@FoldAcc{fa_previous=Just previous} = if compare previous current then acc{fa_previous=Just current} else acc{fa_error=Just current} diff --git a/hledger/Hledger/Cli/Commands/Checkdupes.hs b/hledger/Hledger/Cli/Commands/Checkdupes.hs index 2e4fd2c9f..5e7407a8b 100755 --- a/hledger/Hledger/Cli/Commands/Checkdupes.hs +++ b/hledger/Hledger/Cli/Commands/Checkdupes.hs @@ -16,7 +16,7 @@ import Text.Printf checkdupesmode :: Mode RawOpts checkdupesmode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Checkdupes.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Checkdupes.txt") [] [generalflagsgroup1] [] @@ -40,4 +40,4 @@ checkdupes' l = zip dupLeafs dupAccountNames . sortBy (compare `on` fst) 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)) diff --git a/hledger/Hledger/Cli/Commands/Commodities.hs b/hledger/Hledger/Cli/Commands/Commodities.hs index 41eee921b..8d234f03b 100644 --- a/hledger/Hledger/Cli/Commands/Commodities.hs +++ b/hledger/Hledger/Cli/Commands/Commodities.hs @@ -23,7 +23,7 @@ import Hledger.Cli.CliOptions -- | Command line options for this command. commoditiesmode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Commodities.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Commodities.txt") [] [generalflagsgroup2] [] diff --git a/hledger/Hledger/Cli/Commands/Files.hs b/hledger/Hledger/Cli/Commands/Files.hs index 2c96b6a4b..064532a62 100644 --- a/hledger/Hledger/Cli/Commands/Files.hs +++ b/hledger/Hledger/Cli/Commands/Files.hs @@ -23,7 +23,7 @@ import Hledger.Cli.CliOptions -- | Command line options for this command. filesmode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Files.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Files.txt") [] [generalflagsgroup2] [] @@ -34,7 +34,7 @@ files :: CliOpts -> Journal -> IO () files CliOpts{rawopts_=rawopts} j = do let args = listofstringopt "args" rawopts regex = headMay args - files = (maybe id (filter . regexMatches) regex) + files = maybe id (filter . regexMatches) regex $ map fst $ jfiles j mapM_ putStrLn files diff --git a/hledger/Hledger/Cli/Commands/Help.hs b/hledger/Hledger/Cli/Commands/Help.hs index 936a1b06e..ee95ebe41 100644 --- a/hledger/Hledger/Cli/Commands/Help.hs +++ b/hledger/Hledger/Cli/Commands/Help.hs @@ -35,7 +35,7 @@ import Hledger.Cli.DocFiles --import Hledger.Utils.Debug helpmode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Help.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Help.txt") [flagNone ["info"] (setboolopt "info") "show the manual with info" ,flagNone ["man"] (setboolopt "man") "show the manual with man" ,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," ,"or type \"hledger help -h\" to see options. Manuals available:" ] - ++ "\n " ++ intercalate " " docTopics + ++ "\n " ++ unwords docTopics Just t -> viewer t diff --git a/hledger/Hledger/Cli/Commands/Import.hs b/hledger/Hledger/Cli/Commands/Import.hs index eaa1e259f..7ad5b71b0 100755 --- a/hledger/Hledger/Cli/Commands/Import.hs +++ b/hledger/Hledger/Cli/Commands/Import.hs @@ -9,7 +9,6 @@ where import Control.Monad import Data.List -import Data.Ord import Hledger import Hledger.Cli.CliOptions import Hledger.Cli.Commands.Add (journalAddTransaction) @@ -18,7 +17,7 @@ import System.Console.CmdArgs.Explicit import Text.Printf 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"] [generalflagsgroup1] [] @@ -36,7 +35,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do case enewj of Left e -> error' e Right newj -> - case sortBy (comparing tdate) $ jtxns newj of + case sortOn tdate $ jtxns newj of [] -> return () newts | dryrun -> do 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 mapM_ (putStr . showTransactionUnelided) newts 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) diff --git a/hledger/Hledger/Cli/Commands/Incomestatement.hs b/hledger/Hledger/Cli/Commands/Incomestatement.hs index 58f2dc742..c7706e2ef 100644 --- a/hledger/Hledger/Cli/Commands/Incomestatement.hs +++ b/hledger/Hledger/Cli/Commands/Incomestatement.hs @@ -17,7 +17,7 @@ import Hledger.Cli.CliOptions import Hledger.Cli.CompoundBalanceCommand incomestatementSpec = CompoundBalanceCommandSpec { - cbcdoc = ($(embedFileRelative "Hledger/Cli/Commands/Incomestatement.txt")), + cbcdoc = $(embedFileRelative "Hledger/Cli/Commands/Incomestatement.txt"), cbctitle = "Income Statement", cbcqueries = [ CBCSubreportSpec{ diff --git a/hledger/Hledger/Cli/Commands/Prices.hs b/hledger/Hledger/Cli/Commands/Prices.hs index 3aa0d84d2..8a066ee15 100755 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/hledger/Hledger/Cli/Commands/Prices.hs @@ -15,7 +15,7 @@ import Hledger.Cli.CliOptions import System.Console.CmdArgs.Explicit pricesmode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Prices.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Prices.txt") [flagNone ["costs"] (setboolopt "costs") "print transaction prices from postings" ,flagNone ["inverted-costs"] (setboolopt "inverted-costs") "print transaction inverted prices from postings also"] [generalflagsgroup1] diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index c6406328a..67f2e6144 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -27,7 +27,7 @@ import Hledger.Cli.Commands.Add ( transactionsSimilarTo ) printmode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Print.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Print.txt") ([let arg = "STR" in 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") @@ -66,10 +66,7 @@ entriesReportAsText opts = concatMap (showTransactionUnelided . gettxn) -- Original vs inferred transactions/postings were causing problems here, disabling -B (#551). -- Use the explicit one if -B or -x are active. -- This passes tests; does it also mean -B sometimes shows missing amounts unnecessarily ? - useexplicittxn = or - [ boolopt "explicit" $ rawopts_ opts - , cost_ $ reportopts_ opts - ] + useexplicittxn = boolopt "explicit" (rawopts_ opts) || cost_ (reportopts_ opts) -- Replace this transaction's postings with the original postings if any, but keep the -- current possibly rewritten account names. @@ -147,7 +144,7 @@ postingToCSV p = let commodity = T.unpack c in let credit = if q < 0 then showAmount $ negate 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 where Mixed amounts = pamount p diff --git a/hledger/Hledger/Cli/Commands/Printunique.hs b/hledger/Hledger/Cli/Commands/Printunique.hs index 205541804..77e87b6d4 100755 --- a/hledger/Hledger/Cli/Commands/Printunique.hs +++ b/hledger/Hledger/Cli/Commands/Printunique.hs @@ -7,13 +7,12 @@ module Hledger.Cli.Commands.Printunique ( where import Data.List -import Data.Ord import Hledger import Hledger.Cli.CliOptions import Hledger.Cli.Commands.Print printuniquemode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Printunique.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Printunique.txt") [] [generalflagsgroup1] [] @@ -22,6 +21,6 @@ printuniquemode = hledgerCommandMode printunique opts j@Journal{jtxns=ts} = do print' opts j{jtxns=uniquify ts} 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 = tdate diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index d544f2a43..8d2493a84 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -28,7 +28,7 @@ import Hledger.Cli.CliOptions import Hledger.Cli.Utils registermode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Register.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Register.txt") ([flagNone ["cumulative"] (setboolopt "change") "show running total from report start date (default)" ,flagNone ["historical","H"] (setboolopt "historical") @@ -119,17 +119,17 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda -- use elide*Width to be wide-char-aware -- trace (show (totalwidth, datewidth, descwidth, acctwidth, amtwidth, balwidth)) $ intercalate "\n" $ - [concat [fitString (Just datewidth) (Just datewidth) True True date - ," " - ,fitString (Just descwidth) (Just descwidth) True True desc - ," " - ,fitString (Just acctwidth) (Just acctwidth) True True acct - ," " - ,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline - ," " - ,fitString (Just balwidth) (Just balwidth) True False balfirstline - ]] - ++ + concat [fitString (Just datewidth) (Just datewidth) True True date + ," " + ,fitString (Just descwidth) (Just descwidth) True True desc + ," " + ,fitString (Just acctwidth) (Just acctwidth) True True acct + ," " + ,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline + ," " + ,fitString (Just balwidth) (Just balwidth) True False balfirstline + ] + : [concat [spacer ,fitString (Just amtwidth) (Just amtwidth) True False a ," " diff --git a/hledger/Hledger/Cli/Commands/Registermatch.hs b/hledger/Hledger/Cli/Commands/Registermatch.hs index 3b4d9bd51..d230fadb3 100755 --- a/hledger/Hledger/Cli/Commands/Registermatch.hs +++ b/hledger/Hledger/Cli/Commands/Registermatch.hs @@ -15,7 +15,7 @@ import Hledger.Cli.CliOptions import Hledger.Cli.Commands.Register registermatchmode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Registermatch.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Registermatch.txt") [] [generalflagsgroup1] [] @@ -60,7 +60,7 @@ similarPosting ps desc = -- ((,t):_) = Just t -- [] = Nothing -compareDescriptions :: [Char] -> [Char] -> Double +compareDescriptions :: String -> String -> Double compareDescriptions s t = compareStrings s' t' where s' = simplify s t' = simplify t @@ -72,9 +72,9 @@ compareDescriptions s t = compareStrings s' t' -- with a modification for short strings. compareStrings :: String -> String -> Double compareStrings "" "" = 1 -compareStrings (_:[]) "" = 0 -compareStrings "" (_:[]) = 0 -compareStrings (a:[]) (b:[]) = if toUpper a == toUpper b then 1 else 0 +compareStrings [_] "" = 0 +compareStrings "" [_] = 0 +compareStrings [a] [b] = if toUpper a == toUpper b then 1 else 0 compareStrings s1 s2 = 2.0 * fromIntegral i / fromIntegral u where i = length $ intersect pairs1 pairs2 diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index 959c42746..afd02f3b3 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -23,7 +23,7 @@ import Text.Megaparsec import qualified Data.Algorithm.Diff as D 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'" "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" diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index 326345d0a..896d65d5f 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -17,7 +17,6 @@ import Data.Time.Calendar import Text.Printf import Data.Function (on) import Data.List -import Data.Ord import Numeric.RootFinding import Data.Decimal import System.Console.CmdArgs.Explicit as CmdArgs @@ -30,7 +29,7 @@ import Hledger.Cli.CliOptions 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" ,flagReq ["investment"] (\s opts -> Right $ setopt "investment" s opts) "QUERY" "query to select your investment transactions" @@ -81,7 +80,7 @@ roi CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do splitSpan interval $ 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 let 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 map (\date_cash -> let (dates, cash) = unzip date_cash in (head dates, sum cash)) $ groupBy ((==) `on` fst) - $ sortBy (comparing fst) + $ sortOn fst $ map (\(d,a) -> (d, negate a)) $ filter ((/=0).snd) cashFlow let units = tail $ - (flip scanl) - (0,0,0,initialUnits) - (\(_,_,_,unitBalance) (date, amt) -> - let valueOnDate = - total trans (And [investmentsQuery, Date (DateSpan Nothing (Just date))]) - unitPrice = if unitBalance == 0.0 then initialUnitPrice else valueOnDate / unitBalance - unitsBoughtOrSold = amt / unitPrice - in - (valueOnDate, unitsBoughtOrSold, unitPrice, unitBalance + unitsBoughtOrSold) - ) - cashflow + scanl + (\(_, _, _, unitBalance) (date, amt) -> + let valueOnDate = total trans (And [investmentsQuery, Date (DateSpan Nothing (Just date))]) + unitPrice = + if unitBalance == 0.0 + then initialUnitPrice + else valueOnDate / unitBalance + unitsBoughtOrSold = amt / unitPrice + in (valueOnDate, unitsBoughtOrSold, unitPrice, unitBalance + unitsBoughtOrSold)) + (0, 0, 0, initialUnits) + cashflow let finalUnitBalance = if null units then initialUnits else let (_,_,_,u) = last units in u finalUnitPrice = valueAfter / finalUnitBalance 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 let s d = show $ roundTo 2 d @@ -191,7 +190,7 @@ internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueB 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 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 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 diff --git a/hledger/Hledger/Cli/Commands/Stats.hs b/hledger/Hledger/Cli/Commands/Stats.hs index 250f09d74..1b48e195c 100644 --- a/hledger/Hledger/Cli/Commands/Stats.hs +++ b/hledger/Hledger/Cli/Commands/Stats.hs @@ -31,7 +31,7 @@ import Hledger.Cli.Utils (writeOutput) 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." ] [generalflagsgroup1] @@ -78,12 +78,12 @@ showLedgerStats l today span = where j = ljournal l 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 - 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 | otherwise = Just $ tdate $ last ts - lastelapsed = maybe Nothing (Just . diffDays today) lastdate + lastelapsed = fmap (diffDays today) lastdate showelapsed Nothing = "" showelapsed (Just days) = printf " (%d %s)" days' direction where days' = abs days diff --git a/hledger/Hledger/Cli/Commands/Tags.hs b/hledger/Hledger/Cli/Commands/Tags.hs index 58f2729b5..789a14e37 100755 --- a/hledger/Hledger/Cli/Commands/Tags.hs +++ b/hledger/Hledger/Cli/Commands/Tags.hs @@ -14,7 +14,7 @@ import Hledger import Hledger.Cli.CliOptions tagsmode = hledgerCommandMode - ($(embedFileRelative "Hledger/Cli/Commands/Tags.txt")) + $(embedFileRelative "Hledger/Cli/Commands/Tags.txt") [] -- [flagNone ["strict"] (setboolopt "strict") "makes date comparing strict"] -- [generalflagsgroup1] []