packages feed

hledger-lib 1.0.1 → 1.1

raw patch · 37 files changed

+1614/−667 lines, 37 filesdep +hashtablesdep +parsersdep +system-filepathdep ~basedep ~megaparsecPVP ok

version bump matches the API change (PVP)

Dependencies added: hashtables, parsers, system-filepath, trifecta

Dependency ranges changed: base, megaparsec

API changes (from Hackage documentation)

- Hledger.Data.Types: [rDetector] :: Reader -> FilePath -> Text -> Bool
- Hledger.Read: readFormatNames :: [StorageFormat]
- Hledger.Utils.Debug: dbgIO :: (MonadIO m, Show a) => String -> a -> m ()
+ Hledger.Data.Amount: isNegativeAmount :: Amount -> Bool
+ Hledger.Data.Amount: isReallyZeroAmount :: Amount -> Bool
+ Hledger.Data.Amount: isZeroAmount :: Amount -> Bool
+ Hledger.Data.Dates: periodContainsDate :: Period -> Day -> Bool
+ Hledger.Data.Period: isStandardPeriod :: Period -> Bool
+ Hledger.Data.Period: periodMoveTo :: Day -> Period -> Period
+ Hledger.Data.Posting: isAssignment :: Posting -> Bool
+ Hledger.Data.Posting: removePrices :: Posting -> Posting
+ Hledger.Data.Transaction: assignmentPostings :: Transaction -> [Posting]
+ Hledger.Data.Transaction: balanceTransactionUpdate :: MonadError String m => (AccountName -> MixedAmount -> m ()) -> Maybe (Map CommoditySymbol AmountStyle) -> Transaction -> m Transaction
+ Hledger.Data.Types: [rExperimental] :: Reader -> Bool
+ Hledger.Data.Types: [rExtensions] :: Reader -> [String]
+ Hledger.Read: splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath)
+ Hledger.Read: type PrefixedFilePath = FilePath
+ Hledger.Read.LedgerReader: reader :: Reader
+ Hledger.Read.LedgerReader: tests_Hledger_Read_LedgerReader :: Test
+ Hledger.Reports.ReportOptions: reportEndDate :: Journal -> ReportOpts -> IO (Maybe Day)
+ Hledger.Reports.ReportOptions: reportStartDate :: Journal -> ReportOpts -> IO (Maybe Day)
+ Hledger.Reports.ReportOptions: reportStartEndDates :: Journal -> ReportOpts -> IO (Maybe (Day, Day))
+ Hledger.Utils.Debug: dbg0IO :: (MonadIO m, Show a) => String -> a -> m ()
- Hledger.Data.Journal: journalBalanceTransactions :: Journal -> Either String Journal
+ Hledger.Data.Journal: journalBalanceTransactions :: Bool -> Journal -> Either String Journal
- Hledger.Data.Types: Posting :: Maybe Day -> Maybe Day -> ClearedStatus -> AccountName -> MixedAmount -> Text -> PostingType -> [Tag] -> Maybe MixedAmount -> Maybe Transaction -> Posting
+ Hledger.Data.Types: Posting :: Maybe Day -> Maybe Day -> ClearedStatus -> AccountName -> MixedAmount -> Text -> PostingType -> [Tag] -> Maybe Amount -> Maybe Transaction -> Posting
- Hledger.Data.Types: Reader :: StorageFormat -> (FilePath -> Text -> Bool) -> (Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal) -> Reader
+ Hledger.Data.Types: Reader :: StorageFormat -> [String] -> (Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal) -> Bool -> Reader
- Hledger.Data.Types: [pbalanceassertion] :: Posting -> Maybe MixedAmount
+ Hledger.Data.Types: [pbalanceassertion] :: Posting -> Maybe Amount
- Hledger.Read: postingp :: Maybe Day -> ErroringJournalParser Posting
+ Hledger.Read: postingp :: MonadIO m => Maybe Day -> ErroringJournalParser m Posting
- Hledger.Read: readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> FilePath -> IO (Either String Journal)
+ Hledger.Read: readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> PrefixedFilePath -> IO (Either String Journal)
- Hledger.Read: readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [FilePath] -> IO (Either String Journal)
+ Hledger.Read: readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [PrefixedFilePath] -> IO (Either String Journal)
- Hledger.Read.Common: bracketeddatetagsp :: Maybe Day -> ErroringJournalParser [(TagName, Day)]
+ Hledger.Read.Common: bracketeddatetagsp :: Monad m => Maybe Day -> ErroringJournalParser m [(TagName, Day)]
- Hledger.Read.Common: commentStartingWithp :: [Char] -> ErroringJournalParser Text
+ Hledger.Read.Common: commentStartingWithp :: [Char] -> JournalStateParser m Text
- Hledger.Read.Common: commentp :: ErroringJournalParser Text
+ Hledger.Read.Common: commentp :: JournalStateParser m Text
- Hledger.Read.Common: datetagp :: Maybe Day -> ErroringJournalParser (TagName, Day)
+ Hledger.Read.Common: datetagp :: Monad m => Maybe Day -> ErroringJournalParser m (TagName, Day)
- Hledger.Read.Common: datetimep :: ErroringJournalParser LocalTime
+ Hledger.Read.Common: datetimep :: JournalStateParser m LocalTime
- Hledger.Read.Common: descriptionp :: ErroringJournalParser String
+ Hledger.Read.Common: descriptionp :: JournalStateParser m String
- Hledger.Read.Common: emptyorcommentlinep :: ErroringJournalParser ()
+ Hledger.Read.Common: emptyorcommentlinep :: JournalStateParser m ()
- Hledger.Read.Common: fixedlotpricep :: ErroringJournalParser (Maybe Amount)
+ Hledger.Read.Common: fixedlotpricep :: Monad m => JournalStateParser m (Maybe Amount)
- Hledger.Read.Common: followingcommentandtagsp :: Maybe Day -> ErroringJournalParser (Text, [Tag], Maybe Day, Maybe Day)
+ Hledger.Read.Common: followingcommentandtagsp :: MonadIO m => Maybe Day -> ErroringJournalParser m (Text, [Tag], Maybe Day, Maybe Day)
- Hledger.Read.Common: followingcommentp :: ErroringJournalParser Text
+ Hledger.Read.Common: followingcommentp :: JournalStateParser m Text
- Hledger.Read.Common: getParentAccount :: ErroringJournalParser AccountName
+ Hledger.Read.Common: getParentAccount :: JournalStateParser m AccountName
- Hledger.Read.Common: modifiedaccountnamep :: ErroringJournalParser AccountName
+ Hledger.Read.Common: modifiedaccountnamep :: JournalStateParser m AccountName
- Hledger.Read.Common: multilinecommentp :: ErroringJournalParser ()
+ Hledger.Read.Common: multilinecommentp :: JournalStateParser m ()
- Hledger.Read.Common: parseAndFinaliseJournal :: ErroringJournalParser ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal
+ Hledger.Read.Common: parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal
- Hledger.Read.Common: parserErrorAt :: SourcePos -> String -> ErroringJournalParser a
+ Hledger.Read.Common: parserErrorAt :: Monad m => SourcePos -> String -> ErroringJournalParser m a
- Hledger.Read.Common: partialbalanceassertionp :: ErroringJournalParser (Maybe MixedAmount)
+ Hledger.Read.Common: partialbalanceassertionp :: Monad m => JournalStateParser m (Maybe Amount)
- Hledger.Read.Common: popParentAccount :: ErroringJournalParser ()
+ Hledger.Read.Common: popParentAccount :: JournalStateParser m ()
- Hledger.Read.Common: postingdatesp :: Maybe Day -> ErroringJournalParser [(TagName, Day)]
+ Hledger.Read.Common: postingdatesp :: Monad m => Maybe Day -> ErroringJournalParser m [(TagName, Day)]
- Hledger.Read.Common: pushAccount :: AccountName -> ErroringJournalParser ()
+ Hledger.Read.Common: pushAccount :: AccountName -> JournalStateParser m ()
- Hledger.Read.Common: pushParentAccount :: AccountName -> ErroringJournalParser ()
+ Hledger.Read.Common: pushParentAccount :: AccountName -> JournalStateParser m ()
- Hledger.Read.Common: rejp :: ErroringJournalParser a -> Text -> IO (Either String a)
+ Hledger.Read.Common: rejp :: Monad m => ErroringJournalParser m a -> Text -> m (Either String a)
- Hledger.Read.Common: runErroringJournalParser :: ErroringJournalParser a -> Text -> IO (Either String a)
+ Hledger.Read.Common: runErroringJournalParser :: Monad m => ErroringJournalParser m a -> Text -> m (Either String a)
- Hledger.Read.Common: secondarydatep :: Day -> ErroringJournalParser Day
+ Hledger.Read.Common: secondarydatep :: Day -> JournalStateParser m Day
- Hledger.Read.Common: semicoloncommentp :: ErroringJournalParser Text
+ Hledger.Read.Common: semicoloncommentp :: JournalStateParser m Text
- Hledger.Read.Common: setDefaultCommodityAndStyle :: (CommoditySymbol, AmountStyle) -> ErroringJournalParser ()
+ Hledger.Read.Common: setDefaultCommodityAndStyle :: (CommoditySymbol, AmountStyle) -> JournalStateParser m ()
- Hledger.Read.Common: spaceandamountormissingp :: ErroringJournalParser MixedAmount
+ Hledger.Read.Common: spaceandamountormissingp :: Monad m => JournalStateParser m MixedAmount
- Hledger.Read.JournalReader: datetimep :: ErroringJournalParser LocalTime
+ Hledger.Read.JournalReader: datetimep :: JournalStateParser m LocalTime
- Hledger.Read.JournalReader: defaultyeardirectivep :: ErroringJournalParser ()
+ Hledger.Read.JournalReader: defaultyeardirectivep :: JournalStateParser m ()
- Hledger.Read.JournalReader: directivep :: ErroringJournalParser ()
+ Hledger.Read.JournalReader: directivep :: MonadIO m => ErroringJournalParser m ()
- Hledger.Read.JournalReader: emptyorcommentlinep :: ErroringJournalParser ()
+ Hledger.Read.JournalReader: emptyorcommentlinep :: JournalStateParser m ()
- Hledger.Read.JournalReader: followingcommentp :: ErroringJournalParser Text
+ Hledger.Read.JournalReader: followingcommentp :: JournalStateParser m Text
- Hledger.Read.JournalReader: getParentAccount :: ErroringJournalParser AccountName
+ Hledger.Read.JournalReader: getParentAccount :: JournalStateParser m AccountName
- Hledger.Read.JournalReader: journalp :: ErroringJournalParser ParsedJournal
+ Hledger.Read.JournalReader: journalp :: MonadIO m => ErroringJournalParser m ParsedJournal
- Hledger.Read.JournalReader: marketpricedirectivep :: ErroringJournalParser MarketPrice
+ Hledger.Read.JournalReader: marketpricedirectivep :: Monad m => JournalStateParser m MarketPrice
- Hledger.Read.JournalReader: modifiedaccountnamep :: ErroringJournalParser AccountName
+ Hledger.Read.JournalReader: modifiedaccountnamep :: JournalStateParser m AccountName
- Hledger.Read.JournalReader: parseAndFinaliseJournal :: ErroringJournalParser ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal
+ Hledger.Read.JournalReader: parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal
- Hledger.Read.JournalReader: postingp :: Maybe Day -> ErroringJournalParser Posting
+ Hledger.Read.JournalReader: postingp :: MonadIO m => Maybe Day -> ErroringJournalParser m Posting
- Hledger.Read.JournalReader: rejp :: ErroringJournalParser a -> Text -> IO (Either String a)
+ Hledger.Read.JournalReader: rejp :: Monad m => ErroringJournalParser m a -> Text -> m (Either String a)
- Hledger.Read.JournalReader: runErroringJournalParser :: ErroringJournalParser a -> Text -> IO (Either String a)
+ Hledger.Read.JournalReader: runErroringJournalParser :: Monad m => ErroringJournalParser m a -> Text -> m (Either String a)
- Hledger.Read.TimeclockReader: timeclockfilep :: ErroringJournalParser ParsedJournal
+ Hledger.Read.TimeclockReader: timeclockfilep :: ErroringJournalParser IO ParsedJournal
- Hledger.Read.TimedotReader: timedotfilep :: ErroringJournalParser ParsedJournal
+ Hledger.Read.TimedotReader: timedotfilep :: JournalStateParser m ParsedJournal
- Hledger.Utils.Parse: type ErroringJournalParser a = StateT Journal (ParsecT Dec Text (ExceptT String IO)) a
+ Hledger.Utils.Parse: type ErroringJournalParser m a = StateT Journal (ParsecT Dec Text (ExceptT String m)) a

Files

CHANGES view
@@ -2,6 +2,45 @@ See also the hledger and project change logs (for user-visible changes).  +# 1.1 (2016/12/31)++## journal format++-   balance assignments are now supported (#438, #129, #157, #288)++    This feature also brings a slight performance drop (~5%);+    optimisations welcome.++-   also recognise `*.hledger` files as hledger journal format++## ledger format++-   use ledger-parse from the ledger4 project as an alternate reader for C++ Ledger journals+    +    The idea is that some day we might get better compatibility with Ledger files this way.+    Right now this reader is not very useful and will be used only if you explicitly select it with a `ledger:` prefix.+    It parses transaction dates, descriptions, accounts and amounts, and ignores everything else.+    Amount parsing is delegated to hledger's journal parser, and malformed amounts might be silently ignored.++    This adds at least some of the following as new dependencies for hledger-lib:+    parsers, parsec, attoparsec, trifecta.++## misc++-   update base lower bound to enforce GHC 7.10++    +    hledger-lib had a valid install plan with GHC 7.8, but currently requires GHC 7.10 to compile.+    Now we require base 4.8+ everywhere to ensure the right GHC version at the start.+    +-   Hledger.Read api cleanups++-   rename dbgIO to dbg0IO, consistent with dbg0, and document a bug in dbg*IO++-   make readJournalFiles [f] equivalent to readJournalFile f (#437)++-   more general parser types enabling reuse outside of IO (#439)++ # 1.0.1 (2016/10/27)  - allow megaparsec 5.0 or 5.1@@ -79,7 +118,7 @@  -   file parsers have been ported from Parsec to Megaparsec \o/ (#289, #366) (Alexey Shmalko, Moritz Kiefer) --   most hledger types have been converted from String to Text, reducing memory usage by 30%+ on large files and giving a slight speed increase+-   most hledger types have been converted from String to Text, reducing memory usage by 30%+ on large files  -   file parsers have been simplified for easier troubleshooting (#275). 
Hledger/Data/Amount.hs view
@@ -82,7 +82,10 @@   costOfMixedAmount,   divideMixedAmount,   averageMixedAmounts,+  isNegativeAmount,   isNegativeMixedAmount,+  isZeroAmount,+  isReallyZeroAmount,   isZeroMixedAmount,   isReallyZeroMixedAmount,   isReallyZeroMixedAmountCost,
Hledger/Data/Dates.hs view
@@ -34,6 +34,7 @@   getCurrentYear,   nulldate,   spanContainsDate,+  periodContainsDate,   parsedateM,   parsedate,   showDate,@@ -212,6 +213,11 @@ spanContainsDate (DateSpan (Just b) Nothing)  d = d >= b spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e +-- | Does the period include the given date ?+-- (Here to avoid import cycle).+periodContainsDate :: Period -> Day -> Bool+periodContainsDate p = spanContainsDate (periodAsDateSpan p)+ -- | Calculate the intersection of a number of datespans. spansIntersect [] = nulldatespan spansIntersect [d] = d@@ -324,6 +330,7 @@ -- | Convert a SmartDate to an absolute date using the provided reference date. -- -- ==== Examples:+-- >>> :set -XOverloadedStrings -- >>> let t = fixSmartDateStr (parsedate "2008/11/26") -- >>> t "0000-01-01" -- "0000/01/01"
Hledger/Data/Journal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Rank2Types #-} {-# LANGUAGE StandaloneDeriving, OverloadedStrings #-} {-| @@ -61,7 +62,13 @@   tests_Hledger_Data_Journal, ) where+import Control.Arrow import Control.Monad+import Control.Monad.Except+import qualified Control.Monad.Reader as R+import Control.Monad.ST+import Data.Array.ST+import qualified Data.HashTable.ST.Cuckoo as HT import Data.List -- import Data.Map (findWithDefault) import Data.Maybe@@ -463,8 +470,8 @@ -- check balance assertions. journalFinalise :: ClockTime -> FilePath -> Text -> Bool -> ParsedJournal -> Either String Journal journalFinalise t path txt assrt j@Journal{jfiles=fs} = do-  (journalNumberAndTieTransactions <$>-    (journalBalanceTransactions $+  (journalTieTransactions <$>+    (journalBalanceTransactions assrt $     journalApplyCommodityStyles $     j{ jfiles        = (path,txt) : reverse fs      , jlastreadtime = t@@ -473,7 +480,6 @@      , jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction      , jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice      }))-  >>= if assrt then journalCheckBalanceAssertions else return  journalNumberAndTieTransactions = journalTieTransactions . journalNumberTransactions @@ -494,95 +500,209 @@ -- | Check any balance assertions in the journal and return an error -- message if any of them fail. journalCheckBalanceAssertions :: Journal -> Either String Journal-journalCheckBalanceAssertions j = do-  let postingsByAccount = groupBy (\p1 p2 -> paccount p1 == paccount p2) $-                          sortBy (comparing paccount) $-                          journalPostings j-  forM_ postingsByAccount checkBalanceAssertionsForAccount-  Right j+journalCheckBalanceAssertions j =+  runST $ journalBalanceTransactionsST True j+  (return ()) (\_ _ -> return ()) (const $ return j) -- noops --- Check any balance assertions in this sequence of postings to a single account.-checkBalanceAssertionsForAccount :: [Posting] -> Either String ()-checkBalanceAssertionsForAccount ps-  | null errs = Right ()-  | otherwise = Left $ head errs-  where-    errs = fst $-           foldl' checkBalanceAssertion ([],nullmixedamt) $-           splitAssertions $-           sortBy (comparing postingDate) ps --- Given a starting balance, accumulated errors, and a non-null sequence of--- postings to a single account with a balance assertion in the last:--- check that the final balance matches the balance assertion.--- If it does, return the new balance, otherwise add an error to the--- error list. Intended to be called from a fold.-checkBalanceAssertion :: ([String],MixedAmount) -> [Posting] -> ([String],MixedAmount)-checkBalanceAssertion (errs,startbal) ps-  | null ps = (errs,startbal)-  | isNothing $ pbalanceassertion p = (errs,startbal)-  | iswrong = (errs++[err], finalfullbal)-  | otherwise = (errs,finalfullbal)-  where-    p = last ps-    Just assertedbal = pbalanceassertion p-    assertedcomm = maybe "" acommodity $ headMay $ amounts assertedbal-    finalfullbal = sum $ [startbal] ++ map pamount (dbg2 "ps" ps)-    finalsinglebal = filterMixedAmount (\a -> acommodity a == assertedcomm) finalfullbal-    actualbal = finalsinglebal -- just check the single-commodity balance, like Ledger; maybe add ==FULLBAL later-    iswrong = dbg2 debugmsg $-      not (isReallyZeroMixedAmount (actualbal - assertedbal))-      -- bal' /= assertedbal  -- MixedAmount's Eq instance currently gets confused by different precisions-      where-        debugmsg = "assertions: on " ++ show (postingDate p) ++ " balance of " ++ show assertedcomm-                    ++ " in " ++ T.unpack (paccount p) ++ " should be " ++ show assertedbal-    diff = assertedbal - actualbal-    diffplus | isNegativeMixedAmount diff == Just False = "+"-             | otherwise = ""-    err = printf (unlines [-                      "balance assertion error%s",-                      "after posting:",-                      "%s",-                      "balance assertion details:",-                      "date:       %s",-                      "account:    %s",-                      "commodity:  %s",-                      "calculated: %s",-                      "asserted:   %s (difference: %s)"-                      ])-                 (case ptransaction p of-                    Nothing -> ":" -- shouldn't happen-                    Just t ->  printf " in \"%s\" (line %d, column %d):\nin transaction:\n%s" f l c (chomp $ show t) :: String-                      where GenericSourcePos f l c = tsourcepos t)-                 (showPostingLine p)-                 (showDate $ postingDate p)-                 (T.unpack $ paccount p) -- XXX pack-                 assertedcomm-                 (showMixedAmount finalsinglebal)-                 (showMixedAmount assertedbal)-                 (diffplus ++ showMixedAmount diff)+-- | Check a posting's balance assertion and return an error if it+-- fails.+checkBalanceAssertion :: Posting -> MixedAmount -> Either String ()+checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass} amt+  | isReallyZeroAmount diff = Right ()+  | True    = Left err+    where assertedcomm = acommodity ass+          actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts amt)+          diff = ass - actualbal+          diffplus | isNegativeAmount diff == False = "+"+                   | otherwise = ""+          err = printf (unlines+                        [ "balance assertion error%s",+                          "after posting:",+                          "%s",+                          "balance assertion details:",+                          "date:       %s",+                          "account:    %s",+                          "commodity:  %s",+                          "calculated: %s",+                          "asserted:   %s (difference: %s)"+                        ])+            (case ptransaction p of+               Nothing -> ":" -- shouldn't happen+               Just t ->  printf " in \"%s\" (line %d, column %d):\nin transaction:\n%s"+                          f l c (chomp $ show t) :: String+                 where GenericSourcePos f l c = tsourcepos t)+            (showPostingLine p)+            (showDate $ postingDate p)+            (T.unpack $ paccount p) -- XXX pack+            assertedcomm+            (showAmount actualbal)+            (showAmount ass)+            (diffplus ++ showAmount diff)+checkBalanceAssertion _ _ = Right () --- Given a sequence of postings to a single account, split it into--- sub-sequences consisting of ordinary postings followed by a single--- balance-asserting posting. Postings not followed by a balance--- assertion are discarded.-splitAssertions :: [Posting] -> [[Posting]]-splitAssertions ps-  | null rest = []-  | otherwise = (ps'++[head rest]):splitAssertions (tail rest)-  where-    (ps',rest) = break (isJust . pbalanceassertion) ps+-- | Environment for 'CurrentBalancesModifier'+data Env s = Env { eBalances :: HT.HashTable s AccountName MixedAmount+                 , eStoreTx :: Transaction -> ST s ()+                 , eAssrt :: Bool+                 , eStyles :: Maybe (M.Map CommoditySymbol AmountStyle) } +-- | Monad transformer stack with a reference to a mutable hashtable+-- of current account balances and a mutable array of finished+-- transactions in original parsing order.+type CurrentBalancesModifier s = R.ReaderT (Env s) (ExceptT String (ST s))+ -- | 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 applying canonical commodity styles, since balancing -- depends on display precision. Reports only the first error encountered.-journalBalanceTransactions :: Journal -> Either String Journal-journalBalanceTransactions j@Journal{jtxns=ts, jinferredcommodities=ss} =-  case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'}-                                    Left e    -> Left e-      where balance = balanceTransaction (Just ss)+journalBalanceTransactions :: Bool -> Journal -> Either String Journal+journalBalanceTransactions assrt j =+  runST $ journalBalanceTransactionsST assrt (journalNumberTransactions j)+  (newArray_ (1, genericLength $ jtxns j)+   :: forall s. ST s (STArray s Integer Transaction))+  (\arr tx -> writeArray arr (tindex tx) tx)+  $ fmap (\txns -> j{ jtxns = txns}) . getElems ++-- | Generalization used in the definition of+-- 'journalBalanceTransactionsST and 'journalCheckBalanceAssertions'+journalBalanceTransactionsST ::+  Bool+  -> Journal+  -> ST s txns+  -- ^ creates transaction store+  -> (txns -> Transaction -> ST s ())+  -- ^ "store" operation+  -> (txns -> ST s a)+  -- ^ calculate result from transactions+  -> ST s (Either String a)+journalBalanceTransactionsST assrt j createStore storeIn extract =+  runExceptT $ do+    bals <- lift $ HT.newSized size+    txStore <- lift $ createStore+    flip R.runReaderT (Env bals (storeIn txStore) assrt $+                       Just $ jinferredcommodities j) $ do+      dated <- fmap snd . sortBy (comparing fst) . concat+             <$> mapM discriminateByDate (jtxns j)+      mapM checkInferAndRegisterAmounts dated+    lift $ extract txStore+  where size = genericLength $ journalPostings j++-- | This converts a transaction into a list of objects whose dates+-- have to be considered when checking balance assertions and handled+-- by 'checkInferAndRegisterAmounts'.+--+-- Transaction without balance assignments can be balanced and stored+-- immediately and their (possibly) dated postings are returned.+--+-- Transaction with balance assignments are only supported if no+-- posting has a 'pdate' value. Supported transactions will be+-- returned unchanged and balanced and stored later in 'checkInferAndRegisterAmounts'.+discriminateByDate :: Transaction+  -> CurrentBalancesModifier s [(Day, Either Posting Transaction)]+discriminateByDate tx+  | null (assignmentPostings tx) = do+      styles <- R.reader $ eStyles+      balanced <- lift $ ExceptT $ return+        $ balanceTransaction styles tx+      storeTransaction balanced+      return $ fmap (postingDate &&& (Left . removePrices))+        $ tpostings $ balanced+  | True                         = do+      when (any (isJust . pdate) $ tpostings tx) $+        throwError $ unlines $+        ["Not supported: Transactions with balance assignments "+        ,"AND dated postings without amount:\n"+        , showTransaction tx]+      return [(tdate tx, Right+                $ tx { tpostings = removePrices <$> tpostings tx })]++-- | This function takes different objects describing changes to+-- account balances on a single day. It can handle either a single+-- posting (from an already balanced transaction without assigments)+-- or a whole transaction with assignments (which is required to no+-- posting with pdate set.).+--+-- For a single posting, there is not much to do. Only add its amount+-- to its account and check the assertion, if there is one. This+-- functionality is provided by 'addAmountAndCheckBalance'.+--+-- For a whole transaction, it loops over all postings, and performs+-- 'addAmountAndCheckBalance', if there is an amount. If there is no+-- amount, the amount is inferred by the assertion or left empty if+-- there is no assertion. Then, the transaction is balanced, the+-- inferred amount added to the balance (all in+-- 'balanceTransactionUpdate') and the resulting transaction with no+-- missing amounts is stored in the array, for later retrieval.+--+-- Again in short:+--+-- 'Left Posting': Check the balance assertion and update the+--  account balance. If the amount is empty do nothing.  this can be+--  the case e.g. for virtual postings+--+-- 'Right Transaction': Loop over all postings, infer their amounts+-- and then balance and store the transaction.+checkInferAndRegisterAmounts :: Either Posting Transaction+                             -> CurrentBalancesModifier s ()+checkInferAndRegisterAmounts (Left p) =+  void $ addAmountAndCheckBalance return p+checkInferAndRegisterAmounts (Right oldTx) = do+  let ps = tpostings oldTx+  styles <- R.reader $ eStyles+  newPostings <- forM ps $ addAmountAndCheckBalance inferFromAssignment+  storeTransaction =<< balanceTransactionUpdate+    (fmap void . addToBalance) styles oldTx { tpostings = newPostings }+  where+    inferFromAssignment :: Posting -> CurrentBalancesModifier s Posting+    inferFromAssignment p = maybe (return p)+      (fmap (\a -> p { pamount = a }) . setBalance (paccount p))+      $ pbalanceassertion p++-- | Adds a posting's amonut to the posting's account balance and+-- checks a possible balance assertion. If there is no amount, it runs+-- the supplied fallback action.+addAmountAndCheckBalance :: (Posting -> CurrentBalancesModifier s Posting)+            -- ^ action to execute, if posting has no amount+            -> Posting+            -> CurrentBalancesModifier s Posting+addAmountAndCheckBalance _ p | hasAmount p = do+  newAmt <- addToBalance (paccount p) $ pamount p+  assrt <- R.reader eAssrt+  lift $ when assrt $ ExceptT $ return+    $ checkBalanceAssertion p newAmt+  return p+addAmountAndCheckBalance fallback p = fallback p++-- | Sets an account's balance to a given amount and returns the+-- difference of new and old amount+setBalance :: AccountName -> Amount -> CurrentBalancesModifier s MixedAmount+setBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do+  old <- HT.lookup bals acc+  let new = Mixed $ (amt :) $ maybe []+        (filter ((/= acommodity amt) . acommodity) . amounts) old+  HT.insert bals acc new+  return $ maybe new (new -) old++-- | Adds an amount to an account's balance and returns the resulting+-- balance+addToBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount+addToBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do+  new <- maybe amt (+ amt) <$> HT.lookup bals acc+  HT.insert bals acc new+  return new++-- | Stores a transaction in the transaction array in original parsing+-- order.+storeTransaction :: Transaction -> CurrentBalancesModifier s ()+storeTransaction tx = liftModifier $ ($tx) . eStoreTx++-- | Helper function+liftModifier :: (Env s -> ST s a) -> CurrentBalancesModifier s a+liftModifier f = R.ask >>= lift . lift . f++ -- | Choose and apply a consistent display format to the posting -- amounts in each commodity. Each commodity's format is specified by -- a commodity format directive, or otherwise inferred from posting@@ -792,7 +912,7 @@ --     liabilities:debts  $1 --     assets:bank:checking ---Right samplejournal = journalBalanceTransactions $+Right samplejournal = journalBalanceTransactions False $          nulljournal          {jtxns = [            txnTieKnot $ Transaction {
Hledger/Data/Period.hs view
@@ -118,6 +118,17 @@     12 -> d==31     _ -> False +-- | Is this period a "standard" period, referencing a particular day, week, month, quarter, or year ?+-- Periods of other durations, or infinite duration, or not starting on a standard period boundary, are not.+isStandardPeriod = isStandardPeriod' . simplifyPeriod+  where+    isStandardPeriod' (DayPeriod _) = True+    isStandardPeriod' (WeekPeriod _) = True+    isStandardPeriod' (MonthPeriod _ _) = True+    isStandardPeriod' (QuarterPeriod _ _) = True+    isStandardPeriod' (YearPeriod _) = True+    isStandardPeriod' _ = False+ -- | Render a period as a compact display string suitable for user output. -- -- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25))@@ -143,7 +154,8 @@   where     DateSpan _ me = periodAsDateSpan p --- | Move a period to the following period of same duration.+-- | Move a standard period to the following period of same duration.+-- Non-standard periods are unaffected. periodNext :: Period -> Period periodNext (DayPeriod b) = DayPeriod (addDays 1 b) periodNext (WeekPeriod b) = WeekPeriod (addDays 7 b)@@ -154,7 +166,8 @@ periodNext (YearPeriod y) = YearPeriod (y+1) periodNext p = p --- | Move a period to the preceding period of same duration.+-- | Move a standard period to the preceding period of same duration.+-- Non-standard periods are unaffected. periodPrevious :: Period -> Period periodPrevious (DayPeriod b) = DayPeriod (addDays (-1) b) periodPrevious (WeekPeriod b) = WeekPeriod (addDays (-7) b)@@ -165,7 +178,8 @@ periodPrevious (YearPeriod y) = YearPeriod (y-1) periodPrevious p = p --- | Move a period to the following period of same duration, staying within enclosing dates.+-- | Move a standard period to the following period of same duration, staying within enclosing dates.+-- Non-standard periods are unaffected. periodNextIn :: DateSpan -> Period -> Period periodNextIn (DateSpan _ (Just e)) p =   case mb of@@ -176,7 +190,8 @@     mb = periodStart p' periodNextIn _ p = periodNext p --- | Move a period to the preceding period of same duration, staying within enclosing dates.+-- | Move a standard period to the preceding period of same duration, staying within enclosing dates.+-- Non-standard periods are unaffected. periodPreviousIn :: DateSpan -> Period -> Period periodPreviousIn (DateSpan (Just b) _) p =   case me of@@ -187,11 +202,24 @@     me = periodEnd p' periodPreviousIn _ p = periodPrevious p +-- | Move a standard period stepwise so that it encloses the given date.+-- Non-standard periods are unaffected.+periodMoveTo :: Day -> Period -> Period+periodMoveTo d (DayPeriod _) = DayPeriod d+periodMoveTo d (WeekPeriod _) = WeekPeriod $ mondayBefore d+periodMoveTo d (MonthPeriod _ _) = MonthPeriod y m where (y,m,_) = toGregorian d+periodMoveTo d (QuarterPeriod _ _) = QuarterPeriod y q+  where+    (y,m,_) = toGregorian d+    q = quarterContainingMonth m+periodMoveTo d (YearPeriod _) = YearPeriod y where (y,_,_) = toGregorian d+periodMoveTo _ p = p+ -- | Enlarge a standard period to the next larger enclosing standard period, if there is one. -- Eg, a day becomes the enclosing week. -- A week becomes whichever month the week's thursday falls into. -- A year becomes all (unlimited).--- Growing an unlimited period, or a non-standard period (arbitrary dates) has no effect.+-- Non-standard periods (arbitrary dates, or open-ended) are unaffected. periodGrow :: Period -> Period periodGrow (DayPeriod b) = WeekPeriod $ mondayBefore b periodGrow (WeekPeriod b) = MonthPeriod y m
Hledger/Data/Posting.hs view
@@ -20,10 +20,12 @@   isVirtual,   isBalancedVirtual,   isEmptyPosting,+  isAssignment,   hasAmount,   postingAllTags,   transactionAllTags,   relatedPostings,+  removePrices,   -- * date operations   postingDate,   postingDate2,@@ -117,11 +119,19 @@ hasAmount :: Posting -> Bool hasAmount = (/= missingmixedamt) . pamount +isAssignment :: Posting -> Bool+isAssignment p = not (hasAmount p) && isJust (pbalanceassertion p)+ accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nub . map paccount  sumPostings :: [Posting] -> MixedAmount sumPostings = sum . map pamount++-- | Remove all prices of a posting+removePrices :: Posting -> Posting+removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) }+  where remove a = a { aprice = NoPrice }  -- | Get a posting's (primary) date - it's own primary date if specified, -- otherwise the parent transaction's primary date, or the null date if
Hledger/Data/Transaction.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-|  A 'Transaction' represents a movement of some commodity(ies) between two@@ -19,6 +20,7 @@   showAccountName,   hasRealPostings,   realPostings,+  assignmentPostings,   virtualPostings,   balancedVirtualPostings,   transactionsPostings,@@ -29,6 +31,7 @@   -- * arithmetic   transactionPostingBalances,   balanceTransaction,+  balanceTransactionUpdate,   -- * rendering   showTransaction,   showTransactionUnelided,@@ -39,6 +42,8 @@ ) where import Data.List+import Control.Monad.Except+import Control.Monad.Identity import Data.Maybe import Data.Text (Text) import qualified Data.Text as T@@ -185,8 +190,8 @@     postinglines     ++ newlinecomments   where-    postinglines = map rstrip $ lines $ concatTopPadded [account, "  ", amount, samelinecomment]-+    postinglines = map rstrip $ lines $ concatTopPadded [account, "  ", amount, assertion, samelinecomment]+    assertion = maybe "" ((" = " ++) . showAmount) $ pbalanceassertion p     account =       indent $         showstatus p ++ fitString (Just acctwidth) Nothing False True (showAccountName Nothing (ptype p) (paccount p))@@ -260,6 +265,9 @@ realPostings :: Transaction -> [Posting] realPostings = filter isReal . tpostings +assignmentPostings :: Transaction -> [Posting]+assignmentPostings = filter isAssignment . tpostings+ virtualPostings :: Transaction -> [Posting] virtualPostings = filter isVirtual . tpostings @@ -292,26 +300,42 @@ -- amount or conversion price(s), or return an error message. -- Balancing is affected by commodity display precisions, so those can -- (optionally) be provided.-balanceTransaction :: Maybe (Map.Map CommoditySymbol AmountStyle) -> Transaction -> Either String Transaction-balanceTransaction styles t =-  case inferBalancingAmount t of-    Left err -> Left err-    Right t' -> let t'' = inferBalancingPrices t'-                in if isTransactionBalanced styles t''-                   then Right $ txnTieKnot t''-                   else Left $ printerr $ nonzerobalanceerror t''-     where-      printerr s = intercalate "\n" [s, showTransactionUnelided t]-      nonzerobalanceerror :: Transaction -> String-      nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg-          where-            (rsum, _, bvsum) = transactionPostingBalances t-            rmsg | isReallyZeroMixedAmountCost rsum = ""-                 | otherwise = "real postings are off by " ++ showMixedAmount (costOfMixedAmount rsum)-            bvmsg | isReallyZeroMixedAmountCost bvsum = ""-                  | otherwise = "balanced virtual postings are off by " ++ showMixedAmount (costOfMixedAmount bvsum)-            sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String+-- +-- this fails for example, if there are several missing amounts+-- (possibly with balance assignments)+balanceTransaction :: Maybe (Map.Map CommoditySymbol AmountStyle)+                   -> Transaction -> Either String Transaction+balanceTransaction stylemap = runIdentity . runExceptT+  . balanceTransactionUpdate (\_ _ -> return ()) stylemap ++-- | More general version of 'balanceTransaction' that takes an update+-- function+balanceTransactionUpdate :: MonadError String m+  => (AccountName -> MixedAmount -> m ())+     -- ^ update function+  -> Maybe (Map.Map CommoditySymbol AmountStyle)+  -> Transaction -> m Transaction+balanceTransactionUpdate update styles t =+  finalize =<< inferBalancingAmount update t+  where+    finalize t' = let t'' = inferBalancingPrices t'+                  in if isTransactionBalanced styles t''+                     then return $ txnTieKnot t''+                     else throwError $ printerr $ nonzerobalanceerror t''+    printerr s = intercalate "\n" [s, showTransactionUnelided t]+    nonzerobalanceerror :: Transaction -> String+    nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg+        where+          (rsum, _, bvsum) = transactionPostingBalances t+          rmsg | isReallyZeroMixedAmountCost rsum = ""+               | otherwise = "real postings are off by "+                 ++ showMixedAmount (costOfMixedAmount rsum)+          bvmsg | isReallyZeroMixedAmountCost bvsum = ""+                | otherwise = "balanced virtual postings are off by "+                  ++ showMixedAmount (costOfMixedAmount bvsum)+          sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String+ -- | Infer up to one missing amount for this transactions's real postings, and -- likewise for its balanced virtual postings, if needed; or return an error -- message if we can't.@@ -319,61 +343,70 @@ -- We can infer a missing amount when there are multiple postings and exactly -- one of them is amountless. If the amounts had price(s) the inferred amount -- have the same price(s), and will be converted to the price commodity.--- -inferBalancingAmount :: Transaction -> Either String Transaction-inferBalancingAmount t@Transaction{tpostings=ps}+inferBalancingAmount :: MonadError String m+                     => (AccountName -> MixedAmount -> m ())+                     -- ^ update function+                     -> Transaction -> m Transaction+inferBalancingAmount update t@Transaction{tpostings=ps}   | length amountlessrealps > 1-      = Left $ printerr "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)"+      = throwError $ printerr "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)"   | length amountlessbvps > 1-      = Left $ printerr "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)"+      = throwError $ printerr "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)"   | otherwise-      = Right t{tpostings=map inferamount ps}+      = do postings <- mapM inferamount ps+           return t{tpostings=postings}   where     printerr s = intercalate "\n" [s, showTransactionUnelided t]-    ((amountfulrealps, amountlessrealps), realsum) = (partition hasAmount (realPostings t), sum $ map pamount amountfulrealps)-    ((amountfulbvps, amountlessbvps), bvsum)       = (partition hasAmount (balancedVirtualPostings t), sum $ map pamount amountfulbvps)-    inferamount p@Posting{ptype=RegularPosting}         | not (hasAmount p) = p{pamount=costOfMixedAmount (-realsum)}-    inferamount p@Posting{ptype=BalancedVirtualPosting} | not (hasAmount p) = p{pamount=costOfMixedAmount (-bvsum)}-    inferamount p = p+    ((amountfulrealps, amountlessrealps), realsum) =+      (partition hasAmount (realPostings t), sum $ map pamount amountfulrealps)+    ((amountfulbvps, amountlessbvps), bvsum)       =+      (partition hasAmount (balancedVirtualPostings t), sum $ map pamount amountfulbvps)+    inferamount p@Posting{ptype=RegularPosting}+     | not (hasAmount p) = updateAmount p realsum+    inferamount p@Posting{ptype=BalancedVirtualPosting}+     | not (hasAmount p) = updateAmount p bvsum+    inferamount p = return p+    updateAmount p amt = update (paccount p) amt' >> return p { pamount=amt' }+      where amt' = costOfMixedAmount (-amt)  -- | Infer prices for this transaction's posting amounts, if needed to make -- the postings balance, and if possible. This is done once for the real -- postings and again (separately) for the balanced virtual postings. When -- it's not possible, the transaction is left unchanged.--- +-- -- The simplest example is a transaction with two postings, each in a -- different commodity, with no prices specified. In this case we'll add a -- price to the first posting such that it can be converted to the commodity -- of the second posting (with -B), and such that the postings balance.--- +-- -- In general, we can infer a conversion price when the sum of posting amounts -- contains exactly two different commodities and no explicit prices.  Also -- all postings are expected to contain an explicit amount (no missing -- amounts) in a single commodity. Otherwise no price inferring is attempted.--- +-- -- The transaction itself could contain more than two commodities, and/or -- prices, if they cancel out; what matters is that the sum of posting amounts -- contains exactly two commodities and zero prices.--- +-- -- There can also be more than two postings in either of the commodities.--- +-- -- We want to avoid excessive display of digits when the calculated price is -- an irrational number, while hopefully also ensuring the displayed numbers -- make sense if the user does a manual calculation. This is (mostly) achieved -- in two ways:--- +-- -- - when there is only one posting in the "from" commodity, a total price --   (@@) is used, and all available decimal digits are shown--- +-- -- - otherwise, a suitable averaged unit price (@) is applied to the relevant --   postings, with display precision equal to the summed display precisions --   of the two commodities being converted between, or 2, whichever is larger.--- +-- -- (We don't always calculate a good-looking display precision for unit prices -- when the commodity display precisions are low, eg when a journal doesn't -- use any decimal places. The minimum of 2 helps make the prices shown by the -- print command a bit less surprising in this case. Could do better.)--- +-- inferBalancingPrices :: Transaction -> Transaction inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'}   where
Hledger/Data/Types.hs view
@@ -198,7 +198,7 @@       pcomment          :: Text,              -- ^ this posting's comment lines, as a single non-indented multi-line string       ptype             :: PostingType,       ptags             :: [Tag],             -- ^ tag names and values, extracted from the comment-      pbalanceassertion :: Maybe MixedAmount, -- ^ optional: the expected balance in the account after this posting+      pbalanceassertion :: Maybe Amount,      -- ^ optional: the expected balance in this commodity in the account after this posting       ptransaction      :: Maybe Transaction  -- ^ this posting's parent transaction (co-recursive types).                                               -- Tying this knot gets tedious, Maybe makes it easier/optional.     } deriving (Typeable,Data,Generic)@@ -319,12 +319,21 @@ -- | A hledger journal reader is a triple of storage format name, a -- detector of that format, and a parser from that format to Journal. data Reader = Reader {-     -- name of the format this reader handles++     -- The canonical name of the format handled by this reader      rFormat   :: StorageFormat-     -- quickly check if this reader can probably handle the given file path and file content-    ,rDetector :: FilePath -> Text -> Bool-     -- parse the given string, using the given parse rules file if any, returning a journal or error aware of the given file path++     -- The file extensions recognised as containing this format+    ,rExtensions :: [String]++     -- A text parser for this format, accepting an optional rules file,+     -- assertion-checking flag, and file path for error messages,+     -- producing an exception-raising IO action that returns a journal+     -- or error message.     ,rParser   :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal++     -- Experimental readers are never tried automatically.+    ,rExperimental :: Bool     }  instance Show Reader where show r = rFormat r ++ " reader"
Hledger/Read.hs view
@@ -4,48 +4,50 @@ Journals from various data formats. Use this module if you want to parse journal data or read journal files. Generally it should not be necessary to import modules below this one.- -}  {-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} -module Hledger.Read-  (-       module Hledger.Read.Common,-       readFormatNames,-       -- * Journal reading API-       defaultJournalPath,-       defaultJournal,-       readJournal,-       readJournal',-       readJournalFile,-       readJournalFiles,-       requireJournalFileExists,-       ensureJournalFileExists,-       -- * Parsers used elsewhere-       postingp,-       -- accountnamep,-       -- amountp,-       -- amountp',-       -- mamountp',-       -- numberp,-       -- codep,-       accountaliasp,-       -- * Tests-       samplejournal,-       tests_Hledger_Read,-)-where+module Hledger.Read (++  -- * Journal files+  PrefixedFilePath,+  defaultJournal,+  defaultJournalPath,+  readJournalFiles,+  readJournalFile,+  requireJournalFileExists,+  ensureJournalFileExists,+  splitReaderPrefix,++  -- * Journal parsing+  readJournal,+  readJournal',++  -- * Re-exported+  JournalReader.accountaliasp,+  JournalReader.postingp,+  module Hledger.Read.Common,++  -- * Tests+  samplejournal,+  tests_Hledger_Read,++) where++import Control.Applicative ((<|>))+import Control.Arrow (right) import qualified Control.Exception as C import Control.Monad.Except import Data.List import Data.Maybe import Data.Text (Text) import qualified Data.Text as T+import Safe import System.Directory (doesFileExist, getHomeDirectory) import System.Environment (getEnv) import System.Exit (exitFailure)-import System.FilePath ((</>))+import System.FilePath ((</>), takeExtension) import System.IO (stderr) import Test.HUnit import Text.Printf@@ -53,105 +55,116 @@ import Hledger.Data.Dates (getCurrentDay) import Hledger.Data.Types import Hledger.Read.Common-import Hledger.Read.JournalReader as JournalReader-import Hledger.Read.TimedotReader as TimedotReader-import Hledger.Read.TimeclockReader as TimeclockReader-import Hledger.Read.CsvReader as CsvReader+import qualified Hledger.Read.JournalReader   as JournalReader+import qualified Hledger.Read.LedgerReader    as LedgerReader+import qualified Hledger.Read.TimedotReader   as TimedotReader+import qualified Hledger.Read.TimeclockReader as TimeclockReader+import qualified Hledger.Read.CsvReader       as CsvReader import Hledger.Utils import Prelude hiding (getContents, writeFile) import Hledger.Utils.UTF8IOCompat (writeFile)  --- The available data file readers, each one handling a particular data--- format. The first is also used as the default for unknown formats.+journalEnvVar           = "LEDGER_FILE"+journalEnvVar2          = "LEDGER"+journalDefaultFilename  = ".hledger.journal"++-- The available journal readers, each one handling a particular data format. readers :: [Reader] readers = [   JournalReader.reader  ,TimeclockReader.reader  ,TimedotReader.reader  ,CsvReader.reader+ ,LedgerReader.reader  ] -readFormatNames :: [StorageFormat]-readFormatNames = map rFormat readers+readerNames :: [String]+readerNames = map rFormat readers -journalEnvVar           = "LEDGER_FILE"-journalEnvVar2          = "LEDGER"-journalDefaultFilename  = ".hledger.journal"+-- | A file path optionally prefixed by a reader name and colon+-- (journal:, csv:, timedot:, etc.).+type PrefixedFilePath = FilePath --- | Which readers are worth trying for this (possibly unspecified) format, filepath, and data ?-readersFor :: (Maybe StorageFormat, Maybe FilePath, Text) -> [Reader]-readersFor (format,path,t) =-    dbg1 ("possible readers for "++show (format,path,textElideRight 30 t)) $-    case format of-     Just f  -> case readerForStorageFormat f of Just r  -> [r]-                                                 Nothing -> []-     Nothing -> case path of Nothing  -> readers-                             Just p   -> case readersForPathAndData (p,t) of [] -> readers-                                                                             rs -> rs+-- | Read the default journal file specified by the environment, or raise an error.+defaultJournal :: IO Journal+defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return --- | Find the (first) reader which can handle the given format, if any.-readerForStorageFormat :: StorageFormat -> Maybe Reader-readerForStorageFormat s | null rs = Nothing-                  | otherwise = Just $ head rs+-- | Get the default journal file path specified by the environment.+-- Like ledger, we look first for the LEDGER_FILE environment+-- variable, and if that does not exist, for the legacy LEDGER+-- environment variable. If neither is set, or the value is blank,+-- return the hard-coded default, which is @.hledger.journal@ in the+-- users's home directory (or in the current directory, if we cannot+-- determine a home directory).+defaultJournalPath :: IO String+defaultJournalPath = do+  s <- envJournalPath+  if null s then defaultJournalPath else return s     where-      rs = filter ((s==).rFormat) readers :: [Reader]---- | Find the readers which think they can handle the given file path and data, if any.-readersForPathAndData :: (FilePath,Text) -> [Reader]-readersForPathAndData (f,t) = filter (\r -> dbg1 ("try "++rFormat r++" format") $ (rDetector r) f t) readers---- try each reader in turn, returning the error of the first if all fail-tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)-tryReaders readers mrulesfile assrt path t = firstSuccessOrBestError [] readers-  where-    firstSuccessOrBestError :: [String] -> [Reader] -> IO (Either String Journal)-    firstSuccessOrBestError [] []        = return $ Left "no readers found"-    firstSuccessOrBestError errs (r:rs) = do-      dbg1IO "trying reader" (rFormat r)-      result <- (runExceptT . (rParser r) mrulesfile assrt path') t-      dbg1IO "reader result" $ either id show result-      case result of Right j -> return $ Right j                       -- success!-                     Left e  -> firstSuccessOrBestError (errs++[e]) rs -- keep trying-    firstSuccessOrBestError (e:_) []    = return $ Left e              -- none left, return first error-    path' = fromMaybe "(string)" path+      envJournalPath =+        getEnv journalEnvVar+         `C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2+                                            `C.catch` (\(_::C.IOException) -> return ""))+      defaultJournalPath = do+                  home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "")+                  return $ home </> journalDefaultFilename --- | Read a journal from this string, trying whatever readers seem appropriate:+-- | @readJournalFiles mformat mrulesfile assrt prefixedfiles@ ----- - if a format is specified, try that reader only+-- Read a Journal from each specified file path and combine them into one.+-- Or, return the first error message. ----- - or if one or more readers recognises the file path and data, try those+-- Combining Journals means concatenating them, basically.+-- The parse state resets at the start of each file, which means that+-- directives & aliases do not cross file boundaries.+-- (The final parse state saved in the Journal does span all files, however.) ----- - otherwise, try them all.+-- As with readJournalFile,+-- file paths can optionally have a READER: prefix,+-- and the @mformat@, @mrulesfile, and @assrt@ arguments are supported+-- (and these are applied to all files). ----- A CSV conversion rules file may also be specified for use by the CSV reader.--- Also there is a flag specifying whether to check or ignore balance assertions in the journal.-readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)-readJournal mformat mrulesfile assrt mpath t = tryReaders (readersFor (mformat, mpath, t)) mrulesfile assrt mpath t---- | Call readJournalFile on each specified file path, and combine the--- resulting journals into one. If there are any errors, the first is--- returned, otherwise they are combined per Journal's monoid instance--- (concatenated, basically). Parse context (eg directives & aliases)--- is not maintained across file boundaries, it resets at the start of--- each file (though the rfinal parse state saved in the resulting--- journal is the combination of parse states from all files).-readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [FilePath] -> IO (Either String Journal)-readJournalFiles mformat mrulesfile assrt fs = do-  (either Left (Right . mconcat) . sequence)-    <$> mapM (readJournalFile mformat mrulesfile assrt) fs+readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [PrefixedFilePath] -> IO (Either String Journal)+readJournalFiles mformat mrulesfile assrt prefixedfiles = do+  (right mconcat1 . sequence)+    <$> mapM (readJournalFile mformat mrulesfile assrt) prefixedfiles+  where mconcat1 :: Monoid t => [t] -> t+        mconcat1 [] = mempty+        mconcat1 x = foldr1 mappend x --- | Read a Journal from this file (or stdin if the filename is -) or give--- an error message, using the specified data format or trying all known--- formats. A CSV conversion rules file may be specified for better--- conversion of that format. Also there is a flag specifying whether--- to check or ignore balance assertions in the journal.-readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> FilePath -> IO (Either String Journal)-readJournalFile mformat mrulesfile assrt f = do+-- | @readJournalFile mformat mrulesfile assrt prefixedfile@+--+-- Read a Journal from this file, or from stdin if the file path is -,+-- or return an error message. The file path can have a READER: prefix.+--+-- The reader (data format) is chosen based on (in priority order):+-- the @mformat@ argument;+-- the file path's READER: prefix, if any;+-- a recognised file name extension (in readJournal);+-- if none of these identify a known reader, all built-in readers are tried in turn.+--+-- A CSV conversion rules file (@mrulesfiles@) can be specified to help convert CSV data.+--+-- Optionally, any balance assertions in the journal can be checked (@assrt@).+--+readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> PrefixedFilePath -> IO (Either String Journal)+readJournalFile mformat mrulesfile assrt prefixedfile = do+  let+    (mprefixformat, f) = splitReaderPrefix prefixedfile+    mfmt = mformat <|> mprefixformat   requireJournalFileExists f-  readFileOrStdinAnyLineEnding f >>= readJournal mformat mrulesfile assrt (Just f)+  readFileOrStdinAnyLineEnding f >>= readJournal mfmt mrulesfile assrt (Just f) --- | If the specified journal file does not exist, give a helpful error and quit.+-- | If a filepath is prefixed by one of the reader names and a colon,+-- split that off. Eg "csv:-" -> (Just "csv", "-").+splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath)+splitReaderPrefix f =+  headDef (Nothing, f)+  [(Just r, drop (length r + 1) f) | r <- readerNames, (r++":") `isPrefixOf` f]++-- | If the specified journal file does not exist (and is not "-"),+-- give a helpful error and quit. requireJournalFileExists :: FilePath -> IO () requireJournalFileExists "-" = return () requireJournalFileExists f = do@@ -178,31 +191,7 @@   d <- getCurrentDay   return $ printf "; journal created %s by hledger\n" (show d) --- | Get the default journal file path specified by the environment.--- Like ledger, we look first for the LEDGER_FILE environment--- variable, and if that does not exist, for the legacy LEDGER--- environment variable. If neither is set, or the value is blank,--- return the hard-coded default, which is @.hledger.journal@ in the--- users's home directory (or in the current directory, if we cannot--- determine a home directory).-defaultJournalPath :: IO String-defaultJournalPath = do-  s <- envJournalPath-  if null s then defaultJournalPath else return s-    where-      envJournalPath =-        getEnv journalEnvVar-         `C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2-                                            `C.catch` (\(_::C.IOException) -> return ""))-      defaultJournalPath = do-                  home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "")-                  return $ home </> journalDefaultFilename---- | Read the default journal file specified by the environment, or raise an error.-defaultJournal :: IO Journal-defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return---- | Read a journal from the given text, trying all known formats, or simply throw an error.+-- | Read a Journal from the given text trying all readers in turn, or throw an error. readJournal' :: Text -> IO Journal readJournal' t = readJournal Nothing Nothing True Nothing t >>= either error' return @@ -212,6 +201,64 @@      assertBool "" True  ] +-- | @readJournal mformat mrulesfile assrt mfile txt@+--+-- Read a Journal from some text, or return an error message.+--+-- The reader (data format) is chosen based on (in priority order):+-- the @mformat@ argument;+-- a recognised file name extension in @mfile@ (if provided).+-- If none of these identify a known reader, all built-in readers are tried in turn+-- (returning the first one's error message if none of them succeed).+--+-- A CSV conversion rules file (@mrulesfiles@) can be specified to help convert CSV data.+--+-- Optionally, any balance assertions in the journal can be checked (@assrt@).+--+readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)+readJournal mformat mrulesfile assrt mfile txt =+  let+    stablereaders = filter (not.rExperimental) readers+    rs = maybe stablereaders (:[]) $ findReader mformat mfile+  in+    tryReaders rs mrulesfile assrt mfile txt++-- | @findReader mformat mpath@+--+-- Find the reader named by @mformat@, if provided.+-- Or, if a file path is provided, find the first reader that handles+-- its file extension, if any.+findReader :: Maybe StorageFormat -> Maybe FilePath -> Maybe Reader+findReader Nothing Nothing     = Nothing+findReader (Just fmt) _        = headMay [r | r <- readers, rFormat r == fmt]+findReader Nothing (Just path) =+  case prefix of+    Just fmt -> headMay [r | r <- readers, rFormat r == fmt]+    Nothing  -> headMay [r | r <- readers, ext `elem` rExtensions r]+  where+    (prefix,path') = splitReaderPrefix path+    ext            = drop 1 $ takeExtension path'++-- | @tryReaders readers mrulesfile assrt path t@+--+-- Try to parse the given text to a Journal using each reader in turn,+-- returning the first success, or if all of them fail, the first error message.+tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)+tryReaders readers mrulesfile assrt path t = firstSuccessOrFirstError [] readers+  where+    firstSuccessOrFirstError :: [String] -> [Reader] -> IO (Either String Journal)+    firstSuccessOrFirstError [] []        = return $ Left "no readers found"+    firstSuccessOrFirstError errs (r:rs) = do+      dbg1IO "trying reader" (rFormat r)+      result <- (runExceptT . (rParser r) mrulesfile assrt path') t+      dbg1IO "reader result" $ either id show result+      case result of Right j -> return $ Right j                        -- success!+                     Left e  -> firstSuccessOrFirstError (errs++[e]) rs -- keep trying+    firstSuccessOrFirstError (e:_) []    = return $ Left e              -- none left, return first error+    path' = fromMaybe "(string)" path+++ -- tests  samplejournal = readJournal' $ T.unlines@@ -245,10 +292,11 @@ tests_Hledger_Read = TestList $   tests_readJournal'   ++ [-   tests_Hledger_Read_JournalReader,-   tests_Hledger_Read_TimeclockReader,-   tests_Hledger_Read_TimedotReader,-   tests_Hledger_Read_CsvReader,+   JournalReader.tests_Hledger_Read_JournalReader,+   LedgerReader.tests_Hledger_Read_LedgerReader,+   TimeclockReader.tests_Hledger_Read_TimeclockReader,+   TimedotReader.tests_Hledger_Read_TimedotReader,+   CsvReader.tests_Hledger_Read_CsvReader,     "journal" ~: do     r <- runExceptT $ parseWithState mempty JournalReader.journalp ""
Hledger/Read/Common.hs view
@@ -57,7 +57,7 @@ rjp = runJournalParser  -- | Run an error-raising journal parser with a null journal-parsing state.-runErroringJournalParser, rejp :: ErroringJournalParser a -> Text -> IO (Either String a)+runErroringJournalParser, rejp :: Monad m => ErroringJournalParser m a -> Text -> m (Either String a) runErroringJournalParser p t =   runExceptT $   runJournalParser (evalStateT p mempty)@@ -68,9 +68,10 @@ genericSourcePos :: SourcePos -> GenericSourcePos genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . unPos $ sourceColumn p) --- | Given a parsec ParsedJournal parser, file path and data string,--- parse and post-process a ready-to-use Journal, or give an error.-parseAndFinaliseJournal :: ErroringJournalParser ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal+-- | Given a megaparsec ParsedJournal parser, balance assertion flag, file+-- path and file content: parse and post-process a Journal, or give an error.+parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool+                        -> FilePath -> Text -> ExceptT String IO Journal parseAndFinaliseJournal parser assrt f txt = do   t <- liftIO getClockTime   y <- liftIO getCurrentYear@@ -98,26 +99,26 @@ getYear :: JournalStateParser m (Maybe Year) getYear = fmap jparsedefaultyear get -setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> ErroringJournalParser ()+setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalStateParser m () setDefaultCommodityAndStyle cs = modify' (\j -> j{jparsedefaultcommodity=Just cs})  getDefaultCommodityAndStyle :: JournalStateParser m (Maybe (CommoditySymbol,AmountStyle)) getDefaultCommodityAndStyle = jparsedefaultcommodity `fmap` get -pushAccount :: AccountName -> ErroringJournalParser ()+pushAccount :: AccountName -> JournalStateParser m () pushAccount acct = modify' (\j -> j{jaccounts = acct : jaccounts j}) -pushParentAccount :: AccountName -> ErroringJournalParser ()+pushParentAccount :: AccountName -> JournalStateParser m () pushParentAccount acct = modify' (\j -> j{jparseparentaccounts = acct : jparseparentaccounts j}) -popParentAccount :: ErroringJournalParser ()+popParentAccount :: JournalStateParser m () popParentAccount = do   j <- get   case jparseparentaccounts j of     []       -> unexpected (Tokens ('E' :| "nd of apply account block with no beginning"))     (_:rest) -> put j{jparseparentaccounts=rest} -getParentAccount :: ErroringJournalParser AccountName+getParentAccount :: JournalStateParser m AccountName getParentAccount = fmap (concatAccountNames . reverse . jparseparentaccounts) get  addAccountAlias :: MonadState Journal m => AccountAlias -> m ()@@ -155,7 +156,7 @@  -- | Terminate parsing entirely, returning the given error message -- with the given parse position prepended.-parserErrorAt :: SourcePos -> String -> ErroringJournalParser a+parserErrorAt :: Monad m => SourcePos -> String -> ErroringJournalParser m a parserErrorAt pos s = throwError $ sourcePosPretty pos ++ ":\n" ++ s  --- * parsers@@ -173,7 +174,7 @@ codep :: TextParser m String codep = try (do { some spacenonewline; char '(' <?> "codep"; anyChar `manyTill` char ')' } ) <|> return "" -descriptionp :: ErroringJournalParser String+descriptionp :: JournalStateParser m String descriptionp = many (noneOf (";\n" :: [Char]))  --- ** dates@@ -212,7 +213,7 @@ -- Seconds are optional. -- The timezone is optional and ignored (the time is always interpreted as a local time). -- Leading zeroes may be omitted (except in a timezone).-datetimep :: ErroringJournalParser LocalTime+datetimep :: JournalStateParser m LocalTime datetimep = do   day <- datep   lift $ some spacenonewline@@ -240,7 +241,7 @@   -- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')   return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s') -secondarydatep :: Day -> ErroringJournalParser Day+secondarydatep :: Day -> JournalStateParser m Day secondarydatep primarydate = do   char '='   -- kludgy way to use primary date for default year@@ -266,7 +267,7 @@ --- ** account names  -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.-modifiedaccountnamep :: ErroringJournalParser AccountName+modifiedaccountnamep :: JournalStateParser m AccountName modifiedaccountnamep = do   parent <- getParentAccount   aliases <- getAccountAliases@@ -305,7 +306,7 @@ -- | Parse whitespace then an amount, with an optional left or right -- currency symbol and optional price, or return the special -- "missing" marker amount.-spaceandamountormissingp :: ErroringJournalParser MixedAmount+spaceandamountormissingp :: Monad m => JournalStateParser m MixedAmount spaceandamountormissingp =   try (do         lift $ some spacenonewline@@ -426,14 +427,14 @@             return $ UnitPrice a))          <|> return NoPrice -partialbalanceassertionp :: ErroringJournalParser (Maybe MixedAmount)+partialbalanceassertionp :: Monad m => JournalStateParser m (Maybe Amount) partialbalanceassertionp =     try (do           lift (many spacenonewline)           char '='           lift (many spacenonewline)           a <- amountp -- XXX should restrict to a simple amount-          return $ Just $ Mixed [a])+          return $ Just $ a)          <|> return Nothing  -- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount)@@ -447,7 +448,7 @@ --          <|> return Nothing  -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices-fixedlotpricep :: ErroringJournalParser (Maybe Amount)+fixedlotpricep :: Monad m => JournalStateParser m (Maybe Amount) fixedlotpricep =     try (do           lift (many spacenonewline)@@ -547,7 +548,7 @@  --- ** comments -multilinecommentp :: ErroringJournalParser ()+multilinecommentp :: JournalStateParser m () multilinecommentp = do   string "comment" >> lift (many spacenonewline) >> newline   go@@ -556,13 +557,13 @@          <|> (anyLine >> go)     anyLine = anyChar `manyTill` newline -emptyorcommentlinep :: ErroringJournalParser ()+emptyorcommentlinep :: JournalStateParser m () emptyorcommentlinep = do   lift (many spacenonewline) >> (commentp <|> (lift (many spacenonewline) >> newline >> return ""))   return ()  -- | Parse a possibly multi-line comment following a semicolon.-followingcommentp :: ErroringJournalParser Text+followingcommentp :: JournalStateParser m Text followingcommentp =   -- ptrace "followingcommentp"   do samelinecomment <- lift (many spacenonewline) >> (try semicoloncommentp <|> (newline >> return ""))@@ -588,7 +589,8 @@ -- >>> rejp (followingcommentandtagsp (Just $ fromGregorian 2000 1 2)) "; date:3/4=5/6" -- Right ("date:3/4=5/6\n",[("date","3/4=5/6")],Just 2000-03-04,Nothing) ---followingcommentandtagsp :: Maybe Day -> ErroringJournalParser (Text, [Tag], Maybe Day, Maybe Day)+followingcommentandtagsp :: MonadIO m => Maybe Day+                         -> ErroringJournalParser m (Text, [Tag], Maybe Day, Maybe Day) followingcommentandtagsp mdefdate = do   -- pdbg 0 "followingcommentandtagsp" @@ -623,16 +625,16 @@    return (comment, tags, mdate, mdate2) -commentp :: ErroringJournalParser Text+commentp :: JournalStateParser m Text commentp = commentStartingWithp commentchars  commentchars :: [Char] commentchars = "#;*" -semicoloncommentp :: ErroringJournalParser Text+semicoloncommentp :: JournalStateParser m Text semicoloncommentp = commentStartingWithp ";" -commentStartingWithp :: [Char] -> ErroringJournalParser Text+commentStartingWithp :: [Char] -> JournalStateParser m Text commentStartingWithp cs = do   -- ptrace "commentStartingWith"   oneOf cs@@ -714,7 +716,7 @@ -- are parsed fully to give useful errors. Missing years can be -- inferred only if a default date is provided. ---postingdatesp :: Maybe Day -> ErroringJournalParser [(TagName,Day)]+postingdatesp :: Monad m => Maybe Day -> ErroringJournalParser m [(TagName,Day)] postingdatesp mdefdate = do   -- pdbg 0 $ "postingdatesp"   let p = ((:[]) <$> datetagp mdefdate) <|> bracketeddatetagsp mdefdate@@ -739,7 +741,7 @@ -- >>> rejp (datetagp Nothing) "date:  3/4" -- Left ...1:9...partial date 3/4 found, but the current year is unknown... ---datetagp :: Maybe Day -> ErroringJournalParser (TagName,Day)+datetagp :: Monad m => Maybe Day -> ErroringJournalParser m (TagName,Day) datetagp mdefdate = do   -- pdbg 0 "datetagp"   string "date"@@ -795,7 +797,7 @@ -- >>> rejp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]" -- Left ...1:15:...bad date, different separators... ---bracketeddatetagsp :: Maybe Day -> ErroringJournalParser [(TagName, Day)]+bracketeddatetagsp :: Monad m => Maybe Day -> ErroringJournalParser m [(TagName, Day)] bracketeddatetagsp mdefdate = do   -- pdbg 0 "bracketeddatetagsp"   char '['
Hledger/Read/CsvReader.hs view
@@ -64,16 +64,12 @@   reader :: Reader-reader = Reader format detect parse--format :: String-format = "csv"---- | Does the given file path and data look like it might be CSV ?-detect :: FilePath -> Text -> Bool-detect f t-  | f /= "-"  = takeExtension f == '.':format  -- from a file: yes if the extension is .csv-  | otherwise = T.length (T.filter (==',') t) >= 2 -- from stdin: yes if there are two or more commas+reader = Reader+  {rFormat     = "csv"+  ,rExtensions = ["csv"]+  ,rParser     = parse+  ,rExperimental = False+  }  -- | Parse and post-process a "Journal" from CSV data, or give an error. -- XXX currently ignores the string and reads from the file path@@ -103,14 +99,12 @@    -- parse rules   let rulesfile = fromMaybe (rulesFileFor csvfile) mrulesfile-  created <- ensureRulesFileExists rulesfile-  if created-   then hPrintf stderr "creating default conversion rules file %s, edit this file for better results\n" rulesfile-   else hPrintf stderr "using conversion rules file %s\n" rulesfile-  rules_ <- liftIO $ runExceptT $ parseRulesFile rulesfile-  let rules = case rules_ of-              Right (t::CsvRules) -> t-              Left err -> throwerr err+  rulesfileexists <- doesFileExist rulesfile+  when rulesfileexists $ hPrintf stderr "using conversion rules file %s\n" rulesfile+  rules <-+    if rulesfileexists+    then liftIO (runExceptT $ parseRulesFile rulesfile) >>= either throwerr return+    else return defaultRules   dbg2IO "rules" rules    -- apply skip directive@@ -147,6 +141,11 @@   -- so that same-day txns' original order is preserved       txns' | length txns > 1 && tdate (head txns) > tdate (last txns) = reverse txns             | otherwise = txns++  when (not rulesfileexists) $ do+    hPrintf stderr "created default conversion rules file %s, edit this for better results\n" rulesfile+    writeFile rulesfile $ T.unpack $ defaultRulesText rulesfile+   return $ Right nulljournal{jtxns=sortBy (comparing tdate) txns'}  parseCsv :: FilePath -> String -> IO (Either Parsec.ParseError CSV)@@ -196,22 +195,9 @@ csvFileFor :: FilePath -> FilePath csvFileFor = reverse . drop 6 . reverse --- | Ensure there is a conversion rules file at the given path, creating a--- default one if needed and returning True in this case.-ensureRulesFileExists :: FilePath -> IO Bool-ensureRulesFileExists f = do-  exists <- doesFileExist f-  if exists-   then return False-   else do-     -- note Hledger.Utils.UTF8.* do no line ending conversion on windows,-     -- we currently require unix line endings on all platforms.-     writeFile f $ newRulesFileContent f-     return True--newRulesFileContent :: FilePath -> String-newRulesFileContent f = unlines-  ["# hledger csv conversion rules for " ++ csvFileFor (takeFileName f)+defaultRulesText :: FilePath -> Text+defaultRulesText csvfile = T.pack $ unlines+  ["# hledger csv conversion rules for " ++ csvFileFor (takeFileName csvfile)   ,"# cf http://hledger.org/manual#csv-files"   ,""   ,"account1 assets:bank:checking"@@ -233,6 +219,12 @@   ," account2 assets:bank:savings\n"   ] +defaultRules :: CsvRules+defaultRules =+  either+    (error' "Could not parse the default CSV rules, this should not happen")+    id+    $ parseCsvRules "" $ defaultRulesText ""  -------------------------------------------------------------------------------- -- Conversion rules parsing
Hledger/Read/JournalReader.hs view
@@ -106,17 +106,12 @@ --- * reader  reader :: Reader-reader = Reader format detect parse--format :: String-format = "journal"---- | Does the given file path and data look like it might be hledger's journal format ?-detect :: FilePath -> Text -> Bool-detect f _t-  | f /= "-"  = takeExtension f `elem` ['.':format, ".j"] -- from a known file name: yes if the extension is this format's name or .j-  | otherwise = True                                      -- from stdin: yes, always attempt to parse stdin as journal data-  -- otherwise = regexMatches "(^|\n)[0-9]+.*\n[ \t]+" $ T.unpack t   -- from stdin: yes if we can see something that looks like a journal entry (digits in column 0 with the next line indented)+reader = Reader+  {rFormat     = "journal"+  ,rExtensions = ["journal", "j", "hledger", "ledger"]+  ,rParser     = parse+  ,rExperimental = False+  }  -- | Parse and post-process a "Journal" from hledger's journal file -- format, or give an error.@@ -132,7 +127,7 @@ -- >>> rejp (journalp <* eof) "2015/1/1\n a  0\n" -- Right Journal  with 1 transactions, 1 accounts ---journalp :: ErroringJournalParser ParsedJournal+journalp :: MonadIO m => ErroringJournalParser m ParsedJournal journalp = do   many addJournalItemP   eof@@ -140,7 +135,7 @@  -- | A side-effecting parser; parses any kind of journal item -- and updates the parse state accordingly.-addJournalItemP :: ErroringJournalParser ()+addJournalItemP :: MonadIO m => ErroringJournalParser m () addJournalItemP =   -- all journal line types can be distinguished by the first   -- character, can use choice without backtracking@@ -159,7 +154,7 @@ -- | Parse any journal directive and update the parse state accordingly. -- Cf http://hledger.org/manual.html#directives, -- http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives-directivep :: ErroringJournalParser ()+directivep :: MonadIO m => ErroringJournalParser m () directivep = (do   optional $ char '!'   choiceInState [@@ -179,7 +174,7 @@    ]   ) <?> "directive" -includedirectivep :: ErroringJournalParser ()+includedirectivep :: MonadIO m => ErroringJournalParser m () includedirectivep = do   string "include"   lift (some spacenonewline)@@ -232,15 +227,17 @@     (Right <$> io)     `C.catch` \(e::C.IOException) -> return $ Left $ printf "%s:\n%s" msg (show e) -accountdirectivep :: ErroringJournalParser ()+accountdirectivep :: JournalStateParser m () accountdirectivep = do   string "account"   lift (some spacenonewline)   acct <- lift accountnamep   newline-  _ <- many indentedlinep+  many indentedlinep   modify' (\j -> j{jaccounts = acct : jaccounts j}) ++indentedlinep :: JournalStateParser m String indentedlinep = lift (some spacenonewline) >> (rstrip <$> lift restofline)  -- | Parse a one-line or multi-line commodity directive.@@ -249,14 +246,14 @@ -- >>> Right _ <- rejp commoditydirectivep "commodity $\n  format $1.00" -- >>> Right _ <- rejp commoditydirectivep "commodity $\n\n" -- a commodity with no format -- >>> Right _ <- rejp commoditydirectivep "commodity $1.00\n  format $1.00" -- both, what happens ?-commoditydirectivep :: ErroringJournalParser ()+commoditydirectivep :: Monad m => ErroringJournalParser m () commoditydirectivep = try commoditydirectiveonelinep <|> commoditydirectivemultilinep  -- | Parse a one-line commodity directive. -- -- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00" -- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00 ; blah\n"-commoditydirectiveonelinep :: ErroringJournalParser ()+commoditydirectiveonelinep :: Monad m => JournalStateParser m () commoditydirectiveonelinep = do   string "commodity"   lift (some spacenonewline)@@ -269,7 +266,7 @@ -- | Parse a multi-line commodity directive, containing 0 or more format subdirectives. -- -- >>> Right _ <- rejp commoditydirectivemultilinep "commodity $ ; blah \n  format $1.00 ; blah"-commoditydirectivemultilinep :: ErroringJournalParser ()+commoditydirectivemultilinep :: Monad m => ErroringJournalParser m () commoditydirectivemultilinep = do   string "commodity"   lift (some spacenonewline)@@ -283,7 +280,7 @@  -- | Parse a format (sub)directive, throwing a parse error if its -- symbol does not match the one given.-formatdirectivep :: CommoditySymbol -> ErroringJournalParser AmountStyle+formatdirectivep :: Monad m => CommoditySymbol -> ErroringJournalParser m AmountStyle formatdirectivep expectedsym = do   string "format"   lift (some spacenonewline)@@ -295,7 +292,7 @@     else parserErrorAt pos $          printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity -applyaccountdirectivep :: ErroringJournalParser ()+applyaccountdirectivep :: JournalStateParser m () applyaccountdirectivep = do   string "apply" >> lift (some spacenonewline) >> string "account"   lift (some spacenonewline)@@ -303,12 +300,12 @@   newline   pushParentAccount parent -endapplyaccountdirectivep :: ErroringJournalParser ()+endapplyaccountdirectivep :: JournalStateParser m () endapplyaccountdirectivep = do   string "end" >> lift (some spacenonewline) >> string "apply" >> lift (some spacenonewline) >> string "account"   popParentAccount -aliasdirectivep :: ErroringJournalParser ()+aliasdirectivep :: JournalStateParser m () aliasdirectivep = do   string "alias"   lift (some spacenonewline)@@ -339,12 +336,12 @@   repl <- rstrip <$> anyChar `manyTill` eolof   return $ RegexAlias re repl -endaliasesdirectivep :: ErroringJournalParser ()+endaliasesdirectivep :: JournalStateParser m () endaliasesdirectivep = do   string "end aliases"   clearAccountAliases -tagdirectivep :: ErroringJournalParser ()+tagdirectivep :: JournalStateParser m () tagdirectivep = do   string "tag" <?> "tag directive"   lift (some spacenonewline)@@ -352,13 +349,13 @@   lift restofline   return () -endtagdirectivep :: ErroringJournalParser ()+endtagdirectivep :: JournalStateParser m () endtagdirectivep = do   (string "end tag" <|> string "pop") <?> "end tag or pop directive"   lift restofline   return () -defaultyeardirectivep :: ErroringJournalParser ()+defaultyeardirectivep :: JournalStateParser m () defaultyeardirectivep = do   char 'Y' <?> "default year"   lift (many spacenonewline)@@ -367,7 +364,7 @@   failIfInvalidYear y   setYear y' -defaultcommoditydirectivep :: ErroringJournalParser ()+defaultcommoditydirectivep :: Monad m => JournalStateParser m () defaultcommoditydirectivep = do   char 'D' <?> "default commodity"   lift (some spacenonewline)@@ -375,7 +372,7 @@   lift restofline   setDefaultCommodityAndStyle (acommodity, astyle) -marketpricedirectivep :: ErroringJournalParser MarketPrice+marketpricedirectivep :: Monad m => JournalStateParser m MarketPrice marketpricedirectivep = do   char 'P' <?> "market price"   lift (many spacenonewline)@@ -387,7 +384,7 @@   lift restofline   return $ MarketPrice date symbol price -ignoredpricecommoditydirectivep :: ErroringJournalParser ()+ignoredpricecommoditydirectivep :: JournalStateParser m () ignoredpricecommoditydirectivep = do   char 'N' <?> "ignored-price commodity"   lift (some spacenonewline)@@ -395,7 +392,7 @@   lift restofline   return () -commodityconversiondirectivep :: ErroringJournalParser ()+commodityconversiondirectivep :: Monad m => JournalStateParser m () commodityconversiondirectivep = do   char 'C' <?> "commodity conversion"   lift (some spacenonewline)@@ -409,7 +406,7 @@  --- ** transactions -modifiertransactionp :: ErroringJournalParser ModifierTransaction+modifiertransactionp :: MonadIO m => ErroringJournalParser m ModifierTransaction modifiertransactionp = do   char '=' <?> "modifier transaction"   lift (many spacenonewline)@@ -417,7 +414,7 @@   postings <- postingsp Nothing   return $ ModifierTransaction valueexpr postings -periodictransactionp :: ErroringJournalParser PeriodicTransaction+periodictransactionp :: MonadIO m => ErroringJournalParser m PeriodicTransaction periodictransactionp = do   char '~' <?> "periodic transaction"   lift (many spacenonewline)@@ -426,7 +423,7 @@   return $ PeriodicTransaction periodexpr postings  -- | Parse a (possibly unbalanced) transaction.-transactionp :: ErroringJournalParser Transaction+transactionp :: MonadIO m => ErroringJournalParser m Transaction transactionp = do   -- ptrace "transactionp"   sourcepos <- genericSourcePos <$> getPosition@@ -538,7 +535,7 @@  -- Parse the following whitespace-beginning lines as postings, posting -- tags, and/or comments (inferring year, if needed, from the given date).-postingsp :: Maybe Day -> ErroringJournalParser [Posting]+postingsp :: MonadIO m => Maybe Day -> ErroringJournalParser m [Posting] postingsp mdate = many (try $ postingp mdate) <?> "postings"  -- linebeginningwithspaces :: Monad m => JournalParser m String@@ -548,7 +545,7 @@ --   cs <- lift restofline --   return $ sp ++ (c:cs) ++ "\n" -postingp :: Maybe Day -> ErroringJournalParser Posting+postingp :: MonadIO m => Maybe Day -> ErroringJournalParser m Posting postingp mtdate = do   -- pdbg 0 "postingp"   lift (some spacenonewline)
+ Hledger/Read/LedgerReader.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-}++module Hledger.Read.LedgerReader (+--- * exports++  -- * Reader+  reader++  -- * Tests+  ,tests_Hledger_Read_LedgerReader++)+where+--- * imports+import Prelude ()+import Prelude.Compat hiding (readFile)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Except (ExceptT(..), throwError)+import Data.Maybe+import Data.Text (Text, pack)+import Data.Text.Encoding (encodeUtf8)+-- import Safe+import Test.HUnit+-- #ifdef TESTS+-- import Test.Framework+-- import Text.Megaparsec.Error+-- #endif+import Text.Megaparsec (eof)+-- import Text.Printf+import System.Time+import qualified Filesystem.Path.CurrentOS as F++import Hledger.Data+import Hledger.Read.Common+import Hledger.Utils+import Ledger.Parser.Text+import Text.Trifecta.Result (Result(..))++-- $setup+-- >>> :set -XOverloadedStrings++--- * reader++reader :: Reader+reader = Reader+  {rFormat     = "ledger"+  ,rExtensions = []+  ,rParser     = parse+  ,rExperimental = True+  }++-- | Generate an action that parses and post-processes a "Journal" from a+-- C++ Ledger journal, or raises an error.+parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal+parse _mrulespath assrt path txt = do+  let+    path' = F.decodeString path -- XXX can fail, according to docs+    bs = encodeUtf8 txt+    r = parseJournalFile path' bs+  case r of+    Failure ei -> throwError $ show ei+    Success res -> do+      -- dbg7IO "raw entities" res+      ejus <- liftIO $ sequence <$> mapM rawEntityInSituToJournalUpdate res+      case ejus of+        Left err  -> throwError err+        Right jus -> do+          let pj = foldr (flip (.)) id jus nulljournal+          t <- liftIO getClockTime+          either throwError return $ journalFinalise t path txt assrt pj++-- (I'm not too fond of journal update functions, but ok..)+-- | Convert a ledger4 RawEntityInSitu - representing a parsed transaction,+-- directive, comment etc. - into either a journal update function or an error.+-- Currently converts only transactions, and ignores some transaction fields.+-- Runs in IO because it uses some hledger parsers that have some need for that.+rawEntityInSituToJournalUpdate :: RawEntityInSitu -> IO (Either String (ParsedJournal -> ParsedJournal))+rawEntityInSituToJournalUpdate RawEntityInSitu{rawEntity=RawTransactionEntity (rt@RawTransaction{+    rawTxnDate    = date     -- :: !String+  , rawTxnDateAux = mdate2   -- :: Maybe String+  , rawTxnState   = _mstatus -- :: Maybe Char+  , rawTxnCode    = _mcode   -- :: Maybe String+  , rawTxnDesc    = desc     -- :: !String+  , rawTxnNote    = _mnote   -- :: Maybe String+  , rawTxnPosts   = rps      -- :: ![RawPosting]+  })}+  = do+    let md = parsedateM date+        md2 = mdate2 >>= parsedateM+        dateerr = return . Left . ("could not parse date "++)+    case (md, mdate2, md2) of+      (Nothing, _, _)          -> dateerr date+      (_, Just date2, Nothing) -> dateerr date2+      (Just d, _, _)           -> do+        eps <- sequence . catMaybes <$> mapM rawPostingToPosting rps+        case eps of+          Left err -> return $ Left err+          Right ps -> do+            let t = nulltransaction{+              -- XXX TODO more complete transaction parsing+              -- tindex                   -- :: Integer,   -- ^ this transaction's 1-based position in the input stream, or 0 when not available+              -- tsourcepos               -- :: GenericSourcePos,+                tdate = d                 -- :: Day+              , tdate2 = md2              -- :: Maybe Day+              -- tstatus                  -- :: ClearedStatus,+              -- tcode                    -- :: Text,+              , tdescription = pack desc  -- :: Text,+              -- tcomment                 -- :: Text,      -- ^ this transaction's comment lines, as a single non-indented multi-line string+              -- ttags                    -- :: [Tag],     -- ^ tag names and values, extracted from the comment+              , tpostings = ps            -- :: [Posting], -- ^ this transaction's postings+              -- tpreceding_comment_lines -- :: Text       -- ^ any comment lines immediately preceding this transaction+              }+            dbg7IO "raw transaction" rt+            dbg7IO "cooked transaction" t+            return $ Right $ addTransaction t+-- TODO convert other entities+rawEntityInSituToJournalUpdate _ = return $ Right id++-- | Convert a ledger4 RawPosting to a hledger Posting or an error message.+-- Currently ignores some posting fields, and the RawPostingNote variant+-- (which represents a comment line, not a posting; returns Nothing for these).+rawPostingToPosting :: RawPosting -> IO (Maybe (Either String Posting))+rawPostingToPosting RawPosting{+    -- TODO+    rawPostState   = _mstatus -- :: Maybe Char+  , rawPostAccount = acct     -- :: !String+  , rawPostAmount  = mamtstr  -- :: Maybe String+  , rawPostNote    = _mnote   -- :: Maybe String+  } = do+    eamt <- runErroringJournalParser (spaceandamountormissingp <* eof) $ pack $ maybe "" (' ':) mamtstr+    case eamt of+      Left err -> return $ Just $ Left err+      Right (amt :: MixedAmount) -> do+        return $ Just $ Right nullposting{+        --   pdate             -- :: Maybe Day,         -- ^ this posting's date, if different from the transaction's+        -- , pdate2            -- :: Maybe Day,         -- ^ this posting's secondary date, if different from the transaction's+        -- , pstatus           -- :: ClearedStatus,+          paccount = pack acct -- :: AccountName,+        , pamount = amt        -- :: MixedAmount,+        -- , pcomment          -- :: Text,              -- ^ this posting's comment lines, as a single non-indented multi-line string+        -- , ptype             -- :: PostingType,+        -- , ptags             -- :: [Tag],             -- ^ tag names and values, extracted from the comment+        -- , pbalanceassertion -- :: Maybe MixedAmount, -- ^ optional: the expected balance in the account after this posting+        -- , ptransaction      -- :: Maybe Transaction  -- ^ this posting's parent transaction (co-recursive types).+        }+rawPostingToPosting (RawPostingNote _) = return Nothing+++-- A raw parse example:+--+-- 2010/01/01 * T1+--     Accounts:Hub    30.00 USD+--     Accounts:A1+-- & comments...+--+-- [+-- RawTransactionEntity (RawTransaction {rawTxnDate = "2010/01/01",+--  rawTxnDateAux = Nothing, rawTxnState = Just '*', rawTxnCode = Nothing,+--  rawTxnDesc = "T1", rawTxnNote = Nothing, rawTxnPosts = [+--   RawPosting {rawPostState = Nothing, rawPostAccount = "Accounts:Hub",+--    rawPostAmount = Just "30.00 USD", rawPostNote = Nothing},+--   RawPosting {rawPostState = Nothing, rawPostAccount = "Accounts:A1",+--    rawPostAmount = Nothing, rawPostNote = Nothing}+--   ]})+-- ,Whitespace "\n"+-- ,FileComment "2010/01/01 * T2\n    Accounts:Hub    40.00 USD\n    Accounts:A2\n\n2010/01/01 * T3\n    Accounts:Hub    10.00 USD\n    Accounts:A1\n"+-- ,Whitespace "\n"+-- ,FileComment " Now, I wish to list all transactions that pay into Accounts:Hub ONLY from \n Accounts:A1. How can I write a query like that? My cursory filtering \n attempts didn't work.\n"+-- ,Whitespace "\n"+-- ,FileComment " 2. The register displays all transactions that put a commodity into or take \n a commodity out of an account. Can I display where the money comes \n from/goes to as well? In other words, can I get the complete transaction \n detail in the register?\n"+-- ]+++--- * hunit tests++tests_Hledger_Read_LedgerReader = TestList $ concat [+ ]
Hledger/Read/TimeclockReader.hs view
@@ -61,7 +61,6 @@ import qualified Data.Text as T import           Test.HUnit import           Text.Megaparsec hiding (parse)-import           System.FilePath  import           Hledger.Data -- XXX too much reuse ?@@ -70,16 +69,12 @@   reader :: Reader-reader = Reader format detect parse--format :: String-format = "timeclock"---- | Does the given file path and data look like it might be timeclock.el's timeclock format ?-detect :: FilePath -> Text -> Bool-detect f t-  | f /= "-"  = takeExtension f == '.':format -- from a known file name: yes if the extension is this format's name-  | otherwise = regexMatches "(^|\n)[io] " $ T.unpack t  -- from stdin: yes if any line starts with "i " or "o "+reader = Reader+  {rFormat     = "timeclock"+  ,rExtensions = ["timeclock"]+  ,rParser     = parse+  ,rExperimental = False+  }  -- | Parse and post-process a "Journal" from timeclock.el's timeclock -- format, saving the provided file path and the current time, or give an@@ -87,7 +82,7 @@ parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal parse _ = parseAndFinaliseJournal timeclockfilep -timeclockfilep :: ErroringJournalParser ParsedJournal+timeclockfilep :: ErroringJournalParser IO ParsedJournal timeclockfilep = do many timeclockitemp                     eof                     j@Journal{jparsetimeclockentries=es} <- get@@ -110,7 +105,7 @@                           ] <?> "timeclock entry, or default year or historical price directive"  -- | Parse a timeclock entry.-timeclockentryp :: ErroringJournalParser TimeclockEntry+timeclockentryp :: JournalStateParser m TimeclockEntry timeclockentryp = do   sourcepos <- genericSourcePos <$> lift getPosition   code <- oneOf ("bhioO" :: [Char])
Hledger/Read/TimedotReader.hs view
@@ -41,10 +41,8 @@ import Data.List (foldl') import Data.Maybe import Data.Text (Text)-import qualified Data.Text as T import Test.HUnit import Text.Megaparsec hiding (parse)-import System.FilePath  import Hledger.Data import Hledger.Read.Common@@ -53,30 +51,27 @@ -- easier to toggle this here sometimes -- import qualified Hledger.Utils (ptrace) -- ptrace = Hledger.Utils.ptrace+ptrace :: Monad m => a -> m a ptrace = return  reader :: Reader-reader = Reader format detect parse--format :: String-format = "timedot"---- | Does the given file path and data look like it might contain this format ?-detect :: FilePath -> Text -> Bool-detect f t-  | f /= "-"  = takeExtension f == '.':format -- from a file: yes if the extension matches the format name-  | otherwise = regexMatches "(^|\n)[0-9]" $ T.unpack t  -- from stdin: yes if we can see a possible timedot day entry (digits in column 0)+reader = Reader+  {rFormat     = "timedot"+  ,rExtensions = ["timedot"]+  ,rParser     = parse+  ,rExperimental = False+  }  -- | Parse and post-process a "Journal" from the timedot format, or give an error. parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal parse _ = parseAndFinaliseJournal timedotfilep -timedotfilep :: ErroringJournalParser ParsedJournal+timedotfilep :: JournalStateParser m ParsedJournal timedotfilep = do many timedotfileitemp                   eof                   get     where-      timedotfileitemp :: ErroringJournalParser ()+      timedotfileitemp :: JournalStateParser m ()       timedotfileitemp = do         ptrace "timedotfileitemp"         choice [@@ -94,7 +89,7 @@ -- biz.research . -- inc.client1  .... .... .... .... .... .... -- @-timedotdayp :: ErroringJournalParser [Transaction]+timedotdayp :: JournalStateParser m [Transaction] timedotdayp = do   ptrace " timedotdayp"   d <- datep <* lift eolof@@ -106,7 +101,7 @@ -- @ -- fos.haskell  .... .. -- @-timedotentryp :: ErroringJournalParser Transaction+timedotentryp :: JournalStateParser m Transaction timedotentryp = do   ptrace "  timedotentryp"   pos <- genericSourcePos <$> getPosition@@ -130,14 +125,14 @@         }   return t -timedotdurationp :: ErroringJournalParser Quantity+timedotdurationp :: JournalStateParser m Quantity timedotdurationp = try timedotnumberp <|> timedotdotsp  -- | Parse a duration written as a decimal number of hours (optionally followed by the letter h). -- @ -- 1.5h -- @-timedotnumberp :: ErroringJournalParser Quantity+timedotnumberp :: JournalStateParser m Quantity timedotnumberp = do    (q, _, _, _) <- lift numberp    lift (many spacenonewline)@@ -149,7 +144,7 @@ -- @ -- .... .. -- @-timedotdotsp :: ErroringJournalParser Quantity+timedotdotsp :: JournalStateParser m Quantity timedotdotsp = do   dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))   return $ (/4) $ fromIntegral $ length dots
Hledger/Reports/BalanceReport.hs view
@@ -26,10 +26,12 @@ ) where -import Data.List (sort)+import Data.List+import Data.Ord import Data.Maybe import Data.Time.Calendar import Test.HUnit+import qualified Data.Text as T  import Hledger.Data import Hledger.Read (mamountp')@@ -148,8 +150,11 @@ balanceReportValue j d r = r'   where     (items,total) = r-    r' = dbg8 "balanceReportValue"-         ([(n, n', i, mixedAmountValue j d a) |(n,n',i,a) <- items], mixedAmountValue j d total)+    r' =+      dbg8 "known market prices" (jmarketprices j) `seq`+      dbg8 "report end date" d `seq`+      dbg8 "balanceReportValue"+        ([(n, n', i, mixedAmountValue j d a) |(n,n',i,a) <- items], mixedAmountValue j d total)  mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as@@ -166,17 +171,23 @@                 }     Nothing -> a --- | Find the market value, if known, of one unit of this commodity on--- the given date, in the commodity in which it has most recently been--- market-priced (ie the commodity mentioned in the most recent--- applicable market price directive before this date).+-- | Find the market value, if known, of one unit of this commodity (A) on+-- the given valuation date, in the commodity (B) mentioned in the latest+-- applicable market price. The latest applicable market price is the market+-- price directive for commodity A with the latest date that is on or before+-- the valuation date; or if there are multiple such prices with the same date,+-- the last parsed. commodityValue :: Journal -> Day -> CommoditySymbol -> Maybe Amount-commodityValue j d c-    | null applicableprices = Nothing-    | otherwise             = Just $ mpamount $ last applicableprices+commodityValue j valuationdate c+    | null applicableprices = dbg Nothing+    | otherwise             = dbg $ Just $ mpamount $ last applicableprices   where-    applicableprices = [p | p <- sort $ jmarketprices j, mpcommodity p == c, mpdate p <= d]-+    dbg = dbg8 ("using market price for "++T.unpack c)+    applicableprices =+      [p | p <- sortBy (comparing mpdate) $ jmarketprices j+      , mpcommodity p == c+      , mpdate p <= valuationdate+      ]   @@ -387,7 +398,7 @@  ]  Right samplejournal2 =-  journalBalanceTransactions+  journalBalanceTransactions False     nulljournal{       jtxns = [         txnTieKnot Transaction{
Hledger/Reports/ReportOptions.hs view
@@ -22,6 +22,9 @@   queryOptsFromOpts,   transactionDateFn,   postingDateFn,+  reportStartDate,+  reportEndDate,+  reportStartEndDates,    tests_Hledger_Reports_ReportOptions )@@ -353,6 +356,33 @@                                                              ,query_="date:'to 2013'"                                                              })  ]++-- | The effective report start date is the one specified by options or queries,+-- otherwise the earliest transaction or posting date in the journal,+-- otherwise (for an empty journal) nothing.+-- Needs IO to parse smart dates in options/queries.+reportStartDate :: Journal -> ReportOpts -> IO (Maybe Day)+reportStartDate j ropts = (fst <$>) <$> reportStartEndDates j ropts++-- | The effective report end date is the one specified by options or queries,+-- otherwise the latest transaction or posting date in the journal,+-- otherwise (for an empty journal) nothing.+-- Needs IO to parse smart dates in options/queries.+reportEndDate :: Journal -> ReportOpts -> IO (Maybe Day)+reportEndDate j ropts = (snd <$>) <$> reportStartEndDates j ropts++reportStartEndDates :: Journal -> ReportOpts -> IO (Maybe (Day,Day))+reportStartEndDates j ropts = do+  today <- getCurrentDay+  let+    q = queryFromOpts today ropts+    mrequestedstartdate = queryStartDate False q+    mrequestedenddate = queryEndDate False q+  return $+    case journalDateSpan False j of  -- don't bother with secondary dates+      DateSpan (Just journalstartdate) (Just journalenddate) ->+        Just (fromMaybe journalstartdate mrequestedstartdate, fromMaybe journalenddate mrequestedenddate)+      _ -> Nothing   tests_Hledger_Reports_ReportOptions :: Test
Hledger/Utils.hs view
@@ -125,6 +125,9 @@ -- | Apply a function the specified number of times. Possibly uses O(n) stack ? applyN :: Int -> (a -> a) -> a -> a applyN n f = (!! n) . iterate f+-- from protolude, compare+-- applyN :: Int -> (a -> a) -> a -> a+-- applyN n f = X.foldr (.) identity (X.replicate n f)  -- | Convert a possibly relative, possibly tilde-containing file path to an absolute one, -- given the current directory. ~username is not supported. Leave "-" unchanged.
Hledger/Utils/Debug.hs view
@@ -117,8 +117,11 @@  -- | Convenience aliases for tracePrettyAtIO. -- Like dbg, but convenient to insert in an IO monad.-dbgIO :: (MonadIO m, Show a) => String -> a -> m ()-dbgIO = tracePrettyAtIO 0+-- XXX These have a bug; they should use traceIO, not trace,+-- otherwise GHC can occasionally over-optimise+-- (cf lpaste a few days ago where it killed/blocked a child thread).+dbg0IO :: (MonadIO m, Show a) => String -> a -> m ()+dbg0IO = tracePrettyAtIO 0  dbg1IO :: (MonadIO m, Show a) => String -> a -> m () dbg1IO = tracePrettyAtIO 1
Hledger/Utils/Parse.hs view
@@ -22,7 +22,7 @@ type JournalParser a = StateT Journal (ParsecT Dec Text Identity) a  -- | A journal parser that runs in IO and can throw an error mid-parse.-type ErroringJournalParser a = StateT Journal (ParsecT Dec Text (ExceptT String IO)) a+type ErroringJournalParser m a = StateT Journal (ParsecT Dec Text (ExceptT String m)) a  -- | Backtracking choice, use this when alternatives share a prefix. -- Consumes no input if all choices fail.
Hledger/Utils/String.hs view
@@ -64,7 +64,7 @@  -- | Remove leading whitespace. lstrip :: String -> String-lstrip = dropWhile (`elem` " \t") :: String -> String -- XXX isSpace ?+lstrip = dropWhile isSpace  -- | Remove trailing whitespace. rstrip :: String -> String
Hledger/Utils/UTF8IOCompat.hs view
@@ -1,4 +1,4 @@--- {-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {- |  UTF-8 aware string IO functions that will work across multiple platforms@@ -119,7 +119,13 @@  -- | A SystemString-aware version of error. error' :: String -> a-error' = error . toSystemString+error' =+#if __GLASGOW_HASKELL__ < 800+-- (easier than if base < 4.9)+  error . toSystemString+#else+  errorWithoutStackTrace . toSystemString+#endif  -- | A SystemString-aware version of userError. userError' :: String -> IOError
doc/hledger_csv.5 view
@@ -1,5 +1,5 @@ -.TH "hledger_csv" "5" "October 2016" "hledger 1.0" "hledger User Manuals"+.TH "hledger_csv" "5" "December 2016" "hledger 1.1" "hledger User Manuals"   
doc/hledger_csv.5.info view
@@ -4,7 +4,7 @@  File: hledger_csv.5.info,  Node: Top,  Up: (dir) -hledger_csv(5) hledger 1.0+hledger_csv(5) hledger 1.1 **************************  hledger can read CSV files, converting each CSV record into a journal
doc/hledger_csv.5.txt view
@@ -166,4 +166,4 @@   -hledger 1.0                      October 2016                   hledger_csv(5)+hledger 1.1                      December 2016                  hledger_csv(5)
doc/hledger_journal.5 view
@@ -1,6 +1,6 @@ .\"t -.TH "hledger_journal" "5" "October 2016" "hledger 1.0" "hledger User Manuals"+.TH "hledger_journal" "5" "December 2016" "hledger 1.1" "hledger User Manuals"   @@ -250,8 +250,10 @@ amounts are a number (the "quantity") and optionally a currency symbol/commodity name (the "commodity"). .IP \[bu] 2-the commodity is a symbol, word, or double\-quoted phrase, on the left-or right, with or without a separating space+the commodity is a symbol, word, or phrase, on the left or right, with+or without a separating space.+If the commodity contains numbers, spaces or non\-word punctuation it+must be enclosed in double quotes. .IP \[bu] 2 negative amounts with a commodity on the left can have the minus sign before or after it@@ -325,7 +327,7 @@ which is more correct and provides better error checking. .SS Balance Assertions .PP-hledger supports ledger\-style balance assertions in journal files.+hledger supports Ledger\-style balance assertions in journal files. These look like \f[C]=EXPECTEDBALANCE\f[] following a posting\[aq]s amount. Eg in this example we assert the expected dollar balance in accounts a@@ -421,21 +423,58 @@ virtual. They are not affected by the \f[C]\-\-real/\-R\f[] flag or \f[C]real:\f[] query.+.SS Balance Assignments+.PP+Ledger\-style balance assignments are also supported.+These are like balance assertions, but with no posting amount on the+left side of the equals sign; instead it is calculated automatically so+as to satisfy the assertion.+This can be a convenience during data entry, eg when setting opening+balances:+.IP+.nf+\f[C]+;\ starting\ a\ new\ journal,\ set\ asset\ account\ balances\ +2016/1/1\ opening\ balances+\ \ assets:checking\ \ \ \ \ \ \ \ \ \ \ \ =\ $409.32+\ \ assets:savings\ \ \ \ \ \ \ \ \ \ \ \ \ =\ $735.24+\ \ assets:cash\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ =\ $42+\ \ equity:opening\ balances+\f[]+.fi+.PP+or when adjusting a balance to reality:+.IP+.nf+\f[C]+;\ no\ cash\ left;\ update\ balance,\ record\ any\ untracked\ spending\ as\ a\ generic\ expense+2016/1/15+\ \ assets:cash\ \ \ \ =\ $0+\ \ expenses:misc+\f[]+.fi+.PP+The calculated amount depends on the account\[aq]s balance in the+commodity at that point (which depends on the previously\-dated postings+of the commodity to that account since the last balance assertion or+assignment).+Note that using balance assignments makes your journal a little less+explicit; to know the exact amount posted, you have to run hledger or do+the calculations yourself, instead of just reading it. .SS Prices .SS Transaction prices .PP-When recording a transaction, you can also record an amount\[aq]s price-in another commodity.-This documents the exchange rate, cost (of a purchase), or selling price-(of a sale) that was in effect within this particular transaction (or-more precisely, within the particular posting).-These transaction prices are fixed, and do not change.+Within a transaction posting, you can record an amount\[aq]s price in+another commodity.+This can be used to document the cost (for a purchase), or selling price+(for a sale), or the exchange rate that was used, for this transaction.+These transaction prices are fixed, and do not change over time. .PP-Such priced amounts can be displayed in their transaction price\[aq]s-commodity, by using the \f[C]\-\-cost/\-B\f[] flag (B for "cost Basis"),-supported by most hledger commands.+Amounts with transaction prices can be displayed in the transaction+price\[aq]s commodity, by using the \f[C]\-\-cost/\-B\f[] flag supported+by most hledger commands (mnemonic: "cost Basis"). .PP-There are three ways to specify a transaction price:+There are several ways to record a transaction price: .IP "1." 3 Write the unit price (aka exchange rate), as \f[C]\@\ UNITPRICE\f[] after the amount:@@ -492,27 +531,31 @@ .SS Market prices .PP Market prices are not tied to a particular transaction; they represent-historical exchange rates between two commodities, usually from some-public market which publishes such rates.-.PP-When market prices are known, the \f[C]\-V/\-\-value\f[] option will use-them to convert reported amounts to their market value as of the report-end date.-This option is currently available only with the balance command.+historical exchange rates between two commodities.+(Ledger calls them historical prices.) For example, the prices published+by a stock exchange or the foreign exchange market.+Some commands (balance, currently) can use this information to show the+market value of things at a given date. .PP-You record market prices (Ledger calls them historical prices) with a P-directive, in the journal or perhaps in a separate included file.-Market price directives have the format:+To record market prices, use P directives in the main journal or in an+included file.+Their format is: .IP .nf \f[C]-P\ DATE\ COMMODITYSYMBOL\ UNITPRICE+P\ DATE\ COMMODITYBEINGPRICED\ UNITPRICE \f[] .fi .PP-For example, the following directives say that the euro\[aq]s exchange-rate was 1.35 US dollars during 2009, and $1.40 from 2010 onward (and-unknown before 2009).+DATE is a simple date as usual.+COMMODITYBEINGPRICED is the symbol of the commodity being priced (just+the symbol, no quantity).+UNITPRICE is an ordinary amount (symbol and quantity) in a second+commodity, specifying the unit price or conversion rate for the first+commodity in terms of the second, on the given date.+.PP+For example, the following directives say that one euro was worth 1.35+US dollars during 2009, and $1.40 from 2010 onward: .IP .nf \f[C]@@ -520,8 +563,6 @@ P\ 2010/1/1\ €\ $1.40 \f[] .fi-.PP-Example use for market prices: tracking the value of stocks. .SS Comments .PP Lines in the journal beginning with a semicolon (\f[C];\f[]) or hash
doc/hledger_journal.5.info view
@@ -4,7 +4,7 @@  File: hledger_journal.5.info,  Node: Top,  Up: (dir) -hledger_journal(5) hledger 1.0+hledger_journal(5) hledger 1.1 ******************************  hledger's usual data source is a plain text file containing journal@@ -70,6 +70,7 @@ * Amounts:: * Virtual Postings:: * Balance Assertions::+* Balance Assignments:: * Prices:: * Comments:: * Tags::@@ -257,8 +258,10 @@    * amounts are a number (the "quantity") and optionally a currency      symbol/commodity name (the "commodity"). -   * the commodity is a symbol, word, or double-quoted phrase, on the-     left or right, with or without a separating space+   * the commodity is a symbol, word, or phrase, on the left or right,+     with or without a separating space. If the commodity contains+     numbers, spaces or non-word punctuation it must be enclosed in+     double quotes.     * negative amounts with a commodity on the left can have the minus      sign before or after it@@ -329,12 +332,12 @@ is more correct and provides better error checking.  -File: hledger_journal.5.info,  Node: Balance Assertions,  Next: Prices,  Prev: Virtual Postings,  Up: FILE FORMAT+File: hledger_journal.5.info,  Node: Balance Assertions,  Next: Balance Assignments,  Prev: Virtual Postings,  Up: FILE FORMAT  1.6 Balance Assertions ====================== -hledger supports ledger-style balance assertions in journal files. These+hledger supports Ledger-style balance assertions in journal files. These look like `=EXPECTEDBALANCE' following a posting's amount. Eg in this example we assert the expected dollar balance in accounts a and b after each posting:@@ -440,9 +443,44 @@ virtual. They are not affected by the `--real/-R' flag or `real:' query.  -File: hledger_journal.5.info,  Node: Prices,  Next: Comments,  Prev: Balance Assertions,  Up: FILE FORMAT+File: hledger_journal.5.info,  Node: Balance Assignments,  Next: Prices,  Prev: Balance Assertions,  Up: FILE FORMAT -1.7 Prices+1.7 Balance Assignments+=======================++Ledger-style balance assignments are also supported. These are like+balance assertions, but with no posting amount on the left side of the+equals sign; instead it is calculated automatically so as to satisfy the+assertion. This can be a convenience during data entry, eg when setting+opening balances:+++; starting a new journal, set asset account balances+2016/1/1 opening balances+  assets:checking            = $409.32+  assets:savings             = $735.24+  assets:cash                 = $42+  equity:opening balances++   or when adjusting a balance to reality:+++; no cash left; update balance, record any untracked spending as a generic expense+2016/1/15+  assets:cash    = $0+  expenses:misc++   The calculated amount depends on the account's balance in the+commodity at that point (which depends on the previously-dated postings+of the commodity to that account since the last balance assertion or+assignment). Note that using balance assignments makes your journal a+little less explicit; to know the exact amount posted, you have to run+hledger or do the calculations yourself, instead of just reading it.+++File: hledger_journal.5.info,  Node: Prices,  Next: Comments,  Prev: Balance Assignments,  Up: FILE FORMAT++1.8 Prices ==========  * Menu:@@ -453,20 +491,20 @@  File: hledger_journal.5.info,  Node: Transaction prices,  Next: Market prices,  Up: Prices -1.7.1 Transaction prices+1.8.1 Transaction prices ------------------------ -When recording a transaction, you can also record an amount's price in-another commodity. This documents the exchange rate, cost (of a-purchase), or selling price (of a sale) that was in effect within this-particular transaction (or more precisely, within the particular-posting). These transaction prices are fixed, and do not change.+Within a transaction posting, you can record an amount's price in+another commodity. This can be used to document the cost (for a+purchase), or selling price (for a sale), or the exchange rate that was+used, for this transaction. These transaction prices are fixed, and do+not change over time. -   Such priced amounts can be displayed in their transaction price's-commodity, by using the `--cost/-B' flag (B for "cost Basis"),-supported by most hledger commands.+   Amounts with transaction prices can be displayed in the transaction+price's commodity, by using the `--cost/-B' flag supported by most+hledger commands (mnemonic: "cost Basis"). -   There are three ways to specify a transaction price:+   There are several ways to record a transaction price:    1. Write the unit price (aka exchange rate), as `@ UNITPRICE' after      the amount:@@ -507,38 +545,39 @@  File: hledger_journal.5.info,  Node: Market prices,  Prev: Transaction prices,  Up: Prices -1.7.2 Market prices+1.8.2 Market prices -------------------  Market prices are not tied to a particular transaction; they represent-historical exchange rates between two commodities, usually from some-public market which publishes such rates.+historical exchange rates between two commodities. (Ledger calls them+historical prices.) For example, the prices published by a stock+exchange or the foreign exchange market. Some commands (balance,+currently) can use this information to show the market value of things+at a given date. -   When market prices are known, the `-V/--value' option will use them-to convert reported amounts to their market value as of the report end-date. This option is currently available only with the balance command.+   To record market prices, use P directives in the main journal or in+an included file. Their format is: -   You record market prices (Ledger calls them historical prices) with-a P directive, in the journal or perhaps in a separate included file.-Market price directives have the format: +P DATE COMMODITYBEINGPRICED UNITPRICE -P DATE COMMODITYSYMBOL UNITPRICE+   DATE is a simple date as usual. COMMODITYBEINGPRICED is the symbol of+the commodity being priced (just the symbol, no quantity). UNITPRICE is+an ordinary amount (symbol and quantity) in a second commodity,+specifying the unit price or conversion rate for the first commodity in+terms of the second, on the given date. -   For example, the following directives say that the euro's exchange-rate was 1.35 US dollars during 2009, and $1.40 from 2010 onward (and-unknown before 2009).+   For example, the following directives say that one euro was worth+1.35 US dollars during 2009, and $1.40 from 2010 onward:   P 2009/1/1 € $1.35 P 2010/1/1 € $1.40 -   Example use for market prices: tracking the value of stocks.-  File: hledger_journal.5.info,  Node: Comments,  Next: Tags,  Prev: Prices,  Up: FILE FORMAT -1.8 Comments+1.9 Comments ============  Lines in the journal beginning with a semicolon (`;') or hash (`#') or@@ -579,8 +618,8 @@  File: hledger_journal.5.info,  Node: Tags,  Next: Directives,  Prev: Comments,  Up: FILE FORMAT -1.9 Tags-========+1.10 Tags+=========  A _tag_ is a word followed by a full colon inside a transaction or posting comment. You can write multiple tags, comma separated. Eg: `; a@@ -607,7 +646,7 @@  File: hledger_journal.5.info,  Node: Directives,  Prev: Tags,  Up: FILE FORMAT -1.10 Directives+1.11 Directives ===============  * Menu:@@ -624,7 +663,7 @@  File: hledger_journal.5.info,  Node: Account aliases,  Next: account directive,  Up: Directives -1.10.1 Account aliases+1.11.1 Account aliases ----------------------  You can define aliases which rewrite your account names (after reading@@ -653,7 +692,7 @@  File: hledger_journal.5.info,  Node: Basic aliases,  Next: Regex aliases,  Up: Account aliases -1.10.1.1 Basic aliases+1.11.1.1 Basic aliases ......................  To set an account alias, use the `alias' directive in your journal@@ -678,7 +717,7 @@  File: hledger_journal.5.info,  Node: Regex aliases,  Next: Multiple aliases,  Prev: Basic aliases,  Up: Account aliases -1.10.1.2 Regex aliases+1.11.1.2 Regex aliases ......................  There is also a more powerful variant that uses a regular expression,@@ -704,7 +743,7 @@  File: hledger_journal.5.info,  Node: Multiple aliases,  Next: end aliases,  Prev: Regex aliases,  Up: Account aliases -1.10.1.3 Multiple aliases+1.11.1.3 Multiple aliases .........................  You can define as many aliases as you like using directives or@@ -721,7 +760,7 @@  File: hledger_journal.5.info,  Node: end aliases,  Prev: Multiple aliases,  Up: Account aliases -1.10.1.4 end aliases+1.11.1.4 end aliases ....................  You can clear (forget) all currently defined aliases with the `end@@ -733,7 +772,7 @@  File: hledger_journal.5.info,  Node: account directive,  Next: apply account directive,  Prev: Account aliases,  Up: Directives -1.10.2 account directive+1.11.2 account directive ------------------------  The `account' directive predefines account names, as in Ledger and@@ -755,7 +794,7 @@  File: hledger_journal.5.info,  Node: apply account directive,  Next: Multi-line comments,  Prev: account directive,  Up: Directives -1.10.3 apply account directive+1.11.3 apply account directive ------------------------------  You can specify a parent account which will be prepended to all accounts@@ -794,7 +833,7 @@  File: hledger_journal.5.info,  Node: Multi-line comments,  Next: commodity directive,  Prev: apply account directive,  Up: Directives -1.10.4 Multi-line comments+1.11.4 Multi-line comments --------------------------  A line containing just `comment' starts a multi-line comment, and a@@ -803,7 +842,7 @@  File: hledger_journal.5.info,  Node: commodity directive,  Next: Default commodity,  Prev: Multi-line comments,  Up: Directives -1.10.5 commodity directive+1.11.5 commodity directive --------------------------  The `commodity' directive predefines commodities (currently this is@@ -838,7 +877,7 @@  File: hledger_journal.5.info,  Node: Default commodity,  Next: Default year,  Prev: commodity directive,  Up: Directives -1.10.6 Default commodity+1.11.6 Default commodity ------------------------  The D directive sets a default commodity (and display format), to be@@ -859,7 +898,7 @@  File: hledger_journal.5.info,  Node: Default year,  Next: Including other files,  Prev: Default commodity,  Up: Directives -1.10.7 Default year+1.11.7 Default year -------------------  You can set a default year to be used for subsequent dates which don't@@ -886,7 +925,7 @@  File: hledger_journal.5.info,  Node: Including other files,  Prev: Default year,  Up: Directives -1.10.8 Including other files+1.11.8 Including other files ----------------------------  You can pull in the content of additional journal files by writing an@@ -927,69 +966,71 @@ Node: Top94 Node: FILE FORMAT2284 Ref: #file-format2410-Node: Transactions2569-Ref: #transactions2689-Node: Dates3632-Ref: #dates3760-Node: Simple dates3825-Ref: #simple-dates3953-Node: Secondary dates4317-Ref: #secondary-dates4473-Node: Posting dates6033-Ref: #posting-dates6164-Node: Account names7535-Ref: #account-names7674-Node: Amounts8159-Ref: #amounts8297-Node: Virtual Postings10295-Ref: #virtual-postings10456-Node: Balance Assertions11676-Ref: #balance-assertions11840-Node: Assertions and ordering12662-Ref: #assertions-and-ordering12847-Node: Assertions and commodities13878-Ref: #assertions-and-commodities14104-Node: Assertions and subaccounts14796-Ref: #assertions-and-subaccounts15030-Node: Assertions and virtual postings15552-Ref: #assertions-and-virtual-postings15761-Node: Prices15902-Ref: #prices16034-Node: Transaction prices16085-Ref: #transaction-prices16230-Node: Market prices17837-Ref: #market-prices17972-Node: Comments18860-Ref: #comments18982-Node: Tags20094-Ref: #tags20212-Node: Directives21135-Ref: #directives21250-Node: Account aliases21443-Ref: #account-aliases21589-Node: Basic aliases22191-Ref: #basic-aliases22336-Node: Regex aliases23024-Ref: #regex-aliases23194-Node: Multiple aliases23964-Ref: #multiple-aliases24138-Node: end aliases24634-Ref: #end-aliases24776-Node: account directive24878-Ref: #account-directive25060-Node: apply account directive25356-Ref: #apply-account-directive25554-Node: Multi-line comments26214-Ref: #multi-line-comments26406-Node: commodity directive26533-Ref: #commodity-directive26719-Node: Default commodity27592-Ref: #default-commodity27767-Node: Default year28303-Ref: #default-year28470-Node: Including other files28893-Ref: #including-other-files29052-Node: EDITOR SUPPORT29448-Ref: #editor-support29568+Node: Transactions2593+Ref: #transactions2713+Node: Dates3656+Ref: #dates3784+Node: Simple dates3849+Ref: #simple-dates3977+Node: Secondary dates4341+Ref: #secondary-dates4497+Node: Posting dates6057+Ref: #posting-dates6188+Node: Account names7559+Ref: #account-names7698+Node: Amounts8183+Ref: #amounts8321+Node: Virtual Postings10420+Ref: #virtual-postings10581+Node: Balance Assertions11801+Ref: #balance-assertions11978+Node: Assertions and ordering12800+Ref: #assertions-and-ordering12985+Node: Assertions and commodities14016+Ref: #assertions-and-commodities14242+Node: Assertions and subaccounts14934+Ref: #assertions-and-subaccounts15168+Node: Assertions and virtual postings15690+Ref: #assertions-and-virtual-postings15899+Node: Balance Assignments16040+Ref: #balance-assignments16209+Node: Prices17327+Ref: #prices17460+Node: Transaction prices17511+Ref: #transaction-prices17656+Node: Market prices19236+Ref: #market-prices19371+Node: Comments20371+Ref: #comments20493+Node: Tags21605+Ref: #tags21725+Node: Directives22648+Ref: #directives22763+Node: Account aliases22956+Ref: #account-aliases23102+Node: Basic aliases23704+Ref: #basic-aliases23849+Node: Regex aliases24537+Ref: #regex-aliases24707+Node: Multiple aliases25477+Ref: #multiple-aliases25651+Node: end aliases26147+Ref: #end-aliases26289+Node: account directive26391+Ref: #account-directive26573+Node: apply account directive26869+Ref: #apply-account-directive27067+Node: Multi-line comments27727+Ref: #multi-line-comments27919+Node: commodity directive28046+Ref: #commodity-directive28232+Node: Default commodity29105+Ref: #default-commodity29280+Node: Default year29816+Ref: #default-year29983+Node: Including other files30406+Ref: #including-other-files30565+Node: EDITOR SUPPORT30961+Ref: #editor-support31081  End Tag Table
doc/hledger_journal.5.txt view
@@ -187,8 +187,10 @@        o amounts  are a number (the "quantity") and optionally a currency sym-          bol/commodity name (the "commodity"). -       o the commodity is a symbol, word, or double-quoted phrase, on the left-         or right, with or without a separating space+       o the commodity is a symbol, word, or phrase, on  the  left  or  right,+         with  or  without a separating space.  If the commodity contains num-+         bers, spaces or non-word punctuation it must be  enclosed  in  double+         quotes.         o negative amounts with a commodity on the left can have the minus sign          before or after it@@ -251,7 +253,7 @@        more correct and provides better error checking.     Balance Assertions-       hledger supports ledger-style  balance  assertions  in  journal  files.+       hledger supports Ledger-style  balance  assertions  in  journal  files.        These  look  like =EXPECTEDBALANCE following a posting's amount.  Eg in        this example we assert the expected dollar balance in accounts a and  b        after each posting:@@ -327,21 +329,49 @@        Balance assertions are checked against all postings, both real and vir-        tual.  They are not affected by the --real/-R flag or real: query. +   Balance Assignments+       Ledger-style  balance  assignments  are also supported.  These are like+       balance assertions, but with no posting amount on the left side of  the+       equals  sign;  instead  it is calculated automatically so as to satisfy+       the assertion.  This can be a convenience during data  entry,  eg  when+       setting opening balances:++              ; starting a new journal, set asset account balances+              2016/1/1 opening balances+                assets:checking            = $409.32+                assets:savings             = $735.24+                assets:cash                 = $42+                equity:opening balances++       or when adjusting a balance to reality:++              ; no cash left; update balance, record any untracked spending as a generic expense+              2016/1/15+                assets:cash    = $0+                expenses:misc++       The calculated amount depends on the account's balance in the commodity+       at that point (which depends on the previously-dated  postings  of  the+       commodity  to  that account since the last balance assertion or assign-+       ment).  Note that using balance assignments makes your journal a little+       less explicit; to know the exact amount posted, you have to run hledger+       or do the calculations yourself, instead of just reading it.+    Prices    Transaction prices-       When  recording a transaction, you can also record an amount's price in-       another commodity.  This documents the exchange rate, cost (of  a  pur--       chase),  or  selling  price  (of a sale) that was in effect within this-       particular transaction (or more precisely, within the particular  post--       ing).  These transaction prices are fixed, and do not change.+       Within a transaction posting, you  can  record  an  amount's  price  in+       another  commodity.   This can be used to document the cost (for a pur-+       chase), or selling price (for a sale), or the exchange  rate  that  was+       used, for this transaction.  These transaction prices are fixed, and do+       not change over time. -       Such  priced amounts can be displayed in their transaction price's com--       modity, by using the --cost/-B flag (B for "cost Basis"), supported  by-       most hledger commands.+       Amounts with transaction prices can be  displayed  in  the  transaction+       price's  commodity,  by  using  the  --cost/-B  flag  supported by most+       hledger commands (mnemonic: "cost Basis"). -       There are three ways to specify a transaction price:+       There are several ways to record a transaction price: -       1. Write  the  unit price (aka exchange rate), as @ UNITPRICE after the+       1. Write the unit price (aka exchange rate), as @ UNITPRICE  after  the           amount:                    2009/1/1@@ -355,7 +385,7 @@                     assets:cash         3. Or let hledger infer the price so as to balance the transaction.  To-          permit  this,  you must fully specify all posting amounts, and their+          permit this, you must fully specify all posting amounts,  and  their           sum must have a non-zero amount in exactly two commodities:                    2009/1/1@@ -369,46 +399,46 @@                   assets:foreign currency       $135.00                   assets:cash                  $-135.00 -       Example use for transaction prices: recording the effective  conversion+       Example  use for transaction prices: recording the effective conversion        rate of purchases made in a foreign currency.     Market prices-       Market  prices are not tied to a particular transaction; they represent-       historical exchange rates between two commodities,  usually  from  some-       public market which publishes such rates.+       Market prices are not tied to a particular transaction; they  represent+       historical  exchange rates between two commodities.  (Ledger calls them+       historical prices.) For  example,  the  prices  published  by  a  stock+       exchange  or the foreign exchange market.  Some commands (balance, cur-+       rently) can use this information to show the market value of things  at+       a given date. -       When  market  prices  are known, the -V/--value option will use them to-       convert reported amounts to their market value as  of  the  report  end-       date.   This  option  is currently available only with the balance com--       mand.+       To  record market prices, use P directives in the main journal or in an+       included file.  Their format is: -       You record market prices (Ledger calls them historical prices) with a P-       directive, in the journal or perhaps in a separate included file.  Mar--       ket price directives have the format:+              P DATE COMMODITYBEINGPRICED UNITPRICE -              P DATE COMMODITYSYMBOL UNITPRICE+       DATE is a simple date as usual.  COMMODITYBEINGPRICED is the symbol  of+       the  commodity  being priced (just the symbol, no quantity).  UNITPRICE+       is an ordinary amount (symbol and  quantity)  in  a  second  commodity,+       specifying the unit price or conversion rate for the first commodity in+       terms of the second, on the given date. -       For example, the following directives say that the euro's exchange rate-       was  1.35  US  dollars  during  2009,  and  $1.40 from 2010 onward (and-       unknown before 2009).+       For example, the following directives say that one euro was worth  1.35+       US dollars during 2009, and $1.40 from 2010 onward:                P 2009/1/1  $1.35               P 2010/1/1  $1.40 -       Example use for market prices: tracking the value of stocks.-    Comments-       Lines in the journal beginning with a semicolon  (;)  or  hash  (#)  or-       asterisk  (*)  are  comments,  and will be ignored.  (Asterisk comments-       make it easy to treat your journal like an org-mode outline in  emacs.)+       Lines  in  the  journal  beginning  with a semicolon (;) or hash (#) or+       asterisk (*) are comments, and will  be  ignored.   (Asterisk  comments+       make  it easy to treat your journal like an org-mode outline in emacs.) -       Also,   anything  between  comment  and  end comment  directives  is  a-       (multi-line) comment.  If there is no end comment, the comment  extends+       Also,  anything  between  comment  and  end comment  directives  is   a+       (multi-line)  comment.  If there is no end comment, the comment extends        to the end of the file. -       You  can  attach  comments  to  a transaction by writing them after the-       description and/or indented on the following lines  (before  the  post--       ings).   Similarly, you can attach comments to an individual posting by+       You can attach comments to a transaction  by  writing  them  after  the+       description  and/or  indented  on the following lines (before the post-+       ings).  Similarly, you can attach comments to an individual posting  by        writing them after the amount and/or indented on the following lines.         Some examples:@@ -433,30 +463,30 @@               ; a journal comment (because not indented)     Tags-       A tag is a word followed by a full colon inside a transaction or  post--       ing  comment.   You  can  write  multiple  tags,  comma separated.  Eg:-       ; a comment containing sometag:, anothertag:.  You can search for  tags+       A  tag is a word followed by a full colon inside a transaction or post-+       ing comment.  You  can  write  multiple  tags,  comma  separated.   Eg:+       ; a comment containing sometag:, anothertag:.   You can search for tags        with the tag: query. -       A  tag  can  also have a value, which is any text between the colon and-       the next comma or newline, excluding leading/trailing whitespace.   (So+       A tag can also have a value, which is any text between  the  colon  and+       the  next comma or newline, excluding leading/trailing whitespace.  (So        hledger tag values can not contain commas or newlines). -       Tags  in  a  transaction  comment affect the transaction and all of its-       postings, while tags in a posting comment  affect  only  that  posting.-       For  example,  the  following  transaction  has  three  tags  (A, TAG2,+       Tags in a transaction comment affect the transaction  and  all  of  its+       postings,  while  tags  in  a posting comment affect only that posting.+       For example,  the  following  transaction  has  three  tags  (A,  TAG2,        third-tag) and the posting has four (A, TAG2, third-tag, posting-tag):                1/1 a transaction  ; A:, TAG2:                   ; third-tag: a third transaction tag, this time with a value                   (a)  $1  ; posting-tag: -       Tags are like Ledger's metadata feature, except  hledger's  tag  values+       Tags  are  like  Ledger's metadata feature, except hledger's tag values        are simple strings.     Directives    Account aliases-       You  can define aliases which rewrite your account names (after reading+       You can define aliases which rewrite your account names (after  reading        the journal, before generating reports).  hledger's account aliases can        be useful for: @@ -473,8 +503,8 @@        See also How to use account aliases.     Basic aliases-       To  set an account alias, use the alias directive in your journal file.-       This affects all subsequent journal entries in the current file or  its+       To set an account alias, use the alias directive in your journal  file.+       This  affects all subsequent journal entries in the current file or its        included files.  The spaces around the = are optional:                alias OLD = NEW@@ -482,53 +512,53 @@        Or, you can use the --alias 'OLD=NEW' option on the command line.  This        affects all entries.  It's useful for trying out aliases interactively. -       OLD  and  NEW  are full account names.  hledger will replace any occur--       rence of the old account name with the new one.  Subaccounts  are  also+       OLD and NEW are full account names.  hledger will  replace  any  occur-+       rence  of  the old account name with the new one.  Subaccounts are also        affected.  Eg:                alias checking = assets:bank:wells fargo:checking               # rewrites "checking" to "assets:bank:wells fargo:checking", or "checking:a" to "assets:bank:wells fargo:checking:a"     Regex aliases-       There  is  also a more powerful variant that uses a regular expression,-       indicated by the forward slashes.  (This was the default  behaviour  in+       There is also a more powerful variant that uses a  regular  expression,+       indicated  by  the forward slashes.  (This was the default behaviour in        hledger 0.24-0.25):                alias /REGEX/ = REPLACEMENT         or --alias '/REGEX/=REPLACEMENT'. -       REGEX  is  a  case-insensitive regular expression.  Anywhere it matches-       inside an account name, the matched part will be replaced  by  REPLACE--       MENT.   If REGEX contains parenthesised match groups, these can be ref-+       REGEX is a case-insensitive regular expression.   Anywhere  it  matches+       inside  an  account name, the matched part will be replaced by REPLACE-+       MENT.  If REGEX contains parenthesised match groups, these can be  ref-        erenced by the usual numeric backreferences in REPLACEMENT.  Note, cur--       rently  regular  expression  aliases  may  cause noticeable slow-downs.+       rently regular expression  aliases  may  cause  noticeable  slow-downs.        (And if you use Ledger on your hledger file, they will be ignored.) Eg:                alias /^(.+):bank:([^:]+)(.*)/ = \1:\2 \3               # rewrites "assets:bank:wells fargo:checking" to  "assets:wells fargo checking"     Multiple aliases-       You  can  define  as  many aliases as you like using directives or com--       mand-line options.  Aliases are recursive - each alias sees the  result-       of  applying  previous  ones.   (This  is  different from Ledger, where+       You can define as many aliases as you like  using  directives  or  com-+       mand-line  options.  Aliases are recursive - each alias sees the result+       of applying previous ones.   (This  is  different  from  Ledger,  where        aliases are non-recursive by default).  Aliases are applied in the fol-        lowing order: -       1. alias  directives,  most recently seen first (recent directives take+       1. alias directives, most recently seen first (recent  directives  take           precedence over earlier ones; directives not yet seen are ignored)         2. alias options, in the order they appear on the command line     end aliases-       You  can  clear  (forget)  all  currently  defined  aliases  with   the+       You   can  clear  (forget)  all  currently  defined  aliases  with  the        end aliases directive:                end aliases     account directive-       The  account directive predefines account names, as in Ledger and Bean--       count.  This may be useful for your own documentation; hledger  doesn't+       The account directive predefines account names, as in Ledger and  Bean-+       count.   This may be useful for your own documentation; hledger doesn't        make use of it yet.                ; account ACCT@@ -543,8 +573,8 @@               ; etc.     apply account directive-       You  can  specify  a  parent  account  which  will  be prepended to all-       accounts within a section of the journal.  Use  the  apply account  and+       You can specify a  parent  account  which  will  be  prepended  to  all+       accounts  within  a  section of the journal.  Use the apply account and        end apply account directives like so:                apply account home@@ -561,7 +591,7 @@                   home:food           $10                   home:cash          $-10 -       If  end apply account  is  omitted,  the effect lasts to the end of the+       If end apply account is omitted, the effect lasts to  the  end  of  the        file.  Included files are also affected, eg:                apply account business@@ -570,16 +600,16 @@               apply account personal               include personal.journal -       Prior to hledger 1.0, legacy account and end spellings were  also  sup-+       Prior  to  hledger 1.0, legacy account and end spellings were also sup-        ported.     Multi-line comments-       A  line containing just comment starts a multi-line comment, and a line+       A line containing just comment starts a multi-line comment, and a  line        containing just end comment ends it.  See comments.     commodity directive-       The commodity directive predefines commodities (currently this is  just-       informational),  and  also it may define the display format for amounts+       The  commodity directive predefines commodities (currently this is just+       informational), and also it may define the display format  for  amounts        in this commodity (overriding the automatically inferred format).         It may be written on a single line, like this:@@ -591,8 +621,8 @@               ; separating thousands with comma.               commodity 1,000.0000 AAAA -       or on multiple lines, using the "format" subdirective.   In  this  case-       the  commodity  symbol  appears  twice  and  should be the same in both+       or  on  multiple  lines, using the "format" subdirective.  In this case+       the commodity symbol appears twice and  should  be  the  same  in  both        places:                ; commodity SYMBOL@@ -605,10 +635,10 @@                 format INR 9,99,99,999.00     Default commodity-       The D directive sets a default commodity (and display  format),  to  be+       The  D  directive  sets a default commodity (and display format), to be        used for amounts without a commodity symbol (ie, plain numbers).  (Note-       this differs from Ledger's default commodity directive.) The  commodity-       and  display  format  will  be applied to all subsequent commodity-less+       this  differs from Ledger's default commodity directive.) The commodity+       and display format will be applied  to  all  subsequent  commodity-less        amounts, or until the next D directive.                # commodity-less amounts should be treated as dollars@@ -620,8 +650,8 @@                 b     Default year-       You can set a default year to be used for subsequent dates which  don't-       specify  a year.  This is a line beginning with Y followed by the year.+       You  can set a default year to be used for subsequent dates which don't+       specify a year.  This is a line beginning with Y followed by the  year.        Eg:                Y2009      ; set default year to 2009@@ -641,24 +671,24 @@                 assets     Including other files-       You can pull in the content of additional journal files by  writing  an+       You  can  pull in the content of additional journal files by writing an        include directive, like this:                include path/to/file.journal -       If  the path does not begin with a slash, it is relative to the current+       If the path does not begin with a slash, it is relative to the  current        file.  Glob patterns (*) are not currently supported. -       The include directive can only  be  used  in  journal  files.   It  can+       The  include  directive  can  only  be  used  in journal files.  It can        include journal, timeclock or timedot files, but not CSV files.  EDITOR SUPPORT        Add-on modes exist for various text editors, to make working with jour--       nal files easier.  They add colour, navigation aids  and  helpful  com--       mands.   For  hledger  users  who  edit  the journal file directly (the+       nal  files  easier.   They add colour, navigation aids and helpful com-+       mands.  For hledger users who  edit  the  journal  file  directly  (the        majority), using one of these modes is quite recommended. -       These were written with Ledger in mind,  but  also  work  with  hledger+       These  were  written  with  Ledger  in mind, but also work with hledger        files:  @@ -675,7 +705,7 @@   REPORTING BUGS-       Report  bugs at http://bugs.hledger.org (or on the #hledger IRC channel+       Report bugs at http://bugs.hledger.org (or on the #hledger IRC  channel        or hledger mail list)  @@ -689,7 +719,7 @@   SEE ALSO-       hledger(1),     hledger-ui(1),     hledger-web(1),      hledger-api(1),+       hledger(1),      hledger-ui(1),     hledger-web(1),     hledger-api(1),        hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_time-        dot(5), ledger(1) @@ -697,4 +727,4 @@   -hledger 1.0                      October 2016               hledger_journal(5)+hledger 1.1                      December 2016              hledger_journal(5)
doc/hledger_timeclock.5 view
@@ -1,5 +1,5 @@ -.TH "hledger_timeclock" "5" "October 2016" "hledger 1.0" "hledger User Manuals"+.TH "hledger_timeclock" "5" "December 2016" "hledger 1.1" "hledger User Manuals"   
doc/hledger_timeclock.5.info view
@@ -4,7 +4,7 @@  File: hledger_timeclock.5.info,  Node: Top,  Up: (dir) -hledger_timeclock(5) hledger 1.0+hledger_timeclock(5) hledger 1.1 ********************************  hledger can read timeclock files. As with Ledger, these are (a subset
doc/hledger_timeclock.5.txt view
@@ -79,4 +79,4 @@   -hledger 1.0                      October 2016             hledger_timeclock(5)+hledger 1.1                      December 2016            hledger_timeclock(5)
doc/hledger_timedot.5 view
@@ -1,5 +1,5 @@ -.TH "hledger_timedot" "5" "October 2016" "hledger 1.0" "hledger User Manuals"+.TH "hledger_timedot" "5" "December 2016" "hledger 1.1" "hledger User Manuals"   
doc/hledger_timedot.5.info view
@@ -4,7 +4,7 @@  File: hledger_timedot.5.info,  Node: Top,  Up: (dir) -hledger_timedot(5) hledger 1.0+hledger_timedot(5) hledger 1.1 ******************************  Timedot is a plain text format for logging dated, categorised quantities
doc/hledger_timedot.5.txt view
@@ -120,4 +120,4 @@   -hledger 1.0                      October 2016               hledger_timedot(5)+hledger 1.1                      December 2016              hledger_timedot(5)
hledger-lib.cabal view
@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.14.0.+-- This file has been generated from package.yaml by hpack version 0.15.0. -- -- see: https://github.com/sol/hpack  name:           hledger-lib-version:        1.0.1+version:        1.1 stability:      stable category:       Finance synopsis:       Core data types, parsers and functionality for the hledger accounting tools@@ -53,9 +53,12 @@   default: False  library+  hs-source-dirs:+      other/ledger-parse+    , .   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans   build-depends:-      base >=4.3 && <5+      base >=4.8 && <5     , base-compat >=0.8.1     , array     , blaze-markup >=0.5.1@@ -68,6 +71,7 @@     , deepseq     , directory     , filepath+    , hashtables >= 1.2     , megaparsec >=5.0 && < 5.2     , mtl     , mtl-compat@@ -81,6 +85,9 @@     , uglymemo     , utf8-string >=0.3.5 && <1.1     , HUnit+    , parsers >= 0.5+    , system-filepath+    , trifecta >= 0.91     , parsec     , semigroups   if impl(ghc <7.6)@@ -115,6 +122,7 @@       Hledger.Read.Common       Hledger.Read.CsvReader       Hledger.Read.JournalReader+      Hledger.Read.LedgerReader       Hledger.Read.TimedotReader       Hledger.Read.TimeclockReader       Hledger.Reports@@ -135,17 +143,20 @@       Hledger.Utils.Tree       Hledger.Utils.UTF8IOCompat   other-modules:+      Ledger.Parser.Text       Paths_hledger_lib   default-language: Haskell2010  test-suite doctests   type: exitcode-stdio-1.0   hs-source-dirs:-      tests+      other/ledger-parse+    , .+    , tests   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans   main-is: doctests.hs   build-depends:-      base >=4.3 && <5+      base >=4.8 && <5     , base-compat >=0.8.1     , array     , blaze-markup >=0.5.1@@ -158,6 +169,7 @@     , deepseq     , directory     , filepath+    , hashtables >= 1.2     , megaparsec >=5.0 && < 5.2     , mtl     , mtl-compat@@ -171,21 +183,69 @@     , uglymemo     , utf8-string >=0.3.5 && <1.1     , HUnit+    , parsers >= 0.5+    , system-filepath+    , trifecta >= 0.91     , doctest >=0.8     , Glob >=0.7   if impl(ghc <7.6)     build-depends:         ghc-prim+  other-modules:+      Ledger.Parser.Text+      Hledger+      Hledger.Data+      Hledger.Data.Account+      Hledger.Data.AccountName+      Hledger.Data.Amount+      Hledger.Data.Commodity+      Hledger.Data.Dates+      Hledger.Data.Journal+      Hledger.Data.Ledger+      Hledger.Data.Period+      Hledger.Data.Posting+      Hledger.Data.RawOptions+      Hledger.Data.StringFormat+      Hledger.Data.Timeclock+      Hledger.Data.Transaction+      Hledger.Data.Types+      Hledger.Query+      Hledger.Read+      Hledger.Read.Common+      Hledger.Read.CsvReader+      Hledger.Read.JournalReader+      Hledger.Read.LedgerReader+      Hledger.Read.TimeclockReader+      Hledger.Read.TimedotReader+      Hledger.Reports+      Hledger.Reports.BalanceHistoryReport+      Hledger.Reports.BalanceReport+      Hledger.Reports.EntriesReport+      Hledger.Reports.MultiBalanceReports+      Hledger.Reports.PostingsReport+      Hledger.Reports.ReportOptions+      Hledger.Reports.TransactionsReports+      Hledger.Utils+      Hledger.Utils.Debug+      Hledger.Utils.Parse+      Hledger.Utils.Regex+      Hledger.Utils.String+      Hledger.Utils.Test+      Hledger.Utils.Text+      Hledger.Utils.Tree+      Hledger.Utils.UTF8IOCompat   default-language: Haskell2010  test-suite hunittests   type: exitcode-stdio-1.0   main-is: hunittests.hs   hs-source-dirs:-      tests+      other/ledger-parse+    , .+    , tests   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans   build-depends:-      base >=4.3 && <5+      base >=4.8 && <5     , base-compat >=0.8.1     , array     , blaze-markup >=0.5.1@@ -198,6 +258,7 @@     , deepseq     , directory     , filepath+    , hashtables >= 1.2     , megaparsec >=5.0 && < 5.2     , mtl     , mtl-compat@@ -211,7 +272,11 @@     , uglymemo     , utf8-string >=0.3.5 && <1.1     , HUnit+    , parsers >= 0.5+    , system-filepath+    , trifecta >= 0.91     , hledger-lib+    , parsec     , test-framework     , test-framework-hunit   if impl(ghc <7.6)@@ -224,4 +289,47 @@   else     build-depends:         time >=1.5+  other-modules:+      Ledger.Parser.Text+      Hledger+      Hledger.Data+      Hledger.Data.Account+      Hledger.Data.AccountName+      Hledger.Data.Amount+      Hledger.Data.Commodity+      Hledger.Data.Dates+      Hledger.Data.Journal+      Hledger.Data.Ledger+      Hledger.Data.Period+      Hledger.Data.Posting+      Hledger.Data.RawOptions+      Hledger.Data.StringFormat+      Hledger.Data.Timeclock+      Hledger.Data.Transaction+      Hledger.Data.Types+      Hledger.Query+      Hledger.Read+      Hledger.Read.Common+      Hledger.Read.CsvReader+      Hledger.Read.JournalReader+      Hledger.Read.LedgerReader+      Hledger.Read.TimeclockReader+      Hledger.Read.TimedotReader+      Hledger.Reports+      Hledger.Reports.BalanceHistoryReport+      Hledger.Reports.BalanceReport+      Hledger.Reports.EntriesReport+      Hledger.Reports.MultiBalanceReports+      Hledger.Reports.PostingsReport+      Hledger.Reports.ReportOptions+      Hledger.Reports.TransactionsReports+      Hledger.Utils+      Hledger.Utils.Debug+      Hledger.Utils.Parse+      Hledger.Utils.Regex+      Hledger.Utils.String+      Hledger.Utils.Test+      Hledger.Utils.Text+      Hledger.Utils.Tree+      Hledger.Utils.UTF8IOCompat   default-language: Haskell2010
+ other/ledger-parse/Ledger/Parser/Text.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE OverloadedStrings #-}++module Ledger.Parser.Text+       ( parseJournalFile+       , RawJournal(..)+       , RawEntity(..)+       , RawEntityInSitu(..)+       , RawPosting(..)+       , RawTransaction(..)+       , RawAutoTxn(..)+       , RawPeriodTxn(..)+       -- , main+       ) where++import           Control.Applicative+import           Data.ByteString (ByteString)+import           Data.Maybe+import qualified Data.Text.Encoding as E+import           Filesystem.Path.CurrentOS hiding (concat)+import           Prelude hiding (FilePath, readFile, until)+import           Text.Parser.Combinators+import           Text.Parser.LookAhead+import           Text.Parser.Token+import           Text.Trifecta+import           Text.Trifecta.Delta+-- import Control.DeepSeq+-- import Criterion+-- import Criterion.Main++infixl 4 <$!>++(<$!>) :: TokenParsing m => (a -> b) -> m a -> m b+f <$!> ma = ($!) <$> pure f <*> ma++data RawJournal = RawJournal [RawEntity]+                deriving (Show, Eq)++data RawEntity = Whitespace String+               | FileComment String+               | Directive { directiveChar :: Maybe Char+                           , directiveName :: !String+                           , directiveArg  :: Maybe String }+               | RawTransactionEntity RawTransaction+               | RawAutoTxnEntity RawAutoTxn+               | RawPeriodTxnEntity RawPeriodTxn+               | EndOfFile+               deriving (Show, Eq)++data RawEntityInSitu = RawEntityInSitu { rawEntityIndex    :: !Int+                                       , rawEntityStartPos :: !Rendering+                                       , rawEntity         :: !RawEntity+                                       , rawEntityEndPos   :: !Rendering }++instance Show RawEntityInSitu where+  show x = show (rawEntity x) ++ "\n"++data RawPosting = RawPosting { rawPostState   :: Maybe Char+                             , rawPostAccount :: !String+                             , rawPostAmount  :: Maybe String+                             , rawPostNote    :: Maybe String }+                | RawPostingNote !String+                deriving (Show, Eq)++data RawTransaction = RawTransaction { rawTxnDate    :: !String+                                     , rawTxnDateAux :: Maybe String+                                     , rawTxnState   :: Maybe Char+                                     , rawTxnCode    :: Maybe String+                                     , rawTxnDesc    :: !String+                                     , rawTxnNote    :: Maybe String+                                     , rawTxnPosts   :: ![RawPosting] }+                    deriving (Show, Eq)++data RawAutoTxn = RawAutoTxn { rawATxnQuery :: !String+                             , rawATxnPosts :: ![RawPosting] }+                deriving (Show, Eq)++data RawPeriodTxn = RawPeriodTxn { rawPTxnPeriod :: !String+                                 , rawPTxnPosts  :: ![RawPosting] }+                  deriving (Show, Eq)++txnDateParser :: TokenParsing m => m String+txnDateParser = some (digit <|> oneOf "/-." <|> letter)+                <?> "transaction date"++longSep :: CharParsing m => m ()+longSep = () <$ (try (char ' ' *> char ' ') <|> tab)++noteParser :: (LookAheadParsing m, CharParsing m) => m String+noteParser = char ';' *> manyTill anyChar (try (lookAhead endOfLine))+             <?> "note"++longSepOrEOL :: (LookAheadParsing m, CharParsing m) => m ()+longSepOrEOL = try (lookAhead (longSep <|> endOfLine))++longSepOrEOLIf :: (LookAheadParsing m, CharParsing m) => m p -> m ()+longSepOrEOLIf p = try (lookAhead ((() <$ longSep <* p) <|> endOfLine))++until :: CharParsing m => m () -> m String+until end = (:) <$> noneOf "\r\n" <*> manyTill anyChar end++tokenP :: TokenParsing m => m p -> m p+tokenP p = p <* skipMany spaceChars++postingParser :: (LookAheadParsing m, TokenParsing m) => m RawPosting+postingParser =+  (RawPosting <$!> (some spaceChars *>+                   optional (tokenP (char '*' <|> char '!')))+              <*> tokenP (until longSepOrEOL)+              <*> optional (tokenP (until (longSepOrEOLIf (char ';'))))+              <*> (optional noteParser <* endOfLine)+              <?> "posting")+  <|>+  (RawPostingNote <$!> (concat <$!>+                        some ((++) <$!> (some spaceChars *> noteParser)+                                   <*> ((:[]) <$> endOfLineChar)))+                  <?> "posting note")++spaceChars :: CharParsing m => m ()+spaceChars = () <$ oneOf " \t"++regularTxnParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity+regularTxnParser = RawTransactionEntity <$!> go+  where go = RawTransaction+             <$!> txnDateParser+             <*> optional (char '=' *> txnDateParser)+             <*> (many spaceChars *>+                  optional (tokenP (char '*' <|> char '!')))+             <*> optional+                 (tokenP (parens (many (noneOf ")\r\n"))))+             <*> tokenP (until (longSepOrEOLIf (char ';')))+             <*> optional noteParser+             <*> (endOfLine *> some postingParser)+             <?> "regular transaction"++automatedTxnParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity+automatedTxnParser = RawAutoTxnEntity <$!> go+  where go = RawAutoTxn+             <$!> (tokenP (char '=') *>+                   manyTill anyChar (try (lookAhead endOfLine)))+             <*> (endOfLine *> some postingParser)+             <?> "automated transaction"++periodicTxnParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity+periodicTxnParser = RawPeriodTxnEntity <$!> go+  where go = RawPeriodTxn+             <$!> (tokenP (char '~') *>+                   manyTill anyChar (try (lookAhead endOfLine)))+             <*> (endOfLine *> some postingParser)+             <?> "periodic transaction"++transactionParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity+transactionParser = regularTxnParser+                    <|> automatedTxnParser+                    <|> periodicTxnParser+                    <?> "transaction"++directiveParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity+directiveParser =+  Directive <$!> optional (oneOf "@!")+            <*> ((:) <$!> letter <*> tokenP (many alphaNum))+            <*> (optional+                 ((:) <$!> noneOf "\r\n"+                      <*> manyTill anyChar (try (lookAhead endOfLine)))+                 <* endOfLine)+            <?> "directive"++endOfLine :: CharParsing m => m ()+endOfLine = () <$ endOfLineChar++endOfLineChar :: CharParsing m => m Char+endOfLineChar = skipOptional (char '\r') *> char '\n'++commentParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity+commentParser = FileComment+                <$!> (concat <$!>+                      some ((++) <$!> noteParser+                                 <*> ((:[]) <$> endOfLineChar)))+                <?> "comment"++whitespaceParser :: TokenParsing m => m RawEntity+whitespaceParser = Whitespace <$!> some space <?> "whitespace"++entityParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity+entityParser = directiveParser+               <|> commentParser+               <|> whitespaceParser+               <|> transactionParser+               <?> "journal"++rendCaret :: DeltaParsing m => m Rendering+rendCaret = addCaret <$!> position <*> rend++journalParser :: (LookAheadParsing m, DeltaParsing m) => m [RawEntityInSitu]+journalParser =+  many (RawEntityInSitu <$!> pure 0 <*> rendCaret <*> entityParser <*> rendCaret)++parseJournalFile :: FilePath -> ByteString -> Result [RawEntityInSitu]+parseJournalFile file contents =+  let filepath = either id id $ toText file+      start    = Directed (E.encodeUtf8 filepath) 0 0 0 0+  in zipWith (\e i -> e { rawEntityIndex = i})+       <$> parseByteString journalParser start contents+       <*> pure [1..]++-- testme :: IO (Result [RawEntityInSitu])+-- testme =+--   let file = "/Users/johnw/Documents/Finances/ledger.dat"+--   in parseJournalFile (fromText (T.pack file)) <$> B.readFile file++-- instance NFData RawEntityInSitu+-- instance NFData (Result a)++-- main = do let file = "/Users/johnw/Documents/Finances/ledger.dat"+--           bs <- B.readFile file+--           defaultMain [+--             bench "main" $ nf (parseJournalFile (fromText (T.pack file))) bs ]++-- Text.hs ends here
tests/doctests.hs view
@@ -5,5 +5,6 @@ import Test.DocTest  main = do-  fs <- ("Hledger.hs" :) . filter (not . isInfixOf "/.") <$> glob "Hledger/**/*.hs"-  doctest fs+  fs1 <- filter (not . isInfixOf "/.") <$> glob "Hledger/**/*.hs"+  fs2 <- filter (not . isInfixOf "/.") <$> glob "other/ledger-parse/**/*.hs"+  doctest $ ["Hledger.hs"] ++ fs1 ++ fs2