diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 8cdeeed00..12525d7c4 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/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 = [] diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 1f51d4132..e300de15a 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 157b0e576..c24a89105 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/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"