parsing: support D default commodity directive

MANUAL.markdown

@@ -797,6 +797,20 @@ You can pull in the content of additional journal files, by writing lines like t
 The `!include` directive may only be used in journal files, and currently
 it may only include other journal files (eg, not timelog files.)
 
+##### Default commodity
+
+You can set a default commodity with a `D` directive in the journal. This
+will be used for any subsequent amounts with no commodity symbol,
+including the commodity display settings (left or right symbol, spacing,
+thousands separator, and precision.)
+
+    ; default commodity: british pound, comma thousands separator, two decimal places
+    D £1,000.00
+    
+    2010/1/1
+      a  2340.11   ; <- no commodity symbol, so will use the above
+      b
+
 #### Default parent account
 
 You can specify a default parent account within a section of the journal with

hledger-lib/Hledger/Data/Types.hs

@@ -49,7 +49,7 @@ data Interval = NoInterval | Daily | Weekly | Monthly | Quarterly | Yearly
 
 type AccountName = String
 
-data Side = L | R deriving (Eq,Show,Ord) 
+data Side = L | R deriving (Eq,Show,Read,Ord)
 
 data Commodity = Commodity {
       symbol :: String,  -- ^ the commodity's symbol
@@ -58,7 +58,7 @@ data Commodity = Commodity {
       spaced :: Bool,    -- ^ should there be a space between symbol and quantity
       comma :: Bool,     -- ^ should thousands be comma-separated
       precision :: Int   -- ^ number of decimal places to display
-    } deriving (Eq,Show,Ord)
+    } deriving (Eq,Show,Read,Ord)
 
 data Amount = Amount {
       commodity :: Commodity,

hledger-lib/Hledger/Read/Common.hs

@@ -10,7 +10,7 @@ where
 
 import Control.Monad.Error
 import Hledger.Data.Utils
-import Hledger.Data.Types (Journal)
+import Hledger.Data.Types (Journal, Commodity)
 import Hledger.Data.Journal
 import System.Directory (getHomeDirectory)
 import System.FilePath(takeDirectory,combine)
@@ -44,12 +44,12 @@ parseJournalWith p f s = do
 -- | Some state kept while parsing a journal file.
 data JournalContext = Ctx {
       ctxYear      :: !(Maybe Integer)   -- ^ the default year most recently specified with Y
-    , ctxCommod   :: !(Maybe String)   -- ^ I don't know
+    , ctxCommodity :: !(Maybe Commodity) -- ^ the default commodity recently specified with D
     , ctxAccount   :: ![String]          -- ^ the current stack of parent accounts specified by !account
     } deriving (Read, Show)
 
 emptyCtx :: JournalContext
-emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }
+emptyCtx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [] }
 
 setYear :: Integer -> GenParser tok JournalContext ()
 setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
@@ -57,6 +57,12 @@ setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
 getYear :: GenParser tok JournalContext (Maybe Integer)
 getYear = liftM ctxYear getState
 
+setCommodity :: Commodity -> GenParser tok JournalContext ()
+setCommodity c = updateState (\ctx -> ctx{ctxCommodity=Just c})
+
+getCommodity :: GenParser tok JournalContext (Maybe Commodity)
+getCommodity = liftM ctxCommodity getState
+
 pushParentAccount :: String -> GenParser tok JournalContext ()
 pushParentAccount parent = updateState addParentAccount
     where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }

hledger-lib/Hledger/Read/Journal.hs

@@ -169,6 +169,7 @@ journalFile = do journalupdates <- many journalItem
                           , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction
                           , liftM (return . addHistoricalPrice) ledgerHistoricalPrice
                           , ledgerDefaultYear
+                          , ledgerDefaultCommodity
                           , ledgerIgnoredPriceCommodity
                           , ledgerTagDirective
                           , ledgerEndTagDirective
@@ -178,20 +179,20 @@ journalFile = do journalupdates <- many journalItem
 journalAddFilePath :: FilePath -> Journal -> Journal
 journalAddFilePath f j@Journal{allfilepaths=fs} = j{allfilepaths=fs++[f]}
 
-emptyLine :: GenParser Char st ()
+emptyLine :: GenParser Char JournalContext ()
 emptyLine = do many spacenonewline
                optional $ (char ';' <?> "comment") >> many (noneOf "\n")
                newline
                return ()
 
-ledgercomment :: GenParser Char st String
+ledgercomment :: GenParser Char JournalContext String
 ledgercomment = do
   many1 $ char ';'
   many spacenonewline
   many (noneOf "\n")
   <?> "comment"
 
-ledgercommentline :: GenParser Char st String
+ledgercommentline :: GenParser Char JournalContext String
 ledgercommentline = do
   many spacenonewline
   s <- ledgercomment
@@ -272,14 +273,6 @@ ledgerIgnoredPriceCommodity = do
   restofline
   return $ return id
 
-ledgerDefaultCommodity :: GenParser Char JournalContext JournalUpdate
-ledgerDefaultCommodity = do
-  char 'D' <?> "default commodity"
-  many1 spacenonewline
-  someamount
-  restofline
-  return $ return id
-
 ledgerCommodityConversion :: GenParser Char JournalContext JournalUpdate
 ledgerCommodityConversion = do
   char 'C' <?> "commodity conversion"
@@ -317,6 +310,17 @@ ledgerDefaultYear = do
   setYear y'
   return $ return id
 
+ledgerDefaultCommodity :: GenParser Char JournalContext JournalUpdate
+ledgerDefaultCommodity = do
+  char 'D' <?> "default commodity"
+  many1 spacenonewline
+  a <- someamount
+  -- someamount always returns a MixedAmount containing one Amount, but let's be safe
+  let as = amounts a
+  when (not $ null as) $ setCommodity $ commodity $ head as
+  restofline
+  return $ return id
+
 -- | Try to parse a ledger entry. If we successfully parse an entry,
 -- check it can be balanced, and fail if not.
 ledgerTransaction :: GenParser Char JournalContext Transaction
@@ -384,10 +388,10 @@ ledgereffectivedate actualdate = do
   edate <- withDefaultYear actualdate ledgerdate
   return edate
 
-ledgerstatus :: GenParser Char st Bool
+ledgerstatus :: GenParser Char JournalContext Bool
 ledgerstatus = try (do { many1 spacenonewline; char '*' <?> "status"; return True } ) <|> return False
 
-ledgercode :: GenParser Char st String
+ledgercode :: GenParser Char JournalContext String
 ledgercode = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""
 
 ledgerpostings :: GenParser Char JournalContext [Posting]
@@ -404,7 +408,7 @@ ledgerpostings = do
   return $ map (fromparse . parseWithCtx ctx (setPosition pos >> ledgerposting)) ls'
   <?> "postings"
 
-linebeginningwithspaces :: GenParser Char st String
+linebeginningwithspaces :: GenParser Char JournalContext String
 linebeginningwithspaces = do
   sp <- many1 spacenonewline
   c <- nonspace
@@ -448,17 +452,17 @@ ledgeraccountname = do
 
 -- | Parse an amount, with an optional left or right currency symbol and
 -- optional price.
-postingamount :: GenParser Char st MixedAmount
+postingamount :: GenParser Char JournalContext MixedAmount
 postingamount =
   try (do
         many1 spacenonewline
         someamount <|> return missingamt
       ) <|> return missingamt
 
-someamount :: GenParser Char st MixedAmount
+someamount :: GenParser Char JournalContext MixedAmount
 someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount 
 
-leftsymbolamount :: GenParser Char st MixedAmount
+leftsymbolamount :: GenParser Char JournalContext MixedAmount
 leftsymbolamount = do
   sign <- optionMaybe $ string "-"
   let applysign = if isJust sign then negate else id
@@ -470,7 +474,7 @@ leftsymbolamount = do
   return $ applysign $ Mixed [Amount c q pri]
   <?> "left-symbol amount"
 
-rightsymbolamount :: GenParser Char st MixedAmount
+rightsymbolamount :: GenParser Char JournalContext MixedAmount
 rightsymbolamount = do
   (q,p,comma) <- amountquantity
   sp <- many spacenonewline
@@ -480,28 +484,29 @@ rightsymbolamount = do
   return $ Mixed [Amount c q pri]
   <?> "right-symbol amount"
 
-nosymbolamount :: GenParser Char st MixedAmount
+nosymbolamount :: GenParser Char JournalContext MixedAmount
 nosymbolamount = do
   (q,p,comma) <- amountquantity
   pri <- priceamount
-  let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p}
+  defc <- getCommodity
+  let c = fromMaybe Commodity{symbol="",side=L,spaced=False,comma=comma,precision=p} defc
   return $ Mixed [Amount c q pri]
   <?> "no-symbol amount"
 
-commoditysymbol :: GenParser Char st String
+commoditysymbol :: GenParser Char JournalContext String
 commoditysymbol = (quotedcommoditysymbol <|> simplecommoditysymbol) <?> "commodity symbol"
 
-quotedcommoditysymbol :: GenParser Char st String
+quotedcommoditysymbol :: GenParser Char JournalContext String
 quotedcommoditysymbol = do
   char '"'
   s <- many1 $ noneOf ";\n\""
   char '"'
   return s
 
-simplecommoditysymbol :: GenParser Char st String
+simplecommoditysymbol :: GenParser Char JournalContext String
 simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)
 
-priceamount :: GenParser Char st (Maybe MixedAmount)
+priceamount :: GenParser Char JournalContext (Maybe MixedAmount)
 priceamount =
     try (do
           many spacenonewline
@@ -516,7 +521,7 @@ priceamount =
 -- | Parse a ledger-style numeric quantity and also return the number of
 -- digits to the right of the decimal point and whether thousands are
 -- separated by comma.
-amountquantity :: GenParser Char st (Double, Int, Bool)
+amountquantity :: GenParser Char JournalContext (Double, Int, Bool)
 amountquantity = do
   sign <- optionMaybe $ string "-"
   (intwithcommas,frac) <- numberparts
@@ -534,10 +539,10 @@ amountquantity = do
 -- | parse the two strings of digits before and after a possible decimal
 -- point.  The integer part may contain commas, or either part may be
 -- empty, or there may be no point.
-numberparts :: GenParser Char st (String,String)
+numberparts :: GenParser Char JournalContext (String,String)
 numberparts = numberpartsstartingwithdigit <|> numberpartsstartingwithpoint
 
-numberpartsstartingwithdigit :: GenParser Char st (String,String)
+numberpartsstartingwithdigit :: GenParser Char JournalContext (String,String)
 numberpartsstartingwithdigit = do
   let digitorcomma = digit <|> char ','
   first <- digit
@@ -545,7 +550,7 @@ numberpartsstartingwithdigit = do
   frac <- try (do {char '.'; many digit}) <|> return ""
   return (first:rest,frac)
                      
-numberpartsstartingwithpoint :: GenParser Char st (String,String)
+numberpartsstartingwithpoint :: GenParser Char JournalContext (String,String)
 numberpartsstartingwithpoint = do
   char '.'
   frac <- many1 digit
@@ -618,7 +623,7 @@ tests_Journal = TestList [
      let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity
          assertMixedAmountParse parseresult mixedamount =
              (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)
-     assertMixedAmountParse (parsewith someamount "1 @ $2")
+     assertMixedAmountParse (parseWithCtx emptyCtx someamount "1 @ $2")
                             (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])])
 
   ,"postingamount" ~: do

hledger/Hledger/Cli/Commands/Add.hs

@@ -9,6 +9,7 @@ module Hledger.Cli.Commands.Add
 where
 import Hledger.Data
 import Hledger.Read.Journal (someamount)
+import Hledger.Read.Common (emptyCtx)
 import Hledger.Cli.Options
 import Hledger.Cli.Commands.Register (registerReport, registerReportAsText)
 #if __GLASGOW_HASKELL__ <= 610
@@ -92,7 +93,7 @@ getPostings accept historicalps enteredps = do
     then return enteredps
     else do
       amountstr <- askFor (printf "amount  %d" n) defaultamount validateamount
-      let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr
+      let amount = fromparse $ runParser (someamount <|> return missingamt) emptyCtx "" amountstr
       let p = nullposting{paccount=stripbrackets account,
                           pamount=amount,
                           ptype=postingtype account}
@@ -113,7 +114,7 @@ getPostings accept historicalps enteredps = do
       postingtype _ = RegularPosting
       stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse
       validateamount = Just $ \s -> (null s && not (null enteredrealps))
-                                   || isRight (parse (someamount>>many spacenonewline>>eof) "" s)
+                                   || isRight (runParser (someamount>>many spacenonewline>>eof) emptyCtx "" s)
 
 -- | Prompt for and read a string value, optionally with a default value
 -- and a validator. A validator causes the prompt to repeat until the

tests/default-commodity.test

@@ -0,0 +1,38 @@
+# a default commodity defined with the D directive will be used for any
+# commodity-less amounts in subsequent transactions.
+#
+bin/hledger -f- print
+<<<
+
+; no default commodity
+2010/1/1 x
+  a  1000
+  b
+
+; pound, two decimal places, no thousands separator
+D £1000.00
+
+2010/1/1 y
+  a  1000
+  b
+
+; dollar, no decimal places, comma thousands separator
+D $1,000
+
+2010/1/1 z
+  a  1000
+  b
+
+>>>
+2010/01/01 x
+    a          1000
+    b         -1000
+
+2010/01/01 y
+    a      £1000.00
+    b     £-1000.00
+
+2010/01/01 z
+    a        $1,000
+    b       $-1,000
+