diff --git a/Makefile b/Makefile index 267d13790..8c2c08482 100644 --- a/Makefile +++ b/Makefile @@ -356,7 +356,7 @@ hledgercov: \ $(call def-help,hledgercov, build "bin/hledgercov" for coverage reports (with ghc) ) $(GHC) $(MAIN) -fhpc -o bin/hledgercov -outputdir .hledgercovobjs $(BUILDFLAGS) -# hledger-lib/Hledger/Read/TimelogReaderPP.hs +# hledger-lib/Hledger/Read/TimeclockReaderPP.hs dev: dev.hs $(SOURCEFILES) \ $(call def-help,dev, build the dev.hs script for quick experiments (with ghc) ) stack ghc -- $(CABALMACROSFLAGS) -ihledger-lib dev.hs \ @@ -1047,7 +1047,7 @@ haddock: \ MANPAGES=\ hledger-lib/hledger_csv.5 \ hledger-lib/hledger_journal.5 \ - hledger-lib/hledger_timelog.5 \ + hledger-lib/hledger_timeclock.5 \ hledger-lib/hledger_timedot.5 \ hledger/hledger.1 \ hledger-ui/hledger-ui.1 \ diff --git a/Shake.hs b/Shake.hs index 57cfce0cc..913d267a4 100755 --- a/Shake.hs +++ b/Shake.hs @@ -107,7 +107,7 @@ main = do ,"hledger-api.1" ,"hledger_journal.5" ,"hledger_csv.5" - ,"hledger_timelog.5" + ,"hledger_timeclock.5" ,"hledger_timedot.5" ] diff --git a/dev.hs b/dev.hs index 4a5ebe103..058ecf40d 100755 --- a/dev.hs +++ b/dev.hs @@ -16,9 +16,9 @@ import Hledger -- import Hledger.Utils.Regex (toRegexCI) -- import Hledger.Utils.Debug -- import qualified Hledger.Read.JournalReader as JR --- import qualified Hledger.Read.TimelogReader as TR --- import qualified Hledger.Read.TimelogReaderNoJU as TRNOJU --- import qualified Hledger.Read.TimelogReaderPP as TRPP +-- import qualified Hledger.Read.TimeclockReader as TR +-- import qualified Hledger.Read.TimeclockReaderNoJU as TRNOJU +-- import qualified Hledger.Read.TimeclockReaderPP as TRPP -- import Control.DeepSeq (NFData) -- import Data.Data @@ -36,7 +36,7 @@ journal = -- "data/10000x1000x10.journal" "data/10000x1000x10.journal" -timelog = "data/sample.timelog" +timeclock = "data/sample.timeclock" timeit :: String -> IO a -> IO (Double, a) timeit name action = do @@ -131,8 +131,8 @@ main = do -- return () - -- benchmark timelog parsing - -- s <- readFile inputtimelog + -- benchmark timeclock parsing + -- s <- readFile inputtimeclock -- putStrLn $ show $ length s -- let s = unlines [ -- "i 2009/03/27 09:00:00 projects:a", @@ -144,11 +144,11 @@ main = do -- ] -- -- let output = return . const -- putStrLn.show - -- -- withArgs ["-l"] $ defaultMain [bench "timelog polyparse" $ nfIO $ runExceptT $ TRPP.parseJournalWith' TRPP.timelogFile False "" s] + -- -- withArgs ["-l"] $ defaultMain [bench "timeclock polyparse" $ nfIO $ runExceptT $ TRPP.parseJournalWith' TRPP.timeclockFile False "" s] -- defaultMain [ - -- -- bench ("read "++inputtimelog++" with parsec") $ nfIO $ runExceptT (TR.parse Nothing False "" s) >>= output - -- -- bench ("read "++inputtimelog++" with parsec, no ju") $ nfIO $ runExceptT (TRNOJU.parse Nothing False "" s) >>= output, - -- -- bench ("read "++inputtimelog++" polyparse") $ nfIO $ runExceptT (TRPP.parse Nothing False "" s) >>= output + -- -- bench ("read "++inputtimeclock++" with parsec") $ nfIO $ runExceptT (TR.parse Nothing False "" s) >>= output + -- -- bench ("read "++inputtimeclock++" with parsec, no ju") $ nfIO $ runExceptT (TRNOJU.parse Nothing False "" s) >>= output, + -- -- bench ("read "++inputtimeclock++" polyparse") $ nfIO $ runExceptT (TRPP.parse Nothing False "" s) >>= output -- ] -- return () diff --git a/doc/manpage.html b/doc/manpage.html index 722055536..734bc4eb5 100644 --- a/doc/manpage.html +++ b/doc/manpage.html @@ -32,7 +32,7 @@ Copyright (C) 2007-2015 Simon Michael. Released under GNU GPLv3+. .SH SEE ALSO -hledger(1), hledger\-ui(1), hledger\-web(1), ledger(1) -.br -hledger_csv(5), hledger_journal(5), hledger_timelog(5) +hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1) +hledger_csv(5), hledger_journal(5), hledger_timeclock(5) +ledger(1) --> diff --git a/doc/manpage.nroff b/doc/manpage.nroff index 677a3ea06..a7696cb62 100644 --- a/doc/manpage.nroff +++ b/doc/manpage.nroff @@ -37,7 +37,7 @@ Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), -hledger_csv(5), hledger_journal(5), hledger_timelog(5), hledger_timedot(5), +hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org diff --git a/hledger-api/doc/hledger-api.1 b/hledger-api/doc/hledger-api.1 index bd02c89d0..00ce5d1e1 100644 --- a/hledger-api/doc/hledger-api.1 +++ b/hledger-api/doc/hledger-api.1 @@ -65,7 +65,7 @@ Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), -hledger_csv(5), hledger_journal(5), hledger_timelog(5), hledger_timedot(5), +hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org diff --git a/hledger-api/doc/hledger-api.1.md b/hledger-api/doc/hledger-api.1.md index eae0f97a2..97429c9aa 100644 --- a/hledger-api/doc/hledger-api.1.md +++ b/hledger-api/doc/hledger-api.1.md @@ -38,7 +38,7 @@ Note there is no built-in access control, so you will need to hide hledger-api behind an authenticating proxy if you want to restrict access. - + diff --git a/hledger-lib/Hledger/Data.hs b/hledger-lib/Hledger/Data.hs index fcedc9824..232ca16c8 100644 --- a/hledger-lib/Hledger/Data.hs +++ b/hledger-lib/Hledger/Data.hs @@ -18,7 +18,7 @@ module Hledger.Data ( module Hledger.Data.Posting, module Hledger.Data.RawOptions, module Hledger.Data.StringFormat, - module Hledger.Data.TimeLog, + module Hledger.Data.Timeclock, module Hledger.Data.Transaction, module Hledger.Data.Types, tests_Hledger_Data @@ -36,7 +36,7 @@ import Hledger.Data.Ledger import Hledger.Data.Posting import Hledger.Data.RawOptions import Hledger.Data.StringFormat -import Hledger.Data.TimeLog +import Hledger.Data.Timeclock import Hledger.Data.Transaction import Hledger.Data.Types @@ -53,7 +53,7 @@ tests_Hledger_Data = TestList ,tests_Hledger_Data_Posting -- ,tests_Hledger_Data_RawOptions -- ,tests_Hledger_Data_StringFormat - ,tests_Hledger_Data_TimeLog + ,tests_Hledger_Data_Timeclock ,tests_Hledger_Data_Transaction -- ,tests_Hledger_Data_Types ] diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 268a875aa..60229d821 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -12,7 +12,7 @@ module Hledger.Data.Journal ( addMarketPrice, addModifierTransaction, addPeriodicTransaction, - addTimeLogEntry, + addTimeclockEntry, addTransaction, journalApplyAliases, journalBalanceTransactions, @@ -81,7 +81,7 @@ import Hledger.Data.Amount import Hledger.Data.Dates import Hledger.Data.Transaction import Hledger.Data.Posting -import Hledger.Data.TimeLog +import Hledger.Data.Timeclock import Hledger.Query @@ -116,7 +116,7 @@ instance Show Journal where -- ,show (jtxns j) -- ,show (jmodifiertxns j) -- ,show (jperiodictxns j) --- ,show $ open_timelog_entries j +-- ,show $ open_timeclock_entries j -- ,show $ jmarketprices j -- ,show $ final_comment_lines j -- ,show $ jContext j @@ -127,7 +127,7 @@ nulljournal :: Journal nulljournal = Journal { jmodifiertxns = [] , jperiodictxns = [] , jtxns = [] - , open_timelog_entries = [] + , open_timeclock_entries = [] , jmarketprices = [] , final_comment_lines = [] , jContext = nullctx @@ -160,8 +160,8 @@ addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j } addMarketPrice :: MarketPrice -> Journal -> Journal addMarketPrice h j = j { jmarketprices = h : jmarketprices j } -addTimeLogEntry :: TimeLogEntry -> Journal -> Journal -addTimeLogEntry tle j = j { open_timelog_entries = tle : open_timelog_entries j } +addTimeclockEntry :: TimeclockEntry -> Journal -> Journal +addTimeclockEntry tle j = j { open_timeclock_entries = tle : open_timeclock_entries j } -- | Get the transaction with this index (its 1-based position in the input stream), if any. journalTransactionAt :: Journal -> Integer -> Maybe Transaction @@ -416,12 +416,12 @@ journalApplyAliases aliases j@Journal{jtxns=ts} = -- | Do post-parse processing on a journal to make it ready for use: check -- all transactions balance, canonicalise amount formats, close any open --- timelog entries, maybe check balance assertions and so on. +-- timeclock entries, maybe check balance assertions and so on. journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Bool -> Journal -> Either String Journal journalFinalise tclock tlocal path txt ctx assrt j@Journal{files=fs} = do (journalBalanceTransactions $ journalApplyCommodityStyles $ - journalCloseTimeLogEntries tlocal $ + journalCloseTimeclockEntries tlocal $ j{ files=(path,txt):fs , filereadtime=tclock , jContext=ctx @@ -429,7 +429,7 @@ journalFinalise tclock tlocal path txt ctx assrt j@Journal{files=fs} = do , jmodifiertxns=reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction , jperiodictxns=reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction , jmarketprices=reverse $ jmarketprices j -- NOTE: see addMarketPrice - , open_timelog_entries=reverse $ open_timelog_entries j -- NOTE: see addTimeLogEntry + , open_timeclock_entries=reverse $ open_timeclock_entries j -- NOTE: see addTimeclockEntry }) >>= if assrt then journalCheckBalanceAssertions else return @@ -597,10 +597,10 @@ canonicalStyleFrom ss@(first:_) = -- case ps of (MarketPrice{mpamount=a}:_) -> Just a -- _ -> Nothing --- | Close any open timelog sessions in this journal using the provided current time. -journalCloseTimeLogEntries :: LocalTime -> Journal -> Journal -journalCloseTimeLogEntries now j@Journal{jtxns=ts, open_timelog_entries=es} = - j{jtxns = ts ++ (timeLogEntriesToTransactions now es), open_timelog_entries = []} +-- | Close any open timeclock sessions in this journal using the provided current time. +journalCloseTimeclockEntries :: LocalTime -> Journal -> Journal +journalCloseTimeclockEntries now j@Journal{jtxns=ts, open_timeclock_entries=es} = + j{jtxns = ts ++ (timeclockEntriesToTransactions now es), open_timeclock_entries = []} -- | Convert all this journal's amounts to cost by applying their prices, if any. journalConvertAmountsToCost :: Journal -> Journal diff --git a/hledger-lib/Hledger/Data/TimeLog.hs b/hledger-lib/Hledger/Data/Timeclock.hs similarity index 79% rename from hledger-lib/Hledger/Data/TimeLog.hs rename to hledger-lib/Hledger/Data/Timeclock.hs index 75cd95dce..2ab28929c 100644 --- a/hledger-lib/Hledger/Data/TimeLog.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -1,13 +1,13 @@ {-# LANGUAGE CPP #-} {-| -A 'TimeLogEntry' is a clock-in, clock-out, or other directive in a timelog +A 'TimeclockEntry' is a clock-in, clock-out, or other directive in a timeclock file (see timeclock.el or the command-line version). These can be converted to 'Transactions' and queried like a ledger. -} -module Hledger.Data.TimeLog +module Hledger.Data.Timeclock where import Data.Maybe import Data.Time.Calendar @@ -27,17 +27,17 @@ import Hledger.Data.Amount import Hledger.Data.Posting import Hledger.Data.Transaction -instance Show TimeLogEntry where +instance Show TimeclockEntry where show t = printf "%s %s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlaccount t) (tldescription t) -instance Show TimeLogCode where +instance Show TimeclockCode where show SetBalance = "b" show SetRequiredHours = "h" show In = "i" show Out = "o" show FinalOut = "O" -instance Read TimeLogCode where +instance Read TimeclockCode where readsPrec _ ('b' : xs) = [(SetBalance, xs)] readsPrec _ ('h' : xs) = [(SetRequiredHours, xs)] readsPrec _ ('i' : xs) = [(In, xs)] @@ -48,32 +48,32 @@ instance Read TimeLogCode where -- | Convert time log entries to journal transactions. When there is no -- clockout, add one with the provided current time. Sessions crossing -- midnight are split into days to give accurate per-day totals. -timeLogEntriesToTransactions :: LocalTime -> [TimeLogEntry] -> [Transaction] -timeLogEntriesToTransactions _ [] = [] -timeLogEntriesToTransactions now [i] - | odate > idate = entryFromTimeLogInOut i o' : timeLogEntriesToTransactions now [i',o] - | otherwise = [entryFromTimeLogInOut i o] +timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction] +timeclockEntriesToTransactions _ [] = [] +timeclockEntriesToTransactions now [i] + | odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now [i',o] + | otherwise = [entryFromTimeclockInOut i o] where - o = TimeLogEntry (tlsourcepos i) Out end "" "" + o = TimeclockEntry (tlsourcepos i) Out end "" "" end = if itime > now then itime else now (itime,otime) = (tldatetime i,tldatetime o) (idate,odate) = (localDay itime,localDay otime) o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} -timeLogEntriesToTransactions now (i:o:rest) - | odate > idate = entryFromTimeLogInOut i o' : timeLogEntriesToTransactions now (i':o:rest) - | otherwise = entryFromTimeLogInOut i o : timeLogEntriesToTransactions now rest +timeclockEntriesToTransactions now (i:o:rest) + | odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now (i':o:rest) + | otherwise = entryFromTimeclockInOut i o : timeclockEntriesToTransactions now rest where (itime,otime) = (tldatetime i,tldatetime o) (idate,odate) = (localDay itime,localDay otime) o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} --- | Convert a timelog clockin and clockout entry to an equivalent journal +-- | Convert a timeclock clockin and clockout entry to an equivalent journal -- transaction, representing the time expenditure. Note this entry is not balanced, -- since we omit the \"assets:time\" transaction for simpler output. -entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Transaction -entryFromTimeLogInOut i o +entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction +entryFromTimeclockInOut i o | otime >= itime = t | otherwise = error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t @@ -105,16 +105,16 @@ entryFromTimeLogInOut i o ps = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}] -tests_Hledger_Data_TimeLog = TestList [ +tests_Hledger_Data_Timeclock = TestList [ - "timeLogEntriesToTransactions" ~: do + "timeclockEntriesToTransactions" ~: do today <- getCurrentDay now' <- getCurrentTime tz <- getCurrentTimeZone let now = utcToLocalTime tz now' nowstr = showtime now yesterday = prevday today - clockin = TimeLogEntry nullsourcepos In + clockin = TimeclockEntry nullsourcepos In mktime d = LocalTime d . fromMaybe midnight . #if MIN_VERSION_time(1,5,0) parseTimeM True defaultTimeLocale "%H:%M:%S" @@ -122,7 +122,7 @@ tests_Hledger_Data_TimeLog = TestList [ parseTime defaultTimeLocale "%H:%M:%S" #endif showtime = formatTime defaultTimeLocale "%H:%M" - assertEntriesGiveStrings name es ss = assertEqual name ss (map tdescription $ timeLogEntriesToTransactions now es) + assertEntriesGiveStrings name es ss = assertEqual name ss (map tdescription $ timeclockEntriesToTransactions now es) assertEntriesGiveStrings "started yesterday, split session at midnight" [clockin (mktime yesterday "23:00:00") "" ""] diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index e115e2b26..830ae903c 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -199,19 +199,19 @@ data PeriodicTransaction = PeriodicTransaction { instance NFData PeriodicTransaction -data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Typeable,Data,Generic) +data TimeclockCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Typeable,Data,Generic) -instance NFData TimeLogCode +instance NFData TimeclockCode -data TimeLogEntry = TimeLogEntry { +data TimeclockEntry = TimeclockEntry { tlsourcepos :: GenericSourcePos, - tlcode :: TimeLogCode, + tlcode :: TimeclockCode, tldatetime :: LocalTime, tlaccount :: String, tldescription :: String } deriving (Eq,Ord,Typeable,Data,Generic) -instance NFData TimeLogEntry +instance NFData TimeclockEntry data MarketPrice = MarketPrice { mpdate :: Day, @@ -250,7 +250,7 @@ data Journal = Journal { jmodifiertxns :: [ModifierTransaction], jperiodictxns :: [PeriodicTransaction], jtxns :: [Transaction], - open_timelog_entries :: [TimeLogEntry], + open_timeclock_entries :: [TimeclockEntry], jmarketprices :: [MarketPrice], final_comment_lines :: String, -- ^ any trailing comments from the journal file jContext :: JournalContext, -- ^ the context (parse state) at the end of parsing diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 0de983df0..1a377c4f9 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -41,8 +41,8 @@ import Hledger.Data.Types import Hledger.Data.Journal (nullctx) import Hledger.Read.Util import Hledger.Read.JournalReader as JournalReader +import Hledger.Read.TimeclockReader as TimeclockReader import Hledger.Read.TimedotReader as TimedotReader -import Hledger.Read.TimelogReader as TimelogReader import Hledger.Read.CsvReader as CsvReader import Hledger.Utils import Prelude hiding (getContents, writeFile) @@ -52,8 +52,8 @@ tests_Hledger_Read = TestList $ tests_readJournal' ++ [ tests_Hledger_Read_JournalReader, + tests_Hledger_Read_TimeclockReader, tests_Hledger_Read_TimedotReader, - tests_Hledger_Read_TimelogReader, tests_Hledger_Read_CsvReader, "journal" ~: do diff --git a/hledger-lib/Hledger/Read/TimelogReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs similarity index 72% rename from hledger-lib/Hledger/Read/TimelogReader.hs rename to hledger-lib/Hledger/Read/TimeclockReader.hs index 71ae7e390..501ba4506 100644 --- a/hledger-lib/Hledger/Read/TimelogReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -1,6 +1,6 @@ {-| -A reader for the timelog file format generated by timeclock.el +A reader for the timeclock file format generated by timeclock.el (). Example: @ @@ -11,7 +11,7 @@ o 2007\/03\/10 17:26:02 From timeclock.el 2.6: @ -A timelog contains data in the form of a single entry per line. +A timeclock contains data in the form of a single entry per line. Each entry has the form: CODE YYYY/MM/DD HH:MM:SS [COMMENT] @@ -40,11 +40,11 @@ i, o or O. The meanings of the codes are: -} -module Hledger.Read.TimelogReader ( +module Hledger.Read.TimeclockReader ( -- * Reader reader, -- * Tests - tests_Hledger_Read_TimelogReader + tests_Hledger_Read_TimeclockReader ) where import Prelude () @@ -70,47 +70,47 @@ reader :: Reader reader = Reader format detect parse format :: String -format = "timelog" +format = "timeclock" --- | Does the given file path and data look like it might be timeclock.el's timelog format ? +-- | Does the given file path and data look like it might be timeclock.el's timeclock format ? detect :: FilePath -> String -> Bool detect f s | f /= "-" = takeExtension f == '.':format -- from a known file name: yes if the extension is this format's name | otherwise = regexMatches "(^|\n)[io] " s -- from stdin: yes if any line starts with "i " or "o " --- | Parse and post-process a "Journal" from timeclock.el's timelog +-- | Parse and post-process a "Journal" from timeclock.el's timeclock -- format, saving the provided file path and the current time, or give an -- error. parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal -parse _ = parseAndFinaliseJournal timelogfilep +parse _ = parseAndFinaliseJournal timeclockfilep -timelogfilep :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext) -timelogfilep = do items <- many timelogitemp - eof - ctx <- getState - return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx) +timeclockfilep :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext) +timeclockfilep = do items <- many timeclockitemp + eof + ctx <- getState + return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx) where -- As all ledger line types can be distinguished by the first -- character, excepting transactions versus empty (blank or -- comment-only) lines, can use choice w/o try - timelogitemp = choice [ directivep + timeclockitemp = choice [ directivep , liftM (return . addMarketPrice) marketpricedirectivep , defaultyeardirectivep , emptyorcommentlinep >> return (return id) - , liftM (return . addTimeLogEntry) timelogentryp - ] "timelog entry, or default year or historical price directive" + , liftM (return . addTimeclockEntry) timeclockentryp + ] "timeclock entry, or default year or historical price directive" --- | Parse a timelog entry. -timelogentryp :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry -timelogentryp = do +-- | Parse a timeclock entry. +timeclockentryp :: ParsecT [Char] JournalContext (ExceptT String IO) TimeclockEntry +timeclockentryp = do sourcepos <- genericSourcePos <$> getPosition code <- oneOf "bhioO" many1 spacenonewline datetime <- datetimep account <- fromMaybe "" <$> optionMaybe (many1 spacenonewline >> modifiedaccountnamep) description <- fromMaybe "" <$> optionMaybe (many1 spacenonewline >> restofline) - return $ TimeLogEntry sourcepos (read [code]) datetime account description + return $ TimeclockEntry sourcepos (read [code]) datetime account description -tests_Hledger_Read_TimelogReader = TestList [ +tests_Hledger_Read_TimeclockReader = TestList [ ] diff --git a/hledger-lib/Hledger/Read/Util.hs b/hledger-lib/Hledger/Read/Util.hs index 1c3f98374..47aad93b4 100644 --- a/hledger-lib/Hledger/Read/Util.hs +++ b/hledger-lib/Hledger/Read/Util.hs @@ -21,7 +21,7 @@ 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.TimelogReader as TimelogReader +import Hledger.Read.TimeclockReader as TimeclockReader import Hledger.Read.CsvReader as CsvReader import Hledger.Utils import Prelude hiding (getContents, writeFile) @@ -37,7 +37,7 @@ journalDefaultFilename = ".hledger.journal" readers :: [Reader] readers = [ JournalReader.reader - ,TimelogReader.reader + ,TimeclockReader.reader ,TimedotReader.reader ,CsvReader.reader ] diff --git a/hledger-lib/doc/hledger_csv.5 b/hledger-lib/doc/hledger_csv.5 index 69854c9c1..7bbd78d49 100644 --- a/hledger-lib/doc/hledger_csv.5 +++ b/hledger-lib/doc/hledger_csv.5 @@ -232,7 +232,7 @@ Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), -hledger_csv(5), hledger_journal(5), hledger_timelog(5), hledger_timedot(5), +hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org diff --git a/hledger-lib/doc/hledger_journal.5 b/hledger-lib/doc/hledger_journal.5 index 0c905e4d7..04b81bc44 100644 --- a/hledger-lib/doc/hledger_journal.5 +++ b/hledger-lib/doc/hledger_journal.5 @@ -805,7 +805,7 @@ Glob patterns (\f[C]*\f[]) are not currently supported. .PP The \f[C]include\f[] directive may only be used in journal files, and currently it may only include other journal files (eg, not CSV or -timelog files.) +timeclock files.) .SH EDITOR SUPPORT .PP Add\-on modes exist for various text editors, to make working with @@ -863,7 +863,7 @@ Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), -hledger_csv(5), hledger_journal(5), hledger_timelog(5), hledger_timedot(5), +hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org diff --git a/hledger-lib/doc/hledger_journal.5.md b/hledger-lib/doc/hledger_journal.5.md index 89ad999d1..613c79fa5 100644 --- a/hledger-lib/doc/hledger_journal.5.md +++ b/hledger-lib/doc/hledger_journal.5.md @@ -691,7 +691,7 @@ If the path does not begin with a slash, it is relative to the current file. Glob patterns (`*`) are not currently supported. The `include` directive may only be used in journal files, and currently -it may only include other journal files (eg, not CSV or timelog files.) +it may only include other journal files (eg, not CSV or timeclock files.) # EDITOR SUPPORT diff --git a/hledger-lib/doc/hledger_timelog.5 b/hledger-lib/doc/hledger_timeclock.5 similarity index 75% rename from hledger-lib/doc/hledger_timelog.5 rename to hledger-lib/doc/hledger_timeclock.5 index 421146b28..6939f75d4 100644 --- a/hledger-lib/doc/hledger_timelog.5 +++ b/hledger-lib/doc/hledger_timeclock.5 @@ -1,14 +1,14 @@ -.TH "hledger_timelog" "5" "April 2016" "" "hledger User Manuals" +.TH "hledger_timeclock" "5" "April 2016" "" "hledger User Manuals" .SH NAME .PP -Timelog \- the timeclock time logging format, as read by hledger +Timeclock \- the time logging format of timeclock.el, as read by hledger .SH DESCRIPTION .PP -hledger can read timelog files. +hledger can read timeclock files. As with Ledger, these are (a subset of) timeclock.el\[aq]s format, containing clock\-in and clock\-out entries as in the example below. The date is a simple date (also, default year directives work). @@ -35,7 +35,7 @@ entries: .IP .nf \f[C] -$\ hledger\ \-f\ t.timelog\ print +$\ hledger\ \-f\ t.timeclock\ print 2015/03/30\ *\ optional\ description\ after\ two\ spaces \ \ \ \ (some:account\ name)\ \ \ \ \ \ \ \ \ 0.33h @@ -47,13 +47,13 @@ $\ hledger\ \-f\ t.timelog\ print \f[] .fi .PP -Here is a sample.timelog to download and some queries to try: +Here is a sample.timeclock to download and some queries to try: .IP .nf \f[C] -$\ hledger\ \-f\ sample.timelog\ balance\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #\ current\ time\ balances -$\ hledger\ \-f\ sample.timelog\ register\ \-p\ 2009/3\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #\ sessions\ in\ march\ 2009 -$\ hledger\ \-f\ sample.timelog\ register\ \-p\ weekly\ \-\-depth\ 1\ \-\-empty\ \ #\ time\ summary\ by\ week +$\ hledger\ \-f\ sample.timeclock\ balance\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #\ current\ time\ balances +$\ hledger\ \-f\ sample.timeclock\ register\ \-p\ 2009/3\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #\ sessions\ in\ march\ 2009 +$\ hledger\ \-f\ sample.timeclock\ register\ \-p\ weekly\ \-\-depth\ 1\ \-\-empty\ \ #\ time\ summary\ by\ week \f[] .fi .PP @@ -94,7 +94,7 @@ Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), -hledger_csv(5), hledger_journal(5), hledger_timelog(5), hledger_timedot(5), +hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org diff --git a/hledger-lib/doc/hledger_timelog.5.md b/hledger-lib/doc/hledger_timeclock.5.md similarity index 79% rename from hledger-lib/doc/hledger_timelog.5.md rename to hledger-lib/doc/hledger_timeclock.5.md index e3d02560c..4bda18317 100644 --- a/hledger-lib/doc/hledger_timelog.5.md +++ b/hledger-lib/doc/hledger_timeclock.5.md @@ -1,4 +1,4 @@ -% hledger_timelog(5) +% hledger_timeclock(5) % % April 2016 @@ -9,13 +9,13 @@ # NAME -Timelog - the timeclock time logging format, as read by hledger +Timeclock - the time logging format of timeclock.el, as read by hledger # DESCRIPTION -hledger can read timelog files. +hledger can read timeclock files. [As with Ledger](http://ledger-cli.org/3.0/doc/ledger3.html#Time-Keeping), these are (a subset of) [timeclock.el](http://www.emacswiki.org/emacs/TimeClock)'s format, @@ -25,7 +25,7 @@ The time format is HH:MM[:SS][+-ZZZZ]. Seconds and timezone are optional. The timezone, if present, must be four digits and is ignored (currently the time is always interpreted as a local time). -```timelog +```timeclock i 2015/03/30 09:00:00 some:account name optional description after two spaces o 2015/03/30 09:20:00 i 2015/03/31 22:21:45 another account @@ -38,7 +38,7 @@ one day, it is split into several transactions, one for each day. For the above time log, `hledger print` generates these journal entries: ``` {.shell} -$ hledger -f t.timelog print +$ hledger -f t.timeclock print 2015/03/30 * optional description after two spaces (some:account name) 0.33h @@ -51,13 +51,13 @@ $ hledger -f t.timelog print ``` Here is a -[sample.timelog](https://raw.github.com/simonmichael/hledger/master/data/sample.timelog) to +[sample.timeclock](https://raw.github.com/simonmichael/hledger/master/data/sample.timeclock) to download and some queries to try: ```shell -$ hledger -f sample.timelog balance # current time balances -$ hledger -f sample.timelog register -p 2009/3 # sessions in march 2009 -$ hledger -f sample.timelog register -p weekly --depth 1 --empty # time summary by week +$ hledger -f sample.timeclock balance # current time balances +$ hledger -f sample.timeclock register -p 2009/3 # sessions in march 2009 +$ hledger -f sample.timeclock register -p weekly --depth 1 --empty # time summary by week ``` To generate time logs, ie to clock in and clock out, you could: diff --git a/hledger-lib/doc/hledger_timedot.5 b/hledger-lib/doc/hledger_timedot.5 index 976cac85c..9bf2909b7 100644 --- a/hledger-lib/doc/hledger_timedot.5 +++ b/hledger-lib/doc/hledger_timedot.5 @@ -20,7 +20,7 @@ Though called "timedot", the format does not specify the commodity being logged, so could represent other dated, quantifiable things. Eg you could record a single\-entry journal of financial transactions, perhaps slightly more conveniently than with hledger_journal(5) format. -.SS Format +.SH FILE FORMAT .PP A timedot file contains a series of day entries. A day entry begins with a date, and is followed by category/quantity @@ -140,7 +140,7 @@ Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), -hledger_csv(5), hledger_journal(5), hledger_timelog(5), hledger_timedot(5), +hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org diff --git a/hledger-lib/doc/hledger_timedot.5.md b/hledger-lib/doc/hledger_timedot.5.md index 2805d95de..b8e890ccf 100644 --- a/hledger-lib/doc/hledger_timedot.5.md +++ b/hledger-lib/doc/hledger_timedot.5.md @@ -23,7 +23,7 @@ It can be formatted like a bar chart, making clear at a glance where time was sp Though called "timedot", the format does not specify the commodity being logged, so could represent other dated, quantifiable things. Eg you could record a single-entry journal of financial transactions, perhaps slightly more conveniently than with hledger_journal(5) format. -## Format +# FILE FORMAT A timedot file contains a series of day entries. A day entry begins with a date, and is followed by category/quantity pairs, one per line. diff --git a/hledger-lib/future-package.yaml b/hledger-lib/future-package.yaml index 80aa5c27c..d0a2d0dde 100644 --- a/hledger-lib/future-package.yaml +++ b/hledger-lib/future-package.yaml @@ -106,7 +106,7 @@ library: - Hledger.Data.StringFormat - Hledger.Data.Posting - Hledger.Data.RawOptions - - Hledger.Data.TimeLog + - Hledger.Data.Timeclock - Hledger.Data.Transaction - Hledger.Data.Types - Hledger.Query @@ -114,7 +114,7 @@ library: - Hledger.Read.CsvReader - Hledger.Read.JournalReader - Hledger.Read.TimedotReader - - Hledger.Read.TimelogReader + - Hledger.Read.TimeclockReader - Hledger.Read.Util - Hledger.Reports - Hledger.Reports.ReportOptions diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 445042c00..41df4d7ff 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -31,7 +31,7 @@ extra-source-files: doc/hledger_csv.5 doc/hledger_journal.5 doc/hledger_timedot.5 - doc/hledger_timelog.5 + doc/hledger_timeclock.5 source-repository head type: git @@ -100,7 +100,7 @@ library Hledger.Data.StringFormat Hledger.Data.Posting Hledger.Data.RawOptions - Hledger.Data.TimeLog + Hledger.Data.Timeclock Hledger.Data.Transaction Hledger.Data.Types Hledger.Query @@ -108,7 +108,7 @@ library Hledger.Read.CsvReader Hledger.Read.JournalReader Hledger.Read.TimedotReader - Hledger.Read.TimelogReader + Hledger.Read.TimeclockReader Hledger.Read.Util Hledger.Reports Hledger.Reports.ReportOptions diff --git a/hledger-ui/doc/hledger-ui.1 b/hledger-ui/doc/hledger-ui.1 index f10034115..a512081a5 100644 --- a/hledger-ui/doc/hledger-ui.1 +++ b/hledger-ui/doc/hledger-ui.1 @@ -324,7 +324,7 @@ Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), -hledger_csv(5), hledger_journal(5), hledger_timelog(5), hledger_timedot(5), +hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org diff --git a/hledger-web/doc/hledger-web.1 b/hledger-web/doc/hledger-web.1 index fe41330b1..1602546ac 100644 --- a/hledger-web/doc/hledger-web.1 +++ b/hledger-web/doc/hledger-web.1 @@ -73,7 +73,7 @@ Note there is no built\-in access control, so you will need to hide hledger\-web behind an authenticating proxy (such as apache or nginx) if you want to restrict who can see and add entries to your journal. .PP -With journal and timelog files (but not CSV files, currently) the web +With journal and timeclock files (but not CSV files, currently) the web app detects changes and will show the new data on the next request. If a change makes the file unparseable, hledger\-web will show an error until the file has been fixed. @@ -249,7 +249,7 @@ Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), -hledger_csv(5), hledger_journal(5), hledger_timelog(5), hledger_timedot(5), +hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org diff --git a/hledger-web/doc/hledger-web.1.md b/hledger-web/doc/hledger-web.1.md index 81ea7f69f..705c2433d 100644 --- a/hledger-web/doc/hledger-web.1.md +++ b/hledger-web/doc/hledger-web.1.md @@ -77,7 +77,7 @@ Note there is no built-in access control, so you will need to hide hledger-web behind an authenticating proxy (such as apache or nginx) if you want to restrict who can see and add entries to your journal. -With journal and timelog files (but not CSV files, currently) +With journal and timeclock files (but not CSV files, currently) the web app detects changes and will show the new data on the next request. If a change makes the file unparseable, hledger-web will show an error until the file has been fixed. diff --git a/hledger/doc/hledger.1 b/hledger/doc/hledger.1 index fe1a1d3c4..a57313cd5 100644 --- a/hledger/doc/hledger.1 +++ b/hledger/doc/hledger.1 @@ -2138,7 +2138,7 @@ Released under GNU GPL v3 or later. .SH SEE ALSO hledger(1), hledger\-ui(1), hledger\-web(1), hledger\-api(1), -hledger_csv(5), hledger_journal(5), hledger_timelog(5), hledger_timedot(5), +hledger_csv(5), hledger_journal(5), hledger_timeclock(5), hledger_timedot(5), ledger(1) http://hledger.org diff --git a/site/.gitignore b/site/.gitignore index c157d2cf3..4034b5644 100644 --- a/site/.gitignore +++ b/site/.gitignore @@ -9,5 +9,5 @@ hledger-web.md hledger.md csv.md journal.md +timeclock.md timedot.md -timelog.md diff --git a/site/css/style.css b/site/css/style.css index b15eef659..57f77d8d9 100644 --- a/site/css/style.css +++ b/site/css/style.css @@ -32,7 +32,7 @@ h4, h5, h6 { border:thin solid #cec; /* border:none; */ } -.timelog { +.timeclock { background-color:#ffe; border:thin solid #eec; /* border:none; */ diff --git a/site/docs.md b/site/docs.md index e0d5aa79c..760e287ad 100644 --- a/site/docs.md +++ b/site/docs.md @@ -65,7 +65,7 @@ A JSON API server. - + @@ -75,7 +75,7 @@ A JSON API server. #### [CSV](csv.html) -#### [Timeclock](timelog.html) +#### [Timeclock](timeclock.html) #### [Timedot](timedot.html) diff --git a/site/docs1.md b/site/docs1.md index 27e0faf50..5c4311f97 100644 --- a/site/docs1.md +++ b/site/docs1.md @@ -77,7 +77,7 @@ hledger's primary data format, representing a general journal. #### [hledger_csv(5)](csv.html) How hledger reads Comma Separated Value data. -#### [hledger_timelog(5)](timelog.html) +#### [hledger_timeclock(5)](timeclock.html) Timeclock format, a sequence of clock-in/clock-out records. #### [hledger_timedot(5)](timedot.html) diff --git a/site/faq.md b/site/faq.md index bf8ec3669..373f227b6 100644 --- a/site/faq.md +++ b/site/faq.md @@ -78,7 +78,7 @@ We currently support: - Ledger's journal format, mostly - csv format -- timelog format +- timeclock format - regular journal transactions - multiple commodities - fixed transaction prices @@ -135,9 +135,9 @@ or [balance assertions](manual.html#assertions-and-ordering). - hledger shows start and end dates of the intervals requested, not just the span containing data -- hledger always shows timelog balances in hours +- hledger always shows timeclock balances in hours -- hledger splits multi-day timelog sessions at midnight by default (Ledger does this with an option) +- hledger splits multi-day timeclock sessions at midnight by default (Ledger does this with an option) - hledger's output follows the decimal point character, digit grouping, and digit group separator character used in the journal. @@ -156,14 +156,14 @@ or [balance assertions](manual.html#assertions-and-ordering). seen. Ledger uses D only for commodity display settings and for the entry command. -- hledger generates a description for timelog sessions, instead of +- hledger generates a description for timeclock sessions, instead of taking it from the clock-out entry - hledger's [include directive](manual.html#including-other-files) does not support shell glob patterns (eg `include *.journal` ), which Ledger's does. - hledger's include directive works only in journal files, and currently can only include - journal files, not eg timelog or CSV files + journal files, not eg timeclock or CSV files - when checking [balance assertions](manual.html#balance-assertions) hledger sorts the account's postings first by date and then (for diff --git a/tests/timelog/timelog.test b/tests/timeclock/timeclock.test similarity index 87% rename from tests/timelog/timelog.test rename to tests/timeclock/timeclock.test index 3477415c2..656dcfaa7 100644 --- a/tests/timelog/timelog.test +++ b/tests/timeclock/timeclock.test @@ -1,4 +1,4 @@ -# a timelog session is parsed as a similarly-named transaction with one virtual posting +# a timeclock session is parsed as a similarly-named transaction with one virtual posting hledger -f - print <<< i 2009/1/1 08:00:00 @@ -21,9 +21,9 @@ o 2009/1/3 09:00:00 >>>2 >>>= 0 -# ledger timelog example from #ledger -# ==== consulting.timelog -# ; Timelog for consulting sideline +# ledger timeclock example from #ledger +# ==== consulting.timeclock +# ; Time log for consulting sideline # ; All times UTC # i 2011/01/26 16:00:00 XXXX:Remote "IPMI Access" # o 2011/01/26 16:15:00 @@ -39,7 +39,7 @@ o 2009/1/3 09:00:00 # ; Ledger for Consulting sideline # !account Consulting -# !include consulting.timelog +# !include consulting.timeclock # !end diff --git a/tests/timelog/timezone.test.notimplemented b/tests/timeclock/timezone.test.notimplemented similarity index 100% rename from tests/timelog/timezone.test.notimplemented rename to tests/timeclock/timezone.test.notimplemented diff --git a/tools/.gitignore b/tools/.gitignore index 335da62aa..961a63b6a 100644 --- a/tools/.gitignore +++ b/tools/.gitignore @@ -1 +1 @@ -generatetimelog +generatetimeclock diff --git a/tools/generatetimelog.hs b/tools/generatetimeclock.hs similarity index 81% rename from tools/generatetimelog.hs rename to tools/generatetimeclock.hs index 8e29b6cbe..7770db33d 100644 --- a/tools/generatetimelog.hs +++ b/tools/generatetimeclock.hs @@ -1,8 +1,8 @@ #!/usr/bin/env runhaskell {- -generatetimelog.hs NUMENTRIES +generatetimeclock.hs NUMENTRIES -Outputs a dummy timelog with the specified number of clock-in/clock-out entries, +Outputs a dummy timeclock log with the specified number of clock-in/clock-out entries, one per day. -}