Use haskeline in the "add" command, and tab-complete account names.
This commit is contained in:
parent
d6c2cf6a90
commit
18fd5fe482
@ -14,14 +14,19 @@ import Hledger.Cli.Commands.Register (registerReport, registerReportAsText)
|
|||||||
#if __GLASGOW_HASKELL__ <= 610
|
#if __GLASGOW_HASKELL__ <= 610
|
||||||
import Prelude hiding (putStr, putStrLn, getLine, appendFile)
|
import Prelude hiding (putStr, putStrLn, getLine, appendFile)
|
||||||
import System.IO.UTF8
|
import System.IO.UTF8
|
||||||
import System.IO ( stderr, hFlush )
|
import System.IO ( stderr )
|
||||||
#else
|
#else
|
||||||
import System.IO ( stderr, hFlush, hPutStrLn, hPutStr )
|
import System.IO ( stderr, hPutStrLn, hPutStr )
|
||||||
#endif
|
#endif
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import Text.ParserCombinators.Parsec
|
import Text.ParserCombinators.Parsec
|
||||||
import Hledger.Cli.Utils (readJournalWithOpts)
|
import Hledger.Cli.Utils (readJournalWithOpts)
|
||||||
import qualified Data.Foldable as Foldable (find)
|
import qualified Data.Foldable as Foldable (find)
|
||||||
|
import System.Console.Haskeline (
|
||||||
|
InputT, runInputT, defaultSettings, setComplete, getInputLine)
|
||||||
|
import Control.Monad.Trans (liftIO)
|
||||||
|
import System.Console.Haskeline.Completion
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
|
||||||
-- | Read transactions from the terminal, prompting for each field,
|
-- | Read transactions from the terminal, prompting for each field,
|
||||||
-- and append them to the journal file. If the journal came from stdin, this
|
-- and append them to the journal file. If the journal came from stdin, this
|
||||||
@ -34,23 +39,25 @@ add opts args j
|
|||||||
"Enter one or more transactions, which will be added to your journal file.\n"
|
"Enter one or more transactions, which will be added to your journal file.\n"
|
||||||
++"To complete a transaction, enter . as account name. To quit, press control-c."
|
++"To complete a transaction, enter . as account name. To quit, press control-c."
|
||||||
today <- getCurrentDay
|
today <- getCurrentDay
|
||||||
getAndAddTransactions j opts args today `catch` (\e -> unless (isEOFError e) $ ioError e)
|
runInteraction j (getAndAddTransactions j opts args today)
|
||||||
|
`catch` (\e -> unless (isEOFError e) $ ioError e)
|
||||||
where f = journalFilePath j
|
where f = journalFilePath j
|
||||||
|
|
||||||
-- | Read a number of transactions from the command line, prompting,
|
-- | Read a number of transactions from the command line, prompting,
|
||||||
-- validating, displaying and appending them to the journal file, until
|
-- validating, displaying and appending them to the journal file, until
|
||||||
-- end of input (then raise an EOF exception). Any command-line arguments
|
-- end of input (then raise an EOF exception). Any command-line arguments
|
||||||
-- are used as the first transaction's description.
|
-- are used as the first transaction's description.
|
||||||
getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO ()
|
getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> InputT IO ()
|
||||||
getAndAddTransactions j opts args defaultDate = do
|
getAndAddTransactions j opts args defaultDate = do
|
||||||
(t, d) <- getTransaction j opts args defaultDate
|
(t, d) <- getTransaction j opts args defaultDate
|
||||||
j <- journalAddTransaction j opts t
|
j <- liftIO $ journalAddTransaction j opts t
|
||||||
getAndAddTransactions j opts args d
|
getAndAddTransactions j opts args d
|
||||||
|
|
||||||
-- | Read a transaction from the command line, with history-aware prompting.
|
-- | Read a transaction from the command line, with history-aware prompting.
|
||||||
getTransaction :: Journal -> [Opt] -> [String] -> Day -> IO (Transaction,Day)
|
getTransaction :: Journal -> [Opt] -> [String] -> Day
|
||||||
|
-> InputT IO (Transaction,Day)
|
||||||
getTransaction j opts args defaultDate = do
|
getTransaction j opts args defaultDate = do
|
||||||
today <- getCurrentDay
|
today <- liftIO getCurrentDay
|
||||||
datestr <- askFor "date"
|
datestr <- askFor "date"
|
||||||
(Just $ showDate defaultDate)
|
(Just $ showDate defaultDate)
|
||||||
(Just $ \s -> null s ||
|
(Just $ \s -> null s ||
|
||||||
@ -74,18 +81,18 @@ getTransaction j opts args defaultDate = do
|
|||||||
,tpostings=ps
|
,tpostings=ps
|
||||||
}
|
}
|
||||||
retry msg = do
|
retry msg = do
|
||||||
hPutStrLn stderr $ "\n" ++ msg ++ "please re-enter."
|
liftIO $ hPutStrLn stderr $ "\n" ++ msg ++ "please re-enter."
|
||||||
getpostingsandvalidate
|
getpostingsandvalidate
|
||||||
either retry (return . flip (,) date) $ balanceTransaction t
|
either retry (return . flip (,) date) $ balanceTransaction t
|
||||||
unless (null historymatches)
|
unless (null historymatches)
|
||||||
(do
|
(liftIO $ do
|
||||||
hPutStrLn stderr "Similar transactions found, using the first for defaults:\n"
|
hPutStrLn stderr "Similar transactions found, using the first for defaults:\n"
|
||||||
hPutStr stderr $ concatMap (\(n,t) -> printf "[%3d%%] %s" (round $ n*100 :: Int) (show t)) $ take 3 historymatches)
|
hPutStr stderr $ concatMap (\(n,t) -> printf "[%3d%%] %s" (round $ n*100 :: Int) (show t)) $ take 3 historymatches)
|
||||||
getpostingsandvalidate
|
getpostingsandvalidate
|
||||||
|
|
||||||
-- | Read postings from the command line until . is entered, using the
|
-- | Read postings from the command line until . is entered, using the
|
||||||
-- provided historical postings, if any, to guess defaults.
|
-- provided historical postings, if any, to guess defaults.
|
||||||
getPostings :: (AccountName -> Bool) -> Maybe [Posting] -> [Posting] -> IO [Posting]
|
getPostings :: (AccountName -> Bool) -> Maybe [Posting] -> [Posting] -> InputT IO [Posting]
|
||||||
getPostings accept historicalps enteredps = do
|
getPostings accept historicalps enteredps = do
|
||||||
account <- askFor (printf "account %d" n) defaultaccount (Just accept)
|
account <- askFor (printf "account %d" n) defaultaccount (Just accept)
|
||||||
if account=="."
|
if account=="."
|
||||||
@ -118,11 +125,10 @@ getPostings accept historicalps enteredps = do
|
|||||||
-- | Prompt for and read a string value, optionally with a default value
|
-- | Prompt for and read a string value, optionally with a default value
|
||||||
-- and a validator. A validator causes the prompt to repeat until the
|
-- and a validator. A validator causes the prompt to repeat until the
|
||||||
-- input is valid. May also raise an EOF exception if control-d is pressed.
|
-- input is valid. May also raise an EOF exception if control-d is pressed.
|
||||||
askFor :: String -> Maybe String -> Maybe (String -> Bool) -> IO String
|
askFor :: String -> Maybe String -> Maybe (String -> Bool) -> InputT IO String
|
||||||
askFor prompt def validator = do
|
askFor prompt def validator = do
|
||||||
hPutStr stderr $ prompt ++ maybe "" showdef def ++ ": "
|
l <- fmap (maybe "" id)
|
||||||
hFlush stderr
|
$ getInputLine $ prompt ++ maybe "" showdef def ++ ": "
|
||||||
l <- getLine
|
|
||||||
let input = if null l then fromMaybe l def else l
|
let input = if null l then fromMaybe l def else l
|
||||||
case validator of
|
case validator of
|
||||||
Just valid -> if valid input
|
Just valid -> if valid input
|
||||||
@ -197,3 +203,22 @@ transactionsSimilarTo j apats s =
|
|||||||
ts = jtxns $ filterJournalTransactionsByAccount apats j
|
ts = jtxns $ filterJournalTransactionsByAccount apats j
|
||||||
threshold = 0
|
threshold = 0
|
||||||
|
|
||||||
|
runInteraction :: Journal -> InputT IO a -> IO a
|
||||||
|
runInteraction j m = do
|
||||||
|
let cc = completionCache j
|
||||||
|
runInputT (setComplete (accountCompletion cc) defaultSettings) m
|
||||||
|
|
||||||
|
-- A precomputed list of all accounts previously entered into the journal.
|
||||||
|
type CompletionCache = [AccountName]
|
||||||
|
|
||||||
|
completionCache :: Journal -> CompletionCache
|
||||||
|
completionCache j = -- Only keep unique account names.
|
||||||
|
Set.toList $ Set.fromList
|
||||||
|
[paccount p | t <- jtxns j, p <- tpostings t]
|
||||||
|
|
||||||
|
accountCompletion :: CompletionCache -> CompletionFunc IO
|
||||||
|
accountCompletion cc = completeWord Nothing
|
||||||
|
"" -- don't break words on whitespace, since account names
|
||||||
|
-- can contain spaces.
|
||||||
|
$ \s -> return $ map simpleCompletion
|
||||||
|
$ filter (s `isPrefixOf`) cc
|
||||||
|
|||||||
@ -67,6 +67,7 @@ executable hledger
|
|||||||
,split == 0.1.*
|
,split == 0.1.*
|
||||||
,time
|
,time
|
||||||
,utf8-string >= 0.3.5 && < 0.4
|
,utf8-string >= 0.3.5 && < 0.4
|
||||||
|
,haskeline == 0.6.*
|
||||||
|
|
||||||
-- modules and dependencies below should be as above
|
-- modules and dependencies below should be as above
|
||||||
library
|
library
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user