slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

journal: can now include timeclock/timedot files (#320)

Browse Source 
journal files can now include journal, timeclock or timedot files (but
not yet CSV files). Also timeclock/timedot files no longer support
default year directives.

The Hledger.Read.* modules have been reorganised for better reuse.
Hledger.Read.Utils has been renamed Hledger.Read.Common and holds
low-level parsers & utilities; high-level read utilities have moved to
Hledger.Read.
This commit is contained in:
Simon Michael 2016-05-17 19:46:54 -07:00
parent 4dd7dba771
commit 84097b75c7
11 changed files with 1095 additions and 1073 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

197
hledger-lib/Hledger/Read.hs
View File

@ -8,7 +8,8 @@ to import modules below this one.
-} -}
module Hledger.Read ( module Hledger.Read
(
readFormatNames, readFormatNames,
-- * Journal reading API -- * Journal reading API
defaultJournalPath, defaultJournalPath,
@ -33,22 +34,210 @@ module Hledger.Read (
tests_Hledger_Read, tests_Hledger_Read,
) )
where where
import qualified Control.Exception as C
import Control.Monad.Except import Control.Monad.Except
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import System.Directory (doesFileExist, getHomeDirectory)
import System.Environment (getEnv)
import System.Exit (exitFailure)
import System.FilePath ((</>))
import System.IO (IOMode(..), openFile, stdin, stderr, hSetNewlineMode, universalNewlineMode)
import Test.HUnit import Test.HUnit
import Text.Printf
import Hledger.Data.Types import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.Journal (nullctx) import Hledger.Data.Journal (nullctx)
import Hledger.Read.Util import Hledger.Data.Types
import Hledger.Read.JournalReader as JournalReader import Hledger.Read.JournalReader as JournalReader
import Hledger.Read.TimeclockReader as TimeclockReader
import Hledger.Read.TimedotReader as TimedotReader import Hledger.Read.TimedotReader as TimedotReader
import Hledger.Read.TimeclockReader as TimeclockReader
import Hledger.Read.CsvReader as CsvReader import Hledger.Read.CsvReader as CsvReader
import Hledger.Utils import Hledger.Utils
import Prelude hiding (getContents, writeFile) import Prelude hiding (getContents, writeFile)
import Hledger.Utils.UTF8IOCompat (hGetContents, writeFile)
-- The available data file readers, each one handling a particular data
-- format. The first is also used as the default for unknown formats.
readers :: [Reader]
readers = [
JournalReader.reader
,TimeclockReader.reader
,TimedotReader.reader
,CsvReader.reader
]
readFormatNames :: [StorageFormat]
readFormatNames = map rFormat readers
journalEnvVar = "LEDGER_FILE"
journalEnvVar2 = "LEDGER"
journalDefaultFilename = ".hledger.journal"
-- | Which readers are worth trying for this (possibly unspecified) format, filepath, and data ?
readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader]
readersFor (format,path,s) =
dbg1 ("possible readers for "++show (format,path,elideRight 30 s)) $
case format of
Just f -> case readerForStorageFormat f of Just r -> [r]
Nothing -> []
Nothing -> case path of Nothing -> readers
Just p -> case readersForPathAndData (p,s) of [] -> readers
rs -> rs
-- | 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
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,String) -> [Reader]
readersForPathAndData (f,s) = filter (\r -> (rDetector r) f s) readers
-- try each reader in turn, returning the error of the first if all fail
tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> String -> IO (Either String Journal)
tryReaders readers mrulesfile assrt path s = 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') s
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
-- | Read a journal from this string, trying whatever readers seem appropriate:
--
-- - if a format is specified, try that reader only
--
-- - or if one or more readers recognises the file path and data, try those
--
-- - otherwise, try them all.
--
-- 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 -> String -> IO (Either String Journal)
readJournal mformat mrulesfile assrt path s = tryReaders (readersFor (mformat, path, s)) mrulesfile assrt path s
-- | 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 format rulesfile assrt f = readJournalFiles format rulesfile assrt [f]
readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [FilePath] -> IO (Either String Journal)
readJournalFiles format rulesfile assrt fs = do
contents <- fmap concat $ mapM readFileAnyNewline fs
readJournal format rulesfile assrt (listToMaybe fs) contents
where
readFileAnyNewline f = do
requireJournalFileExists f
h <- fileHandle f
hSetNewlineMode h universalNewlineMode
hGetContents h
fileHandle "-" = return stdin
fileHandle f = openFile f ReadMode
-- | If the specified journal file does not exist, give a helpful error and quit.
requireJournalFileExists :: FilePath -> IO ()
requireJournalFileExists "-" = return ()
requireJournalFileExists f = do
exists <- doesFileExist f
when (not exists) $ do
hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f
hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"
hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n"
exitFailure
-- | Ensure there is a journal file at the given path, creating an empty one if needed.
ensureJournalFileExists :: FilePath -> IO ()
ensureJournalFileExists f = do
exists <- doesFileExist f
when (not exists) $ do
hPrintf stderr "Creating hledger journal file %s.\n" f
-- note Hledger.Utils.UTF8.* do no line ending conversion on windows,
-- we currently require unix line endings on all platforms.
newJournalContent >>= writeFile f
-- | Give the content for a new auto-created journal file.
newJournalContent :: IO String
newJournalContent = do
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 string, trying all known formats, or simply throw an error.
readJournal' :: String -> IO Journal
readJournal' s = readJournal Nothing Nothing True Nothing s >>= either error' return
tests_readJournal' = [
"readJournal' parses sample journal" ~: do
_ <- samplejournal
assertBool "" True
]
-- tests
samplejournal = readJournal' $ unlines
["2008/01/01 income"
," assets:bank:checking $1"
," income:salary"
,""
,"comment"
,"multi line comment here"
,"for testing purposes"
,"end comment"
,""
,"2008/06/01 gift"
," assets:bank:checking $1"
," income:gifts"
,""
,"2008/06/02 save"
," assets:bank:saving $1"
," assets:bank:checking"
,""
,"2008/06/03 * eat & shop"
," expenses:food $1"
," expenses:supplies $1"
," assets:cash"
,""
,"2008/12/31 * pay off"
," liabilities:debts $1"
," assets:bank:checking"
]
tests_Hledger_Read = TestList $ tests_Hledger_Read = TestList $
tests_readJournal' tests_readJournal'
++ [ ++ [

867
hledger-lib/Hledger/Read/Common.hs Normal file
View File

@ -0,0 +1,867 @@
--- * doc
-- Lines beginning "--- *" are collapsible orgstruct nodes. Emacs users,
-- (add-hook 'haskell-mode-hook
-- (lambda () (set-variable 'orgstruct-heading-prefix-regexp "--- " t))
-- 'orgstruct-mode)
-- and press TAB on nodes to expand/collapse.
{-|
Some common parsers and parsing helpers used by several readers.
-}
--- * module
{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections #-}
module Hledger.Read.Common
where
--- * imports
import Prelude ()
import Prelude.Compat hiding (readFile)
import Control.Monad.Compat
import Control.Monad.Except (ExceptT(..), liftIO, runExceptT, throwError) --, catchError)
import Data.Char (isNumber)
import Data.Functor.Identity
import Data.List.Compat
import Data.List.Split (wordsBy)
import Data.Maybe
import Data.Time.Calendar
import Data.Time.LocalTime
import Safe
import System.Time (getClockTime)
import Text.Parsec hiding (parse)
import Hledger.Data
import Hledger.Utils
--- * parsing utils
-- | A parser of strings with generic user state, monad and return type.
type StringParser u m a = ParsecT String u m a
-- | A string parser with journal-parsing state.
type JournalParser m a = StringParser JournalContext m a
-- | A journal parser that runs in IO and can throw an error mid-parse.
type ErroringJournalParser a = JournalParser (ExceptT String IO) a
-- | Run a string parser with no state in the identity monad.
runStringParser, rsp :: StringParser () Identity a -> String -> Either ParseError a
runStringParser p s = runIdentity $ runParserT p () "" s
rsp = runStringParser
-- | Run a journal parser with a null journal-parsing state.
runJournalParser, rjp :: Monad m => JournalParser m a -> String -> m (Either ParseError a)
runJournalParser p s = runParserT p nullctx "" s
rjp = runJournalParser
-- | Run an error-raising journal parser with a null journal-parsing state.
runErroringJournalParser, rejp :: ErroringJournalParser a -> String -> IO (Either String a)
runErroringJournalParser p s = runExceptT $ runJournalParser p s >>= either (throwError.show) return
rejp = runErroringJournalParser
genericSourcePos :: SourcePos -> GenericSourcePos
genericSourcePos p = GenericSourcePos (sourceName p) (sourceLine p) (sourceColumn p)
-- | Flatten a list of JournalUpdate's (journal-transforming
-- monadic actions which can do IO or raise an exception) into a
-- single equivalent action.
combineJournalUpdates :: [JournalUpdate] -> JournalUpdate
combineJournalUpdates us = foldl' (flip (.)) id <$> sequence us
-- XXX may be contributing to excessive stack use
-- cf http://neilmitchell.blogspot.co.uk/2015/09/detecting-space-leaks.html
-- $ ./devprof +RTS -K576K -xc
-- Exception (reporting due to +RTS -xc): (THUNK_STATIC), stack trace:
-- Hledger.Read.JournalReader.combineJournalUpdates.\,
-- called from Hledger.Read.JournalReader.combineJournalUpdates,
-- called from Hledger.Read.JournalReader.fixedlotprice,
-- called from Hledger.Read.JournalReader.partialbalanceassertion,
-- called from Hledger.Read.JournalReader.getDefaultCommodityAndStyle,
-- called from Hledger.Read.JournalReader.priceamount,
-- called from Hledger.Read.JournalReader.nosymbolamount,
-- called from Hledger.Read.JournalReader.numberp,
-- called from Hledger.Read.JournalReader.rightsymbolamount,
-- called from Hledger.Read.JournalReader.simplecommoditysymbol,
-- called from Hledger.Read.JournalReader.quotedcommoditysymbol,
-- called from Hledger.Read.JournalReader.commoditysymbol,
-- called from Hledger.Read.JournalReader.signp,
-- called from Hledger.Read.JournalReader.leftsymbolamount,
-- called from Hledger.Read.JournalReader.amountp,
-- called from Hledger.Read.JournalReader.spaceandamountormissing,
-- called from Hledger.Read.JournalReader.accountnamep.singlespace,
-- called from Hledger.Utils.Parse.nonspace,
-- called from Hledger.Read.JournalReader.accountnamep,
-- called from Hledger.Read.JournalReader.getAccountAliases,
-- called from Hledger.Read.JournalReader.getParentAccount,
-- called from Hledger.Read.JournalReader.modifiedaccountnamep,
-- called from Hledger.Read.JournalReader.postingp,
-- called from Hledger.Read.JournalReader.postings,
-- called from Hledger.Read.JournalReader.commentStartingWith,
-- called from Hledger.Read.JournalReader.semicoloncomment,
-- called from Hledger.Read.JournalReader.followingcommentp,
-- called from Hledger.Read.JournalReader.descriptionp,
-- called from Hledger.Read.JournalReader.codep,
-- called from Hledger.Read.JournalReader.statusp,
-- called from Hledger.Utils.Parse.spacenonewline,
-- called from Hledger.Read.JournalReader.secondarydatep,
-- called from Hledger.Data.Dates.datesepchar,
-- called from Hledger.Read.JournalReader.datep,
-- called from Hledger.Read.JournalReader.transaction,
-- called from Hledger.Utils.Parse.choice',
-- called from Hledger.Read.JournalReader.directive,
-- called from Hledger.Read.JournalReader.emptyorcommentlinep,
-- called from Hledger.Read.JournalReader.multilinecommentp,
-- called from Hledger.Read.JournalReader.journal.journalItem,
-- called from Hledger.Read.JournalReader.journal,
-- called from Hledger.Read.JournalReader.parseJournalWith,
-- called from Hledger.Read.readJournal.tryReaders.firstSuccessOrBestError,
-- called from Hledger.Read.readJournal.tryReaders,
-- called from Hledger.Read.readJournal,
-- called from Main.main,
-- called from Main.CAF
-- Stack space overflow: current size 33568 bytes.
-- | Given a JournalUpdate-generating parsec parser, file path and data string,
-- parse and post-process a Journal so that it's ready to use, or give an error.
parseAndFinaliseJournal :: ErroringJournalParser (JournalUpdate,JournalContext) -> Bool -> FilePath -> String -> ExceptT String IO Journal
parseAndFinaliseJournal parser assrt f s = do
tc <- liftIO getClockTime
tl <- liftIO getCurrentLocalTime
y <- liftIO getCurrentYear
r <- runParserT parser nullctx{ctxYear=Just y} f s
case r of
Right (updates,ctx) -> do
j <- ap updates (return nulljournal)
case journalFinalise tc tl f s ctx assrt j of
Right j' -> return j'
Left estr -> throwError estr
Left e -> throwError $ show e
setYear :: Monad m => Integer -> JournalParser m ()
setYear y = modifyState (\ctx -> ctx{ctxYear=Just y})
getYear :: Monad m => JournalParser m (Maybe Integer)
getYear = fmap ctxYear getState
setDefaultCommodityAndStyle :: Monad m => (CommoditySymbol,AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle cs = modifyState (\ctx -> ctx{ctxDefaultCommodityAndStyle=Just cs})
getDefaultCommodityAndStyle :: Monad m => JournalParser m (Maybe (CommoditySymbol,AmountStyle))
getDefaultCommodityAndStyle = ctxDefaultCommodityAndStyle `fmap` getState
pushAccount :: Monad m => String -> JournalParser m ()
pushAccount acct = modifyState addAccount
where addAccount ctx0 = ctx0 { ctxAccounts = acct : ctxAccounts ctx0 }
pushParentAccount :: Monad m => String -> JournalParser m ()
pushParentAccount parent = modifyState addParentAccount
where addParentAccount ctx0 = ctx0 { ctxParentAccount = parent : ctxParentAccount ctx0 }
popParentAccount :: Monad m => JournalParser m ()
popParentAccount = do ctx0 <- getState
case ctxParentAccount ctx0 of
[] -> unexpected "End of apply account block with no beginning"
(_:rest) -> setState $ ctx0 { ctxParentAccount = rest }
getParentAccount :: Monad m => JournalParser m String
getParentAccount = fmap (concatAccountNames . reverse . ctxParentAccount) getState
addAccountAlias :: Monad m => AccountAlias -> JournalParser m ()
addAccountAlias a = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases})
getAccountAliases :: Monad m => JournalParser m [AccountAlias]
getAccountAliases = fmap ctxAliases getState
clearAccountAliases :: Monad m => JournalParser m ()
clearAccountAliases = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]})
getIndex :: Monad m => JournalParser m Integer
getIndex = fmap ctxTransactionIndex getState
setIndex :: Monad m => Integer -> JournalParser m ()
setIndex i = modifyState (\ctx -> ctx{ctxTransactionIndex=i})
journalAddFile :: (FilePath,String) -> Journal -> Journal
journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}
-- NOTE: first encountered file to left, to avoid a reverse
-- -- | Terminate parsing entirely, returning the given error message
-- -- with the current parse position prepended.
-- parserError :: String -> ErroringJournalParser a
-- parserError s = do
-- pos <- getPosition
-- parserErrorAt pos s
-- | Terminate parsing entirely, returning the given error message
-- with the given parse position prepended.
parserErrorAt :: SourcePos -> String -> ErroringJournalParser a
parserErrorAt pos s = throwError $ show pos ++ ":\n" ++ s
--- * parsers
--- ** transaction bits
statusp :: Monad m => JournalParser m ClearedStatus
statusp =
choice'
[ many spacenonewline >> char '*' >> return Cleared
, many spacenonewline >> char '!' >> return Pending
, return Uncleared
]
<?> "cleared status"
codep :: Monad m => JournalParser m String
codep = try (do { many1 spacenonewline; char '(' <?> "codep"; anyChar `manyTill` char ')' } ) <|> return ""
descriptionp :: Monad m => JournalParser m String
descriptionp = many (noneOf ";\n")
--- ** dates
-- | Parse a date in YYYY/MM/DD format.
-- Hyphen (-) and period (.) are also allowed as separators.
-- The year may be omitted if a default year has been set.
-- Leading zeroes may be omitted.
datep :: Monad m => JournalParser m Day
datep = do
-- hacky: try to ensure precise errors for invalid dates
-- XXX reported error position is not too good
-- pos <- genericSourcePos <$> getPosition
datestr <- do
c <- digit
cs <- many $ choice' [digit, datesepchar]
return $ c:cs
let sepchars = nub $ sort $ filter (`elem` datesepchars) datestr
when (length sepchars /= 1) $ fail $ "bad date, different separators used: " ++ datestr
let dateparts = wordsBy (`elem` datesepchars) datestr
currentyear <- getYear
[y,m,d] <- case (dateparts,currentyear) of
([m,d],Just y) -> return [show y,m,d]
([_,_],Nothing) -> fail $ "partial date "++datestr++" found, but the current year is unknown"
([y,m,d],_) -> return [y,m,d]
_ -> fail $ "bad date: " ++ datestr
let maybedate = fromGregorianValid (read y) (read m) (read d)
case maybedate of
Nothing -> fail $ "bad date: " ++ datestr
Just date -> return date
<?> "full or partial date"
-- | Parse a date and time in YYYY/MM/DD HH:MM[:SS][+-ZZZZ] format.
-- Hyphen (-) and period (.) are also allowed as date separators.
-- The year may be omitted if a default year has been set.
-- 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 :: Monad m => JournalParser m LocalTime
datetimep = do
day <- datep
many1 spacenonewline
h <- many1 digit
let h' = read h
guard $ h' >= 0 && h' <= 23
char ':'
m <- many1 digit
let m' = read m
guard $ m' >= 0 && m' <= 59
s <- optionMaybe $ char ':' >> many1 digit
let s' = case s of Just sstr -> read sstr
Nothing -> 0
guard $ s' >= 0 && s' <= 59
{- tz <- -}
optionMaybe $ do
plusminus <- oneOf "-+"
d1 <- digit
d2 <- digit
d3 <- digit
d4 <- digit
return $ plusminus:d1:d2:d3:d4:""
-- ltz <- liftIO $ getCurrentTimeZone
-- let tz' = maybe ltz (fromMaybe ltz . parseTime defaultTimeLocale "%z") tz
-- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
secondarydatep :: Monad m => Day -> JournalParser m Day
secondarydatep primarydate = do
char '='
-- kludgy way to use primary date for default year
let withDefaultYear d p = do
y <- getYear
let (y',_,_) = toGregorian d in setYear y'
r <- p
when (isJust y) $ setYear $ fromJust y -- XXX
-- mapM setYear <$> y
return r
withDefaultYear primarydate datep
-- |
-- >> parsewith twoorthreepartdatestringp "2016/01/2"
-- Right "2016/01/2"
-- twoorthreepartdatestringp = do
-- n1 <- many1 digit
-- c <- datesepchar
-- n2 <- many1 digit
-- mn3 <- optionMaybe $ char c >> many1 digit
-- return $ n1 ++ c:n2 ++ maybe "" (c:) mn3
--- ** account names
-- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
modifiedaccountnamep :: Monad m => JournalParser m AccountName
modifiedaccountnamep = do
parent <- getParentAccount
aliases <- getAccountAliases
a <- accountnamep
return $
accountNameApplyAliases aliases $
-- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference
joinAccountNames parent
a
-- | Parse an account name. Account names start with a non-space, may
-- have single spaces inside them, and are terminated by two or more
-- spaces (or end of input). Also they have one or more components of
-- at least one character, separated by the account separator char.
-- (This parser will also consume one following space, if present.)
accountnamep :: Monad m => StringParser u m AccountName
accountnamep = do
a <- do
c <- nonspace
cs <- striptrailingspace <$> many (nonspace <|> singlespace)
return $ c:cs
when (accountNameFromComponents (accountNameComponents a) /= a)
(fail $ "account name seems ill-formed: "++a)
return a
where
singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})
striptrailingspace "" = ""
striptrailingspace s = if last s == ' ' then init s else s
-- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace
-- <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"
--- ** amounts
-- | Parse whitespace then an amount, with an optional left or right
-- currency symbol and optional price, or return the special
-- "missing" marker amount.
spaceandamountormissingp :: Monad m => JournalParser m MixedAmount
spaceandamountormissingp =
try (do
many1 spacenonewline
(Mixed . (:[])) `fmap` amountp <|> return missingmixedamt
) <|> return missingmixedamt
#ifdef TESTS
assertParseEqual' :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion
assertParseEqual' parse expected = either (assertFailure.show) (`is'` expected) parse
is' :: (Eq a, Show a) => a -> a -> Assertion
a `is'` e = assertEqual e a
test_spaceandamountormissingp = do
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " $47.18") (Mixed [usd 47.18])
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "$47.18") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " ") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "") missingmixedamt
#endif
-- | Parse a single-commodity amount, with optional symbol on the left or
-- right, optional unit or total price, and optional (ignored)
-- ledger-style balance assertion or fixed lot price declaration.
amountp :: Monad m => JournalParser m Amount
amountp = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp
#ifdef TESTS
test_amountp = do
assertParseEqual' (parseWithCtx nullctx amountp "$47.18") (usd 47.18)
assertParseEqual' (parseWithCtx nullctx amountp "$1.") (usd 1 `withPrecision` 0)
-- ,"amount with unit price" ~: do
assertParseEqual'
(parseWithCtx nullctx amountp "$10 @ €0.5")
(usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1))
-- ,"amount with total price" ~: do
assertParseEqual'
(parseWithCtx nullctx amountp "$10 @@ €5")
(usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0))
#endif
-- | Parse an amount from a string, or get an error.
amountp' :: String -> Amount
amountp' s =
case runParser (amountp <* eof) nullctx "" s of
Right t -> t
Left err -> error' $ show err -- XXX should throwError
-- | Parse a mixed amount from a string, or get an error.
mamountp' :: String -> MixedAmount
mamountp' = Mixed . (:[]) . amountp'
signp :: Monad m => JournalParser m String
signp = do
sign <- optionMaybe $ oneOf "+-"
return $ case sign of Just '-' -> "-"
_ -> ""
leftsymbolamountp :: Monad m => JournalParser m Amount
leftsymbolamountp = do
sign <- signp
c <- commoditysymbolp
sp <- many spacenonewline
(q,prec,mdec,mgrps) <- numberp
let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
p <- priceamountp
let applysign = if sign=="-" then negate else id
return $ applysign $ Amount c q p s
<?> "left-symbol amount"
rightsymbolamountp :: Monad m => JournalParser m Amount
rightsymbolamountp = do
(q,prec,mdec,mgrps) <- numberp
sp <- many spacenonewline
c <- commoditysymbolp
p <- priceamountp
let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
return $ Amount c q p s
<?> "right-symbol amount"
nosymbolamountp :: Monad m => JournalParser m Amount
nosymbolamountp = do
(q,prec,mdec,mgrps) <- numberp
p <- priceamountp
-- apply the most recently seen default commodity and style to this commodityless amount
defcs <- getDefaultCommodityAndStyle
let (c,s) = case defcs of
Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) prec})
Nothing -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps})
return $ Amount c q p s
<?> "no-symbol amount"
commoditysymbolp :: Monad m => JournalParser m String
commoditysymbolp = (quotedcommoditysymbolp <|> simplecommoditysymbolp) <?> "commodity symbol"
quotedcommoditysymbolp :: Monad m => JournalParser m String
quotedcommoditysymbolp = do
char '"'
s <- many1 $ noneOf ";\n\""
char '"'
return s
simplecommoditysymbolp :: Monad m => JournalParser m String
simplecommoditysymbolp = many1 (noneOf nonsimplecommoditychars)
priceamountp :: Monad m => JournalParser m Price
priceamountp =
try (do
many spacenonewline
char '@'
try (do
char '@'
many spacenonewline
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
return $ TotalPrice a)
<|> (do
many spacenonewline
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
return $ UnitPrice a))
<|> return NoPrice
partialbalanceassertionp :: Monad m => JournalParser m (Maybe MixedAmount)
partialbalanceassertionp =
try (do
many spacenonewline
char '='
many spacenonewline
a <- amountp -- XXX should restrict to a simple amount
return $ Just $ Mixed [a])
<|> return Nothing
-- balanceassertion :: Monad m => JournalParser m (Maybe MixedAmount)
-- balanceassertion =
-- try (do
-- many spacenonewline
-- string "=="
-- many spacenonewline
-- a <- amountp -- XXX should restrict to a simple amount
-- return $ Just $ Mixed [a])
-- <|> return Nothing
-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
fixedlotpricep :: Monad m => JournalParser m (Maybe Amount)
fixedlotpricep =
try (do
many spacenonewline
char '{'
many spacenonewline
char '='
many spacenonewline
a <- amountp -- XXX should restrict to a simple amount
many spacenonewline
char '}'
return $ Just a)
<|> return Nothing
-- | Parse a string representation of a number for its value and display
-- attributes.
--
-- Some international number formats are accepted, eg either period or comma
-- may be used for the decimal point, and the other of these may be used for
-- separating digit groups in the integer part. See
-- http://en.wikipedia.org/wiki/Decimal_separator for more examples.
--
-- This returns: the parsed numeric value, the precision (number of digits
-- seen following the decimal point), the decimal point character used if any,
-- and the digit group style if any.
--
numberp :: Monad m => JournalParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
numberp = do
-- a number is an optional sign followed by a sequence of digits possibly
-- interspersed with periods, commas, or both
-- ptrace "numberp"
sign <- signp
parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']
dbg8 "numberp parsed" (sign,parts) `seq` return ()
-- check the number is well-formed and identify the decimal point and digit
-- group separator characters used, if any
let (numparts, puncparts) = partition numeric parts
(ok, mdecimalpoint, mseparator) =
case (numparts, puncparts) of
([],_) -> (False, Nothing, Nothing) -- no digits, not ok
(_,[]) -> (True, Nothing, Nothing) -- digits with no punctuation, ok
(_,[[d]]) -> (True, Just d, Nothing) -- just a single punctuation of length 1, assume it's a decimal point
(_,[_]) -> (False, Nothing, Nothing) -- a single punctuation of some other length, not ok
(_,_:_:_) -> -- two or more punctuations
let (s:ss, d) = (init puncparts, last puncparts) -- the leftmost is a separator and the rightmost may be a decimal point
in if any ((/=1).length) puncparts -- adjacent punctuation chars, not ok
|| any (s/=) ss -- separator chars vary, not ok
|| head parts == s -- number begins with a separator char, not ok
then (False, Nothing, Nothing)
else if s == d
then (True, Nothing, Just $ head s) -- just one kind of punctuation - must be separators
else (True, Just $ head d, Just $ head s) -- separator(s) and a decimal point
unless ok $ fail $ "number seems ill-formed: "++concat parts
-- get the digit group sizes and digit group style if any
let (intparts',fracparts') = span ((/= mdecimalpoint) . Just . head) parts
(intparts, fracpart) = (filter numeric intparts', filter numeric fracparts')
groupsizes = reverse $ case map length intparts of
(a:b:cs) | a < b -> b:cs
gs -> gs
mgrps = (`DigitGroups` groupsizes) <$> mseparator
-- put the parts back together without digit group separators, get the precision and parse the value
let int = concat $ "":intparts
frac = concat $ "":fracpart
precision = length frac
int' = if null int then "0" else int
frac' = if null frac then "0" else frac
quantity = read $ sign++int'++"."++frac' -- this read should never fail
return $ dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" (quantity,precision,mdecimalpoint,mgrps)
<?> "numberp"
where
numeric = isNumber . headDef '_'
-- test_numberp = do
-- let s `is` n = assertParseEqual (parseWithCtx nullctx numberp s) n
-- assertFails = assertBool . isLeft . parseWithCtx nullctx numberp
-- assertFails ""
-- "0" `is` (0, 0, '.', ',', [])
-- "1" `is` (1, 0, '.', ',', [])
-- "1.1" `is` (1.1, 1, '.', ',', [])
-- "1,000.1" `is` (1000.1, 1, '.', ',', [3])
-- "1.00.000,1" `is` (100000.1, 1, ',', '.', [3,2])
-- "1,000,000" `is` (1000000, 0, '.', ',', [3,3])
-- "1." `is` (1, 0, '.', ',', [])
-- "1," `is` (1, 0, ',', '.', [])
-- ".1" `is` (0.1, 1, '.', ',', [])
-- ",1" `is` (0.1, 1, ',', '.', [])
-- assertFails "1,000.000,1"
-- assertFails "1.000,000.1"
-- assertFails "1,000.000.1"
-- assertFails "1,,1"
-- assertFails "1..1"
-- assertFails ".1,"
-- assertFails ",1."
--- ** comments
multilinecommentp :: Monad m => JournalParser m ()
multilinecommentp = do
string "comment" >> many spacenonewline >> newline
go
where
go = try (eof <|> (string "end comment" >> newline >> return ()))
<|> (anyLine >> go)
anyLine = anyChar `manyTill` newline
emptyorcommentlinep :: Monad m => JournalParser m ()
emptyorcommentlinep = do
many spacenonewline >> (commentp <|> (many spacenonewline >> newline >> return ""))
return ()
-- | Parse a possibly multi-line comment following a semicolon.
followingcommentp :: Monad m => JournalParser m String
followingcommentp =
-- ptrace "followingcommentp"
do samelinecomment <- many spacenonewline >> (try semicoloncommentp <|> (newline >> return ""))
newlinecomments <- many (try (many1 spacenonewline >> semicoloncommentp))
return $ unlines $ samelinecomment:newlinecomments
-- | Parse a possibly multi-line comment following a semicolon, and
-- any tags and/or posting dates within it. Posting dates can be
-- expressed with "date"/"date2" tags and/or bracketed dates. The
-- dates are parsed in full here so that errors are reported in the
-- right position. Missing years can be inferred if a default date is
-- provided.
--
-- >>> rejp (followingcommentandtagsp (Just $ fromGregorian 2000 1 2)) "; a:b, date:3/4, [=5/6]"
-- Right ("a:b, date:3/4, [=5/6]\n",[("a","b"),("date","3/4")],Just 2000-03-04,Just 2000-05-06)
--
-- Year unspecified and no default provided -> unknown year error, at correct position:
-- >>> rejp (followingcommentandtagsp Nothing) " ; xxx date:3/4\n ; second line"
-- Left ...line 1, column 22...year is unknown...
--
-- Date tag value contains trailing text - forgot the comma, confused:
-- the syntaxes ? We'll accept the leading date anyway
-- >>> 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 (String, [Tag], Maybe Day, Maybe Day)
followingcommentandtagsp mdefdate = do
-- pdbg 0 "followingcommentandtagsp"
-- Parse a single or multi-line comment, starting on this line or the next one.
-- Save the starting position and preserve all whitespace for the subsequent re-parsing,
-- to get good error positions.
startpos <- getPosition
commentandwhitespace <- do
let semicoloncommentp' = (:) <$> char ';' <*> anyChar `manyTill` eolof
sp1 <- many spacenonewline
l1 <- try semicoloncommentp' <|> (newline >> return "")
ls <- many $ try ((++) <$> many1 spacenonewline <*> semicoloncommentp')
return $ unlines $ (sp1 ++ l1) : ls
let comment = unlines $ map (lstrip . dropWhile (==';') . strip) $ lines commentandwhitespace
-- pdbg 0 $ "commentws:"++show commentandwhitespace
-- pdbg 0 $ "comment:"++show comment
-- Reparse the comment for any tags.
tags <- case runStringParser (setPosition startpos >> tagsp) commentandwhitespace of
Right ts -> return ts
Left e -> throwError $ show e
-- pdbg 0 $ "tags: "++show tags
-- Reparse the comment for any posting dates. Use the transaction date for defaults, if provided.
epdates <- liftIO $ rejp (setPosition startpos >> postingdatesp mdefdate) commentandwhitespace
pdates <- case epdates of
Right ds -> return ds
Left e -> throwError e
-- pdbg 0 $ "pdates: "++show pdates
let mdate = headMay $ map snd $ filter ((=="date").fst) pdates
mdate2 = headMay $ map snd $ filter ((=="date2").fst) pdates
return (comment, tags, mdate, mdate2)
commentp :: Monad m => JournalParser m String
commentp = commentStartingWithp commentchars
commentchars :: [Char]
commentchars = "#;*"
semicoloncommentp :: Monad m => JournalParser m String
semicoloncommentp = commentStartingWithp ";"
commentStartingWithp :: Monad m => String -> JournalParser m String
commentStartingWithp cs = do
-- ptrace "commentStartingWith"
oneOf cs
many spacenonewline
l <- anyChar `manyTill` eolof
optional newline
return l
--- ** tags
-- | Extract any tags (name:value ended by comma or newline) embedded in a string.
--
-- >>> commentTags "a b:, c:c d:d, e"
-- [("b",""),("c","c d:d")]
--
-- >>> commentTags "a [1/1/1] [1/1] [1], [=1/1/1] [=1/1] [=1] [1/1=1/1/1] [1=1/1/1] b:c"
-- [("b","c")]
--
-- --[("date","1/1/1"),("date","1/1"),("date2","1/1/1"),("date2","1/1"),("date","1/1"),("date2","1/1/1"),("date","1"),("date2","1/1/1")]
--
-- >>> commentTags "\na b:, \nd:e, f"
-- [("b",""),("d","e")]
--
commentTags :: String -> [Tag]
commentTags s =
case runStringParser tagsp s of
Right r -> r
Left _ -> [] -- shouldn't happen
-- | Parse all tags found in a string.
tagsp :: StringParser u Identity [Tag]
tagsp = -- do
-- pdbg 0 $ "tagsp"
many (try (nontagp >> tagp))
-- | Parse everything up till the first tag.
--
-- >>> rsp nontagp "\na b:, \nd:e, f"
-- Right "\na "
nontagp :: StringParser u Identity String
nontagp = -- do
-- pdbg 0 "nontagp"
-- anyChar `manyTill` (lookAhead (try (tagorbracketeddatetagsp Nothing >> return ()) <|> eof))
anyChar `manyTill` lookAhead (try (void tagp) <|> eof)
-- XXX costly ?
-- | Tags begin with a colon-suffixed tag name (a word beginning with
-- a letter) and are followed by a tag value (any text up to a comma
-- or newline, whitespace-stripped).
--
-- >>> rsp tagp "a:b b , c AuxDate: 4/2"
-- Right ("a","b b")
--
tagp :: Monad m => StringParser u m Tag
tagp = do
-- pdbg 0 "tagp"
n <- tagnamep
v <- tagvaluep
return (n,v)
-- |
-- >>> rsp tagnamep "a:"
-- Right "a"
tagnamep :: Monad m => StringParser u m String
tagnamep = -- do
-- pdbg 0 "tagnamep"
many1 (noneOf ": \t\n") <* char ':'
tagvaluep :: Monad m => StringParser u m String
tagvaluep = do
-- ptrace "tagvalue"
v <- anyChar `manyTill` (void (try (char ',')) <|> eolof)
return $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v
--- ** posting dates
-- | Parse all posting dates found in a string. Posting dates can be
-- expressed with date/date2 tags and/or bracketed dates. The dates
-- 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 mdefdate = do
-- pdbg 0 $ "postingdatesp"
let p = ((:[]) <$> datetagp mdefdate) <|> bracketeddatetagsp mdefdate
nonp =
many (notFollowedBy p >> anyChar)
-- anyChar `manyTill` (lookAhead (try (p >> return ()) <|> eof))
concat <$> many (try (nonp >> p))
--- ** date tags
-- | Date tags are tags with name "date" or "date2". Their value is
-- parsed as a date, using the provided default date if any for
-- inferring a missing year if needed. Any error in date parsing is
-- reported and terminates parsing.
--
-- >>> rejp (datetagp Nothing) "date: 2000/1/2 "
-- Right ("date",2000-01-02)
--
-- >>> rejp (datetagp (Just $ fromGregorian 2001 2 3)) "date2:3/4"
-- Right ("date2",2001-03-04)
--
-- >>> rejp (datetagp Nothing) "date: 3/4"
-- Left ...line 1, column 9...year is unknown...
--
datetagp :: Maybe Day -> ErroringJournalParser (TagName,Day)
datetagp mdefdate = do
-- pdbg 0 "datetagp"
string "date"
n <- fromMaybe "" <$> optionMaybe (string "2")
char ':'
startpos <- getPosition
v <- tagvaluep
-- re-parse value as a date.
ctx <- getState
ep <- parseWithCtx
ctx{ctxYear=first3.toGregorian <$> mdefdate}
-- The value extends to a comma, newline, or end of file.
-- It seems like ignoring any extra stuff following a date
-- gives better errors here.
(do
setPosition startpos
datep) -- <* eof)
v
case ep
of Left e -> throwError $ show e
Right d -> return ("date"++n, d)
--- ** bracketed dates
-- tagorbracketeddatetagsp :: Monad m => Maybe Day -> StringParser u m [Tag]
-- tagorbracketeddatetagsp mdefdate =
-- bracketeddatetagsp mdefdate <|> ((:[]) <$> tagp)
-- | Parse Ledger-style bracketed posting dates ([DATE=DATE2]), as
-- "date" and/or "date2" tags. Anything that looks like an attempt at
-- this (a square-bracketed sequence of 0123456789/-.= containing at
-- least one digit and one date separator) is also parsed, and will
-- throw an appropriate error.
--
-- The dates are parsed in full here so that errors are reported in
-- the right position. A missing year in DATE can be inferred if a
-- default date is provided. A missing year in DATE2 will be inferred
-- from DATE.
--
-- >>> rejp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]"
-- Right [("date",2016-01-02),("date2",2016-03-04)]
--
-- >>> rejp (bracketeddatetagsp Nothing) "[1]"
-- Left ...not a bracketed date...
--
-- >>> rejp (bracketeddatetagsp Nothing) "[2016/1/32]"
-- Left ...line 1, column 11...bad date...
--
-- >>> rejp (bracketeddatetagsp Nothing) "[1/31]"
-- Left ...line 1, column 6...year is unknown...
--
-- >>> rejp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]"
-- Left ...line 1, column 15...bad date, different separators...
--
bracketeddatetagsp :: Maybe Day -> ErroringJournalParser [(TagName, Day)]
bracketeddatetagsp mdefdate = do
-- pdbg 0 "bracketeddatetagsp"
char '['
startpos <- getPosition
let digits = "0123456789"
s <- many1 (oneOf $ '=':digits++datesepchars)
char ']'
unless (any (`elem` s) digits && any (`elem` datesepchars) s) $
parserFail "not a bracketed date"
-- looks sufficiently like a bracketed date, now we
-- re-parse as dates and throw any errors
ctx <- getState
ep <- parseWithCtx
ctx{ctxYear=first3.toGregorian <$> mdefdate}
(do
setPosition startpos
md1 <- optionMaybe datep
maybe (return ()) (setYear.first3.toGregorian) md1
md2 <- optionMaybe $ char '=' >> datep
eof
return (md1,md2)
)
s
case ep
of Left e -> throwError $ show e
Right (md1,md2) -> return $ catMaybes
[("date",) <$> md1, ("date2",) <$> md2]

2
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -51,7 +51,7 @@ import Text.Printf (hPrintf,printf)
import Hledger.Data import Hledger.Data
import Hledger.Utils.UTF8IOCompat (getContents) import Hledger.Utils.UTF8IOCompat (getContents)
import Hledger.Utils import Hledger.Utils
import Hledger.Read.JournalReader (amountp, statusp, genericSourcePos) import Hledger.Read.Common (amountp, statusp, genericSourcePos)
reader :: Reader reader :: Reader

861
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -19,12 +19,16 @@ reader should handle many ledger files as well. Example:
assets:cash assets:cash
@ @
Journal format supports the include directive which can read files in
other formats, so the other file format readers need to be importable
here. Some low-level journal syntax parsers which those readers also
use are therefore defined separately in Hledger.Read.Common, avoiding
import cycles.
-} -}
--- * module --- * module
-- {-# OPTIONS_GHC -F -pgmF htfpp #-}
{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections #-} {-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections #-}
module Hledger.Read.JournalReader ( module Hledger.Read.JournalReader (
@ -64,27 +68,18 @@ module Hledger.Read.JournalReader (
emptyorcommentlinep, emptyorcommentlinep,
followingcommentp, followingcommentp,
accountaliasp accountaliasp
-- * Tests -- * Tests
,tests_Hledger_Read_JournalReader ,tests_Hledger_Read_JournalReader
#ifdef TESTS
-- disabled by default, HTF not available on windows
,htf_thisModulesTests
,htf_Hledger_Read_JournalReader_importedTests
#endif
) )
where where
--- * imports --- * imports
import Prelude () import Prelude ()
import Prelude.Compat hiding (readFile) import Prelude.Compat hiding (readFile)
import qualified Control.Exception as C import qualified Control.Exception as C
import Control.Monad.Compat
import Control.Monad.Except (ExceptT(..), liftIO, runExceptT, throwError, catchError) import Control.Monad.Except (ExceptT(..), liftIO, runExceptT, throwError, catchError)
import Data.Char (isNumber)
import Data.Functor.Identity
import Data.List.Compat
import Data.List.Split (wordsBy)
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.LocalTime import Data.Time.LocalTime
import Safe import Safe
@ -96,9 +91,11 @@ import Text.Parsec.Error
import Text.Parsec hiding (parse) import Text.Parsec hiding (parse)
import Text.Printf import Text.Printf
import System.FilePath import System.FilePath
import System.Time (getClockTime)
import Hledger.Data import Hledger.Data
import Hledger.Read.Common
import Hledger.Read.TimeclockReader (timeclockfilep)
import Hledger.Read.TimedotReader (timedotfilep)
import Hledger.Utils import Hledger.Utils
@ -121,154 +118,6 @@ detect f s
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
parse _ = parseAndFinaliseJournal journalp parse _ = parseAndFinaliseJournal journalp
--- * parsing utils
-- | A parser of strings with generic user state, monad and return type.
type StringParser u m a = ParsecT String u m a
-- | A string parser with journal-parsing state.
type JournalParser m a = StringParser JournalContext m a
-- | A journal parser that runs in IO and can throw an error mid-parse.
type ErroringJournalParser a = JournalParser (ExceptT String IO) a
-- | Run a string parser with no state in the identity monad.
runStringParser, rsp :: StringParser () Identity a -> String -> Either ParseError a
runStringParser p s = runIdentity $ runParserT p () "" s
rsp = runStringParser
-- | Run a journal parser with a null journal-parsing state.
runJournalParser, rjp :: Monad m => JournalParser m a -> String -> m (Either ParseError a)
runJournalParser p s = runParserT p nullctx "" s
rjp = runJournalParser
-- | Run an error-raising journal parser with a null journal-parsing state.
runErroringJournalParser, rejp :: ErroringJournalParser a -> String -> IO (Either String a)
runErroringJournalParser p s = runExceptT $ runJournalParser p s >>= either (throwError.show) return
rejp = runErroringJournalParser
genericSourcePos :: SourcePos -> GenericSourcePos
genericSourcePos p = GenericSourcePos (sourceName p) (sourceLine p) (sourceColumn p)
-- | Flatten a list of JournalUpdate's (journal-transforming
-- monadic actions which can do IO or raise an exception) into a
-- single equivalent action.
combineJournalUpdates :: [JournalUpdate] -> JournalUpdate
combineJournalUpdates us = foldl' (flip (.)) id <$> sequence us
-- XXX may be contributing to excessive stack use
-- cf http://neilmitchell.blogspot.co.uk/2015/09/detecting-space-leaks.html
-- $ ./devprof +RTS -K576K -xc
-- Exception (reporting due to +RTS -xc): (THUNK_STATIC), stack trace:
-- Hledger.Read.JournalReader.combineJournalUpdates.\,
-- called from Hledger.Read.JournalReader.combineJournalUpdates,
-- called from Hledger.Read.JournalReader.fixedlotprice,
-- called from Hledger.Read.JournalReader.partialbalanceassertion,
-- called from Hledger.Read.JournalReader.getDefaultCommodityAndStyle,
-- called from Hledger.Read.JournalReader.priceamount,
-- called from Hledger.Read.JournalReader.nosymbolamount,
-- called from Hledger.Read.JournalReader.numberp,
-- called from Hledger.Read.JournalReader.rightsymbolamount,
-- called from Hledger.Read.JournalReader.simplecommoditysymbol,
-- called from Hledger.Read.JournalReader.quotedcommoditysymbol,
-- called from Hledger.Read.JournalReader.commoditysymbol,
-- called from Hledger.Read.JournalReader.signp,
-- called from Hledger.Read.JournalReader.leftsymbolamount,
-- called from Hledger.Read.JournalReader.amountp,
-- called from Hledger.Read.JournalReader.spaceandamountormissing,
-- called from Hledger.Read.JournalReader.accountnamep.singlespace,
-- called from Hledger.Utils.Parse.nonspace,
-- called from Hledger.Read.JournalReader.accountnamep,
-- called from Hledger.Read.JournalReader.getAccountAliases,
-- called from Hledger.Read.JournalReader.getParentAccount,
-- called from Hledger.Read.JournalReader.modifiedaccountnamep,
-- called from Hledger.Read.JournalReader.postingp,
-- called from Hledger.Read.JournalReader.postings,
-- called from Hledger.Read.JournalReader.commentStartingWith,
-- called from Hledger.Read.JournalReader.semicoloncomment,
-- called from Hledger.Read.JournalReader.followingcommentp,
-- called from Hledger.Read.JournalReader.descriptionp,
-- called from Hledger.Read.JournalReader.codep,
-- called from Hledger.Read.JournalReader.statusp,
-- called from Hledger.Utils.Parse.spacenonewline,
-- called from Hledger.Read.JournalReader.secondarydatep,
-- called from Hledger.Data.Dates.datesepchar,
-- called from Hledger.Read.JournalReader.datep,
-- called from Hledger.Read.JournalReader.transaction,
-- called from Hledger.Utils.Parse.choice',
-- called from Hledger.Read.JournalReader.directive,
-- called from Hledger.Read.JournalReader.emptyorcommentlinep,
-- called from Hledger.Read.JournalReader.multilinecommentp,
-- called from Hledger.Read.JournalReader.journal.journalItem,
-- called from Hledger.Read.JournalReader.journal,
-- called from Hledger.Read.JournalReader.parseJournalWith,
-- called from Hledger.Read.readJournal.tryReaders.firstSuccessOrBestError,
-- called from Hledger.Read.readJournal.tryReaders,
-- called from Hledger.Read.readJournal,
-- called from Main.main,
-- called from Main.CAF
-- Stack space overflow: current size 33568 bytes.
-- | Given a JournalUpdate-generating parsec parser, file path and data string,
-- parse and post-process a Journal so that it's ready to use, or give an error.
parseAndFinaliseJournal :: ErroringJournalParser (JournalUpdate,JournalContext) -> Bool -> FilePath -> String -> ExceptT String IO Journal
parseAndFinaliseJournal parser assrt f s = do
tc <- liftIO getClockTime
tl <- liftIO getCurrentLocalTime
y <- liftIO getCurrentYear
r <- runParserT parser nullctx{ctxYear=Just y} f s
case r of
Right (updates,ctx) -> do
j <- ap updates (return nulljournal)
case journalFinalise tc tl f s ctx assrt j of
Right j' -> return j'
Left estr -> throwError estr
Left e -> throwError $ show e
setYear :: Monad m => Integer -> JournalParser m ()
setYear y = modifyState (\ctx -> ctx{ctxYear=Just y})
getYear :: Monad m => JournalParser m (Maybe Integer)
getYear = fmap ctxYear getState
setDefaultCommodityAndStyle :: Monad m => (CommoditySymbol,AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle cs = modifyState (\ctx -> ctx{ctxDefaultCommodityAndStyle=Just cs})
getDefaultCommodityAndStyle :: Monad m => JournalParser m (Maybe (CommoditySymbol,AmountStyle))
getDefaultCommodityAndStyle = ctxDefaultCommodityAndStyle `fmap` getState
pushAccount :: Monad m => String -> JournalParser m ()
pushAccount acct = modifyState addAccount
where addAccount ctx0 = ctx0 { ctxAccounts = acct : ctxAccounts ctx0 }
pushParentAccount :: Monad m => String -> JournalParser m ()
pushParentAccount parent = modifyState addParentAccount
where addParentAccount ctx0 = ctx0 { ctxParentAccount = parent : ctxParentAccount ctx0 }
popParentAccount :: Monad m => JournalParser m ()
popParentAccount = do ctx0 <- getState
case ctxParentAccount ctx0 of
[] -> unexpected "End of apply account block with no beginning"
(_:rest) -> setState $ ctx0 { ctxParentAccount = rest }
getParentAccount :: Monad m => JournalParser m String
getParentAccount = fmap (concatAccountNames . reverse . ctxParentAccount) getState
addAccountAlias :: Monad m => AccountAlias -> JournalParser m ()
addAccountAlias a = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases})
getAccountAliases :: Monad m => JournalParser m [AccountAlias]
getAccountAliases = fmap ctxAliases getState
clearAccountAliases :: Monad m => JournalParser m ()
clearAccountAliases = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]})
getIndex :: Monad m => JournalParser m Integer
getIndex = fmap ctxTransactionIndex getState
setIndex :: Monad m => Integer -> JournalParser m ()
setIndex i = modifyState (\ctx -> ctx{ctxTransactionIndex=i})
--- * parsers --- * parsers
--- ** journal --- ** journal
@ -325,11 +174,18 @@ includedirectivep = do
outerState <- getState outerState <- getState
outerPos <- getPosition outerPos <- getPosition
let curdir = takeDirectory (sourceName outerPos) let curdir = takeDirectory (sourceName outerPos)
-- XXX clean this up, probably after getting rid of JournalUpdate
let (u::ExceptT String IO (Journal -> Journal, JournalContext)) = do let (u::ExceptT String IO (Journal -> Journal, JournalContext)) = do
filepath <- expandPath curdir filename filepath <- expandPath curdir filename
txt <- readFileOrError outerPos filepath txt <- readFileOrError outerPos filepath
let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
r <- runParserT journalp outerState filepath txt r <- runParserT
(choice' [journalp
,timeclockfilep
,timedotfilep
-- can't include a csv file yet, that reader is special
])
outerState filepath txt
case r of case r of
Right (ju, ctx) -> do Right (ju, ctx) -> do
@ -346,12 +202,6 @@ includedirectivep = do
Left err -> return $ throwError err Left err -> return $ throwError err
Right (ju, _finalparsectx) -> return $ ExceptT $ return $ Right ju Right (ju, _finalparsectx) -> return $ ExceptT $ return $ Right ju
journalAddFile :: (FilePath,String) -> Journal -> Journal
journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}
-- NOTE: first encountered file to left, to avoid a reverse
indentedlinep = many1 spacenonewline >> (rstrip <$> restofline)
accountdirectivep :: ErroringJournalParser JournalUpdate accountdirectivep :: ErroringJournalParser JournalUpdate
accountdirectivep = do accountdirectivep = do
string "account" string "account"
@ -362,17 +212,7 @@ accountdirectivep = do
pushAccount acct pushAccount acct
return $ ExceptT $ return $ Right id return $ ExceptT $ return $ Right id
-- -- | Terminate parsing entirely, returning the given error message indentedlinep = many1 spacenonewline >> (rstrip <$> restofline)
-- -- with the current parse position prepended.
-- parserError :: String -> ErroringJournalParser a
-- parserError s = do
-- pos <- getPosition
-- parserErrorAt pos s
-- | Terminate parsing entirely, returning the given error message
-- with the given parse position prepended.
parserErrorAt :: SourcePos -> String -> ErroringJournalParser a
parserErrorAt pos s = throwError $ show pos ++ ":\n" ++ s
-- | Parse a one-line or multi-line commodity directive. -- | Parse a one-line or multi-line commodity directive.
-- --
@ -673,107 +513,6 @@ test_transactionp = do
assertEqual 2 (let Right t = p in length $ tpostings t) assertEqual 2 (let Right t = p in length $ tpostings t)
#endif #endif
statusp :: Monad m => JournalParser m ClearedStatus
statusp =
choice'
[ many spacenonewline >> char '*' >> return Cleared
, many spacenonewline >> char '!' >> return Pending
, return Uncleared
]
<?> "cleared status"
codep :: Monad m => JournalParser m String
codep = try (do { many1 spacenonewline; char '(' <?> "codep"; anyChar `manyTill` char ')' } ) <|> return ""
descriptionp = many (noneOf ";\n")
--- ** dates
-- | Parse a date in YYYY/MM/DD format.
-- Hyphen (-) and period (.) are also allowed as separators.
-- The year may be omitted if a default year has been set.
-- Leading zeroes may be omitted.
datep :: Monad m => JournalParser m Day
datep = do
-- hacky: try to ensure precise errors for invalid dates
-- XXX reported error position is not too good
-- pos <- genericSourcePos <$> getPosition
datestr <- do
c <- digit
cs <- many $ choice' [digit, datesepchar]
return $ c:cs
let sepchars = nub $ sort $ filter (`elem` datesepchars) datestr
when (length sepchars /= 1) $ fail $ "bad date, different separators used: " ++ datestr
let dateparts = wordsBy (`elem` datesepchars) datestr
currentyear <- getYear
[y,m,d] <- case (dateparts,currentyear) of
([m,d],Just y) -> return [show y,m,d]
([_,_],Nothing) -> fail $ "partial date "++datestr++" found, but the current year is unknown"
([y,m,d],_) -> return [y,m,d]
_ -> fail $ "bad date: " ++ datestr
let maybedate = fromGregorianValid (read y) (read m) (read d)
case maybedate of
Nothing -> fail $ "bad date: " ++ datestr
Just date -> return date
<?> "full or partial date"
-- | Parse a date and time in YYYY/MM/DD HH:MM[:SS][+-ZZZZ] format.
-- Hyphen (-) and period (.) are also allowed as date separators.
-- The year may be omitted if a default year has been set.
-- 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 :: Monad m => JournalParser m LocalTime
datetimep = do
day <- datep
many1 spacenonewline
h <- many1 digit
let h' = read h
guard $ h' >= 0 && h' <= 23
char ':'
m <- many1 digit
let m' = read m
guard $ m' >= 0 && m' <= 59
s <- optionMaybe $ char ':' >> many1 digit
let s' = case s of Just sstr -> read sstr
Nothing -> 0
guard $ s' >= 0 && s' <= 59
{- tz <- -}
optionMaybe $ do
plusminus <- oneOf "-+"
d1 <- digit
d2 <- digit
d3 <- digit
d4 <- digit
return $ plusminus:d1:d2:d3:d4:""
-- ltz <- liftIO $ getCurrentTimeZone
-- let tz' = maybe ltz (fromMaybe ltz . parseTime defaultTimeLocale "%z") tz
-- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
secondarydatep :: Monad m => Day -> JournalParser m Day
secondarydatep primarydate = do
char '='
-- kludgy way to use primary date for default year
let withDefaultYear d p = do
y <- getYear
let (y',_,_) = toGregorian d in setYear y'
r <- p
when (isJust y) $ setYear $ fromJust y -- XXX
-- mapM setYear <$> y
return r
withDefaultYear primarydate datep
-- |
-- >> parsewith twoorthreepartdatestringp "2016/01/2"
-- Right "2016/01/2"
-- twoorthreepartdatestringp = do
-- n1 <- many1 digit
-- c <- datesepchar
-- n2 <- many1 digit
-- mn3 <- optionMaybe $ char c >> many1 digit
-- return $ n1 ++ c:n2 ++ maybe "" (c:) mn3
--- ** postings --- ** postings
-- Parse the following whitespace-beginning lines as postings, posting -- Parse the following whitespace-beginning lines as postings, posting
@ -861,566 +600,6 @@ test_postingp = do
-- assertEqual (Just nullmixedamt) (pbalanceassertion p) -- assertEqual (Just nullmixedamt) (pbalanceassertion p)
#endif #endif
--- ** account names
-- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
modifiedaccountnamep :: Monad m => JournalParser m AccountName
modifiedaccountnamep = do
parent <- getParentAccount
aliases <- getAccountAliases
a <- accountnamep
return $
accountNameApplyAliases aliases $
-- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference
joinAccountNames parent
a
-- | Parse an account name. Account names start with a non-space, may
-- have single spaces inside them, and are terminated by two or more
-- spaces (or end of input). Also they have one or more components of
-- at least one character, separated by the account separator char.
-- (This parser will also consume one following space, if present.)
accountnamep :: Monad m => StringParser u m AccountName
accountnamep = do
a <- do
c <- nonspace
cs <- striptrailingspace <$> many (nonspace <|> singlespace)
return $ c:cs
when (accountNameFromComponents (accountNameComponents a) /= a)
(fail $ "account name seems ill-formed: "++a)
return a
where
singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})
striptrailingspace "" = ""
striptrailingspace s = if last s == ' ' then init s else s
-- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace
-- <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"
--- ** amounts
-- | Parse whitespace then an amount, with an optional left or right
-- currency symbol and optional price, or return the special
-- "missing" marker amount.
spaceandamountormissingp :: Monad m => JournalParser m MixedAmount
spaceandamountormissingp =
try (do
many1 spacenonewline
(Mixed . (:[])) `fmap` amountp <|> return missingmixedamt
) <|> return missingmixedamt
#ifdef TESTS
assertParseEqual' :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion
assertParseEqual' parse expected = either (assertFailure.show) (`is'` expected) parse
is' :: (Eq a, Show a) => a -> a -> Assertion
a `is'` e = assertEqual e a
test_spaceandamountormissingp = do
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " $47.18") (Mixed [usd 47.18])
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "$47.18") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " ") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "") missingmixedamt
#endif
-- | Parse a single-commodity amount, with optional symbol on the left or
-- right, optional unit or total price, and optional (ignored)
-- ledger-style balance assertion or fixed lot price declaration.
amountp :: Monad m => JournalParser m Amount
amountp = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp
#ifdef TESTS
test_amountp = do
assertParseEqual' (parseWithCtx nullctx amountp "$47.18") (usd 47.18)
assertParseEqual' (parseWithCtx nullctx amountp "$1.") (usd 1 `withPrecision` 0)
-- ,"amount with unit price" ~: do
assertParseEqual'
(parseWithCtx nullctx amountp "$10 @ €0.5")
(usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1))
-- ,"amount with total price" ~: do
assertParseEqual'
(parseWithCtx nullctx amountp "$10 @@ €5")
(usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0))
#endif
-- | Parse an amount from a string, or get an error.
amountp' :: String -> Amount
amountp' s =
case runParser (amountp <* eof) nullctx "" s of
Right t -> t
Left err -> error' $ show err -- XXX should throwError
-- | Parse a mixed amount from a string, or get an error.
mamountp' :: String -> MixedAmount
mamountp' = Mixed . (:[]) . amountp'
signp :: Monad m => JournalParser m String
signp = do
sign <- optionMaybe $ oneOf "+-"
return $ case sign of Just '-' -> "-"
_ -> ""
leftsymbolamountp :: Monad m => JournalParser m Amount
leftsymbolamountp = do
sign <- signp
c <- commoditysymbolp
sp <- many spacenonewline
(q,prec,mdec,mgrps) <- numberp
let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
p <- priceamountp
let applysign = if sign=="-" then negate else id
return $ applysign $ Amount c q p s
<?> "left-symbol amount"
rightsymbolamountp :: Monad m => JournalParser m Amount
rightsymbolamountp = do
(q,prec,mdec,mgrps) <- numberp
sp <- many spacenonewline
c <- commoditysymbolp
p <- priceamountp
let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
return $ Amount c q p s
<?> "right-symbol amount"
nosymbolamountp :: Monad m => JournalParser m Amount
nosymbolamountp = do
(q,prec,mdec,mgrps) <- numberp
p <- priceamountp
-- apply the most recently seen default commodity and style to this commodityless amount
defcs <- getDefaultCommodityAndStyle
let (c,s) = case defcs of
Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) prec})
Nothing -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps})
return $ Amount c q p s
<?> "no-symbol amount"
commoditysymbolp :: Monad m => JournalParser m String
commoditysymbolp = (quotedcommoditysymbolp <|> simplecommoditysymbolp) <?> "commodity symbol"
quotedcommoditysymbolp :: Monad m => JournalParser m String
quotedcommoditysymbolp = do
char '"'
s <- many1 $ noneOf ";\n\""
char '"'
return s
simplecommoditysymbolp :: Monad m => JournalParser m String
simplecommoditysymbolp = many1 (noneOf nonsimplecommoditychars)
priceamountp :: Monad m => JournalParser m Price
priceamountp =
try (do
many spacenonewline
char '@'
try (do
char '@'
many spacenonewline
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
return $ TotalPrice a)
<|> (do
many spacenonewline
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
return $ UnitPrice a))
<|> return NoPrice
partialbalanceassertionp :: Monad m => JournalParser m (Maybe MixedAmount)
partialbalanceassertionp =
try (do
many spacenonewline
char '='
many spacenonewline
a <- amountp -- XXX should restrict to a simple amount
return $ Just $ Mixed [a])
<|> return Nothing
-- balanceassertion :: Monad m => JournalParser m (Maybe MixedAmount)
-- balanceassertion =
-- try (do
-- many spacenonewline
-- string "=="
-- many spacenonewline
-- a <- amountp -- XXX should restrict to a simple amount
-- return $ Just $ Mixed [a])
-- <|> return Nothing
-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
fixedlotpricep :: Monad m => JournalParser m (Maybe Amount)
fixedlotpricep =
try (do
many spacenonewline
char '{'
many spacenonewline
char '='
many spacenonewline
a <- amountp -- XXX should restrict to a simple amount
many spacenonewline
char '}'
return $ Just a)
<|> return Nothing
-- | Parse a string representation of a number for its value and display
-- attributes.
--
-- Some international number formats are accepted, eg either period or comma
-- may be used for the decimal point, and the other of these may be used for
-- separating digit groups in the integer part. See
-- http://en.wikipedia.org/wiki/Decimal_separator for more examples.
--
-- This returns: the parsed numeric value, the precision (number of digits
-- seen following the decimal point), the decimal point character used if any,
-- and the digit group style if any.
--
numberp :: Monad m => JournalParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
numberp = do
-- a number is an optional sign followed by a sequence of digits possibly
-- interspersed with periods, commas, or both
-- ptrace "numberp"
sign <- signp
parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']
dbg8 "numberp parsed" (sign,parts) `seq` return ()
-- check the number is well-formed and identify the decimal point and digit
-- group separator characters used, if any
let (numparts, puncparts) = partition numeric parts
(ok, mdecimalpoint, mseparator) =
case (numparts, puncparts) of
([],_) -> (False, Nothing, Nothing) -- no digits, not ok
(_,[]) -> (True, Nothing, Nothing) -- digits with no punctuation, ok
(_,[[d]]) -> (True, Just d, Nothing) -- just a single punctuation of length 1, assume it's a decimal point
(_,[_]) -> (False, Nothing, Nothing) -- a single punctuation of some other length, not ok
(_,_:_:_) -> -- two or more punctuations
let (s:ss, d) = (init puncparts, last puncparts) -- the leftmost is a separator and the rightmost may be a decimal point
in if any ((/=1).length) puncparts -- adjacent punctuation chars, not ok
|| any (s/=) ss -- separator chars vary, not ok
|| head parts == s -- number begins with a separator char, not ok
then (False, Nothing, Nothing)
else if s == d
then (True, Nothing, Just $ head s) -- just one kind of punctuation - must be separators
else (True, Just $ head d, Just $ head s) -- separator(s) and a decimal point
unless ok $ fail $ "number seems ill-formed: "++concat parts
-- get the digit group sizes and digit group style if any
let (intparts',fracparts') = span ((/= mdecimalpoint) . Just . head) parts
(intparts, fracpart) = (filter numeric intparts', filter numeric fracparts')
groupsizes = reverse $ case map length intparts of
(a:b:cs) | a < b -> b:cs
gs -> gs
mgrps = (`DigitGroups` groupsizes) <$> mseparator
-- put the parts back together without digit group separators, get the precision and parse the value
let int = concat $ "":intparts
frac = concat $ "":fracpart
precision = length frac
int' = if null int then "0" else int
frac' = if null frac then "0" else frac
quantity = read $ sign++int'++"."++frac' -- this read should never fail
return $ dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" (quantity,precision,mdecimalpoint,mgrps)
<?> "numberp"
where
numeric = isNumber . headDef '_'
-- test_numberp = do
-- let s `is` n = assertParseEqual (parseWithCtx nullctx numberp s) n
-- assertFails = assertBool . isLeft . parseWithCtx nullctx numberp
-- assertFails ""
-- "0" `is` (0, 0, '.', ',', [])
-- "1" `is` (1, 0, '.', ',', [])
-- "1.1" `is` (1.1, 1, '.', ',', [])
-- "1,000.1" `is` (1000.1, 1, '.', ',', [3])
-- "1.00.000,1" `is` (100000.1, 1, ',', '.', [3,2])
-- "1,000,000" `is` (1000000, 0, '.', ',', [3,3])
-- "1." `is` (1, 0, '.', ',', [])
-- "1," `is` (1, 0, ',', '.', [])
-- ".1" `is` (0.1, 1, '.', ',', [])
-- ",1" `is` (0.1, 1, ',', '.', [])
-- assertFails "1,000.000,1"
-- assertFails "1.000,000.1"
-- assertFails "1,000.000.1"
-- assertFails "1,,1"
-- assertFails "1..1"
-- assertFails ".1,"
-- assertFails ",1."
--- ** comments
multilinecommentp :: Monad m => JournalParser m ()
multilinecommentp = do
string "comment" >> many spacenonewline >> newline
go
where
go = try (eof <|> (string "end comment" >> newline >> return ()))
<|> (anyLine >> go)
anyLine = anyChar `manyTill` newline
emptyorcommentlinep :: Monad m => JournalParser m ()
emptyorcommentlinep = do
many spacenonewline >> (commentp <|> (many spacenonewline >> newline >> return ""))
return ()
-- | Parse a possibly multi-line comment following a semicolon.
followingcommentp :: Monad m => JournalParser m String
followingcommentp =
-- ptrace "followingcommentp"
do samelinecomment <- many spacenonewline >> (try semicoloncommentp <|> (newline >> return ""))
newlinecomments <- many (try (many1 spacenonewline >> semicoloncommentp))
return $ unlines $ samelinecomment:newlinecomments
-- | Parse a possibly multi-line comment following a semicolon, and
-- any tags and/or posting dates within it. Posting dates can be
-- expressed with "date"/"date2" tags and/or bracketed dates. The
-- dates are parsed in full here so that errors are reported in the
-- right position. Missing years can be inferred if a default date is
-- provided.
--
-- >>> rejp (followingcommentandtagsp (Just $ fromGregorian 2000 1 2)) "; a:b, date:3/4, [=5/6]"
-- Right ("a:b, date:3/4, [=5/6]\n",[("a","b"),("date","3/4")],Just 2000-03-04,Just 2000-05-06)
--
-- Year unspecified and no default provided -> unknown year error, at correct position:
-- >>> rejp (followingcommentandtagsp Nothing) " ; xxx date:3/4\n ; second line"
-- Left ...line 1, column 22...year is unknown...
--
-- Date tag value contains trailing text - forgot the comma, confused:
-- the syntaxes ? We'll accept the leading date anyway
-- >>> 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 (String, [Tag], Maybe Day, Maybe Day)
followingcommentandtagsp mdefdate = do
-- pdbg 0 "followingcommentandtagsp"
-- Parse a single or multi-line comment, starting on this line or the next one.
-- Save the starting position and preserve all whitespace for the subsequent re-parsing,
-- to get good error positions.
startpos <- getPosition
commentandwhitespace <- do
let semicoloncommentp' = (:) <$> char ';' <*> anyChar `manyTill` eolof
sp1 <- many spacenonewline
l1 <- try semicoloncommentp' <|> (newline >> return "")
ls <- many $ try ((++) <$> many1 spacenonewline <*> semicoloncommentp')
return $ unlines $ (sp1 ++ l1) : ls
let comment = unlines $ map (lstrip . dropWhile (==';') . strip) $ lines commentandwhitespace
-- pdbg 0 $ "commentws:"++show commentandwhitespace
-- pdbg 0 $ "comment:"++show comment
-- Reparse the comment for any tags.
tags <- case runStringParser (setPosition startpos >> tagsp) commentandwhitespace of
Right ts -> return ts
Left e -> throwError $ show e
-- pdbg 0 $ "tags: "++show tags
-- Reparse the comment for any posting dates. Use the transaction date for defaults, if provided.
epdates <- liftIO $ rejp (setPosition startpos >> postingdatesp mdefdate) commentandwhitespace
pdates <- case epdates of
Right ds -> return ds
Left e -> throwError e
-- pdbg 0 $ "pdates: "++show pdates
let mdate = headMay $ map snd $ filter ((=="date").fst) pdates
mdate2 = headMay $ map snd $ filter ((=="date2").fst) pdates
return (comment, tags, mdate, mdate2)
commentp :: Monad m => JournalParser m String
commentp = commentStartingWithp commentchars
commentchars :: [Char]
commentchars = "#;*"
semicoloncommentp :: Monad m => JournalParser m String
semicoloncommentp = commentStartingWithp ";"
commentStartingWithp :: Monad m => String -> JournalParser m String
commentStartingWithp cs = do
-- ptrace "commentStartingWith"
oneOf cs
many spacenonewline
l <- anyChar `manyTill` eolof
optional newline
return l
--- ** tags
-- | Extract any tags (name:value ended by comma or newline) embedded in a string.
--
-- >>> commentTags "a b:, c:c d:d, e"
-- [("b",""),("c","c d:d")]
--
-- >>> commentTags "a [1/1/1] [1/1] [1], [=1/1/1] [=1/1] [=1] [1/1=1/1/1] [1=1/1/1] b:c"
-- [("b","c")]
--
-- --[("date","1/1/1"),("date","1/1"),("date2","1/1/1"),("date2","1/1"),("date","1/1"),("date2","1/1/1"),("date","1"),("date2","1/1/1")]
--
-- >>> commentTags "\na b:, \nd:e, f"
-- [("b",""),("d","e")]
--
commentTags :: String -> [Tag]
commentTags s =
case runStringParser tagsp s of
Right r -> r
Left _ -> [] -- shouldn't happen
-- | Parse all tags found in a string.
tagsp :: StringParser u Identity [Tag]
tagsp = -- do
-- pdbg 0 $ "tagsp"
many (try (nontagp >> tagp))
-- | Parse everything up till the first tag.
--
-- >>> rsp nontagp "\na b:, \nd:e, f"
-- Right "\na "
nontagp :: StringParser u Identity String
nontagp = -- do
-- pdbg 0 "nontagp"
-- anyChar `manyTill` (lookAhead (try (tagorbracketeddatetagsp Nothing >> return ()) <|> eof))
anyChar `manyTill` lookAhead (try (void tagp) <|> eof)
-- XXX costly ?
-- | Tags begin with a colon-suffixed tag name (a word beginning with
-- a letter) and are followed by a tag value (any text up to a comma
-- or newline, whitespace-stripped).
--
-- >>> rsp tagp "a:b b , c AuxDate: 4/2"
-- Right ("a","b b")
--
tagp :: Monad m => StringParser u m Tag
tagp = do
-- pdbg 0 "tagp"
n <- tagnamep
v <- tagvaluep
return (n,v)
-- |
-- >>> rsp tagnamep "a:"
-- Right "a"
tagnamep :: Monad m => StringParser u m String
tagnamep = -- do
-- pdbg 0 "tagnamep"
many1 (noneOf ": \t\n") <* char ':'
tagvaluep :: Monad m => StringParser u m String
tagvaluep = do
-- ptrace "tagvalue"
v <- anyChar `manyTill` (void (try (char ',')) <|> eolof)
return $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v
--- ** posting dates
-- | Parse all posting dates found in a string. Posting dates can be
-- expressed with date/date2 tags and/or bracketed dates. The dates
-- 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 mdefdate = do
-- pdbg 0 $ "postingdatesp"
let p = ((:[]) <$> datetagp mdefdate) <|> bracketeddatetagsp mdefdate
nonp =
many (notFollowedBy p >> anyChar)
-- anyChar `manyTill` (lookAhead (try (p >> return ()) <|> eof))
concat <$> many (try (nonp >> p))
--- ** date tags
-- | Date tags are tags with name "date" or "date2". Their value is
-- parsed as a date, using the provided default date if any for
-- inferring a missing year if needed. Any error in date parsing is
-- reported and terminates parsing.
--
-- >>> rejp (datetagp Nothing) "date: 2000/1/2 "
-- Right ("date",2000-01-02)
--
-- >>> rejp (datetagp (Just $ fromGregorian 2001 2 3)) "date2:3/4"
-- Right ("date2",2001-03-04)
--
-- >>> rejp (datetagp Nothing) "date: 3/4"
-- Left ...line 1, column 9...year is unknown...
--
datetagp :: Maybe Day -> ErroringJournalParser (TagName,Day)
datetagp mdefdate = do
-- pdbg 0 "datetagp"
string "date"
n <- fromMaybe "" <$> optionMaybe (string "2")
char ':'
startpos <- getPosition
v <- tagvaluep
-- re-parse value as a date.
ctx <- getState
ep <- parseWithCtx
ctx{ctxYear=first3.toGregorian <$> mdefdate}
-- The value extends to a comma, newline, or end of file.
-- It seems like ignoring any extra stuff following a date
-- gives better errors here.
(do
setPosition startpos
datep) -- <* eof)
v
case ep
of Left e -> throwError $ show e
Right d -> return ("date"++n, d)
--- ** bracketed dates
-- tagorbracketeddatetagsp :: Monad m => Maybe Day -> StringParser u m [Tag]
-- tagorbracketeddatetagsp mdefdate =
-- bracketeddatetagsp mdefdate <|> ((:[]) <$> tagp)
-- | Parse Ledger-style bracketed posting dates ([DATE=DATE2]), as
-- "date" and/or "date2" tags. Anything that looks like an attempt at
-- this (a square-bracketed sequence of 0123456789/-.= containing at
-- least one digit and one date separator) is also parsed, and will
-- throw an appropriate error.
--
-- The dates are parsed in full here so that errors are reported in
-- the right position. A missing year in DATE can be inferred if a
-- default date is provided. A missing year in DATE2 will be inferred
-- from DATE.
--
-- >>> rejp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]"
-- Right [("date",2016-01-02),("date2",2016-03-04)]
--
-- >>> rejp (bracketeddatetagsp Nothing) "[1]"
-- Left ...not a bracketed date...
--
-- >>> rejp (bracketeddatetagsp Nothing) "[2016/1/32]"
-- Left ...line 1, column 11...bad date...
--
-- >>> rejp (bracketeddatetagsp Nothing) "[1/31]"
-- Left ...line 1, column 6...year is unknown...
--
-- >>> rejp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]"
-- Left ...line 1, column 15...bad date, different separators...
--
bracketeddatetagsp :: Maybe Day -> ErroringJournalParser [(TagName, Day)]
bracketeddatetagsp mdefdate = do
-- pdbg 0 "bracketeddatetagsp"
char '['
startpos <- getPosition
let digits = "0123456789"
s <- many1 (oneOf $ '=':digits++datesepchars)
char ']'
unless (any (`elem` s) digits && any (`elem` datesepchars) s) $
parserFail "not a bracketed date"
-- looks sufficiently like a bracketed date, now we
-- re-parse as dates and throw any errors
ctx <- getState
ep <- parseWithCtx
ctx{ctxYear=first3.toGregorian <$> mdefdate}
(do
setPosition startpos
md1 <- optionMaybe datep
maybe (return ()) (setYear.first3.toGregorian) md1
md2 <- optionMaybe $ char '=' >> datep
eof
return (md1,md2)
)
s
case ep
of Left e -> throwError $ show e
Right (md1,md2) -> return $ catMaybes
[("date",) <$> md1, ("date2",) <$> md2]
--- * more tests --- * more tests
tests_Hledger_Read_JournalReader = TestList $ concat [ tests_Hledger_Read_JournalReader = TestList $ concat [

13
hledger-lib/Hledger/Read/TimeclockReader.hs
View File

@ -43,6 +43,8 @@ i, o or O. The meanings of the codes are:
module Hledger.Read.TimeclockReader ( module Hledger.Read.TimeclockReader (
-- * Reader -- * Reader
reader, reader,
-- * Misc other exports
timeclockfilep,
-- * Tests -- * Tests
tests_Hledger_Read_TimeclockReader tests_Hledger_Read_TimeclockReader
) )
@ -59,9 +61,8 @@ import System.FilePath
import Hledger.Data import Hledger.Data
-- XXX too much reuse ? -- XXX too much reuse ?
import Hledger.Read.JournalReader ( import Hledger.Read.Common (
directivep, marketpricedirectivep, defaultyeardirectivep, emptyorcommentlinep, datetimep, emptyorcommentlinep, datetimep, parseAndFinaliseJournal, modifiedaccountnamep, genericSourcePos
parseAndFinaliseJournal, modifiedaccountnamep, genericSourcePos
) )
import Hledger.Utils import Hledger.Utils
@ -93,10 +94,8 @@ timeclockfilep = do items <- many timeclockitemp
-- As all ledger line types can be distinguished by the first -- As all ledger line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or -- character, excepting transactions versus empty (blank or
-- comment-only) lines, can use choice w/o try -- comment-only) lines, can use choice w/o try
timeclockitemp = choice [ directivep timeclockitemp = choice [
, liftM (return . addMarketPrice) marketpricedirectivep emptyorcommentlinep >> return (return id)
, defaultyeardirectivep
, emptyorcommentlinep >> return (return id)
, liftM (return . addTimeclockEntry) timeclockentryp , liftM (return . addTimeclockEntry) timeclockentryp
] <?> "timeclock entry, or default year or historical price directive" ] <?> "timeclock entry, or default year or historical price directive"

8
hledger-lib/Hledger/Read/TimedotReader.hs
View File

@ -24,6 +24,8 @@ inc.client1 .... .... ..
module Hledger.Read.TimedotReader ( module Hledger.Read.TimedotReader (
-- * Reader -- * Reader
reader, reader,
-- * Misc other exports
timedotfilep,
-- * Tests -- * Tests
tests_Hledger_Read_TimedotReader tests_Hledger_Read_TimedotReader
) )
@ -40,9 +42,8 @@ import Text.Parsec hiding (parse)
import System.FilePath import System.FilePath
import Hledger.Data import Hledger.Data
-- XXX too much reuse ? import Hledger.Read.Common (
import Hledger.Read.JournalReader ( datep, numberp, emptyorcommentlinep, followingcommentp,
datep, numberp, defaultyeardirectivep, emptyorcommentlinep, followingcommentp,
parseAndFinaliseJournal, modifiedaccountnamep, genericSourcePos parseAndFinaliseJournal, modifiedaccountnamep, genericSourcePos
) )
import Hledger.Utils hiding (ptrace) import Hledger.Utils hiding (ptrace)
@ -77,7 +78,6 @@ timedotfilep = do items <- many timedotfileitemp
timedotfileitemp = do timedotfileitemp = do
ptrace "timedotfileitemp" ptrace "timedotfileitemp"
choice [ choice [
defaultyeardirectivep,
emptyorcommentlinep >> return (return id), emptyorcommentlinep >> return (return id),
liftM (return . addTransactions) timedotdayp liftM (return . addTransactions) timedotdayp
] <?> "timedot day entry, or default year or comment line or blank line" ] <?> "timedot day entry, or default year or comment line or blank line"

209
hledger-lib/Hledger/Read/Util.hs
View File

@ -1,209 +0,0 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Read.Util
where
import Control.Monad.Except
import Data.Maybe
--
import qualified Control.Exception as C
-- import Control.Monad.Except
import Data.List
-- import Data.Maybe
import System.Directory (doesFileExist, getHomeDirectory)
import System.Environment (getEnv)
import System.Exit (exitFailure)
import System.FilePath ((</>))
import System.IO (IOMode(..), openFile, stdin, stderr, hSetNewlineMode, universalNewlineMode)
import Test.HUnit
import Text.Printf
import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.Journal () -- Show instance
import Hledger.Data.Types
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 Hledger.Utils
import Prelude hiding (getContents, writeFile)
import Hledger.Utils.UTF8IOCompat (hGetContents, writeFile)
journalEnvVar = "LEDGER_FILE"
journalEnvVar2 = "LEDGER"
journalDefaultFilename = ".hledger.journal"
-- The available data file readers, each one handling a particular data
-- format. The first is also used as the default for unknown formats.
readers :: [Reader]
readers = [
JournalReader.reader
,TimeclockReader.reader
,TimedotReader.reader
,CsvReader.reader
]
readFormatNames :: [StorageFormat]
readFormatNames = map rFormat readers
-- | Which readers are worth trying for this (possibly unspecified) format, filepath, and data ?
readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader]
readersFor (format,path,s) =
dbg1 ("possible readers for "++show (format,path,elideRight 30 s)) $
case format of
Just f -> case readerForStorageFormat f of Just r -> [r]
Nothing -> []
Nothing -> case path of Nothing -> readers
Just p -> case readersForPathAndData (p,s) of [] -> readers
rs -> rs
-- | 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
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,String) -> [Reader]
readersForPathAndData (f,s) = filter (\r -> (rDetector r) f s) readers
-- try each reader in turn, returning the error of the first if all fail
tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> String -> IO (Either String Journal)
tryReaders readers mrulesfile assrt path s = 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') s
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
-- | Read a journal from this string, trying whatever readers seem appropriate:
--
-- - if a format is specified, try that reader only
--
-- - or if one or more readers recognises the file path and data, try those
--
-- - otherwise, try them all.
--
-- 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 -> String -> IO (Either String Journal)
readJournal mformat mrulesfile assrt path s = tryReaders (readersFor (mformat, path, s)) mrulesfile assrt path s
-- | 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 format rulesfile assrt f = readJournalFiles format rulesfile assrt [f]
readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [FilePath] -> IO (Either String Journal)
readJournalFiles format rulesfile assrt fs = do
contents <- fmap concat $ mapM readFileAnyNewline fs
readJournal format rulesfile assrt (listToMaybe fs) contents
where
readFileAnyNewline f = do
requireJournalFileExists f
h <- fileHandle f
hSetNewlineMode h universalNewlineMode
hGetContents h
fileHandle "-" = return stdin
fileHandle f = openFile f ReadMode
-- | If the specified journal file does not exist, give a helpful error and quit.
requireJournalFileExists :: FilePath -> IO ()
requireJournalFileExists "-" = return ()
requireJournalFileExists f = do
exists <- doesFileExist f
when (not exists) $ do
hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f
hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"
hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n"
exitFailure
-- | Ensure there is a journal file at the given path, creating an empty one if needed.
ensureJournalFileExists :: FilePath -> IO ()
ensureJournalFileExists f = do
exists <- doesFileExist f
when (not exists) $ do
hPrintf stderr "Creating hledger journal file %s.\n" f
-- note Hledger.Utils.UTF8.* do no line ending conversion on windows,
-- we currently require unix line endings on all platforms.
newJournalContent >>= writeFile f
-- | Give the content for a new auto-created journal file.
newJournalContent :: IO String
newJournalContent = do
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 string, trying all known formats, or simply throw an error.
readJournal' :: String -> IO Journal
readJournal' s = readJournal Nothing Nothing True Nothing s >>= either error' return
tests_readJournal' = [
"readJournal' parses sample journal" ~: do
_ <- samplejournal
assertBool "" True
]
-- tests
samplejournal = readJournal' $ unlines
["2008/01/01 income"
," assets:bank:checking $1"
," income:salary"
,""
,"comment"
,"multi line comment here"
,"for testing purposes"
,"end comment"
,""
,"2008/06/01 gift"
," assets:bank:checking $1"
," income:gifts"
,""
,"2008/06/02 save"
," assets:bank:saving $1"
," assets:bank:checking"
,""
,"2008/06/03 * eat & shop"
," expenses:food $1"
," expenses:supplies $1"
," assets:cash"
,""
,"2008/12/31 * pay off"
," liabilities:debts $1"
," assets:bank:checking"
]

5
hledger-lib/doc/hledger_journal.5.m4.md
View File

@ -693,11 +693,10 @@ include path/to/file.journal
``` ```
If the path does not begin with a slash, it is relative to the current file. If the path does not begin with a slash, it is relative to the current file.
Glob patterns (`*`) are not currently supported. Glob patterns (`*`) are not currently supported.
The `include` directive may only be used in journal files, and currently The `include` directive can only be used in journal files.
it may only include other journal files (eg, not CSV or timeclock files.) It can include journal, timeclock or timedot files, but not CSV files.
# EDITOR SUPPORT # EDITOR SUPPORT

2
hledger-lib/doc/hledger_timeclock.5.m4.md
View File

@ -21,7 +21,7 @@ hledger can read timeclock files.
these are (a subset of) these are (a subset of)
[timeclock.el](http://www.emacswiki.org/emacs/TimeClock)'s format, [timeclock.el](http://www.emacswiki.org/emacs/TimeClock)'s format,
containing clock-in and clock-out entries as in the example below. containing clock-in and clock-out entries as in the example below.
The date is a [simple date](#simple-dates) (also, [default year directives](#default-year) work). The date is a [simple date](#simple-dates).
The time format is HH:MM[:SS][+-ZZZZ]. Seconds and timezone are optional. The time format is HH:MM[:SS][+-ZZZZ]. Seconds and timezone are optional.
The timezone, if present, must be four digits and is ignored The timezone, if present, must be four digits and is ignored
(currently the time is always interpreted as a local time). (currently the time is always interpreted as a local time).

2
hledger-lib/doc/hledger_timedot.5.m4.md
View File

@ -109,8 +109,6 @@ $ hledger -f t.timedot --alias /\\./=: bal date:2016/2/4
4.50 4.50
``` ```
[default year directives](#default-year) may be used.
Here is a Here is a
[sample.timedot](https://raw.github.com/simonmichael/hledger/master/data/sample.timedot). [sample.timedot](https://raw.github.com/simonmichael/hledger/master/data/sample.timedot).
<!-- to download and some queries to try: --> <!-- to download and some queries to try: -->

2
hledger-lib/hledger-lib.cabal
View File

@ -115,11 +115,11 @@ library
Hledger.Data.Types Hledger.Data.Types
Hledger.Query Hledger.Query
Hledger.Read Hledger.Read
Hledger.Read.Common
Hledger.Read.CsvReader Hledger.Read.CsvReader
Hledger.Read.JournalReader Hledger.Read.JournalReader
Hledger.Read.TimedotReader Hledger.Read.TimedotReader
Hledger.Read.TimeclockReader Hledger.Read.TimeclockReader
Hledger.Read.Util
Hledger.Reports Hledger.Reports
Hledger.Reports.ReportOptions Hledger.Reports.ReportOptions
Hledger.Reports.BalanceHistoryReport Hledger.Reports.BalanceHistoryReport