From c5e7b12a593971bce3715572dc5ff5e4f4b81f59 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 8 Apr 2009 05:30:26 +0000 Subject: [PATCH] add command, reads transactions interactively and adds them to the ledger --- AddCommand.hs | 93 +++++++++++++++++++++++++++++++++++++++++++++++++ Ledger/Utils.hs | 6 +++- Tests.hs | 3 ++ Utils.hs | 5 +-- hledger.hs | 3 ++ 5 files changed, 107 insertions(+), 3 deletions(-) create mode 100644 AddCommand.hs diff --git a/AddCommand.hs b/AddCommand.hs new file mode 100644 index 000000000..3dbc0e855 --- /dev/null +++ b/AddCommand.hs @@ -0,0 +1,93 @@ +{-| + +A simple add command to help with data entry. + +-} + +module AddCommand +where +import Ledger +import Options +import RegisterCommand (showRegisterReport) +import System.IO +import System.IO.Error +import Text.ParserCombinators.Parsec +import Utils (ledgerFromStringWithOpts) + + +-- | Read ledger transactions from the command line, prompting for each +-- field, and append them to the ledger file. If the ledger came from +-- stdin, this command has no effect. +add :: [Opt] -> [String] -> Ledger -> IO () +add opts args l + | filepath (rawledger l) == "-" = return () + | otherwise = do + hPutStrLn stderr ("Please enter one or more transactions, which will be added to your ledger file.\n\ + \A blank account or amount ends the current transaction, control-d to finish.") + ts <- getAndAddTransactions l + putStrLn $ printf "\n\nAdded %d transactions to %s ." (length ts) (filepath $ rawledger l) + +-- | Read a number of ledger transactions from the command line, +-- prompting, validating, displaying and appending them to the ledger file. +getAndAddTransactions :: Ledger -> IO [LedgerTransaction] +getAndAddTransactions l = (do + today <- getCurrentDay + date <- liftM (fixSmartDate today . fromparse . parse smartdate "" . lowercase) + $ askFor "date" (Just $ showDate today) + -- cleared' <- askFor "cleared, y/n" (Just "n") + -- let cleared = if cleared' == "y" then True else False + description <- askFor "description" Nothing + ps <- getPostings [] + let t = nullledgertxn{ltdate=date + ,ltstatus=False -- cleared + ,ltdescription=description + ,ltpostings=ps + } + appendToLedgerFile l $ show t + registerFromString (show t) >>= putStrLn + liftM (t:) (getAndAddTransactions l) + ) `catch` (\e -> if isEOFError e then return [] else ioError e) + +-- | Read one or more postings interactively. +getPostings :: [Posting] -> IO [Posting] +getPostings prevps = do + account <- askFor "account" Nothing + if null account + then return prevps + else do + amount <- liftM (fromparse . parse (someamount <|> return missingamt) "") + $ askFor "amount" Nothing + let p = nullrawposting{paccount=account,pamount=amount} + if amount == missingamt + then return $ prevps ++ [p] + else getPostings $ prevps ++ [p] + +-- | Prompt and read a string value, possibly with a default. +askFor :: String -> Maybe String -> IO String +askFor prompt def = do + hPutStr stderr $ prompt ++ (maybe "" showdef def) ++ ": " + hFlush stderr + l <- getLine + return $ if null l then fromMaybe l def else l + where showdef s = " [" ++ s ++ "]" + +-- | Append a string of transactions to the ledger's file, ensuring proper +-- separation from the existing data; or if the file is "-", print them +-- to stdout. +appendToLedgerFile :: Ledger -> String -> IO () +appendToLedgerFile l s = + if f == "-" + then putStr $ sep ++ s + else appendFile f $ sep++s + where + f = filepath $ rawledger l + t = rawledgertext l + sep = replicate (2 - min 2 (length nls)) '\n' where nls = takeWhile (=='\n') $ reverse t + +-- | Convert a string of ledger data into a register report. +registerFromString :: String -> IO String +registerFromString s = do + now <- getCurrentLocalTime + l <- ledgerFromStringWithOpts [] [] now s + return $ showRegisterReport [] [] l + diff --git a/Ledger/Utils.hs b/Ledger/Utils.hs index 58a1f8f51..aad8f15f4 100644 --- a/Ledger/Utils.hs +++ b/Ledger/Utils.hs @@ -24,6 +24,7 @@ module Test.HUnit, ) where import Char +import Control.Exception import Control.Monad import Data.List --import qualified Data.Map as Map @@ -34,6 +35,7 @@ import Data.Time.Clock import Data.Time.Calendar import Data.Time.LocalTime import Debug.Trace +import System.IO import Test.HUnit import Text.Printf import Text.Regex @@ -240,7 +242,7 @@ getCurrentLocalTime = do tz <- getCurrentTimeZone return $ utcToLocalTime tz t - +-- misc isLeft :: Either a b -> Bool isLeft (Left _) = True @@ -249,3 +251,5 @@ isLeft _ = False isRight :: Either a b -> Bool isRight = not . isLeft +strictReadFile :: FilePath -> IO String +strictReadFile f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s diff --git a/Tests.hs b/Tests.hs index 7230b4ade..eb1a3414a 100644 --- a/Tests.hs +++ b/Tests.hs @@ -1116,6 +1116,7 @@ rawledger7 = RawLedger [] [] "" + "" ledger7 = cacheLedger [] rawledger7 @@ -1139,6 +1140,7 @@ a1 = Mixed [(hours 1){price=Just $ Mixed [Amount (comm "$") 10 Nothing]}] a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}] a3 = Mixed $ (amounts a1) ++ (amounts a2) +rawLedgerWithAmounts :: [String] -> RawLedger rawLedgerWithAmounts as = RawLedger [] @@ -1147,5 +1149,6 @@ rawLedgerWithAmounts as = [] [] "" + "" where parse = fromparse . parseWithCtx postingamount . (" "++) diff --git a/Utils.hs b/Utils.hs index 4dae61def..2e19e5e33 100644 --- a/Utils.hs +++ b/Utils.hs @@ -22,8 +22,9 @@ withLedgerDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> I withLedgerDo opts args cmd = do f <- ledgerFilePathFromOpts opts -- kludgily read the file a second time to get the full text. Only the ui command needs it. - -- kludgily try not to fail if it's stdin. XXX - rawtext <- readFile $ if f == "-" then "/dev/null" else f + -- kludgily try not to fail if it's stdin. + -- read it strictly to let the add command work + rawtext <- strictReadFile $ if f == "-" then "/dev/null" else f t <- getCurrentLocalTime let runcmd = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext . (\rl -> rl{filepath=f}) return f >>= runErrorT . parseLedgerFile t >>= either (hPutStrLn stderr) runcmd diff --git a/hledger.hs b/hledger.hs index a6f37add5..d8a0a4fae 100644 --- a/hledger.hs +++ b/hledger.hs @@ -41,6 +41,7 @@ module Main ( module PrintCommand, module RegisterCommand, module HistogramCommand, + module AddCommand, #ifdef VTY module UICommand, #endif @@ -62,6 +63,7 @@ import BalanceCommand import PrintCommand import RegisterCommand import HistogramCommand +import AddCommand #ifdef VTY import UICommand #endif @@ -82,6 +84,7 @@ main = do | cmd `isPrefixOf` "print" = withLedgerDo opts args print' | cmd `isPrefixOf` "register" = withLedgerDo opts args register | cmd `isPrefixOf` "histogram" = withLedgerDo opts args histogram + | cmd `isPrefixOf` "add" = withLedgerDo opts args add #ifdef VTY | cmd `isPrefixOf` "ui" = withLedgerDo opts args ui #endif