add: hack apart getPostingsLoop into smaller pieces

hledger/Hledger/Cli/Add.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, RecordWildCards #-}
 {-| 
 
 A history-aware add command to help with data entry.
@@ -124,8 +124,7 @@ data EntryState = EntryState {
    esJournal                 :: Journal              -- ^ the journal we are adding to
   ,esDefaultsRemaining       :: [String]             -- ^ command line arguments not yet used as defaults
   ,esValidateAccount         :: AccountName -> Bool  -- ^ validator for entered account names
-  ,esSuggestHistoricalAmount :: Bool                 -- ^ should the amount from a similar past txn be suggested
+  ,esHistoricalPostings      :: Maybe [Posting]      -- ^ postings of the most similar past txn, if applicable
-  ,esHistoricalPostings      :: Maybe [Posting]      -- ^ the postings of the most similar past txn
   ,esEnteredPostings         :: [Posting]            -- ^ postings entered so far
   }
 
@@ -133,7 +132,6 @@ defEntryState = EntryState {
    esJournal = nulljournal
   ,esDefaultsRemaining = []
   ,esValidateAccount = const True
-  ,esSuggestHistoricalAmount = True
   ,esHistoricalPostings = Nothing
   ,esEnteredPostings = []
 }
@@ -178,38 +176,48 @@ getPostingsForTransactionWithHistory j opts datestr code description comment def
 -- useful defaults based on historical context and postings entered so far.
 getPostingsLoop :: EntryState -> IO [Posting]
 getPostingsLoop st = do
-  let bestmatch | isNothing historicalps = Nothing
+  (st1,account) <- getAccount st
-                | n <= length ps = Just $ ps !! (n-1)
-                | otherwise = Nothing
-                where Just ps = historicalps
-      bestmatchacct = maybe Nothing (Just . showacctname) bestmatch
-      defs = esDefaultsRemaining st
-      (defacct, defs') = (maybe bestmatchacct Just $ headMay defs, tailDef [] defs)
-      ordot | null enteredps || length enteredrealps == 1 = "" :: String
-            | otherwise = " (or . to complete this transaction)"
-  account <- runInteractionWithAccountCompletion j $ askFor (printf "account %d%s" n ordot) defacct (Just validateaccount)
-  when (account=="<") $ throwIO RestartEntryException
   if account=="."
-    then
+    then case esEnteredPostings st of
-     if null enteredps
+           [] -> hPutStrLn stderr "\nPlease enter some postings first." >> getPostingsLoop st
-      then do hPutStrLn stderr $ "\nPlease enter some postings first."
+           ps -> return ps
-              getPostingsLoop st
-      else return enteredps
     else do
-      let defacctaccepted = Just account == defacct
+      (st2,amt,comment) <- getAmountAndComment st1
-          historicalps' = if defacctaccepted then historicalps else Nothing
+      let p = nullposting{paccount=stripbrackets account
-          bestmatch' | isNothing historicalps' = Nothing
+                         ,pamount=mixed amt
-                     | n <= length ps = Just $ ps !! (n-1)
+                         ,pcomment=comment
-                     | otherwise = Nothing
+                         ,ptype=accountNamePostingType account
-                     where Just ps = historicalps'
+                         }
-          (amtfromdefs, defs'') = (headMay defs', tailDef [] defs')
+      getPostingsLoop st2{esEnteredPostings=esEnteredPostings st2 ++ [p]}
-          defamountstr | isJust amtfromdefs                     = amtfromdefs
+
-                       | isJust bestmatch' && suggesthistorical = Just historicalamountstr
+getAccount :: EntryState -> IO (EntryState,AccountName)
-                       | n > 1                                  = Just balancingamountstr
+getAccount st@EntryState{..} = do
-                       | otherwise                              = Nothing
+  let pnum = length esEnteredPostings + 1
+      mhistoricalacct = maybe Nothing (Just . showacctname) mhistoricalp
           where
-                historicalamountstr = showMixedAmountWithPrecision p $ pamount $ fromJust bestmatch'
+            mhistoricalp | isNothing esHistoricalPostings = Nothing
-                balancingamountstr  = showMixedAmountWithPrecision p $ negate $ sum $ map pamount enteredrealps
+                         | pnum <= length historicalps = Just $ historicalps !! (pnum-1)
+                         | otherwise = Nothing
+                         where Just historicalps = esHistoricalPostings
+            showacctname p = showAccountName Nothing (ptype p) $ paccount p
+      (mdefacct, st1) = case esDefaultsRemaining of
+                          d:ds -> (Just d, st{esDefaultsRemaining=ds})
+                          []   -> (mhistoricalacct, st)
+      endmsg | null esEnteredPostings || numenteredrealps == 1 = "" :: String
+             | otherwise                                       = " (or . to complete this transaction)"
+             where numenteredrealps = length $ filter isReal esEnteredPostings
+  account <- runInteractionWithAccountCompletion esJournal $
+             askFor (printf "account %d%s" pnum endmsg) mdefacct (Just esValidateAccount)
+  if (account=="<")
+  then throwIO RestartEntryException
+  else let defacctaccepted = Just account == mdefacct
+           st2 = if defacctaccepted then st1 else st1{esHistoricalPostings=Nothing}
+       in return (st2, account)
+
+getAmountAndComment :: EntryState -> IO (EntryState,Amount,String)
+getAmountAndComment st@EntryState{..} = do
+  let pnum = length esEnteredPostings + 1
+      showamt = showMixedAmountWithPrecision
                   -- what should this be ?
                   -- 1 maxprecision (show all decimal places or none) ?
                   -- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ?
@@ -217,46 +225,42 @@ getPostingsLoop st = do
                   -- 4 maximum precision entered so far in this transaction ?
                   -- 5 3 or 4, whichever would show the most decimal places ?
                   -- I think 1 or 4, whichever would show the most decimal places
-                p = maxprecisionwithpoint
+                  maxprecisionwithpoint
-      amt <- runInteraction $ askFor (printf "amount  %d" n) defamountstr validateamount
+      mhistoricalamt = maybe Nothing (Just . showamt . pamount) mhistoricalp
-      when (amt=="<") $ throwIO RestartEntryException
-      let (amountstr,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amt
-      let a  = fromparse $ runParser (amountp <|> return missingamt) ctx     "" amountstr
-          a' = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amountstr
-          defamtaccepted = Just (showAmount a) == defamountstr
-          defcommodityadded | acommodity a == acommodity a' = Nothing
-                            | otherwise                     = Just $ acommodity a
-          p = nullposting{paccount=stripbrackets account
-                         ,pamount=mixed a
-                         ,pcomment=comment
-                         ,ptype=postingtype account
-                         }
-          st' = st{esEnteredPostings=esEnteredPostings st ++ [p]
-                  ,esDefaultsRemaining=defs''
-                  }
-          st'' = if defamtaccepted
-                 then st'
-                 else st'{esHistoricalPostings=historicalps', esSuggestHistoricalAmount=False}
-      when (isJust defcommodityadded) $
-           liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust defcommodityadded)
-      getPostingsLoop st''
           where
-      j = esJournal st
+            mhistoricalp | isNothing esHistoricalPostings = Nothing
-      historicalps = esHistoricalPostings st
+                         | pnum <= length historicalps    = Just $ historicalps !! (pnum-1)
-      ctx = jContext j
+                         | otherwise                      = Nothing
-      validateaccount = esValidateAccount st
+                         where Just historicalps = esHistoricalPostings
-      suggesthistorical = esSuggestHistoricalAmount st
+      enteredrealps = filter isReal esEnteredPostings
-      enteredps = esEnteredPostings st
+      (mdefamt, st1) = case esDefaultsRemaining of
-      n = length enteredps + 1
+                         d:ds                      -> (Just d, st{esDefaultsRemaining=ds})
-      enteredrealps = filter isReal enteredps
+                         _ | isJust mhistoricalamt -> (mhistoricalamt, st)
-      showacctname p = showAccountName Nothing (ptype p) $ paccount p
+                         _ | pnum > 1              -> (Just balancingamt, st)
-      postingtype ('[':_) = BalancedVirtualPosting
+                         _                         -> (Nothing, st)
-      postingtype ('(':_) = VirtualPosting
+                         where
-      postingtype _ = RegularPosting
+                           balancingamt  = showamt $ negate $ sum $ map pamount enteredrealps
-      validateamount = Just $ \s -> (null s && not (null enteredrealps))
+      validateamount = Just $ \s ->
+                         (null s && not (null enteredrealps))
                          || s == "<"
-                                    || (isRight (runParser (amountp >> many spacenonewline >> optional (char ';' >> many anyChar) >> eof) ctx "" s)
+                         || (s /= "." && isRight (runParser amountandoptionalcommentp (jContext esJournal) "" s))
-                                        && s /= ".")
+                         where
+                           amountandoptionalcommentp = do
+                             amountp
+                             many spacenonewline
+                             optional (char ';' >> many anyChar)
+                             eof
+  amtcmt <- runInteraction $ askFor (printf "amount  %d" pnum) mdefamt validateamount
+  when (amtcmt=="<") $ throwIO RestartEntryException
+  let (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt
+      a           = fromparse $ runParser (amountp <|> return missingamt) (jContext esJournal) "" amt
+      awithoutctx = fromparse $ runParser (amountp <|> return missingamt) nullctx              "" amt
+      defamtaccepted = Just (showAmount a) == mdefamt
+      st2 = if defamtaccepted then st1 else st1{esHistoricalPostings=Nothing}
+      mdefaultcommodityapplied = if acommodity a == acommodity awithoutctx then Nothing else Just $ acommodity a
+  when (isJust mdefaultcommodityapplied) $
+       liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied)
+  return (st2, a, comment)
 
 -- | Prompt for and read a string value, optionally with a default value
 -- and a validator. A validator causes the prompt to repeat until the