hledger-lib 0.12.1 → 0.13

raw patch · 16 files changed

+1036/−901 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Hledger/Data/Amount.hs +52/−6
• Hledger/Data/Dates.hs +1/−1
• Hledger/Data/Journal.hs +38/−12
• Hledger/Data/Posting.hs +1/−1
• Hledger/Data/TimeLog.hs +2/−1
• Hledger/Data/Transaction.hs +33/−25
• Hledger/Data/Types.hs +39/−9
• Hledger/Data/Utils.hs +0/−4
• Hledger/Read.hs +9/−9
• Hledger/Read/Common.hs +0/−80
• Hledger/Read/Journal.hs +0/−647
• Hledger/Read/JournalReader.hs +681/−0
• Hledger/Read/Timelog.hs +0/−100
• Hledger/Read/TimelogReader.hs +101/−0
• Hledger/Read/Utils.hs +73/−0
• hledger-lib.cabal +6/−6

@@ -40,6 +40,9 @@  module Hledger.Data.Amount where+import qualified Data.Map as Map+import Data.Map (findWithDefault)+ import Hledger.Data.Utils import Hledger.Data.Types import Hledger.Data.Commodity@@ -110,11 +113,18 @@       R -> printf "%s%s%s%s" quantity space sym' price     where       sym' = quoteCommoditySymbolIfNeeded sym-      space = if spaced then " " else ""+      space = if (spaced && not (null sym')) then " " else ""       quantity = showAmount' a       price = case pri of (Just pamt) -> " @ " ++ showMixedAmount pamt                           Nothing -> "" +-- | Get the string representation of an amount, based on its commodity's+-- display settings except using the specified precision.+showAmountWithPrecision :: Int -> Amount -> String+showAmountWithPrecision p = showAmount . setAmountPrecision p++setAmountPrecision p a@Amount{commodity=c} = a{commodity=c{precision=p}}+ -- XXX refactor -- | Get the unambiguous string representation of an amount, for debugging. showAmountDebug :: Amount -> String@@ -125,13 +135,23 @@ showAmountWithoutPrice :: Amount -> String showAmountWithoutPrice a = showAmount a{price=Nothing} --- | Get the string representation (of the number part of) of an amount+-- | Get the string representation of an amount, without any price or commodity symbol.+showAmountWithoutPriceOrCommodity :: Amount -> String+showAmountWithoutPriceOrCommodity a@Amount{commodity=c} = showAmount a{commodity=c{symbol=""}, price=Nothing}++-- | Get the string representation of the number part of of an amount,+-- using the display precision from its commodity. showAmount' :: Amount -> String-showAmount' (Amount (Commodity {comma=comma,precision=p}) q _) = quantity+showAmount' (Amount (Commodity {comma=comma,precision=p}) q _) = addthousandsseparators $ qstr   where-    quantity = commad $ printf ("%."++show p++"f") q-    commad = if comma then punctuatethousands else id+    addthousandsseparators = if comma then punctuatethousands else id+    qstr | p == maxprecision && isint q = printf "%d" (round q::Integer)+         | p == maxprecision            = printf "%f" q+         | otherwise                    = printf ("%."++show p++"f") q+    isint n = fromIntegral (round n) == n +maxprecision = 999999+ -- | Add thousands-separating commas to a decimal number string punctuatethousands :: String -> String punctuatethousands s =@@ -145,7 +165,7 @@  -- | Does this amount appear to be zero when displayed with its given precision ? isZeroAmount :: Amount -> Bool-isZeroAmount = null . filter (`elem` "123456789") . showAmountWithoutPrice+isZeroAmount = null . filter (`elem` "123456789") . showAmountWithoutPriceOrCommodity  -- | Is this amount "really" zero, regardless of the display precision ? -- Since we are using floating point, for now just test to some high precision.@@ -197,6 +217,17 @@ showMixedAmount :: MixedAmount -> String showMixedAmount m = vConcatRightAligned $ map show $ amounts $ normaliseMixedAmount m +setMixedAmountPrecision :: Int -> MixedAmount -> MixedAmount+setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as++-- | Get the string representation of a mixed amount, showing each of its+-- component amounts with the specified precision, ignoring their+-- commoditys' display precision settings. NB a mixed amount can have an+-- empty amounts list in which case it shows as \"\".+showMixedAmountWithPrecision :: Int -> MixedAmount -> String+showMixedAmountWithPrecision p m =+    vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmount m+ -- | Get an unambiguous string representation of a mixed amount for debugging. showMixedAmountDebug :: MixedAmount -> String showMixedAmountDebug m = printf "Mixed [%s]" as@@ -240,6 +271,21 @@       as' | null nonzeros = [head $ zeros ++ [nullamt]]           | otherwise = nonzeros       (zeros,nonzeros) = partition isReallyZeroAmount as++-- | Set a mixed amount's commodity to the canonicalised commodity from+-- the provided commodity map.+canonicaliseMixedAmount :: Maybe (Map.Map String Commodity) -> MixedAmount -> MixedAmount+canonicaliseMixedAmount canonicalcommoditymap (Mixed as) = Mixed $ map (canonicaliseAmount canonicalcommoditymap) as++-- | Set an amount's commodity to the canonicalised commodity from+-- the provided commodity map.+canonicaliseAmount :: Maybe (Map.Map String Commodity) -> Amount -> Amount+canonicaliseAmount Nothing                      = id+canonicaliseAmount (Just canonicalcommoditymap) = fixamount+    where+      -- like journalCanonicaliseAmounts+      fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c}+      fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap  -- various sum variants.. 

@@ -258,7 +258,7 @@ > 21 > october, oct > yesterday, today, tomorrow-> (not yet) this/next/last week/day/month/quarter/year+> this/next/last week/day/month/quarter/year  Returns a SmartDate, to be converted to a full date later (see fixSmartDate). Assumes any text in the parse stream has been lowercased.

@@ -10,6 +10,7 @@ where import qualified Data.Map as Map import Data.Map (findWithDefault, (!))+import Safe (headDef) import System.Time (ClockTime(TOD)) import Hledger.Data.Utils import Hledger.Data.Types@@ -17,14 +18,14 @@ import Hledger.Data.Amount import Hledger.Data.Commodity (canonicaliseCommodities) import Hledger.Data.Dates (nulldatespan)-import Hledger.Data.Transaction (journalTransactionWithDate)+import Hledger.Data.Transaction (journalTransactionWithDate,balanceTransaction) import Hledger.Data.Posting import Hledger.Data.TimeLog   instance Show Journal where     show j = printf "Journal %s with %d transactions, %d accounts: %s"-             (filepath j)+             (journalFilePath j)              (length (jtxns j) +               length (jmodifiertxns j) +               length (jperiodictxns j))@@ -40,11 +41,14 @@                       , open_timelog_entries = []                       , historical_prices = []                       , final_comment_lines = []-                      , filepath = ""+                      , jContext = nullctx+                      , files = []                       , filereadtime = TOD 0 0-                      , jtext = ""                       } +nullctx :: JournalContext+nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [] }+ nullfilterspec = FilterSpec {      datespan=nulldatespan     ,cleared=Nothing@@ -57,6 +61,15 @@     ,depth=Nothing     } +journalFilePath :: Journal -> FilePath+journalFilePath = fst . mainfile++journalFilePaths :: Journal -> [FilePath]+journalFilePaths = map fst . files++mainfile :: Journal -> (FilePath, String)+mainfile = headDef ("", "") . files+ addTransaction :: Transaction -> Journal -> Journal addTransaction t l0 = l0 { jtxns = t : jtxns l0 } @@ -212,12 +225,24 @@     j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j}  -- | Do post-parse processing on a journal, to make it ready for use.-journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> Journal -> Journal-journalFinalise tclock tlocal path txt j = journalCanonicaliseAmounts $-                                           journalApplyHistoricalPrices $-                                           journalCloseTimeLogEntries tlocal-                                             j{filepath=path, filereadtime=tclock, jtext=txt}+journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Either String Journal+journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} =+    journalBalanceTransactions $+    journalCanonicaliseAmounts $+    journalApplyHistoricalPrices $+    journalCloseTimeLogEntries tlocal+    j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx} +-- | Fill in any missing amounts and check that all journal transactions+-- balance, or return an error message. This is done after parsing all+-- amounts and working out the canonical commodities, since balancing+-- depends on display precision. Reports only the first error encountered.+journalBalanceTransactions :: Journal -> Either String Journal+journalBalanceTransactions j@Journal{jtxns=ts} =+  case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'}+                                    Left e    -> Left e+      where balance = balanceTransaction (Just $ journalCanonicalCommodities j)+ -- | Convert all the journal's amounts to their canonical display -- settings.  Ie, all amounts in a given commodity will use (a) the -- display settings of the first, and (b) the greatest precision, of the@@ -229,7 +254,7 @@       fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}       fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}       fixmixedamount (Mixed as) = Mixed $ map fixamount as-      fixamount a@Amount{commodity=c,price=p} = a{commodity=fixcommodity c, price=maybe Nothing (Just . fixmixedamount) p}+      fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c}       fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap       canonicalcommoditymap = journalCanonicalCommodities j @@ -262,14 +287,15 @@ journalConvertAmountsToCost :: Journal -> Journal journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}     where+      -- similar to journalCanonicaliseAmounts       fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}       fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}       fixmixedamount (Mixed as) = Mixed $ map fixamount as-      fixamount = costOfAmount+      fixamount = canonicaliseAmount (Just $ journalCanonicalCommodities j) . costOfAmount  -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. journalCanonicalCommodities :: Journal -> Map.Map String Commodity-journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountAndPriceCommodities j+journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j  -- | Get all this journal's amounts' commodities, in the order parsed. journalAmountCommodities :: Journal -> [Commodity]

@@ -19,7 +19,7 @@  instance Show Posting where show = showPosting -nullposting = Posting False "" nullmixedamt "" RegularPosting Nothing+nullposting = Posting False "" nullmixedamt "" RegularPosting [] Nothing  showPosting :: Posting -> String showPosting (Posting{paccount=a,pamount=amt,pcomment=com,ptype=t}) =

@@ -74,6 +74,7 @@             tcode         = "",             tdescription  = showtime itod ++ "-" ++ showtime otod,             tcomment      = "",+            tmetadata     = [],             tpostings = ps,             tpreceding_comment_lines=""           }@@ -87,7 +88,7 @@       hrs      = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc       amount   = Mixed [hours hrs]       ps       = [Posting{pstatus=False,paccount=acctname,pamount=amount,-                          pcomment="",ptype=VirtualPosting,ptransaction=Just t}]+                          pcomment="",ptype=VirtualPosting,pmetadata=[],ptransaction=Just t}]  tests_TimeLog = TestList [ 

@@ -8,6 +8,8 @@  module Hledger.Data.Transaction where+import qualified Data.Map as Map+ import Hledger.Data.Utils import Hledger.Data.Types import Hledger.Data.Dates@@ -31,6 +33,7 @@                     tcode="",                      tdescription="",                      tcomment="",+                    tmetadata=[],                     tpostings=[],                     tpreceding_comment_lines=""                   }@@ -74,7 +77,7 @@       showdate = printf "%-10s" . showDate       showedate = printf "=%s" . showdate       showpostings ps-          | elide && length ps > 1 && isTransactionBalanced t+          | elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check               = map showposting (init ps) ++ [showpostingnoamt (last ps)]           | otherwise = map showposting ps           where@@ -121,20 +124,25 @@ -- | Is this transaction balanced ? A balanced transaction's real -- (non-virtual) postings sum to 0, and any balanced virtual postings -- also sum to 0.-isTransactionBalanced :: Transaction -> Bool-isTransactionBalanced t = isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum-    where (rsum, _, bvsum) = transactionPostingBalances t+isTransactionBalanced :: Maybe (Map.Map String Commodity) -> Transaction -> Bool+isTransactionBalanced canonicalcommoditymap t =+    -- isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum+    isZeroMixedAmount rsum' && isZeroMixedAmount bvsum'+    where+      (rsum, _, bvsum) = transactionPostingBalances t+      rsum'  = canonicaliseMixedAmount canonicalcommoditymap $ costOfMixedAmount rsum+      bvsum' = canonicaliseMixedAmount canonicalcommoditymap $ costOfMixedAmount bvsum  -- | Ensure that this entry is balanced, possibly auto-filling a missing -- amount first. We can auto-fill if there is just one non-virtual -- transaction without an amount. The auto-filled balance will be -- converted to cost basis if possible. If the entry can not be balanced, -- return an error message instead.-balanceTransaction :: Transaction -> Either String Transaction-balanceTransaction t@Transaction{tpostings=ps}+balanceTransaction :: Maybe (Map.Map String Commodity) -> Transaction -> Either String Transaction+balanceTransaction canonicalcommoditymap t@Transaction{tpostings=ps}     | length rwithoutamounts > 1 || length bvwithoutamounts > 1         = Left $ printerr "could not balance this transaction (too many missing amounts)"-    | not $ isTransactionBalanced t' = Left $ printerr $ nonzerobalanceerror t'+    | not $ isTransactionBalanced canonicalcommoditymap t' = Left $ printerr $ nonzerobalanceerror t'     | otherwise = Right t'     where       rps = filter isReal ps@@ -144,9 +152,9 @@       t' = t{tpostings=map balance ps}           where              balance p | not (hasAmount p) && isReal p-                          = p{pamount = costOfMixedAmount (-(sum $ map pamount rwithamounts))}+                          = p{pamount = (-(sum $ map pamount rwithamounts))}                       | not (hasAmount p) && isBalancedVirtual p-                          = p{pamount = costOfMixedAmount (-(sum $ map pamount bvwithamounts))}+                          = p{pamount = (-(sum $ map pamount bvwithamounts))}                       | otherwise = p       printerr s = intercalate "\n" [s, showTransactionUnelided t] @@ -183,9 +191,9 @@         ,"    assets:checking"         ,""         ])-       (let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""-                [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting (Just t)-                ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting (Just t)+       (let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+                [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] (Just t)+                ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting [] (Just t)                 ] ""         in showTransaction t) @@ -197,9 +205,9 @@         ,"    assets:checking               $-47.18"         ,""         ])-       (let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""-                [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting (Just t)-                ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting (Just t)+       (let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+                [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] (Just t)+                ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting [] (Just t)                 ] ""         in showTransactionUnelided t) @@ -213,9 +221,9 @@         ,""         ])        (showTransaction-        (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""-         [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing-         ,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting Nothing+        (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+         [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] Nothing+         ,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting [] Nothing          ] ""))    ,"showTransaction" ~: do@@ -226,8 +234,8 @@         ,""         ])        (showTransaction-        (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""-         [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing+        (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+         [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] Nothing          ] ""))    ,"showTransaction" ~: do@@ -238,8 +246,8 @@         ,""         ])        (showTransaction-        (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""-         [Posting False "expenses:food:groceries" missingamt "" RegularPosting Nothing+        (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+         [Posting False "expenses:food:groceries" missingamt "" RegularPosting [] Nothing          ] ""))    ,"showTransaction" ~: do@@ -251,9 +259,9 @@         ,""         ])        (showTransaction-        (txnTieKnot $ Transaction (parsedate "2010/01/01") Nothing False "" "x" ""-         [Posting False "a" (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) "" RegularPosting Nothing-         ,Posting False "b" missingamt "" RegularPosting Nothing+        (txnTieKnot $ Transaction (parsedate "2010/01/01") Nothing False "" "x" "" []+         [Posting False "a" (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) "" RegularPosting [] Nothing+         ,Posting False "b" missingamt "" RegularPosting [] Nothing          ] ""))    ]

@@ -32,12 +32,14 @@  module Hledger.Data.Types where-import Hledger.Data.Utils+import Control.Monad.Error (ErrorT)+import Data.Typeable (Typeable) import qualified Data.Map as Map import System.Time (ClockTime)-import Data.Typeable (Typeable) +import Hledger.Data.Utils + type SmartDate = (String,String,String)  data WhichDate = ActualDate | EffectiveDate deriving (Eq,Show)@@ -49,7 +51,7 @@  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 +60,7 @@       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,@@ -77,6 +79,7 @@       pamount :: MixedAmount,       pcomment :: String,       ptype :: PostingType,+      pmetadata :: [(String,String)],       ptransaction :: Maybe Transaction  -- ^ this posting's parent transaction (co-recursive types).                                         -- Tying this knot gets tedious, Maybe makes it easier/optional.     }@@ -84,7 +87,7 @@ -- The equality test for postings ignores the parent transaction's -- identity, to avoid infinite loops. instance Eq Posting where-    (==) (Posting a1 b1 c1 d1 e1 _) (Posting a2 b2 c2 d2 e2 _) =  a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2+    (==) (Posting a1 b1 c1 d1 e1 f1 _) (Posting a2 b2 c2 d2 e2 f2 _) =  a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2  data Transaction = Transaction {       tdate :: Day,@@ -93,6 +96,7 @@       tcode :: String,       tdescription :: String,       tcomment :: String,+      tmetadata :: [(String,String)],       tpostings :: [Posting],            -- ^ this transaction's postings (co-recursive types).       tpreceding_comment_lines :: String     } deriving (Eq)@@ -121,17 +125,43 @@       hamount :: MixedAmount     } deriving (Eq) -- & Show (in Amount.hs) +type Year = Integer++-- | A journal "context" is some data which can change in the course of+-- parsing a journal. An example is the default year, which changes when a+-- Y directive is encountered.  At the end of parsing, the final context+-- is saved for later use by eg the add command.+data JournalContext = Ctx {+      ctxYear      :: !(Maybe Year)      -- ^ the default year most recently specified with Y+    , ctxCommodity :: !(Maybe Commodity) -- ^ the default commodity most recently specified with D+    , ctxAccount   :: ![AccountName]     -- ^ the current stack of parent accounts specified by !account+    } deriving (Read, Show, Eq)+ data Journal = Journal {       jmodifiertxns :: [ModifierTransaction],       jperiodictxns :: [PeriodicTransaction],       jtxns :: [Transaction],       open_timelog_entries :: [TimeLogEntry],       historical_prices :: [HistoricalPrice],-      final_comment_lines :: String,-      filepath :: FilePath,-      filereadtime :: ClockTime,-      jtext :: String+      final_comment_lines :: String,        -- ^ any trailing comments from the journal file+      jContext :: JournalContext,           -- ^ the context (parse state) at the end of parsing+      files :: [(FilePath, String)],        -- ^ the file path and raw text of the main and+                                           -- 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)     } deriving (Eq, Typeable)++-- | A JournalUpdate is some transformation of a Journal. It can do I/O or+-- raise an error.+type JournalUpdate = ErrorT String IO (Journal -> Journal)++-- | A hledger journal reader is a triple of format name, format-detecting+-- predicate, and a parser to Journal.+data Reader = Reader {rFormat   :: String+                     ,rDetector :: FilePath -> String -> Bool+                     ,rParser   :: FilePath -> String -> ErrorT String IO Journal+                     }  data Ledger = Ledger {       journal :: Journal,

@@ -26,7 +26,6 @@ where import Data.Char import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded)-import Control.Exception import Control.Monad import Data.List --import qualified Data.Map as Map@@ -360,9 +359,6 @@  isRight :: Either a b -> Bool isRight = not . isLeft--strictReadFile :: FilePath -> IO String-strictReadFile f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s  -- -- | Expand ~ in a file path (does not handle ~name). -- tildeExpand :: FilePath -> IO FilePath

@@ -17,11 +17,11 @@ ) where import Hledger.Data.Dates (getCurrentDay)-import Hledger.Data.Types (Journal(..))+import Hledger.Data.Types (Journal(..), Reader(..))+import Hledger.Data.Journal (nullctx) import Hledger.Data.Utils-import Hledger.Read.Common-import Hledger.Read.Journal as Journal-import Hledger.Read.Timelog as Timelog+import Hledger.Read.JournalReader as JournalReader+import Hledger.Read.TimelogReader as TimelogReader  import Control.Monad.Error import Data.Either (partitionEithers)@@ -46,8 +46,8 @@ -- Here are the available readers. The first is the default, used for unknown data formats. readers :: [Reader] readers = [-  Journal.reader- ,Timelog.reader+  JournalReader.reader+ ,TimelogReader.reader  ]  formats   = map rFormat readers@@ -139,10 +139,10 @@   [     "journalFile" ~: do-    assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx emptyCtx Journal.journalFile "")+    assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx nullctx JournalReader.journalFile "")     jE <- readJournal Nothing "" -- don't know how to get it from journalFile     either error' (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE -  ,Journal.tests_Journal-  ,Timelog.tests_Timelog+  ,JournalReader.tests_JournalReader+  ,TimelogReader.tests_TimelogReader   ]

@@ -1,80 +0,0 @@-{-|--Common utilities for hledger data readers, such as the context (state)-that is kept while parsing a journal.---}--module Hledger.Read.Common-where--import Control.Monad.Error-import Hledger.Data.Utils-import Hledger.Data.Types (Journal)-import Hledger.Data.Journal-import System.Directory (getHomeDirectory)-import System.FilePath(takeDirectory,combine)-import System.Time (getClockTime)-import Text.ParserCombinators.Parsec----- | A hledger data reader is a triple of format name, format-detecting predicate, and a parser to Journal.-data Reader = Reader {rFormat   :: String-                     ,rDetector :: FilePath -> String -> Bool-                     ,rParser   :: FilePath -> String -> ErrorT String IO Journal-                     }---- | A JournalUpdate is some transformation of a "Journal". It can do I/O--- or raise an error.-type JournalUpdate = ErrorT String IO (Journal -> Journal)---- | Given a JournalUpdate-generating parsec parser, file path and data string,--- parse and post-process a Journal so that it's ready to use, or give an error.-parseJournalWith :: (GenParser Char JournalContext JournalUpdate) -> FilePath -> String -> ErrorT String IO Journal-parseJournalWith p f s = do-  tc <- liftIO getClockTime-  tl <- liftIO getCurrentLocalTime-  case runParser p emptyCtx f s of-    Right updates -> liftM (journalFinalise tc tl f s) $ updates `ap` return nulljournal-    Left err      -> throwError $ show err---- | 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-    , ctxAccount  :: ![String]         -- ^ the current stack of parent accounts specified by !account-    } deriving (Read, Show)--emptyCtx :: JournalContext-emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }--setYear :: Integer -> GenParser tok JournalContext ()-setYear y = updateState (\ctx -> ctx{ctxYear=Just y})--getYear :: GenParser tok JournalContext (Maybe Integer)-getYear = liftM ctxYear getState--pushParentAccount :: String -> GenParser tok JournalContext ()-pushParentAccount parent = updateState addParentAccount-    where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }-          normalize = (++ ":") --popParentAccount :: GenParser tok JournalContext ()-popParentAccount = do ctx0 <- getState-                      case ctxAccount ctx0 of-                        [] -> unexpected "End of account block with no beginning"-                        (_:rest) -> setState $ ctx0 { ctxAccount = rest }--getParentAccount :: GenParser tok JournalContext String-getParentAccount = liftM (concat . reverse . ctxAccount) getState--expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath-expandPath pos fp = liftM mkRelative (expandHome fp)-  where-    mkRelative = combine (takeDirectory (sourceName pos))-    expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory-                                                      return $ homedir ++ drop 1 inname-                      | otherwise                = return inname--fileSuffix :: FilePath -> String-fileSuffix = reverse . takeWhile (/='.') . reverse . dropWhile (/='.')

@@ -1,647 +0,0 @@-{-# LANGUAGE CPP #-}-{-|--A reader for hledger's (and c++ ledger's) journal file format.--From the ledger 2.5 manual:--@-The ledger file format is quite simple, but also very flexible. It supports-many options, though typically the user can ignore most of them. They are-summarized below.  The initial character of each line determines what the-line means, and how it should be interpreted. Allowable initial characters-are:--NUMBER      A line beginning with a number denotes an entry. It may be followed by any-            number of lines, each beginning with whitespace, to denote the entry’s account-            transactions. The format of the first line is:--                    DATE[=EDATE] [*|!] [(CODE)] DESC--            If ‘*’ appears after the date (with optional effective date), it indicates the entry-            is “cleared”, which can mean whatever the user wants it t omean. If ‘!’ appears-            after the date, it indicates d the entry is “pending”; i.e., tentatively cleared from-            the user’s point of view, but not yet actually cleared. If a ‘CODE’ appears in-            parentheses, it may be used to indicate a check number, or the type of the-            transaction. Following these is the payee, or a description of the transaction.-            The format of each following transaction is:--                      ACCOUNT     AMOUNT    [; NOTE]--            The ‘ACCOUNT’ may be surrounded by parentheses if it is a virtual-            transactions, or square brackets if it is a virtual transactions that must-            balance. The ‘AMOUNT’ can be followed by a per-unit transaction cost,-            by specifying ‘ AMOUNT’, or a complete transaction cost with ‘\@ AMOUNT’.-            Lastly, the ‘NOTE’ may specify an actual and/or effective date for the-            transaction by using the syntax ‘[ACTUAL_DATE]’ or ‘[=EFFECTIVE_DATE]’ or-            ‘[ACTUAL_DATE=EFFECtIVE_DATE]’.--=           An automated entry. A value expression must appear after the equal sign.-            After this initial line there should be a set of one or more transactions, just as-            if it were normal entry. If the amounts of the transactions have no commodity,-            they will be applied as modifiers to whichever real transaction is matched by-            the value expression.- -~           A period entry. A period expression must appear after the tilde.-            After this initial line there should be a set of one or more transactions, just as-            if it were normal entry.--!           A line beginning with an exclamation mark denotes a command directive. It-            must be immediately followed by the command word. The supported commands-            are:--           ‘!include’-                        Include the stated ledger file.-           ‘!account’-                        The account name is given is taken to be the parent of all transac--                        tions that follow, until ‘!end’ is seen.-           ‘!end’       Ends an account block.- -;          A line beginning with a colon indicates a comment, and is ignored.- -Y          If a line begins with a capital Y, it denotes the year used for all subsequent-           entries that give a date without a year. The year should appear immediately-           after the Y, for example: ‘Y2004’. This is useful at the beginning of a file, to-           specify the year for that file. If all entries specify a year, however, this command-           has no effect.-           - -P          Specifies a historical price for a commodity. These are usually found in a pricing-           history file (see the ‘-Q’ option). The syntax is:--                  P DATE SYMBOL PRICE--N SYMBOL   Indicates that pricing information is to be ignored for a given symbol, nor will-           quotes ever be downloaded for that symbol. Useful with a home currency, such-           as the dollar ($). It is recommended that these pricing options be set in the price-           database file, which defaults to ‘~/.pricedb’. The syntax for this command is:--                  N SYMBOL--        -D AMOUNT   Specifies the default commodity to use, by specifying an amount in the expected-           format. The entry command will use this commodity as the default when none-           other can be determined. This command may be used multiple times, to set-           the default flags for different commodities; whichever is seen last is used as the-           default commodity. For example, to set US dollars as the default commodity,-           while also setting the thousands flag and decimal flag for that commodity, use:--                  D $1,000.00--C AMOUNT1 = AMOUNT2-           Specifies a commodity conversion, where the first amount is given to be equiv--           alent to the second amount. The first amount should use the decimal precision-           desired during reporting:--                  C 1.00 Kb = 1024 bytes--i, o, b, h-           These four relate to timeclock support, which permits ledger to read timelog-           files. See the timeclock’s documentation for more info on the syntax of its-           timelog files.-@---}--module Hledger.Read.Journal (-       tests_Journal,-       reader,-       journalFile,-       someamount,-       ledgeraccountname,-       ledgerExclamationDirective,-       ledgerHistoricalPrice,-       ledgerDefaultYear,-       emptyLine,-       ledgerdatetime,-)-where-import Control.Monad.Error (ErrorT(..), throwError, catchError)-import Data.List.Split (wordsBy)-import Text.ParserCombinators.Parsec hiding (parse)-#if __GLASGOW_HASKELL__ <= 610-import Prelude hiding (readFile, putStr, putStrLn, print, getContents)-import System.IO.UTF8-#endif-import System.FilePath-import Hledger.Data.Utils-import Hledger.Data.Types-import Hledger.Data.Dates-import Hledger.Data.AccountName (accountNameFromComponents,accountNameComponents)-import Hledger.Data.Amount-import Hledger.Data.Transaction-import Hledger.Data.Posting-import Hledger.Data.Journal-import Hledger.Data.Commodity (dollars,dollar,unknown,nonsimplecommoditychars)-import Hledger.Read.Common----- let's get to it--reader :: Reader-reader = Reader format detect parse--format :: String-format = "journal"---- | Does the given file path and data provide hledger's journal file format ?-detect :: FilePath -> String -> Bool-detect f _ = fileSuffix f == format---- | Parse and post-process a "Journal" from hledger's journal file--- format, or give an error.-parse :: FilePath -> String -> ErrorT String IO Journal-parse = parseJournalWith journalFile---- | Top-level journal parser. Returns a single composite, I/O performing,--- error-raising "JournalUpdate" which can be applied to an empty journal--- to get the final result.-journalFile :: GenParser Char JournalContext JournalUpdate-journalFile = do items <- many journalItem-                 eof-                 return $ liftM (foldr (.) id) $ sequence items-    where -      -- As all journal line types can be distinguished by the first-      -- character, excepting transactions versus empty (blank or-      -- comment-only) lines, can use choice w/o try-      journalItem = choice [ ledgerExclamationDirective-                          , liftM (return . addTransaction) ledgerTransaction-                          , liftM (return . addModifierTransaction) ledgerModifierTransaction-                          , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction-                          , liftM (return . addHistoricalPrice) ledgerHistoricalPrice-                          , ledgerDefaultYear-                          , ledgerIgnoredPriceCommodity-                          , ledgerTagDirective-                          , ledgerEndTagDirective-                          , emptyLine >> return (return id)-                          ] <?> "journal transaction or directive"--emptyLine :: GenParser Char st ()-emptyLine = do many spacenonewline-               optional $ (char ';' <?> "comment") >> many (noneOf "\n")-               newline-               return ()--ledgercomment :: GenParser Char st String-ledgercomment = do-  many1 $ char ';'-  many spacenonewline-  many (noneOf "\n")-  <?> "comment"--ledgercommentline :: GenParser Char st String-ledgercommentline = do-  many spacenonewline-  s <- ledgercomment-  optional newline-  eof-  return s-  <?> "comment"--ledgerExclamationDirective :: GenParser Char JournalContext JournalUpdate-ledgerExclamationDirective = do-  char '!' <?> "directive"-  directive <- many nonspace-  case directive of-    "include" -> ledgerInclude-    "account" -> ledgerAccountBegin-    "end"     -> ledgerAccountEnd-    _         -> mzero--ledgerInclude :: GenParser Char JournalContext JournalUpdate-ledgerInclude = do many1 spacenonewline-                   filename <- restofline-                   outerState <- getState-                   outerPos <- getPosition-                   let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"-                   return $ do contents <- expandPath outerPos filename >>= readFileE outerPos-                               case runParser journalFile outerState (combine ((takeDirectory . sourceName) outerPos) filename) contents of-                                 Right l   -> l `catchError` (throwError . (inIncluded ++))-                                 Left perr -> throwError $ inIncluded ++ show perr-    where readFileE outerPos filename = ErrorT $ liftM Right (readFile filename) `catch` leftError-              where leftError err = return $ Left $ currentPos ++ whileReading ++ show err-                    currentPos = show outerPos-                    whileReading = " reading " ++ show filename ++ ":\n"--ledgerAccountBegin :: GenParser Char JournalContext JournalUpdate-ledgerAccountBegin = do many1 spacenonewline-                        parent <- ledgeraccountname-                        newline-                        pushParentAccount parent-                        return $ return id--ledgerAccountEnd :: GenParser Char JournalContext JournalUpdate-ledgerAccountEnd = popParentAccount >> return (return id)--ledgerModifierTransaction :: GenParser Char JournalContext ModifierTransaction-ledgerModifierTransaction = do-  char '=' <?> "modifier transaction"-  many spacenonewline-  valueexpr <- restofline-  postings <- ledgerpostings-  return $ ModifierTransaction valueexpr postings--ledgerPeriodicTransaction :: GenParser Char JournalContext PeriodicTransaction-ledgerPeriodicTransaction = do-  char '~' <?> "periodic transaction"-  many spacenonewline-  periodexpr <- restofline-  postings <- ledgerpostings-  return $ PeriodicTransaction periodexpr postings--ledgerHistoricalPrice :: GenParser Char JournalContext HistoricalPrice-ledgerHistoricalPrice = do-  char 'P' <?> "historical price"-  many spacenonewline-  date <- try (do {LocalTime d _ <- ledgerdatetime; return d}) <|> ledgerdate -- a time is ignored-  many1 spacenonewline-  symbol <- commoditysymbol-  many spacenonewline-  price <- someamount-  restofline-  return $ HistoricalPrice date symbol price--ledgerIgnoredPriceCommodity :: GenParser Char JournalContext JournalUpdate-ledgerIgnoredPriceCommodity = do-  char 'N' <?> "ignored-price commodity"-  many1 spacenonewline-  commoditysymbol-  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"-  many1 spacenonewline-  someamount-  many spacenonewline-  char '='-  many spacenonewline-  someamount-  restofline-  return $ return id--ledgerTagDirective :: GenParser Char JournalContext JournalUpdate-ledgerTagDirective = do-  string "tag" <?> "tag directive"-  many1 spacenonewline-  _ <- many1 nonspace-  restofline-  return $ return id--ledgerEndTagDirective :: GenParser Char JournalContext JournalUpdate-ledgerEndTagDirective = do-  string "end tag" <?> "end tag directive"-  restofline-  return $ return id---- like ledgerAccountBegin, updates the JournalContext-ledgerDefaultYear :: GenParser Char JournalContext JournalUpdate-ledgerDefaultYear = do-  char 'Y' <?> "default year"-  many spacenonewline-  y <- many1 digit-  let y' = read y-  failIfInvalidYear y-  setYear y'-  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-ledgerTransaction = do-  date <- ledgerdate <?> "transaction"-  edate <- optionMaybe (ledgereffectivedate date) <?> "effective date"-  status <- ledgerstatus <?> "cleared flag"-  code <- ledgercode <?> "transaction code"-  (description, comment) <--      (do {many1 spacenonewline; d <- liftM rstrip (many (noneOf ";\n")); c <- ledgercomment <|> return ""; newline; return (d, c)} <|>-       do {many spacenonewline; c <- ledgercomment <|> return ""; newline; return ("", c)}-      ) <?> "description and/or comment"-  postings <- ledgerpostings-  let t = txnTieKnot $ Transaction date edate status code description comment postings ""-  case balanceTransaction t of-    Right t' -> return t'-    Left err -> fail err--ledgerdate :: GenParser Char JournalContext Day-ledgerdate = do-  -- hacky: try to ensure precise errors for invalid dates-  -- XXX reported error position is not too good-  -- pos <- getPosition-  datestr <- many1 $ choice' [digit, datesepchar]-  let dateparts = wordsBy (`elem` datesepchars) datestr-  case dateparts of-    [y,m,d] -> do-               failIfInvalidYear y-               failIfInvalidMonth m-               failIfInvalidDay d-               return $ fromGregorian (read y) (read m) (read d)-    [m,d]   -> do-               y <- getYear-               case y of Nothing -> fail "partial date found, but no default year specified"-                         Just y' -> do failIfInvalidYear $ show y'-                                       failIfInvalidMonth m-                                       failIfInvalidDay d-                                       return $ fromGregorian y' (read m) (read d)-    _       -> fail $ "bad date: " ++ datestr-  <?> "full or partial date"--ledgerdatetime :: GenParser Char JournalContext LocalTime-ledgerdatetime = do -  day <- ledgerdate-  many1 spacenonewline-  h <- many1 digit-  char ':'-  m <- many1 digit-  s <- optionMaybe $ do-      char ':'-      many1 digit-  let tod = TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s)-  return $ LocalTime day tod--ledgereffectivedate :: Day -> GenParser Char JournalContext Day-ledgereffectivedate actualdate = do-  char '='-  -- kludgy way to use actual date for default year-  let withDefaultYear d p = do-        y <- getYear-        let (y',_,_) = toGregorian d in setYear y'-        r <- p-        when (isJust y) $ setYear $ fromJust y-        return r-  edate <- withDefaultYear actualdate ledgerdate-  return edate--ledgerstatus :: GenParser Char st Bool-ledgerstatus = try (do { many1 spacenonewline; char '*' <?> "status"; return True } ) <|> return False--ledgercode :: GenParser Char st String-ledgercode = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""--ledgerpostings :: GenParser Char JournalContext [Posting]-ledgerpostings = do-  -- complicated to handle intermixed comment lines.. please make me better.-  ctx <- getState-  let parses p = isRight . parseWithCtx ctx p-  -- parse the following non-comment whitespace-beginning lines as postings-  -- make sure the sub-parse starts from the current position, for useful errors-  pos <- getPosition-  ls <- many1 $ try linebeginningwithspaces-  let ls' = filter (not . (ledgercommentline `parses`)) ls-  when (null ls') $ fail "no postings"-  return $ map (fromparse . parseWithCtx ctx (setPosition pos >> ledgerposting)) ls'-  <?> "postings"--linebeginningwithspaces :: GenParser Char st String-linebeginningwithspaces = do-  sp <- many1 spacenonewline-  c <- nonspace-  cs <- restofline-  return $ sp ++ (c:cs) ++ "\n"--ledgerposting :: GenParser Char JournalContext Posting-ledgerposting = do-  many1 spacenonewline-  status <- ledgerstatus-  account <- transactionaccountname-  let (ptype, account') = (postingTypeFromAccountName account, unbracket account)-  amount <- postingamount-  many spacenonewline-  comment <- ledgercomment <|> return ""-  newline-  return (Posting status account' amount comment ptype Nothing)---- qualify with the parent account from parsing context-transactionaccountname :: GenParser Char JournalContext AccountName-transactionaccountname = liftM2 (++) getParentAccount ledgeraccountname---- | Parse an account name. Account names may have single spaces inside--- them, and are terminated by two or more spaces. They should have one or--- more components of at least one character, separated by the account--- separator char.-ledgeraccountname :: GenParser Char st AccountName-ledgeraccountname = do-    a <- many1 (nonspace <|> singlespace)-    let a' = striptrailingspace a-    when (accountNameFromComponents (accountNameComponents a') /= a')-         (fail $ "accountname seems ill-formed: "++a')-    return a'-    where -      singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})-      -- couldn't avoid consuming a final space sometimes, harmless-      striptrailingspace s = if last s == ' ' then init s else s---- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace---     <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"---- | Parse an amount, with an optional left or right currency symbol and--- optional price.-postingamount :: GenParser Char st MixedAmount-postingamount =-  try (do-        many1 spacenonewline-        someamount <|> return missingamt-      ) <|> return missingamt--someamount :: GenParser Char st MixedAmount-someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount --leftsymbolamount :: GenParser Char st MixedAmount-leftsymbolamount = do-  sign <- optionMaybe $ string "-"-  let applysign = if isJust sign then negate else id-  sym <- commoditysymbol -  sp <- many spacenonewline-  (q,p,comma) <- amountquantity-  pri <- priceamount-  let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p}-  return $ applysign $ Mixed [Amount c q pri]-  <?> "left-symbol amount"--rightsymbolamount :: GenParser Char st MixedAmount-rightsymbolamount = do-  (q,p,comma) <- amountquantity-  sp <- many spacenonewline-  sym <- commoditysymbol-  pri <- priceamount-  let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p}-  return $ Mixed [Amount c q pri]-  <?> "right-symbol amount"--nosymbolamount :: GenParser Char st MixedAmount-nosymbolamount = do-  (q,p,comma) <- amountquantity-  pri <- priceamount-  let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p}-  return $ Mixed [Amount c q pri]-  <?> "no-symbol amount"--commoditysymbol :: GenParser Char st String-commoditysymbol = (quotedcommoditysymbol <|> simplecommoditysymbol) <?> "commodity symbol"--quotedcommoditysymbol :: GenParser Char st String-quotedcommoditysymbol = do-  char '"'-  s <- many1 $ noneOf ";\n\""-  char '"'-  return s--simplecommoditysymbol :: GenParser Char st String-simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)--priceamount :: GenParser Char st (Maybe MixedAmount)-priceamount =-    try (do-          many spacenonewline-          char '@'-          many spacenonewline-          a <- someamount -- XXX could parse more prices ad infinitum, shouldn't-          return $ Just a-          ) <|> return Nothing---- gawd.. trying to parse a ledger number without error:---- | 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 = do-  sign <- optionMaybe $ string "-"-  (intwithcommas,frac) <- numberparts-  let comma = ',' `elem` intwithcommas-  let precision = length frac-  -- read the actual value. We expect this read to never fail.-  let int = filter (/= ',') intwithcommas-  let int' = if null int then "0" else int-  let frac' = if null frac then "0" else frac-  let sign' = fromMaybe "" sign-  let quantity = read $ sign'++int'++"."++frac'-  return (quantity, precision, comma)-  <?> "commodity quantity"---- | 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 = numberpartsstartingwithdigit <|> numberpartsstartingwithpoint--numberpartsstartingwithdigit :: GenParser Char st (String,String)-numberpartsstartingwithdigit = do-  let digitorcomma = digit <|> char ','-  first <- digit-  rest <- many digitorcomma-  frac <- try (do {char '.'; many digit}) <|> return ""-  return (first:rest,frac)-                     -numberpartsstartingwithpoint :: GenParser Char st (String,String)-numberpartsstartingwithpoint = do-  char '.'-  frac <- many1 digit-  return ("",frac)-                     --tests_Journal = TestList [--   "ledgerTransaction" ~: do-    assertParseEqual (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1-    assertBool "ledgerTransaction should not parse just a date"-                   $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1\n"-    assertBool "ledgerTransaction should require some postings"-                   $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n"-    let t = parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n"-    assertBool "ledgerTransaction should not include a comment in the description"-                   $ either (const False) ((== "a") . tdescription) t--  ,"ledgerModifierTransaction" ~: do-     assertParse (parseWithCtx emptyCtx ledgerModifierTransaction "= (some value expr)\n some:postings  1\n")--  ,"ledgerPeriodicTransaction" ~: do-     assertParse (parseWithCtx emptyCtx ledgerPeriodicTransaction "~ (some period expr)\n some:postings  1\n")--  ,"ledgerExclamationDirective" ~: do-     assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!include /some/file.x\n")-     assertParse (parseWithCtx emptyCtx ledgerExclamationDirective "!account some:account\n")-     assertParse (parseWithCtx emptyCtx (ledgerExclamationDirective >> ledgerExclamationDirective) "!account a\n!end\n")--  ,"ledgercommentline" ~: do-     assertParse (parseWithCtx emptyCtx ledgercommentline "; some comment \n")-     assertParse (parseWithCtx emptyCtx ledgercommentline " \t; x\n")-     assertParse (parseWithCtx emptyCtx ledgercommentline ";x")--  ,"ledgerDefaultYear" ~: do-     assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 2010\n")-     assertParse (parseWithCtx emptyCtx ledgerDefaultYear "Y 10001\n")--  ,"ledgerHistoricalPrice" ~:-    assertParseEqual (parseWithCtx emptyCtx ledgerHistoricalPrice "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55])--  ,"ledgerIgnoredPriceCommodity" ~: do-     assertParse (parseWithCtx emptyCtx ledgerIgnoredPriceCommodity "N $\n")--  ,"ledgerDefaultCommodity" ~: do-     assertParse (parseWithCtx emptyCtx ledgerDefaultCommodity "D $1,000.0\n")--  ,"ledgerCommodityConversion" ~: do-     assertParse (parseWithCtx emptyCtx ledgerCommodityConversion "C 1h = $50.00\n")--  ,"ledgerTagDirective" ~: do-     assertParse (parseWithCtx emptyCtx ledgerTagDirective "tag foo \n")--  ,"ledgerEndTagDirective" ~: do-     assertParse (parseWithCtx emptyCtx ledgerEndTagDirective "end tag \n")--  ,"ledgeraccountname" ~: do-    assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c")-    assertBool "ledgeraccountname rejects an empty inner component" (isLeft $ parsewith ledgeraccountname "a::c")-    assertBool "ledgeraccountname rejects an empty leading component" (isLeft $ parsewith ledgeraccountname ":b:c")-    assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:")-- ,"ledgerposting" ~: do-    assertParseEqual (parseWithCtx emptyCtx ledgerposting "  expenses:food:dining  $10.00\n") -                     (Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing)-    assertBool "ledgerposting parses a quoted commodity with numbers"-                   (isRight $ parseWithCtx emptyCtx ledgerposting "  a  1 \"DE123\"\n")--  ,"someamount" ~: do-     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")-                            (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])])--  ,"postingamount" ~: do-    assertParseEqual (parseWithCtx emptyCtx postingamount " $47.18") (Mixed [dollars 47.18])-    assertParseEqual (parseWithCtx emptyCtx postingamount " $1.")-                (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])--  ,"leftsymbolamount" ~: do-    assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "$1")-                     (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])-    assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "$-1")-                     (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])-    assertParseEqual (parseWithCtx emptyCtx leftsymbolamount "-$1")-                     (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])-- ]--entry1_str = unlines- ["2007/01/28 coopportunity"- ,"    expenses:food:groceries                   $47.18"- ,"    assets:checking                          $-47.18"- ,""- ]--entry1 =-    txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""-     [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing, -      Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting Nothing] ""-

@@ -0,0 +1,681 @@+{-# LANGUAGE CPP #-}+{-|++A reader for hledger's (and c++ ledger's) journal file format.++From the ledger 2.5 manual:++@+The ledger file format is quite simple, but also very flexible. It supports+many options, though typically the user can ignore most of them. They are+summarized below.  The initial character of each line determines what the+line means, and how it should be interpreted. Allowable initial characters+are:++NUMBER      A line beginning with a number denotes an entry. It may be followed by any+            number of lines, each beginning with whitespace, to denote the entry’s account+            transactions. The format of the first line is:++                    DATE[=EDATE] [*|!] [(CODE)] DESC++            If ‘*’ appears after the date (with optional effective date), it indicates the entry+            is “cleared”, which can mean whatever the user wants it t omean. If ‘!’ appears+            after the date, it indicates d the entry is “pending”; i.e., tentatively cleared from+            the user’s point of view, but not yet actually cleared. If a ‘CODE’ appears in+            parentheses, it may be used to indicate a check number, or the type of the+            transaction. Following these is the payee, or a description of the transaction.+            The format of each following transaction is:++                      ACCOUNT     AMOUNT    [; NOTE]++            The ‘ACCOUNT’ may be surrounded by parentheses if it is a virtual+            transactions, or square brackets if it is a virtual transactions that must+            balance. The ‘AMOUNT’ can be followed by a per-unit transaction cost,+            by specifying ‘ AMOUNT’, or a complete transaction cost with ‘\@ AMOUNT’.+            Lastly, the ‘NOTE’ may specify an actual and/or effective date for the+            transaction by using the syntax ‘[ACTUAL_DATE]’ or ‘[=EFFECTIVE_DATE]’ or+            ‘[ACTUAL_DATE=EFFECtIVE_DATE]’.++=           An automated entry. A value expression must appear after the equal sign.+            After this initial line there should be a set of one or more transactions, just as+            if it were normal entry. If the amounts of the transactions have no commodity,+            they will be applied as modifiers to whichever real transaction is matched by+            the value expression.+ +~           A period entry. A period expression must appear after the tilde.+            After this initial line there should be a set of one or more transactions, just as+            if it were normal entry.++!           A line beginning with an exclamation mark denotes a command directive. It+            must be immediately followed by the command word. The supported commands+            are:++           ‘!include’+                        Include the stated ledger file.+           ‘!account’+                        The account name is given is taken to be the parent of all transac-+                        tions that follow, until ‘!end’ is seen.+           ‘!end’       Ends an account block.+ +;          A line beginning with a colon indicates a comment, and is ignored.+ +Y          If a line begins with a capital Y, it denotes the year used for all subsequent+           entries that give a date without a year. The year should appear immediately+           after the Y, for example: ‘Y2004’. This is useful at the beginning of a file, to+           specify the year for that file. If all entries specify a year, however, this command+           has no effect.+           + +P          Specifies a historical price for a commodity. These are usually found in a pricing+           history file (see the ‘-Q’ option). The syntax is:++                  P DATE SYMBOL PRICE++N SYMBOL   Indicates that pricing information is to be ignored for a given symbol, nor will+           quotes ever be downloaded for that symbol. Useful with a home currency, such+           as the dollar ($). It is recommended that these pricing options be set in the price+           database file, which defaults to ‘~/.pricedb’. The syntax for this command is:++                  N SYMBOL++        +D AMOUNT   Specifies the default commodity to use, by specifying an amount in the expected+           format. The entry command will use this commodity as the default when none+           other can be determined. This command may be used multiple times, to set+           the default flags for different commodities; whichever is seen last is used as the+           default commodity. For example, to set US dollars as the default commodity,+           while also setting the thousands flag and decimal flag for that commodity, use:++                  D $1,000.00++C AMOUNT1 = AMOUNT2+           Specifies a commodity conversion, where the first amount is given to be equiv-+           alent to the second amount. The first amount should use the decimal precision+           desired during reporting:++                  C 1.00 Kb = 1024 bytes++i, o, b, h+           These four relate to timeclock support, which permits ledger to read timelog+           files. See the timeclock’s documentation for more info on the syntax of its+           timelog files.+@++-}++module Hledger.Read.JournalReader (+       tests_JournalReader,+       reader,+       journalFile,+       journalAddFile,+       someamount,+       ledgeraccountname,+       ledgerExclamationDirective,+       ledgerHistoricalPrice,+       ledgerDefaultYear,+       emptyLine,+       ledgerdatetime,+)+where+import Control.Monad.Error (ErrorT(..), throwError, catchError)+import Data.List.Split (wordsBy)+import Text.ParserCombinators.Parsec hiding (parse)+#if __GLASGOW_HASKELL__ <= 610+import Prelude hiding (readFile, putStr, putStrLn, print, getContents)+import System.IO.UTF8+#endif++import Hledger.Data+import Hledger.Read.Utils+++-- let's get to it++reader :: Reader+reader = Reader format detect parse++format :: String+format = "journal"++-- | Does the given file path and data provide hledger's journal file format ?+detect :: FilePath -> String -> Bool+detect f _ = fileSuffix f == format++-- | Parse and post-process a "Journal" from hledger's journal file+-- format, or give an error.+parse :: FilePath -> String -> ErrorT String IO Journal+parse = parseJournalWith journalFile++-- | Top-level journal parser. Returns a single composite, I/O performing,+-- error-raising "JournalUpdate" (and final "JournalContext") which can be+-- applied to an empty journal to get the final result.+journalFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)+journalFile = do+  journalupdates <- many journalItem+  eof+  finalctx <- getState+  return $ (juSequence journalupdates, finalctx)+    where +      -- As all journal line types can be distinguished by the first+      -- character, excepting transactions versus empty (blank or+      -- comment-only) lines, can use choice w/o try+      journalItem = choice [ ledgerExclamationDirective+                          , liftM (return . addTransaction) ledgerTransaction+                          , liftM (return . addModifierTransaction) ledgerModifierTransaction+                          , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction+                          , liftM (return . addHistoricalPrice) ledgerHistoricalPrice+                          , ledgerDefaultYear+                          , ledgerDefaultCommodity+                          , ledgerCommodityConversion+                          , ledgerIgnoredPriceCommodity+                          , ledgerTagDirective+                          , ledgerEndTagDirective+                          , emptyLine >> return (return id)+                          ] <?> "journal transaction or directive"++journalAddFile :: (FilePath,String) -> Journal -> Journal+journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}++emptyLine :: GenParser Char JournalContext ()+emptyLine = do many spacenonewline+               optional $ (char ';' <?> "comment") >> many (noneOf "\n")+               newline+               return ()++ledgercomment :: GenParser Char JournalContext String+ledgercomment = do+  many1 $ char ';'+  many spacenonewline+  many (noneOf "\n")+  <?> "comment"++ledgercommentline :: GenParser Char JournalContext String+ledgercommentline = do+  many spacenonewline+  s <- ledgercomment+  optional newline+  eof+  return s+  <?> "comment"++ledgerExclamationDirective :: GenParser Char JournalContext JournalUpdate+ledgerExclamationDirective = do+  char '!' <?> "directive"+  directive <- many nonspace+  case directive of+    "include" -> ledgerInclude+    "account" -> ledgerAccountBegin+    "end"     -> ledgerAccountEnd+    _         -> mzero++ledgerInclude :: GenParser Char JournalContext JournalUpdate+ledgerInclude = do+  many1 spacenonewline+  filename <- restofline+  outerState <- getState+  outerPos <- getPosition+  return $ do filepath <- expandPath outerPos filename+              txt <- readFileOrError outerPos filepath+              let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"+              case runParser journalFile outerState filepath txt of+                Right (ju,_) -> juSequence [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++))+                Left err     -> throwError $ inIncluded ++ show err+      where readFileOrError pos fp =+                ErrorT $ liftM Right (readFile fp) `catch`+                  \err -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show err)++ledgerAccountBegin :: GenParser Char JournalContext JournalUpdate+ledgerAccountBegin = do many1 spacenonewline+                        parent <- ledgeraccountname+                        newline+                        pushParentAccount parent+                        return $ return id++ledgerAccountEnd :: GenParser Char JournalContext JournalUpdate+ledgerAccountEnd = popParentAccount >> return (return id)++ledgerModifierTransaction :: GenParser Char JournalContext ModifierTransaction+ledgerModifierTransaction = do+  char '=' <?> "modifier transaction"+  many spacenonewline+  valueexpr <- restofline+  postings <- ledgerpostings+  return $ ModifierTransaction valueexpr postings++ledgerPeriodicTransaction :: GenParser Char JournalContext PeriodicTransaction+ledgerPeriodicTransaction = do+  char '~' <?> "periodic transaction"+  many spacenonewline+  periodexpr <- restofline+  postings <- ledgerpostings+  return $ PeriodicTransaction periodexpr postings++ledgerHistoricalPrice :: GenParser Char JournalContext HistoricalPrice+ledgerHistoricalPrice = do+  char 'P' <?> "historical price"+  many spacenonewline+  date <- try (do {LocalTime d _ <- ledgerdatetime; return d}) <|> ledgerdate -- a time is ignored+  many1 spacenonewline+  symbol <- commoditysymbol+  many spacenonewline+  price <- someamount+  restofline+  return $ HistoricalPrice date symbol price++ledgerIgnoredPriceCommodity :: GenParser Char JournalContext JournalUpdate+ledgerIgnoredPriceCommodity = do+  char 'N' <?> "ignored-price commodity"+  many1 spacenonewline+  commoditysymbol+  restofline+  return $ return id++ledgerCommodityConversion :: GenParser Char JournalContext JournalUpdate+ledgerCommodityConversion = do+  char 'C' <?> "commodity conversion"+  many1 spacenonewline+  someamount+  many spacenonewline+  char '='+  many spacenonewline+  someamount+  restofline+  return $ return id++ledgerTagDirective :: GenParser Char JournalContext JournalUpdate+ledgerTagDirective = do+  string "tag" <?> "tag directive"+  many1 spacenonewline+  _ <- many1 nonspace+  restofline+  return $ return id++ledgerEndTagDirective :: GenParser Char JournalContext JournalUpdate+ledgerEndTagDirective = do+  string "end tag" <?> "end tag directive"+  restofline+  return $ return id++-- like ledgerAccountBegin, updates the JournalContext+ledgerDefaultYear :: GenParser Char JournalContext JournalUpdate+ledgerDefaultYear = do+  char 'Y' <?> "default year"+  many spacenonewline+  y <- many1 digit+  let y' = read y+  failIfInvalidYear y+  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+ledgerTransaction = do+  date <- ledgerdate <?> "transaction"+  edate <- optionMaybe (ledgereffectivedate date) <?> "effective date"+  status <- ledgerstatus <?> "cleared flag"+  code <- ledgercode <?> "transaction code"+  (description, comment) <-+      (do {many1 spacenonewline; d <- liftM rstrip (many (noneOf ";\n")); c <- ledgercomment <|> return ""; newline; return (d, c)} <|>+       do {many spacenonewline; c <- ledgercomment <|> return ""; newline; return ("", c)}+      ) <?> "description and/or comment"+  md <- try ledgermetadata <|> return []+  postings <- ledgerpostings+  let t = txnTieKnot $ Transaction date edate status code description comment md postings ""+  -- case balanceTransaction Nothing t of+  --   Right t' -> return t'+  --   Left err -> fail err+  -- check it later, after we have worked out commodity display precisions+  return t++ledgerdate :: GenParser Char JournalContext Day+ledgerdate = do+  -- hacky: try to ensure precise errors for invalid dates+  -- XXX reported error position is not too good+  -- pos <- getPosition+  datestr <- many1 $ choice' [digit, datesepchar]+  let dateparts = wordsBy (`elem` datesepchars) datestr+  case dateparts of+    [y,m,d] -> do+               failIfInvalidYear y+               failIfInvalidMonth m+               failIfInvalidDay d+               return $ fromGregorian (read y) (read m) (read d)+    [m,d]   -> do+               y <- getYear+               case y of Nothing -> fail "partial date found, but no default year specified"+                         Just y' -> do failIfInvalidYear $ show y'+                                       failIfInvalidMonth m+                                       failIfInvalidDay d+                                       return $ fromGregorian y' (read m) (read d)+    _       -> fail $ "bad date: " ++ datestr+  <?> "full or partial date"++ledgerdatetime :: GenParser Char JournalContext LocalTime+ledgerdatetime = do +  day <- ledgerdate+  many1 spacenonewline+  h <- many1 digit+  char ':'+  m <- many1 digit+  s <- optionMaybe $ do+      char ':'+      many1 digit+  let tod = TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s)+  return $ LocalTime day tod++ledgereffectivedate :: Day -> GenParser Char JournalContext Day+ledgereffectivedate actualdate = do+  char '='+  -- kludgy way to use actual date for default year+  let withDefaultYear d p = do+        y <- getYear+        let (y',_,_) = toGregorian d in setYear y'+        r <- p+        when (isJust y) $ setYear $ fromJust y+        return r+  edate <- withDefaultYear actualdate ledgerdate+  return edate++ledgerstatus :: GenParser Char JournalContext Bool+ledgerstatus = try (do { many spacenonewline; char '*' <?> "status"; return True } ) <|> return False++ledgercode :: GenParser Char JournalContext String+ledgercode = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""++ledgermetadata :: GenParser Char JournalContext [(String,String)]+ledgermetadata = many ledgermetadataline++-- a comment line containing a metadata declaration, eg:+-- ; name: value+ledgermetadataline :: GenParser Char JournalContext (String,String)+ledgermetadataline = do+  many1 spacenonewline+  many1 $ char ';'+  many spacenonewline+  name <- many1 $ noneOf ": \t"+  char ':'+  many spacenonewline+  value <- many (noneOf "\n")+  optional newline+--  eof+  return (name,value)+  <?> "metadata line"++-- Parse the following whitespace-beginning lines as postings, posting metadata, and/or comments.+-- complicated to handle intermixed comment and metadata lines.. make me better ?+ledgerpostings :: GenParser Char JournalContext [Posting]+ledgerpostings = do+  ctx <- getState+  -- pass current position to the sub-parses for more useful errors+  pos <- getPosition+  ls <- many1 $ try linebeginningwithspaces+  let parses p = isRight . parseWithCtx ctx p+      postinglines = filter (not . (ledgercommentline `parses`)) ls+      postinglinegroups :: [String] -> [String]+      postinglinegroups [] = []+      postinglinegroups (pline:ls) = (unlines $ pline:mdlines):postinglinegroups rest+          where (mdlines,rest) = span (ledgermetadataline `parses`) ls+      pstrs = postinglinegroups postinglines+  when (null pstrs) $ fail "no postings"+  return $ map (fromparse . parseWithCtx ctx (setPosition pos >> ledgerposting)) pstrs+  <?> "postings"+            +linebeginningwithspaces :: GenParser Char JournalContext String+linebeginningwithspaces = do+  sp <- many1 spacenonewline+  c <- nonspace+  cs <- restofline+  return $ sp ++ (c:cs) ++ "\n"++ledgerposting :: GenParser Char JournalContext Posting+ledgerposting = do+  many1 spacenonewline+  status <- ledgerstatus+  many spacenonewline+  account <- transactionaccountname+  let (ptype, account') = (postingTypeFromAccountName account, unbracket account)+  amount <- postingamount+  many spacenonewline+  comment <- ledgercomment <|> return ""+  newline+  md <- ledgermetadata+  return (Posting status account' amount comment ptype md Nothing)++-- qualify with the parent account from parsing context+transactionaccountname :: GenParser Char JournalContext AccountName+transactionaccountname = liftM2 (++) getParentAccount ledgeraccountname++-- | Parse an account name. Account names may have single spaces inside+-- them, and are terminated by two or more spaces. They should have one or+-- more components of at least one character, separated by the account+-- separator char.+ledgeraccountname :: GenParser Char st AccountName+ledgeraccountname = do+    a <- many1 (nonspace <|> singlespace)+    let a' = striptrailingspace a+    when (accountNameFromComponents (accountNameComponents a') /= a')+         (fail $ "accountname seems ill-formed: "++a')+    return a'+    where +      singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})+      -- couldn't avoid consuming a final space sometimes, harmless+      striptrailingspace s = if last s == ' ' then init s else s++-- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace+--     <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"++-- | Parse an amount, with an optional left or right currency symbol and+-- optional price.+postingamount :: GenParser Char JournalContext MixedAmount+postingamount =+  try (do+        many1 spacenonewline+        someamount <|> return missingamt+      ) <|> return missingamt++someamount :: GenParser Char JournalContext MixedAmount+someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount ++leftsymbolamount :: GenParser Char JournalContext MixedAmount+leftsymbolamount = do+  sign <- optionMaybe $ string "-"+  let applysign = if isJust sign then negate else id+  sym <- commoditysymbol +  sp <- many spacenonewline+  (q,p,comma) <- amountquantity+  pri <- priceamount+  let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p}+  return $ applysign $ Mixed [Amount c q pri]+  <?> "left-symbol amount"++rightsymbolamount :: GenParser Char JournalContext MixedAmount+rightsymbolamount = do+  (q,p,comma) <- amountquantity+  sp <- many spacenonewline+  sym <- commoditysymbol+  pri <- priceamount+  let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p}+  return $ Mixed [Amount c q pri]+  <?> "right-symbol amount"++nosymbolamount :: GenParser Char JournalContext MixedAmount+nosymbolamount = do+  (q,p,comma) <- amountquantity+  pri <- priceamount+  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 JournalContext String+commoditysymbol = (quotedcommoditysymbol <|> simplecommoditysymbol) <?> "commodity symbol"++quotedcommoditysymbol :: GenParser Char JournalContext String+quotedcommoditysymbol = do+  char '"'+  s <- many1 $ noneOf ";\n\""+  char '"'+  return s++simplecommoditysymbol :: GenParser Char JournalContext String+simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)++priceamount :: GenParser Char JournalContext (Maybe MixedAmount)+priceamount =+    try (do+          many spacenonewline+          char '@'+          many spacenonewline+          a <- someamount -- XXX could parse more prices ad infinitum, shouldn't+          return $ Just a+          ) <|> return Nothing++-- gawd.. trying to parse a ledger number without error:++-- | 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 JournalContext (Double, Int, Bool)+amountquantity = do+  sign <- optionMaybe $ string "-"+  (intwithcommas,frac) <- numberparts+  let comma = ',' `elem` intwithcommas+  let precision = length frac+  -- read the actual value. We expect this read to never fail.+  let int = filter (/= ',') intwithcommas+  let int' = if null int then "0" else int+  let frac' = if null frac then "0" else frac+  let sign' = fromMaybe "" sign+  let quantity = read $ sign'++int'++"."++frac'+  return (quantity, precision, comma)+  <?> "commodity quantity"++-- | 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 JournalContext (String,String)+numberparts = numberpartsstartingwithdigit <|> numberpartsstartingwithpoint++numberpartsstartingwithdigit :: GenParser Char JournalContext (String,String)+numberpartsstartingwithdigit = do+  let digitorcomma = digit <|> char ','+  first <- digit+  rest <- many digitorcomma+  frac <- try (do {char '.'; many digit}) <|> return ""+  return (first:rest,frac)+                     +numberpartsstartingwithpoint :: GenParser Char JournalContext (String,String)+numberpartsstartingwithpoint = do+  char '.'+  frac <- many1 digit+  return ("",frac)+                     ++tests_JournalReader = TestList [++   "ledgerTransaction" ~: do+    assertParseEqual (parseWithCtx nullctx ledgerTransaction entry1_str) entry1+    assertBool "ledgerTransaction should not parse just a date"+                   $ isLeft $ parseWithCtx nullctx ledgerTransaction "2009/1/1\n"+    assertBool "ledgerTransaction should require some postings"+                   $ isLeft $ parseWithCtx nullctx ledgerTransaction "2009/1/1 a\n"+    let t = parseWithCtx nullctx ledgerTransaction "2009/1/1 a ;comment\n b 1\n"+    assertBool "ledgerTransaction should not include a comment in the description"+                   $ either (const False) ((== "a") . tdescription) t++  ,"ledgerModifierTransaction" ~: do+     assertParse (parseWithCtx nullctx ledgerModifierTransaction "= (some value expr)\n some:postings  1\n")++  ,"ledgerPeriodicTransaction" ~: do+     assertParse (parseWithCtx nullctx ledgerPeriodicTransaction "~ (some period expr)\n some:postings  1\n")++  ,"ledgerExclamationDirective" ~: do+     assertParse (parseWithCtx nullctx ledgerExclamationDirective "!include /some/file.x\n")+     assertParse (parseWithCtx nullctx ledgerExclamationDirective "!account some:account\n")+     assertParse (parseWithCtx nullctx (ledgerExclamationDirective >> ledgerExclamationDirective) "!account a\n!end\n")++  ,"ledgercommentline" ~: do+     assertParse (parseWithCtx nullctx ledgercommentline "; some comment \n")+     assertParse (parseWithCtx nullctx ledgercommentline " \t; x\n")+     assertParse (parseWithCtx nullctx ledgercommentline ";x")++  ,"ledgerDefaultYear" ~: do+     assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 2010\n")+     assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 10001\n")++  ,"ledgerHistoricalPrice" ~:+    assertParseEqual (parseWithCtx nullctx ledgerHistoricalPrice "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55])++  ,"ledgerIgnoredPriceCommodity" ~: do+     assertParse (parseWithCtx nullctx ledgerIgnoredPriceCommodity "N $\n")++  ,"ledgerDefaultCommodity" ~: do+     assertParse (parseWithCtx nullctx ledgerDefaultCommodity "D $1,000.0\n")++  ,"ledgerCommodityConversion" ~: do+     assertParse (parseWithCtx nullctx ledgerCommodityConversion "C 1h = $50.00\n")++  ,"ledgerTagDirective" ~: do+     assertParse (parseWithCtx nullctx ledgerTagDirective "tag foo \n")++  ,"ledgerEndTagDirective" ~: do+     assertParse (parseWithCtx nullctx ledgerEndTagDirective "end tag \n")++  ,"ledgeraccountname" ~: do+    assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c")+    assertBool "ledgeraccountname rejects an empty inner component" (isLeft $ parsewith ledgeraccountname "a::c")+    assertBool "ledgeraccountname rejects an empty leading component" (isLeft $ parsewith ledgeraccountname ":b:c")+    assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:")++ ,"ledgerposting" ~: do+    assertParseEqual (parseWithCtx nullctx ledgerposting "  expenses:food:dining  $10.00\n")+                     (Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting [] Nothing)+    assertBool "ledgerposting parses a quoted commodity with numbers"+                   (isRight $ parseWithCtx nullctx ledgerposting "  a  1 \"DE123\"\n")++  ,"someamount" ~: do+     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 (parseWithCtx nullctx someamount "1 @ $2")+                            (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])])++  ,"postingamount" ~: do+    assertParseEqual (parseWithCtx nullctx postingamount " $47.18") (Mixed [dollars 47.18])+    assertParseEqual (parseWithCtx nullctx postingamount " $1.")+                (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])++  ,"leftsymbolamount" ~: do+    assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1")+                     (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])+    assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1")+                     (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])+    assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1")+                     (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} (-1) Nothing])++ ]++entry1_str = unlines+ ["2007/01/28 coopportunity"+ ,"    expenses:food:groceries                   $47.18"+ ,"    assets:checking                          $-47.18"+ ,""+ ]++entry1 =+    txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+     [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] Nothing, +      Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting [] Nothing] ""+

@@ -1,100 +0,0 @@-{-# LANGUAGE CPP #-}-{-|--A reader for the timelog file format generated by timeclock.el.--From timeclock.el 2.6:--@-A timelog contains data in the form of a single entry per line.-Each entry has the form:--  CODE YYYY/MM/DD HH:MM:SS [COMMENT]--CODE is one of: b, h, i, o or O.  COMMENT is optional when the code is-i, o or O.  The meanings of the codes are:--  b  Set the current time balance, or \"time debt\".  Useful when-     archiving old log data, when a debt must be carried forward.-     The COMMENT here is the number of seconds of debt.--  h  Set the required working time for the given day.  This must-     be the first entry for that day.  The COMMENT in this case is-     the number of hours in this workday.  Floating point amounts-     are allowed.--  i  Clock in.  The COMMENT in this case should be the name of the-     project worked on.--  o  Clock out.  COMMENT is unnecessary, but can be used to provide-     a description of how the period went, for example.--  O  Final clock out.  Whatever project was being worked on, it is-     now finished.  Useful for creating summary reports.-@--Example:--@-i 2007/03/10 12:26:00 hledger-o 2007/03/10 17:26:02-@---}--module Hledger.Read.Timelog (-       tests_Timelog,-       reader,-)-where-import Control.Monad.Error (ErrorT(..))-import Text.ParserCombinators.Parsec hiding (parse)-import Hledger.Data-import Hledger.Read.Common-import Hledger.Read.Journal (ledgerExclamationDirective, ledgerHistoricalPrice,-                             ledgerDefaultYear, emptyLine, ledgerdatetime)---reader :: Reader-reader = Reader format detect parse--format :: String-format = "timelog"---- | Does the given file path and data provide timeclock.el's timelog format ?-detect :: FilePath -> String -> Bool-detect f _ = fileSuffix f == format---- | Parse and post-process a "Journal" from timeclock.el's timelog--- format, saving the provided file path and the current time, or give an--- error.-parse :: FilePath -> String -> ErrorT String IO Journal-parse = parseJournalWith timelogFile--timelogFile :: GenParser Char JournalContext JournalUpdate-timelogFile = do items <- many timelogItem-                 eof-                 return $ liftM (foldr (.) id) $ sequence items-    where -      -- As all ledger line types can be distinguished by the first-      -- character, excepting transactions versus empty (blank or-      -- comment-only) lines, can use choice w/o try-      timelogItem = choice [ ledgerExclamationDirective-                          , liftM (return . addHistoricalPrice) ledgerHistoricalPrice-                          , ledgerDefaultYear-                          , emptyLine >> return (return id)-                          , liftM (return . addTimeLogEntry)  timelogentry-                          ] <?> "timelog entry, or default year or historical price directive"---- | Parse a timelog entry.-timelogentry :: GenParser Char JournalContext TimeLogEntry-timelogentry = do-  code <- oneOf "bhioO"-  many1 spacenonewline-  datetime <- ledgerdatetime-  comment <- optionMaybe (many1 spacenonewline >> liftM2 (++) getParentAccount restofline)-  return $ TimeLogEntry (read [code]) datetime (maybe "" rstrip comment)--tests_Timelog = TestList [- ]-

@@ -0,0 +1,101 @@+{-# LANGUAGE CPP #-}+{-|++A reader for the timelog file format generated by timeclock.el.++From timeclock.el 2.6:++@+A timelog contains data in the form of a single entry per line.+Each entry has the form:++  CODE YYYY/MM/DD HH:MM:SS [COMMENT]++CODE is one of: b, h, i, o or O.  COMMENT is optional when the code is+i, o or O.  The meanings of the codes are:++  b  Set the current time balance, or \"time debt\".  Useful when+     archiving old log data, when a debt must be carried forward.+     The COMMENT here is the number of seconds of debt.++  h  Set the required working time for the given day.  This must+     be the first entry for that day.  The COMMENT in this case is+     the number of hours in this workday.  Floating point amounts+     are allowed.++  i  Clock in.  The COMMENT in this case should be the name of the+     project worked on.++  o  Clock out.  COMMENT is unnecessary, but can be used to provide+     a description of how the period went, for example.++  O  Final clock out.  Whatever project was being worked on, it is+     now finished.  Useful for creating summary reports.+@++Example:++@+i 2007/03/10 12:26:00 hledger+o 2007/03/10 17:26:02+@++-}++module Hledger.Read.TimelogReader (+       tests_TimelogReader,+       reader,+)+where+import Control.Monad.Error (ErrorT(..))+import Text.ParserCombinators.Parsec hiding (parse)+import Hledger.Data+import Hledger.Read.Utils+import Hledger.Read.JournalReader (ledgerExclamationDirective, ledgerHistoricalPrice,+                                   ledgerDefaultYear, emptyLine, ledgerdatetime)+++reader :: Reader+reader = Reader format detect parse++format :: String+format = "timelog"++-- | Does the given file path and data provide timeclock.el's timelog format ?+detect :: FilePath -> String -> Bool+detect f _ = fileSuffix f == format++-- | Parse and post-process a "Journal" from timeclock.el's timelog+-- format, saving the provided file path and the current time, or give an+-- error.+parse :: FilePath -> String -> ErrorT String IO Journal+parse = parseJournalWith timelogFile++timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)+timelogFile = do items <- many timelogItem+                 eof+                 ctx <- getState+                 return (liftM (foldr (.) id) $ sequence items, ctx)+    where +      -- As all ledger line types can be distinguished by the first+      -- character, excepting transactions versus empty (blank or+      -- comment-only) lines, can use choice w/o try+      timelogItem = choice [ ledgerExclamationDirective+                          , liftM (return . addHistoricalPrice) ledgerHistoricalPrice+                          , ledgerDefaultYear+                          , emptyLine >> return (return id)+                          , liftM (return . addTimeLogEntry)  timelogentry+                          ] <?> "timelog entry, or default year or historical price directive"++-- | Parse a timelog entry.+timelogentry :: GenParser Char JournalContext TimeLogEntry+timelogentry = do+  code <- oneOf "bhioO"+  many1 spacenonewline+  datetime <- ledgerdatetime+  comment <- optionMaybe (many1 spacenonewline >> liftM2 (++) getParentAccount restofline)+  return $ TimeLogEntry (read [code]) datetime (maybe "" rstrip comment)++tests_TimelogReader = TestList [+ ]+

@@ -0,0 +1,73 @@+{-|+Utilities common to hledger journal readers.+-}++module Hledger.Read.Utils+where++import Control.Monad.Error+import System.Directory (getHomeDirectory)+import System.FilePath(takeDirectory,combine)+import System.Time (getClockTime)+import Text.ParserCombinators.Parsec++import Hledger.Data.Types (Journal, JournalContext(..), Commodity, JournalUpdate)+import Hledger.Data.Utils+import Hledger.Data.Journal (nullctx, nulljournal, journalFinalise)+++juSequence :: [JournalUpdate] -> JournalUpdate+juSequence us = liftM (foldr (.) id) $ sequence us++-- | Given a JournalUpdate-generating parsec parser, file path and data string,+-- parse and post-process a Journal so that it's ready to use, or give an error.+parseJournalWith :: (GenParser Char JournalContext (JournalUpdate,JournalContext)) -> FilePath -> String -> ErrorT String IO Journal+parseJournalWith p f s = do+  tc <- liftIO getClockTime+  tl <- liftIO getCurrentLocalTime+  case runParser p nullctx f s of+    Right (updates,ctx) -> do+                           j <- updates `ap` return nulljournal+                           case journalFinalise tc tl f s ctx j of+                             Right j'  -> return j'+                             Left estr -> throwError estr+    Left e -> throwError $ show e++setYear :: Integer -> GenParser tok JournalContext ()+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 }+          normalize = (++ ":") ++popParentAccount :: GenParser tok JournalContext ()+popParentAccount = do ctx0 <- getState+                      case ctxAccount ctx0 of+                        [] -> unexpected "End of account block with no beginning"+                        (_:rest) -> setState $ ctx0 { ctxAccount = rest }++getParentAccount :: GenParser tok JournalContext String+getParentAccount = liftM (concat . reverse . ctxAccount) getState++-- | Convert a possibly relative, possibly tilde-containing file path to an absolute one.+-- using the current directory from a parsec source position. ~username is not supported.+expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath+expandPath pos fp = liftM mkAbsolute (expandHome fp)+  where+    mkAbsolute = combine (takeDirectory (sourceName pos))+    expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory+                                                      return $ homedir ++ drop 1 inname+                      | otherwise                = return inname++fileSuffix :: FilePath -> String+fileSuffix = reverse . takeWhile (/='.') . reverse . dropWhile (/='.')

@@ -1,5 +1,5 @@ name:           hledger-lib-version: 0.12.1+version: 0.13 category:       Finance synopsis:       Core types and utilities for working with hledger (or c++ ledger) data. description:@@ -12,11 +12,11 @@ maintainer:     Simon Michael <simon@joyful.com> homepage:       http://hledger.org bug-reports:    http://code.google.com/p/hledger/issues-stability:      experimental+stability:      beta tested-with:    GHC==6.10 cabal-version:  >= 1.6 build-type:     Simple--- data-dir:       +-- data-dir:       data -- data-files: -- extra-tmp-files: -- extra-source-files:@@ -42,9 +42,9 @@                   Hledger.Data.Types                   Hledger.Data.Utils                   Hledger.Read-                  Hledger.Read.Common-                  Hledger.Read.Journal-                  Hledger.Read.Timelog+                  Hledger.Read.Utils+                  Hledger.Read.JournalReader+                  Hledger.Read.TimelogReader   Build-Depends:                   base >= 3 && < 5                  ,containers