diff --git a/bin/hledger-check-dates.hs b/bin/hledger-check-dates.hs index 73a952a7c..f2cac0970 100755 --- a/bin/hledger-check-dates.hs +++ b/bin/hledger-check-dates.hs @@ -3,6 +3,8 @@ --package hledger-lib --package hledger -} +-- You can compile this script for speed: +-- stack build hledger && stack ghc bin/hledger-check-dates.hs {-| hledger-check-dates [--strict] [--date2] [-f JOURNALFILE] diff --git a/bin/hledger-equity.hs b/bin/hledger-equity.hs index 115be7e88..cd0dccab2 100755 --- a/bin/hledger-equity.hs +++ b/bin/hledger-equity.hs @@ -4,6 +4,8 @@ --package hledger --package time -} +-- You can compile this script for speed: +-- stack build hledger && stack ghc bin/hledger-equity.hs {- hledger-equity [HLEDGEROPTS] [QUERY] diff --git a/bin/hledger-print-unique.hs b/bin/hledger-print-unique.hs index d3599587d..7e6e6f10c 100755 --- a/bin/hledger-print-unique.hs +++ b/bin/hledger-print-unique.hs @@ -1,11 +1,18 @@ -#!/usr/bin/env runhaskell -{-| +#!/usr/bin/env stack +{- stack runghc --verbosity info + --package hledger-lib + --package hledger +-} +-- You can compile this script for speed: +-- stack build hledger && stack ghc bin/hledger-print-unique.hs + +{- hledger-print-unique [-f JOURNALFILE | -f-] Print only journal entries which are unique by description (or something else). Reads the default or specified journal, or stdin. -|-} +-} import Data.List import Data.Ord diff --git a/bin/hledger-register-match.hs b/bin/hledger-register-match.hs new file mode 100755 index 000000000..cab5b016d --- /dev/null +++ b/bin/hledger-register-match.hs @@ -0,0 +1,100 @@ +#!/usr/bin/env stack +{- stack runghc --verbosity info + --package hledger-lib + --package hledger + --package text +-} +-- You can compile this script for speed: +-- stack build hledger && stack ghc bin/hledger-register-match.hs + +{-| +hledger-register-match DESC + +A helper for ledger-autosync. This prints the one posting whose transaction +description is closest to DESC, in the style of the register command. +If there are multiple equally good matches, it shows the most recent. +Query options (options, not arguments) can be used to restrict the search space. + +|-} + +{-# LANGUAGE OverloadedStrings #-} + +import Data.Char (toUpper) +import Data.List +import qualified Data.Text as T + +import System.Console.CmdArgs +import System.Console.CmdArgs.Explicit + +import Hledger +import Hledger.Cli.CliOptions +import Hledger.Cli ( withJournalDo, postingsReportAsText ) + +main = getCliOpts (defCommandMode ["hledger-register-match"]) >>= flip withJournalDo match + +match :: CliOpts -> Journal -> IO () +match opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do + let args' = listofstringopt "args" rawopts + case args' of + [desc] -> do + d <- getCurrentDay + let q = queryFromOptsOnly d ropts + (_,pris) = postingsReport ropts q j + ps = [p | (_,_,_,p,_) <- pris] + case similarPosting ps desc of + Nothing -> putStrLn "no matches found." + Just p -> putStr $ postingsReportAsText opts ("",[pri]) + where pri = (Just (postingDate p) + ,Nothing + ,Just $ T.unpack (maybe "" tdescription $ ptransaction p) + ,p + ,0) + _ -> putStrLn "please provide one description argument." + +-- Identify the closest recent match for this description in the given date-sorted postings. +similarPosting :: [Posting] -> String -> Maybe Posting +similarPosting ps desc = + let matches = + sortBy compareRelevanceAndRecency + $ filter ((> threshold).fst) + [(maybe 0 (\t -> compareDescriptions desc (T.unpack $ tdescription t)) (ptransaction p), p) | p <- ps] + where + compareRelevanceAndRecency (n1,p1) (n2,p2) = compare (n2,postingDate p2) (n1,postingDate p1) + threshold = 0 + in case matches of [] -> Nothing + m:_ -> Just $ snd m + +-- -- Identify the closest recent match for this description in past transactions. +-- similarTransaction :: Journal -> Query -> String -> Maybe Transaction +-- similarTransaction j q desc = +-- case historymatches = transactionsSimilarTo j q desc of +-- ((,t):_) = Just t +-- [] = Nothing + +compareDescriptions :: [Char] -> [Char] -> Double +compareDescriptions s t = compareStrings s' t' + where s' = simplify s + t' = simplify t + simplify = filter (not . (`elem` ("0123456789"::String))) + +-- | Return a similarity measure, from 0 to 1, for two strings. +-- This is Simon White's letter pairs algorithm from +-- http://www.catalysoft.com/articles/StrikeAMatch.html +-- 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 s1 s2 = 2.0 * fromIntegral i / fromIntegral u + where + i = length $ intersect pairs1 pairs2 + u = length pairs1 + length pairs2 + pairs1 = wordLetterPairs $ uppercase s1 + pairs2 = wordLetterPairs $ uppercase s2 + +wordLetterPairs = concatMap letterPairs . words + +letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) +letterPairs _ = [] + diff --git a/bin/hledger-rewrite.hs b/bin/hledger-rewrite.hs index 571445e22..43c5f7380 100755 --- a/bin/hledger-rewrite.hs +++ b/bin/hledger-rewrite.hs @@ -5,9 +5,8 @@ --package megaparsec --package text -} --- To run or compile this script, it's easiest to be in the hledger source tree. Then: --- To run it directly: bin/hledger-rewrite.hs ARGS --- To compile it: stack build hledger --only-dependencies && stack ghc bin/hledger-rewrite.hs +-- You can compile this script for speed: +-- stack build hledger && stack ghc bin/hledger-rewrite.hs {-| hledger-rewrite [PATTERNS] --add-posting "ACCT AMTEXPR" ... @@ -23,9 +22,7 @@ hledger-rewrite.hs expenses:gifts --add-posting '(reserve:gifts) *-1"' Note the single quotes to protect the dollar sign from bash, and the two spaces between account and amount. See the command-line help for more details. -Currently does not work when invoked via hledger, run hledger-rewrite[.hs] directly. - -Tested-with: hledger HEAD ~ 2016/3/2 +Currently does not work when invoked via hledger, run it directly instead. Related: https://github.com/simonmichael/hledger/issues/99