add command, reads transactions interactively and adds them to the ledger

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
+

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

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 . (" "++)
 

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
+  -- kludgily try not to fail if it's stdin.
-  rawtext <- readFile $ if f == "-" then "/dev/null" else f
+  -- 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

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