diff --git a/Hledger/Cli/Commands/Add.hs b/Hledger/Cli/Commands/Add.hs index f95563b96..df8aeaa76 100644 --- a/Hledger/Cli/Commands/Add.hs +++ b/Hledger/Cli/Commands/Add.hs @@ -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] diff --git a/Hledger/Cli/Commands/Convert.hs b/Hledger/Cli/Commands/Convert.hs index 0e32b2d43..bb47bfc8b 100644 --- a/Hledger/Cli/Commands/Convert.hs +++ b/Hledger/Cli/Commands/Convert.hs @@ -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) diff --git a/Hledger/Cli/Commands/Register.hs b/Hledger/Cli/Commands/Register.hs index 7119d7a49..2737e44d7 100644 --- a/Hledger/Cli/Commands/Register.hs +++ b/Hledger/Cli/Commands/Register.hs @@ -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 diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index 518c68332..e9d7fb0df 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/Hledger/Cli/Commands/Web.hs @@ -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' diff --git a/Hledger/Cli/Main.hs b/Hledger/Cli/Main.hs index 10240a7f5..166d5931b 100644 --- a/Hledger/Cli/Main.hs +++ b/Hledger/Cli/Main.hs @@ -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 diff --git a/Hledger/Cli/Options.hs b/Hledger/Cli/Options.hs index 6904c830e..77788466e 100644 --- a/Hledger/Cli/Options.hs +++ b/Hledger/Cli/Options.hs @@ -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 diff --git a/Hledger/Cli/Tests.hs b/Hledger/Cli/Tests.hs index 8aa7660ce..428ba8fda 100644 --- a/Hledger/Cli/Tests.hs +++ b/Hledger/Cli/Tests.hs @@ -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 diff --git a/Hledger/Cli/Utils.hs b/Hledger/Cli/Utils.hs index 666803832..b8bfd5bcc 100644 --- a/Hledger/Cli/Utils.hs +++ b/Hledger/Cli/Utils.hs @@ -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 diff --git a/hledger-lib/Hledger/Data.hs b/hledger-lib/Hledger/Data.hs index 478e04169..1a39a98fc 100644 --- a/hledger-lib/Hledger/Data.hs +++ b/hledger-lib/Hledger/Data.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 79608b861..74d88c5f2 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 } diff --git a/hledger-lib/Hledger/Data/IO.hs b/hledger-lib/Hledger/Read.hs similarity index 50% rename from hledger-lib/Hledger/Data/IO.hs rename to hledger-lib/Hledger/Read.hs index 035420c20..8e75e465e 100644 --- a/hledger-lib/Hledger/Data/IO.hs +++ b/hledger-lib/Hledger/Read.hs @@ -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 + ] diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs new file mode 100644 index 000000000..6bf102c39 --- /dev/null +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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 + diff --git a/hledger-lib/Hledger/Data/Parse.hs b/hledger-lib/Hledger/Read/Journal.hs similarity index 85% rename from hledger-lib/Hledger/Data/Parse.hs rename to hledger-lib/Hledger/Read/Journal.hs index 7a4c0e53c..17f227936 100644 --- a/hledger-lib/Hledger/Data/Parse.hs +++ b/hledger-lib/Hledger/Read/Journal.hs @@ -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] "" - diff --git a/hledger-lib/Hledger/Read/Timelog.hs b/hledger-lib/Hledger/Read/Timelog.hs new file mode 100644 index 000000000..8bb00d351 --- /dev/null +++ b/hledger-lib/Hledger/Read/Timelog.hs @@ -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 [ + ] + diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index b3b2ff418..5987a3a34 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -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