use longer but standard and clearer getCurrentTime/Day
This commit is contained in:
parent
b0178b88cc
commit
44cbed59cb
@ -42,14 +42,11 @@ showDate d = formatTime defaultTimeLocale "%Y/%m/%d" d
|
|||||||
mkUTCTime :: Day -> TimeOfDay -> UTCTime
|
mkUTCTime :: Day -> TimeOfDay -> UTCTime
|
||||||
mkUTCTime day tod = localTimeToUTC utc (LocalTime day tod)
|
mkUTCTime day tod = localTimeToUTC utc (LocalTime day tod)
|
||||||
|
|
||||||
today :: IO Day
|
getCurrentDay :: IO Day
|
||||||
today = do
|
getCurrentDay = do
|
||||||
t <- getZonedTime
|
t <- getZonedTime
|
||||||
return $ localDay (zonedTimeToLocalTime t)
|
return $ localDay (zonedTimeToLocalTime t)
|
||||||
|
|
||||||
now :: IO UTCTime
|
|
||||||
now = getCurrentTime
|
|
||||||
|
|
||||||
elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
|
elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
|
||||||
elapsedSeconds t1 t2 = realToFrac $ diffUTCTime t1 t2
|
elapsedSeconds t1 t2 = realToFrac $ diffUTCTime t1 t2
|
||||||
|
|
||||||
@ -231,7 +228,7 @@ Assumes any text in the parse stream has been lowercased.
|
|||||||
-}
|
-}
|
||||||
smartdate :: GenParser Char st SmartDate
|
smartdate :: GenParser Char st SmartDate
|
||||||
smartdate = do
|
smartdate = do
|
||||||
let dateparsers = [yyyymmdd, ymd, ym, md, y, d, month, mon, today', yesterday, tomorrow,
|
let dateparsers = [yyyymmdd, ymd, ym, md, y, d, month, mon, today, yesterday, tomorrow,
|
||||||
lastthisnextthing
|
lastthisnextthing
|
||||||
]
|
]
|
||||||
(y,m,d) <- choice $ map try dateparsers
|
(y,m,d) <- choice $ map try dateparsers
|
||||||
@ -310,8 +307,8 @@ mon = do
|
|||||||
let i = monIndex m
|
let i = monIndex m
|
||||||
return ("",show i,"")
|
return ("",show i,"")
|
||||||
|
|
||||||
today',yesterday,tomorrow :: GenParser Char st SmartDate
|
today,yesterday,tomorrow :: GenParser Char st SmartDate
|
||||||
today' = string "today" >> return ("","","today")
|
today = string "today" >> return ("","","today")
|
||||||
yesterday = string "yesterday" >> return ("","","yesterday")
|
yesterday = string "yesterday" >> return ("","","yesterday")
|
||||||
tomorrow = string "tomorrow" >> return ("","","tomorrow")
|
tomorrow = string "tomorrow" >> return ("","","tomorrow")
|
||||||
|
|
||||||
|
|||||||
12
Options.hs
12
Options.hs
@ -147,14 +147,14 @@ parseArguments = do
|
|||||||
-- based on today's date.
|
-- based on today's date.
|
||||||
fixOptDates :: [Opt] -> IO [Opt]
|
fixOptDates :: [Opt] -> IO [Opt]
|
||||||
fixOptDates opts = do
|
fixOptDates opts = do
|
||||||
t <- today
|
d <- getCurrentDay
|
||||||
return $ map (fixopt t) opts
|
return $ map (fixopt d) opts
|
||||||
where
|
where
|
||||||
fixopt t (Begin s) = Begin $ fixSmartDateStr t s
|
fixopt d (Begin s) = Begin $ fixSmartDateStr d s
|
||||||
fixopt t (End s) = End $ fixSmartDateStr t s
|
fixopt d (End s) = End $ fixSmartDateStr d s
|
||||||
fixopt t (Display s) = -- hacky
|
fixopt d (Display s) = -- hacky
|
||||||
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s
|
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s
|
||||||
where fixbracketeddatestr s = "[" ++ (fixSmartDateStr t $ init $ tail s) ++ "]"
|
where fixbracketeddatestr s = "[" ++ (fixSmartDateStr d $ init $ tail s) ++ "]"
|
||||||
fixopt _ o = o
|
fixopt _ o = o
|
||||||
|
|
||||||
-- | Figure out the overall date span we should report on, based on any
|
-- | Figure out the overall date span we should report on, based on any
|
||||||
|
|||||||
2
Utils.hs
2
Utils.hs
@ -41,7 +41,7 @@ ledgerfromfilewithopts :: [Opt] -> [String] -> FilePath -> IO Ledger
|
|||||||
ledgerfromfilewithopts opts args f = do
|
ledgerfromfilewithopts opts args f = do
|
||||||
s <- readFile f
|
s <- readFile f
|
||||||
rl <- rawledgerfromstring s
|
rl <- rawledgerfromstring s
|
||||||
reftime <- now
|
reftime <- getCurrentTime
|
||||||
return $ prepareLedger opts args reftime s rl
|
return $ prepareLedger opts args reftime s rl
|
||||||
|
|
||||||
-- | Get a Ledger from your default ledger file, or raise an error.
|
-- | Get a Ledger from your default ledger file, or raise an error.
|
||||||
|
|||||||
@ -97,6 +97,6 @@ parseLedgerAndDo opts args cmd = do
|
|||||||
-- and, doesn't work with stdin. kludge it, stdin won't work with ui command
|
-- and, doesn't work with stdin. kludge it, stdin won't work with ui command
|
||||||
let f' = if f == "-" then "/dev/null" else f
|
let f' = if f == "-" then "/dev/null" else f
|
||||||
rawtext <- readFile f'
|
rawtext <- readFile f'
|
||||||
reftime <- now
|
reftime <- getCurrentTime
|
||||||
let runcmd = cmd opts args . prepareLedger opts args reftime rawtext
|
let runcmd = cmd opts args . prepareLedger opts args reftime rawtext
|
||||||
return f >>= runErrorT . parseLedgerFile >>= either (hPutStrLn stderr) runcmd
|
return f >>= runErrorT . parseLedgerFile >>= either (hPutStrLn stderr) runcmd
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user