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

parse timelog entries according to a timezone stored in the context

Browse Source
This commit is contained in:
Simon Michael 2009-01-24 21:46:09 +00:00
parent 44cbed59cb
commit 25526cf4b3
2 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Ledger/Dates.hs
View File

@ -39,9 +39,6 @@ import Ledger.Utils
showDate :: Day -> String showDate :: Day -> String
showDate d = formatTime defaultTimeLocale "%Y/%m/%d" d showDate d = formatTime defaultTimeLocale "%Y/%m/%d" d
mkUTCTime :: Day -> TimeOfDay -> UTCTime
mkUTCTime day tod = localTimeToUTC utc (LocalTime day tod)
getCurrentDay :: IO Day getCurrentDay :: IO Day
getCurrentDay = do getCurrentDay = do
t <- getZonedTime t <- getZonedTime

26
Ledger/Parse.hs
View File

@ -16,6 +16,8 @@ import qualified Text.ParserCombinators.Parsec.Token as P
import System.Directory import System.Directory
import System.IO import System.IO
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Time.LocalTime
import Data.Time.Calendar
import Ledger.Utils import Ledger.Utils
import Ledger.Types import Ledger.Types
import Ledger.Dates import Ledger.Dates
@ -24,21 +26,20 @@ import Ledger.Entry
import Ledger.Commodity import Ledger.Commodity
import Ledger.TimeLog import Ledger.TimeLog
import Ledger.RawLedger import Ledger.RawLedger
import Data.Time.LocalTime
import Data.Time.Calendar
-- utils -- utils
-- | Some context kept during parsing. -- | Some context kept during parsing.
data LedgerFileCtx = Ctx { data LedgerFileCtx = Ctx {
ctxYear :: !(Maybe Integer) -- ^ the current default year specified with Y, if any ctxTimeZone :: !TimeZone -- ^ the user's timezone
, ctxCommod :: !(Maybe String) -- ^ I don't know , ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y
, ctxAccount :: ![String] -- ^ the current "container" account specified with !account, if any , ctxCommod :: !(Maybe String) -- ^ I don't know
, ctxAccount :: ![String] -- ^ the current stack of "container" accounts specified by !account
} deriving (Read, Show) } deriving (Read, Show)
emptyCtx :: LedgerFileCtx emptyCtx :: LedgerFileCtx
emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] } emptyCtx = Ctx { ctxTimeZone=utc, ctxYear=Nothing, ctxCommod=Nothing, ctxAccount=[] }
-- containing accounts "nest" hierarchically -- containing accounts "nest" hierarchically
@ -62,6 +63,12 @@ setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
getYear :: GenParser tok LedgerFileCtx (Maybe Integer) getYear :: GenParser tok LedgerFileCtx (Maybe Integer)
getYear = liftM ctxYear getState getYear = liftM ctxYear getState
setTimeZone :: TimeZone -> GenParser tok LedgerFileCtx ()
setTimeZone tz = updateState (\ctx -> ctx{ctxTimeZone=tz})
getCtxTimeZone :: GenParser tok LedgerFileCtx TimeZone
getCtxTimeZone = liftM ctxTimeZone getState
-- let's get to it -- let's get to it
parseLedgerFile :: FilePath -> ErrorT String IO RawLedger parseLedgerFile :: FilePath -> ErrorT String IO RawLedger
@ -326,7 +333,7 @@ ledgerpartialdate = do
when (y==Nothing) $ error "partial date found, but no default year specified" when (y==Nothing) $ error "partial date found, but no default year specified"
return $ fromGregorian (fromJust y) (read m) (read d) return $ fromGregorian (fromJust y) (read m) (read d)
ledgerdatetime :: GenParser Char st UTCTime ledgerdatetime :: GenParser Char LedgerFileCtx UTCTime
ledgerdatetime = do ledgerdatetime = do
day <- ledgerdate day <- ledgerdate
h <- many1 digit h <- many1 digit
@ -336,8 +343,9 @@ ledgerdatetime = do
char ':' char ':'
many1 digit many1 digit
many spacenonewline many spacenonewline
return $ mkUTCTime day (TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s)) let tod = TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s)
tz <- getCtxTimeZone
return $ localTimeToUTC tz (LocalTime day tod)
ledgerstatus :: GenParser Char st Bool ledgerstatus :: GenParser Char st Bool
ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> return False ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> return False