bin: add register-match, convert all to stack scripts

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]

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]

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

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 _ = []
+

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