journal: parse and store commodity formats

hledger-lib/Hledger/Data/Journal.hs

@@ -127,6 +127,7 @@ nulljournal :: Journal
 nulljournal = Journal { jmodifiertxns = []
                       , jperiodictxns = []
                       , jtxns = []
+                      , jcommodities = M.fromList []
                       , open_timeclock_entries = []
                       , jmarketprices = []
                       , final_comment_lines = []

hledger-lib/Hledger/Data/Types.hs

@@ -114,7 +114,9 @@ type CommoditySymbol = String
 data Commodity = Commodity {
   csymbol :: CommoditySymbol,
   cformat :: Maybe AmountStyle
-  } -- deriving (Eq,Ord,Typeable,Data,Generic)
+  } deriving (Show,Eq,Data,Generic) --,Ord,Typeable,Data,Generic)
+
+instance NFData Commodity
 
 data Amount = Amount {
       acommodity :: CommoditySymbol,
@@ -257,6 +259,8 @@ data Journal = Journal {
       jmodifiertxns :: [ModifierTransaction],
       jperiodictxns :: [PeriodicTransaction],
       jtxns :: [Transaction],
+      jcommoditystyles :: M.Map CommoditySymbol AmountStyle,  -- ^ commodities and formats inferred from journal amounts
+      jcommodities :: M.Map CommoditySymbol Commodity,        -- ^ commodities and formats defined by commodity directives
       open_timeclock_entries :: [TimeclockEntry],
       jmarketprices :: [MarketPrice],
       final_comment_lines :: String,        -- ^ any trailing comments from the journal file
@@ -265,8 +269,7 @@ data Journal = Journal {
                                             -- any included journal files. The main file is
                                             -- first followed by any included files in the
                                             -- order encountered.
-      filereadtime :: ClockTime,            -- ^ when this journal was last read from its file(s)
-      jcommoditystyles :: M.Map CommoditySymbol AmountStyle  -- ^ how to display amounts in each commodity
+      filereadtime :: ClockTime             -- ^ when this journal was last read from its file(s)
     } deriving (Eq, Typeable, Data, Generic)
 
 instance NFData Journal

hledger-lib/Hledger/Read/JournalReader.hs

@@ -25,7 +25,7 @@ reader should handle many ledger files as well. Example:
 
 -- {-# OPTIONS_GHC -F -pgmF htfpp #-}
 
-{-# LANGUAGE CPP, RecordWildCards, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections #-}
+{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections #-}
 
 module Hledger.Read.JournalReader (
 
@@ -83,6 +83,7 @@ import Data.Char (isNumber)
 import Data.Functor.Identity
 import Data.List.Compat
 import Data.List.Split (wordsBy)
+import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.Time.Calendar
 import Data.Time.LocalTime
@@ -307,6 +308,7 @@ directivep = do
    ,endaliasesdirectivep
    ,accountdirectivep
    ,applyaccountdirectivep
+   ,commoditydirectivep
    ,endapplyaccountdirectivep
    ,tagdirectivep
    ,endtagdirectivep
@@ -350,17 +352,58 @@ journalAddFile :: (FilePath,String) -> Journal -> Journal
 journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}
  -- NOTE: first encountered file to left, to avoid a reverse
 
+indentedlinep = many1 spacenonewline >> (rstrip <$> restofline)
+
 accountdirectivep :: ErroringJournalParser JournalUpdate
 accountdirectivep = do
   string "account"
   many1 spacenonewline
   acct <- accountnamep
   newline
-  let indentedline = many1 spacenonewline >> restofline
-  many indentedline
+  _ <- many indentedlinep
   pushAccount acct
   return $ ExceptT $ return $ Right id
 
+-- | Terminate parsing entirely, returning the given error message
+-- with the current parse position prepended.
+parserError :: String -> ErroringJournalParser a
+parserError s = do
+  pos <- getPosition
+  parserErrorAt pos s
+
+-- | Terminate parsing entirely, returning the given error message
+-- with the given parse position prepended.
+parserErrorAt :: SourcePos -> String -> ErroringJournalParser a
+parserErrorAt pos s = do
+  throwError $ show pos ++ ":\n" ++ s
+
+-- | Parse a commodity directive, containing 0 or more format subdirectives.
+commoditydirectivep :: ErroringJournalParser JournalUpdate
+commoditydirectivep = do
+  string "commodity"
+  many1 spacenonewline
+  sym <- commoditysymbolp
+  _ <- followingcommentp
+  mformat <- lastMay <$> many (indented $ formatdirectivep sym)
+  let comm = Commodity{csymbol=sym, cformat=mformat}
+  return $ ExceptT $ return $ Right $ \j -> j{jcommodities=M.insert sym comm $ jcommodities j}
+
+indented = (many1 spacenonewline >>)
+
+-- | Parse a format (sub)directive, throwing a parse error if its
+-- symbol does not match the one given.
+formatdirectivep :: CommoditySymbol -> ErroringJournalParser AmountStyle
+formatdirectivep expectedsym = do
+  string "format"
+  many1 spacenonewline
+  pos <- getPosition
+  Amount{acommodity,astyle} <- amountp
+  _ <- followingcommentp
+  if acommodity==expectedsym
+    then return astyle
+    else parserErrorAt pos $
+         printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity
+
 applyaccountdirectivep :: ErroringJournalParser JournalUpdate
 applyaccountdirectivep = do
   string "apply" >> many1 spacenonewline >> string "account"
@@ -370,6 +413,11 @@ applyaccountdirectivep = do
   pushParentAccount parent
   return $ ExceptT $ return $ Right id
 
+data Commodity2 = Commodity2 {
+  csymbol :: String,
+  cformat :: Maybe AmountStyle
+  } -- deriving (Eq,Ord,Typeable,Data,Generic)
+
 endapplyaccountdirectivep :: ErroringJournalParser JournalUpdate
 endapplyaccountdirectivep = do
   string "end" >> many1 spacenonewline >> string "apply" >> many1 spacenonewline >> string "account"