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