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

clean up and combine I/O and parsing under Hledger.Read.*

Browse Source 
This facilitates adding readers for new data formats. Timelog parsing is temporarily broken.
This commit is contained in:
Simon Michael 2010-05-30 19:11:58 +00:00
parent f168124501
commit a848a835a2
15 changed files with 291 additions and 203 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Hledger/Cli/Commands/Add.hs
View File

@ -8,6 +8,7 @@ A history-aware add command to help with data entry.
module Hledger.Cli.Commands.Add
where
import Hledger.Data
import Hledger.Read.Journal (someamount)
import Hledger.Cli.Options
import Hledger.Cli.Commands.Register (showRegisterReport)
#if __GLASGOW_HASKELL__ <= 610
@ -19,7 +20,7 @@ import System.IO ( stderr, hFlush, hPutStrLn, hPutStr )
#endif
import System.IO.Error
import Text.ParserCombinators.Parsec
import Hledger.Cli.Utils (journalFromStringWithOpts)
import Hledger.Cli.Utils (readJournalWithOpts)
import qualified Data.Foldable as Foldable (find)
-- | Read ledger transactions from the terminal, prompting for each field,
@ -157,7 +158,7 @@ appendToJournalFile Journal{filepath=f, jtext=t} s =
registerFromString :: String -> IO String
registerFromString s = do
now <- getCurrentLocalTime
l <- journalFromStringWithOpts [] s
l <- readJournalWithOpts [] s
return $ showRegisterReport opts (optsToFilterSpec opts [] now) l
where opts = [Empty]

3
Hledger/Cli/Commands/Convert.hs
View File

@ -8,7 +8,8 @@ import Hledger.Cli.Options (Opt(Debug))
import Hledger.Cli.Version (versionstr)
import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..))
import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual)
import Hledger.Data.Parse (someamount, emptyCtx, ledgeraccountname)
import Hledger.Read.Common (emptyCtx)
import Hledger.Read.Journal (someamount,ledgeraccountname)
import Hledger.Data.Amount (nullmixedamt)
import Safe (atDef, maximumDef)
import System.IO (stderr)

23
Hledger/Cli/Commands/Register.hs
View File

@ -19,6 +19,7 @@ import Hledger.Cli.Options
import Prelude hiding ( putStr )
import System.IO.UTF8
#endif
import Text.ParserCombinators.Parsec
-- | Print a register report.
@ -71,6 +72,28 @@ displayExprMatches :: Maybe String -> Posting -> Bool
displayExprMatches Nothing _ = True
displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p
-- | Parse a hledger display expression, which is a simple date test like
-- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.
datedisplayexpr :: GenParser Char st (Posting -> Bool)
datedisplayexpr = do
char 'd'
op <- compareop
char '['
(y,m,d) <- smartdate
char ']'
let date = parsedate $ printf "%04s/%02s/%02s" y m d
test op = return $ (`op` date) . postingDate
case op of
"<" -> test (<)
"<=" -> test (<=)
"=" -> test (==)
"==" -> test (==)
">=" -> test (>=)
">" -> test (>)
_ -> mzero
where
compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
-- XXX confusing, refactor
-- | Given a date span (representing a reporting interval) and a list of
-- postings within it: aggregate the postings so there is only one per

3
Hledger/Cli/Commands/Web.hs
View File

@ -36,6 +36,7 @@ import Hledger.Cli.Commands.Histogram
import Hledger.Cli.Commands.Print
import Hledger.Cli.Commands.Register
import Hledger.Data
import Hledger.Read
import Hledger.Cli.Options hiding (value)
#ifdef MAKE
import Paths_hledger_make (getDataFileName)
@ -114,7 +115,7 @@ journalFileModifiedTime Journal{filepath=f}
reload :: Journal -> IO Journal
reload Journal{filepath=f} = do
j' <- readJournal f
j' <- readJournalFile f
putValue "hledger" "journal" j'
return j'

2
Hledger/Cli/Main.hs
View File

@ -20,7 +20,7 @@ You can use the command line:
or ghci:
> $ ghci hledger
> > j <- readJournal "data/sample.journal"
> > j <- readJournalFile "data/sample.journal"
> > register [] ["income","expenses"] j
> 2008/01/01 income income:salary $-1 $-1
> 2008/06/01 gift income:gifts $-1 $-2

2
Hledger/Cli/Options.hs
View File

@ -8,7 +8,7 @@ where
import System.Console.GetOpt
import System.Environment
import Hledger.Cli.Version (timeprogname)
import Hledger.Data.IO (myLedgerPath,myTimelogPath)
import Hledger.Read (myLedgerPath,myTimelogPath)
import Hledger.Data.Utils
import Hledger.Data.Types
import Hledger.Data.Dates

33
Hledger/Cli/Tests.hs
View File

@ -35,6 +35,8 @@ import System.Time (ClockTime(TOD))
import Hledger.Cli.Commands.All
import Hledger.Data -- including testing utils in Hledger.Data.Utils
import Hledger.Read.Common (emptyCtx)
import Hledger.Read (someamount,readJournal)
import Hledger.Cli.Options
import Hledger.Cli.Utils
@ -61,8 +63,8 @@ tests = TestList [
tests_Hledger_Commands,
"account directive" ~:
let sameParse str1 str2 = do j1 <- journalFromString str1
j2 <- journalFromString str2
let sameParse str1 str2 = do j1 <- readJournal str1
j2 <- readJournal str2
j1 `is` j2{filereadtime=filereadtime j1, jtext=jtext j1}
in TestList
[
@ -229,7 +231,7 @@ tests = TestList [
]
,"balance report with cost basis" ~: do
j <- journalFromString $ unlines
j <- readJournal $ unlines
[""
,"2008/1/1 test "
," a:b 10h @ $50"
@ -244,7 +246,7 @@ tests = TestList [
]
,"balance report elides zero-balance root account(s)" ~: do
l <- journalFromStringWithOpts []
l <- readJournalWithOpts []
(unlines
["2008/1/1 one"
," test:a 1"
@ -372,15 +374,10 @@ tests = TestList [
"assets:bank" `isSubAccountNameOf` "my assets" `is` False
,"default year" ~: do
rl <- journalFromString defaultyear_ledger_str
rl <- readJournal defaultyear_ledger_str
tdate (head $ jtxns rl) `is` fromGregorian 2009 1 1
return ()
,"ledgerFile" ~: do
assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx ledgerFile "")
r <- journalFromString "" -- don't know how to get it from ledgerFile
assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ jtxns r
,"normaliseMixedAmount" ~: do
normaliseMixedAmount (Mixed []) ~?= Mixed [nullamt]
@ -468,7 +465,7 @@ tests = TestList [
,"register report with cleared option" ~:
do
let opts = [Cleared]
l <- journalFromStringWithOpts opts sample_ledger_str
l <- readJournalWithOpts opts sample_ledger_str
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/06/03 eat & shop expenses:food $1 $1"
," expenses:supplies $1 $2"
@ -480,7 +477,7 @@ tests = TestList [
,"register report with uncleared option" ~:
do
let opts = [UnCleared]
l <- journalFromStringWithOpts opts sample_ledger_str
l <- readJournalWithOpts opts sample_ledger_str
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0"
@ -492,7 +489,7 @@ tests = TestList [
,"register report sorts by date" ~:
do
l <- journalFromStringWithOpts [] $ unlines
l <- readJournalWithOpts [] $ unlines
["2008/02/02 a"
," b 1"
," c"
@ -577,14 +574,14 @@ tests = TestList [
,"show hours" ~: show (hours 1) ~?= "1.0h"
,"unicode in balance layout" ~: do
l <- journalFromStringWithOpts []
l <- readJournalWithOpts []
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showBalanceReport [] (optsToFilterSpec [] [] t1) l `is` unlines
[" -100 актив:наличные"
," 100 расходы:покупки"]
,"unicode in register layout" ~: do
l <- journalFromStringWithOpts []
l <- readJournalWithOpts []
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines
["2009/01/01 медвежья шкура расходы:покупки 100 100"
@ -673,8 +670,8 @@ tests = TestList [
date1 = parsedate "2008/11/26"
t1 = LocalTime date1 midday
sampleledger = journalFromStringWithOpts [] sample_ledger_str
sampleledgerwithopts opts _ = journalFromStringWithOpts opts sample_ledger_str
sampleledger = readJournalWithOpts [] sample_ledger_str
sampleledgerwithopts opts _ = readJournalWithOpts opts sample_ledger_str
sample_ledger_str = unlines
["; A sample ledger file."
@ -1078,5 +1075,5 @@ journalWithAmounts as =
""
(TOD 0 0)
""
where parse = fromparse . parseWithCtx emptyCtx postingamount . (" "++)
where parse = fromparse . parseWithCtx emptyCtx someamount

25
Hledger/Cli/Utils.hs
View File

@ -1,7 +1,7 @@
{-# LANGUAGE CPP #-}
{-|
Utilities for top-level modules and ghci. See also Hledger.Data.IO and
Utilities for top-level modules and ghci. See also Hledger.Read and
Hledger.Data.Utils.
-}
@ -9,27 +9,21 @@ Hledger.Data.Utils.
module Hledger.Cli.Utils
(
withJournalDo,
journalFromStringWithOpts,
readJournalWithOpts,
openBrowserOn
)
where
import Control.Monad.Error
import Hledger.Data
import Hledger.Read
import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) -- ,optsToFilterSpec)
import System.Directory (doesFileExist)
import System.IO (stderr)
#if __GLASGOW_HASKELL__ <= 610
import System.IO.UTF8 (hPutStrLn)
#else
import System.IO (hPutStrLn)
#endif
import System.Exit
import System.Process (readProcessWithExitCode)
import System.Info (os)
import System.Process (readProcessWithExitCode)
-- | Parse the user's specified journal file and run a hledger command on
-- it, or report a parse error. This function makes the whole thing go.
-- it, or throw an error.
withJournalDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Journal -> IO ()) -> IO ()
withJournalDo opts args cmdname cmd = do
-- We kludgily read the file before parsing to grab the full text, unless
@ -42,13 +36,12 @@ withJournalDo opts args cmdname cmd = do
runcmd = cmd opts args . costify
if creating
then runcmd nulljournal
else (runErrorT . parseJournalFile) f >>= either parseerror runcmd
where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
else readJournalFile f >>= runcmd
-- | Get a journal from the given string and options, or throw an error.
journalFromStringWithOpts :: [Opt] -> String -> IO Journal
journalFromStringWithOpts opts s = do
j <- journalFromString s
readJournalWithOpts :: [Opt] -> String -> IO Journal
readJournalWithOpts opts s = do
j <- readJournal s
let cost = CostBasis `elem` opts
return $ (if cost then journalConvertAmountsToCost else id) j

6
hledger-lib/Hledger/Data.hs
View File

@ -12,10 +12,8 @@ module Hledger.Data (
module Hledger.Data.Amount,
module Hledger.Data.Commodity,
module Hledger.Data.Dates,
module Hledger.Data.IO,
module Hledger.Data.Transaction,
module Hledger.Data.Ledger,
module Hledger.Data.Parse,
module Hledger.Data.Journal,
module Hledger.Data.Posting,
module Hledger.Data.TimeLog,
@ -29,10 +27,8 @@ import Hledger.Data.AccountName
import Hledger.Data.Amount
import Hledger.Data.Commodity
import Hledger.Data.Dates
import Hledger.Data.IO
import Hledger.Data.Transaction
import Hledger.Data.Ledger
import Hledger.Data.Parse
import Hledger.Data.Journal
import Hledger.Data.Posting
import Hledger.Data.TimeLog
@ -46,10 +42,8 @@ tests_Hledger_Data = TestList
Hledger.Data.Amount.tests_Amount
-- ,Hledger.Data.Commodity.tests_Commodity
,Hledger.Data.Dates.tests_Dates
-- ,Hledger.Data.IO.tests_IO
,Hledger.Data.Transaction.tests_Transaction
-- ,Hledger.Data.Hledger.Data.tests_Hledger.Data
,Hledger.Data.Parse.tests_Parse
-- ,Hledger.Data.Journal.tests_Journal
-- ,Hledger.Data.Posting.tests_Posting
,Hledger.Data.TimeLog.tests_TimeLog

13
hledger-lib/Hledger/Data/Journal.hs
View File

@ -15,6 +15,7 @@ import Hledger.Data.Utils
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount
import Hledger.Data.Dates (nulldatespan)
import Hledger.Data.Transaction (ledgerTransactionWithDate)
import Hledger.Data.Posting
import Hledger.Data.TimeLog
@ -43,6 +44,18 @@ nulljournal = Journal { jmodifiertxns = []
, jtext = ""
}
nullfilterspec = FilterSpec {
datespan=nulldatespan
,cleared=Nothing
,real=False
,empty=False
,costbasis=False
,acctpats=[]
,descpats=[]
,whichdate=ActualDate
,depth=Nothing
}
addTransaction :: Transaction -> Journal -> Journal
addTransaction t l0 = l0 { jtxns = t : jtxns l0 }

80
hledger-lib/Hledger/Data/IO.hs → hledger-lib/Hledger/Read.hs
View File

@ -1,21 +1,39 @@
{-# LANGUAGE CPP #-}
{-|
Utilities for doing I/O with ledger files.
Read hledger data from various data formats, and related utilities.
-}
module Hledger.Data.IO
module Hledger.Read (
tests_Hledger_Read,
module Hledger.Read.Common,
Hledger.Read.Journal.someamount,
readJournalFile,
readJournal,
myLedgerPath,
myTimelogPath,
myJournal,
myTimelog,
)
where
import Hledger.Data.Types (Journal(..))
import Hledger.Data.Utils
import Hledger.Read.Common
import qualified Hledger.Read.Journal (parseJournal,parseJournalFile,ledgerFile,someamount,tests_Journal)
import qualified Hledger.Read.Timelog (tests_Timelog) --parseJournal
import Control.Monad.Error
import Hledger.Data.Parse (parseJournal)
import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..))
import Hledger.Data.Dates (nulldatespan)
import System.Directory (getHomeDirectory)
import System.Environment (getEnv)
#if __GLASGOW_HASKELL__ <= 610
import Prelude hiding (readFile)
import System.IO.UTF8
#endif
import System.FilePath ((</>))
import System.Exit
import System.IO (stderr)
#if __GLASGOW_HASKELL__ <= 610
import System.IO.UTF8 (hPutStrLn)
#else
import System.IO (hPutStrLn)
#endif
ledgerenvvar = "LEDGER"
@ -23,18 +41,6 @@ timelogenvvar = "TIMELOG"
ledgerdefaultfilename = ".ledger"
timelogdefaultfilename = ".timelog"
nullfilterspec = FilterSpec {
datespan=nulldatespan
,cleared=Nothing
,real=False
,empty=False
,costbasis=False
,acctpats=[]
,descpats=[]
,whichdate=ActualDate
,depth=Nothing
}
-- | Get the user's default ledger file path.
myLedgerPath :: IO String
myLedgerPath =
@ -53,23 +59,22 @@ myTimelogPath =
-- | Read the user's default journal file, or give an error.
myJournal :: IO Journal
myJournal = myLedgerPath >>= readJournal
myJournal = myLedgerPath >>= readJournalFile
-- | Read the user's default timelog file, or give an error.
myTimelog :: IO Journal
myTimelog = myTimelogPath >>= readJournal
myTimelog = myTimelogPath >>= readJournalFile
-- | Read a journal from this file, or throw an error.
readJournal :: FilePath -> IO Journal
readJournal f = do
s <- readFile f
j <- journalFromString s
return j{filepath=f}
readJournalFile :: FilePath -> IO Journal
readJournalFile f =
(runErrorT . Hledger.Read.Journal.parseJournalFile) f >>= either printerror return
where printerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
-- | Read a Journal from the given string, using the current time as
-- reference time, or throw an error.
journalFromString :: String -> IO Journal
journalFromString s = liftM (either error id) $ runErrorT $ parseJournal "(from string)" s
-- | Read a Journal from this string, or throw an error.
readJournal :: String -> IO Journal
readJournal s =
(runErrorT . Hledger.Read.Journal.parseJournal "(from string)") s >>= either error return
-- -- | Expand ~ in a file path (does not handle ~name).
-- tildeExpand :: FilePath -> IO FilePath
@ -82,3 +87,14 @@ journalFromString s = liftM (either error id) $ runErrorT $ parseJournal "(from
-- -- return (homeDirectory pw ++ path)
-- tildeExpand xs = return xs
tests_Hledger_Read = TestList
[
"ledgerFile" ~: do
assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx Hledger.Read.Journal.ledgerFile "")
r <- readJournal "" -- don't know how to get it from ledgerFile
assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ jtxns r
,Hledger.Read.Journal.tests_Journal
,Hledger.Read.Timelog.tests_Timelog
]

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

@ -0,0 +1,60 @@
{-|
Common utilities for hledger data readers, such as the context (state)
that is kept while parsing a journal.
-}
module Hledger.Read.Common
where
import Control.Monad.Error
import Data.List
import Hledger.Data.Types (Journal)
import Text.ParserCombinators.Parsec
import System.Directory (getHomeDirectory)
import System.FilePath(takeDirectory,combine)
-- | A JournalUpdate is some transformation of a "Journal". It can do I/O
-- or raise an error.
type JournalUpdate = ErrorT String IO (Journal -> Journal)
-- | Some context kept during parsing.
data LedgerFileCtx = Ctx {
ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y
, ctxCommod :: !(Maybe String) -- ^ I don't know
, ctxAccount :: ![String] -- ^ the current stack of parent accounts specified by !account
} deriving (Read, Show)
emptyCtx :: LedgerFileCtx
emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }
setYear :: Integer -> GenParser tok LedgerFileCtx ()
setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
getYear :: GenParser tok LedgerFileCtx (Maybe Integer)
getYear = liftM ctxYear getState
pushParentAccount :: String -> GenParser tok LedgerFileCtx ()
pushParentAccount parent = updateState addParentAccount
where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }
normalize = (++ ":")
popParentAccount :: GenParser tok LedgerFileCtx ()
popParentAccount = do ctx0 <- getState
case ctxAccount ctx0 of
[] -> unexpected "End of account block with no beginning"
(_:rest) -> setState $ ctx0 { ctxAccount = rest }
getParentAccount :: GenParser tok LedgerFileCtx String
getParentAccount = liftM (concat . reverse . ctxAccount) getState
expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath
expandPath pos fp = liftM mkRelative (expandHome fp)
where
mkRelative = combine (takeDirectory (sourceName pos))
expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory
return $ homedir ++ drop 1 inname
| otherwise = return inname

136
hledger-lib/Hledger/Data/Parse.hs → hledger-lib/Hledger/Read/Journal.hs
View File

@ -1,9 +1,9 @@
{-# LANGUAGE CPP #-}
{-|
Parsers for hledger's journal file format and the timelog file format.
A reader for hledger's (and c++ ledger's) journal file format.
Here is the ledger grammar from the ledger 2.5 manual:
From the ledger 2.5 manual:
@
The ledger file format is quite simple, but also very flexible. It supports
@ -101,50 +101,18 @@ i, o, b, h
timelog files.
@
Here is the timelog grammar from timeclock.el 2.6:
@
A timelog contains data in the form of a single entry per line.
Each entry has the form:
CODE YYYY/MM/DD HH:MM:SS [COMMENT]
CODE is one of: b, h, i, o or O. COMMENT is optional when the code is
i, o or O. The meanings of the codes are:
b Set the current time balance, or \"time debt\". Useful when
archiving old log data, when a debt must be carried forward.
The COMMENT here is the number of seconds of debt.
h Set the required working time for the given day. This must
be the first entry for that day. The COMMENT in this case is
the number of hours in this workday. Floating point amounts
are allowed.
i Clock in. The COMMENT in this case should be the name of the
project worked on.
o Clock out. COMMENT is unnecessary, but can be used to provide
a description of how the period went, for example.
O Final clock out. Whatever project was being worked on, it is
now finished. Useful for creating summary reports.
@
Example:
@
i 2007/03/10 12:26:00 hledger
o 2007/03/10 17:26:02
@
-}
module Hledger.Data.Parse
module Hledger.Read.Journal {- (
parseJournal,
parseJournalFile,
someamount,
emptyCtx,
ledgeraccountname
) -}
where
import Control.Monad.Error (ErrorT(..), MonadIO, liftIO, throwError, catchError)
import Text.ParserCombinators.Parsec
import System.Directory
#if __GLASGOW_HASKELL__ <= 610
import Prelude hiding (readFile, putStr, putStrLn, print, getContents)
import System.IO.UTF8
@ -158,52 +126,10 @@ import Hledger.Data.Transaction
import Hledger.Data.Posting
import Hledger.Data.Journal
import Hledger.Data.Commodity (dollars,dollar,unknown,nonsimplecommoditychars)
import System.FilePath(takeDirectory,combine)
import Hledger.Read.Common
import System.Time (getClockTime)
-- | A JournalUpdate is some transformation of a "Journal". It can do I/O
-- or raise an error.
type JournalUpdate = ErrorT String IO (Journal -> Journal)
-- | Some context kept during parsing.
data LedgerFileCtx = Ctx {
ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y
, ctxCommod :: !(Maybe String) -- ^ I don't know
, ctxAccount :: ![String] -- ^ the current stack of parent accounts specified by !account
} deriving (Read, Show)
emptyCtx :: LedgerFileCtx
emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }
setYear :: Integer -> GenParser tok LedgerFileCtx ()
setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
getYear :: GenParser tok LedgerFileCtx (Maybe Integer)
getYear = liftM ctxYear getState
pushParentAccount :: String -> GenParser tok LedgerFileCtx ()
pushParentAccount parent = updateState addParentAccount
where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }
normalize = (++ ":")
popParentAccount :: GenParser tok LedgerFileCtx ()
popParentAccount = do ctx0 <- getState
case ctxAccount ctx0 of
[] -> unexpected "End of account block with no beginning"
(_:rest) -> setState $ ctx0 { ctxAccount = rest }
getParentAccount :: GenParser tok LedgerFileCtx String
getParentAccount = liftM (concat . reverse . ctxAccount) getState
expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath
expandPath pos fp = liftM mkRelative (expandHome fp)
where
mkRelative = combine (takeDirectory (sourceName pos))
expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory
return $ homedir ++ drop 1 inname
| otherwise = return inname
-- let's get to it
-- | Parse and post-process a journal file or timelog file to a "Journal",
@ -212,8 +138,9 @@ parseJournalFile :: FilePath -> ErrorT String IO Journal
parseJournalFile "-" = liftIO getContents >>= parseJournal "-"
parseJournalFile f = liftIO (readFile f) >>= parseJournal f
-- | Parse and post-process a "Journal" from a string, saving the provided
-- file path and the current time, or give an error.
-- | Parse and post-process a "Journal" from hledger's journal file
-- format, saving the provided file path and the current time, or give an
-- error.
parseJournal :: FilePath -> String -> ErrorT String IO Journal
parseJournal f s = do
tc <- liftIO getClockTime
@ -243,7 +170,6 @@ ledgerFile = do items <- many ledgerItem
, ledgerTagDirective
, ledgerEndTagDirective
, emptyLine >> return (return id)
, liftM (return . addTimeLogEntry) timelogentry
] <?> "ledger transaction, timelog entry, or directive"
emptyLine :: GenParser Char st ()
@ -610,40 +536,7 @@ numberpartsstartingwithpoint = do
return ("",frac)
-- | Parse a timelog entry.
timelogentry :: GenParser Char LedgerFileCtx TimeLogEntry
timelogentry = do
code <- oneOf "bhioO"
many1 spacenonewline
datetime <- ledgerdatetime
comment <- optionMaybe (many1 spacenonewline >> liftM2 (++) getParentAccount restofline)
return $ TimeLogEntry (read [code]) datetime (fromMaybe "" comment)
-- | Parse a hledger display expression, which is a simple date test like
-- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.
datedisplayexpr :: GenParser Char st (Posting -> Bool)
datedisplayexpr = do
char 'd'
op <- compareop
char '['
(y,m,d) <- smartdate
char ']'
let date = parsedate $ printf "%04s/%02s/%02s" y m d
test op = return $ (`op` date) . postingDate
case op of
"<" -> test (<)
"<=" -> test (<=)
"=" -> test (==)
"==" -> test (==)
">=" -> test (>=)
">" -> test (>)
_ -> mzero
compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
tests_Parse = TestList [
tests_Journal = TestList [
"ledgerTransaction" ~: do
assertParseEqual (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1
@ -739,4 +632,3 @@ entry1 =
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing,
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting Nothing] ""

95
hledger-lib/Hledger/Read/Timelog.hs Normal file
View File

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

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

@ -32,15 +32,17 @@ library
Hledger.Data.Amount
Hledger.Data.Commodity
Hledger.Data.Dates
Hledger.Data.IO
Hledger.Data.Transaction
Hledger.Data.Journal
Hledger.Data.Ledger
Hledger.Data.Posting
Hledger.Data.Parse
Hledger.Data.TimeLog
Hledger.Data.Types
Hledger.Data.Utils
Hledger.Read
Hledger.Read.Common
Hledger.Read.Journal
Hledger.Read.Timelog
Build-Depends:
base >= 3 && < 5
,containers