gather date stuff together, FuzzyDate -> SmartDate
This commit is contained in:
Simon Michael
parent
52ab3372b8
commit
884ebf2979
@ -10,6 +10,7 @@ module Ledger (
|
||||
module Ledger.AccountName,
|
||||
module Ledger.Amount,
|
||||
module Ledger.Commodity,
|
||||
module Ledger.Dates,
|
||||
module Ledger.Entry,
|
||||
module Ledger.Ledger,
|
||||
module Ledger.Parse,
|
||||
@ -25,6 +26,7 @@ import Ledger.Account
|
||||
import Ledger.AccountName
|
||||
import Ledger.Amount
|
||||
import Ledger.Commodity
|
||||
import Ledger.Dates
|
||||
import Ledger.Entry
|
||||
import Ledger.Ledger
|
||||
import Ledger.Parse
|
||||
|
||||
215
Ledger/Dates.hs
215
Ledger/Dates.hs
@ -1,21 +1,16 @@
|
||||
{-|
|
||||
|
||||
Types for Dates and DateTimes, implemented in terms of UTCTime
|
||||
'Date' and 'DateTime' are a helper layer on top of the standard UTCTime,
|
||||
Day etc.
|
||||
|
||||
A 'SmartDate' is a date which may be partially-specified or relative.
|
||||
Eg 2008/12/31, but also 2008/12, 12/31, tomorrow, last week, next year.
|
||||
We represent these as a triple of strings like ("2008","12",""),
|
||||
("","","tomorrow"), ("","last","week").
|
||||
|
||||
-}
|
||||
|
||||
module Ledger.Dates
|
||||
--(
|
||||
-- Date,
|
||||
-- DateTime,
|
||||
-- mkDate,
|
||||
-- mkDateTime,
|
||||
-- parsedatetime,
|
||||
-- parsedate,
|
||||
-- datetimeToDate,
|
||||
-- elapsedSeconds,
|
||||
-- today
|
||||
-- )
|
||||
where
|
||||
|
||||
import Data.Time.Clock
|
||||
@ -25,12 +20,12 @@ import Data.Time.LocalTime
|
||||
import System.Locale (defaultTimeLocale)
|
||||
import Text.Printf
|
||||
import Data.Maybe
|
||||
import Text.ParserCombinators.Parsec
|
||||
import Text.ParserCombinators.Parsec.Char
|
||||
import Text.ParserCombinators.Parsec.Combinator
|
||||
import Ledger.Types
|
||||
import Ledger.Utils
|
||||
|
||||
newtype Date = Date UTCTime
|
||||
deriving (Ord, Eq)
|
||||
|
||||
newtype DateTime = DateTime UTCTime
|
||||
deriving (Ord, Eq)
|
||||
|
||||
instance Show Date where
|
||||
show (Date t) = formatTime defaultTimeLocale "%Y/%m/%d" t
|
||||
@ -38,12 +33,6 @@ instance Show Date where
|
||||
instance Show DateTime where
|
||||
show (DateTime t) = formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" t
|
||||
|
||||
-- | A fuzzy date is either a partially-specified or a relative date.
|
||||
-- We represent it as a triple of strings such as
|
||||
-- ("2008","01","01") or ("2008","","") or ("","","tomorrow") or
|
||||
-- ("","last|this|next","day|week|month|quarter|year").
|
||||
type FuzzyDate = (String,String,String)
|
||||
|
||||
mkDate :: Day -> Date
|
||||
mkDate day = Date (localTimeToUTC utc (LocalTime day midnight))
|
||||
|
||||
@ -58,23 +47,6 @@ today = do
|
||||
now :: IO DateTime
|
||||
now = fmap DateTime getCurrentTime
|
||||
|
||||
-- | Parse a date-time string to a time type, or raise an error.
|
||||
parsedatetime :: String -> DateTime
|
||||
parsedatetime s = DateTime $
|
||||
parsetimewith "%Y/%m/%d %H:%M:%S" s $
|
||||
error $ printf "could not parse timestamp \"%s\"" s
|
||||
|
||||
-- | Parse a date string to a time type, or raise an error.
|
||||
parsedate :: String -> Date
|
||||
parsedate s = Date $
|
||||
parsetimewith "%Y/%m/%d" s $
|
||||
error $ printf "could not parse date \"%s\"" s
|
||||
|
||||
-- | Parse a time string to a time type using the provided pattern, or
|
||||
-- return the default.
|
||||
parsetimewith :: ParseTime t => String -> String -> t -> t
|
||||
parsetimewith pat s def = fromMaybe def $ parseTime defaultTimeLocale pat s
|
||||
|
||||
datetimeToDate :: DateTime -> Date
|
||||
datetimeToDate (DateTime (UTCTime{utctDay=day})) = Date (UTCTime day 0)
|
||||
|
||||
@ -92,3 +64,166 @@ dateDay date = d where (_,_,d) = dateComponents date
|
||||
|
||||
-- dateMonth :: Date -> Day
|
||||
dateMonth date = m where (_,m,_) = dateComponents date
|
||||
|
||||
-- | Convert a fuzzy date string to an explicit yyyy/mm/dd string using
|
||||
-- the provided date as reference point.
|
||||
fixSmartDateStr :: Date -> String -> String
|
||||
fixSmartDateStr t s = printf "%04d/%02d/%02d" y m d
|
||||
where
|
||||
pdate = fromparse $ parsewith smartdate $ map toLower s
|
||||
(y,m,d) = dateComponents $ fixSmartDate t pdate
|
||||
|
||||
-- | Convert a SmartDate to an absolute date using the provided date as
|
||||
-- reference point.
|
||||
fixSmartDate :: Date -> SmartDate -> Date
|
||||
fixSmartDate refdate sdate = mkDate $ fromGregorian y m d
|
||||
where
|
||||
(y,m,d) = fix sdate
|
||||
fix :: SmartDate -> (Integer,Int,Int)
|
||||
fix ("","","today") = (ry, rm, rd)
|
||||
fix ("","this","day") = (ry, rm, rd)
|
||||
fix ("","","yesterday") = dateComponents $ lastday refdate
|
||||
fix ("","last","day") = dateComponents $ lastday refdate
|
||||
fix ("","","tomorrow") = dateComponents $ nextday refdate
|
||||
fix ("","next","day") = dateComponents $ nextday refdate
|
||||
fix ("","last","week") = dateComponents $ lastweek refdate
|
||||
fix ("","this","week") = dateComponents $ thisweek refdate
|
||||
fix ("","next","week") = dateComponents $ nextweek refdate
|
||||
fix ("","",d) = (ry, rm, read d)
|
||||
fix ("",m,d) = (ry, read m, read d)
|
||||
fix (y,m,d) = (read y, read m, read d)
|
||||
(ry,rm,rd) = dateComponents refdate
|
||||
|
||||
lastday, nextday :: Date -> Date
|
||||
lastday = mkDate . (addDays (-1)) . utctDay . dateToUTC
|
||||
nextday = mkDate . (addDays 1) . utctDay . dateToUTC
|
||||
lastweek = mkDate . (addDays (-7)) . utctDay . dateToUTC
|
||||
thisweek = mkDate . (addDays 0) . utctDay . dateToUTC
|
||||
nextweek = mkDate . (addDays 7) . utctDay . dateToUTC
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- parsing
|
||||
|
||||
-- | Parse a date-time string to a time type, or raise an error.
|
||||
parsedatetime :: String -> DateTime
|
||||
parsedatetime s = DateTime $
|
||||
parsetimewith "%Y/%m/%d %H:%M:%S" s $
|
||||
error $ printf "could not parse timestamp \"%s\"" s
|
||||
|
||||
-- | Parse a date string to a time type, or raise an error.
|
||||
parsedate :: String -> Date
|
||||
parsedate s = Date $
|
||||
parsetimewith "%Y/%m/%d" s $
|
||||
error $ printf "could not parse date \"%s\"" s
|
||||
|
||||
-- | Parse a time string to a time type using the provided pattern, or
|
||||
-- return the default.
|
||||
parsetimewith :: ParseTime t => String -> String -> t -> t
|
||||
parsetimewith pat s def = fromMaybe def $ parseTime defaultTimeLocale pat s
|
||||
|
||||
{-|
|
||||
Parse a date in any of the formats allowed in ledger's period expressions,
|
||||
and maybe some others:
|
||||
|
||||
> 2004
|
||||
> 2004/10
|
||||
> 2004/10/1
|
||||
> 10/1
|
||||
> 21
|
||||
> october, oct
|
||||
> yesterday, today, tomorrow
|
||||
> (not yet) this/next/last week/day/month/quarter/year
|
||||
|
||||
Returns a SmartDate, to be converted to a full date later (see fixSmartDate).
|
||||
Assumes any text in the parse stream has been lowercased.
|
||||
-}
|
||||
smartdate :: Parser SmartDate
|
||||
smartdate = do
|
||||
let dateparsers = [ymd, ym, md, y, d, month, mon, today', yesterday, tomorrow
|
||||
-- lastthisnextthing
|
||||
]
|
||||
(y,m,d) <- choice $ map try dateparsers
|
||||
return $ (y,m,d)
|
||||
|
||||
datesepchar = oneOf "/-."
|
||||
|
||||
ymd :: Parser SmartDate
|
||||
ymd = do
|
||||
y <- many1 digit
|
||||
datesepchar
|
||||
m <- many1 digit
|
||||
guard (read m <= 12)
|
||||
datesepchar
|
||||
d <- many1 digit
|
||||
guard (read d <= 31)
|
||||
return (y,m,d)
|
||||
|
||||
ym :: Parser SmartDate
|
||||
ym = do
|
||||
y <- many1 digit
|
||||
guard (read y > 12)
|
||||
datesepchar
|
||||
m <- many1 digit
|
||||
guard (read m <= 12)
|
||||
return (y,m,"1")
|
||||
|
||||
y :: Parser SmartDate
|
||||
y = do
|
||||
y <- many1 digit
|
||||
guard (read y >= 1000)
|
||||
return (y,"1","1")
|
||||
|
||||
d :: Parser SmartDate
|
||||
d = do
|
||||
d <- many1 digit
|
||||
guard (read d <= 31)
|
||||
return ("","",d)
|
||||
|
||||
md :: Parser SmartDate
|
||||
md = do
|
||||
m <- many1 digit
|
||||
guard (read m <= 12)
|
||||
datesepchar
|
||||
d <- many1 digit
|
||||
guard (read d <= 31)
|
||||
return ("",m,d)
|
||||
|
||||
months = ["january","february","march","april","may","june",
|
||||
"july","august","september","october","november","december"]
|
||||
|
||||
mons = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"]
|
||||
|
||||
month :: Parser SmartDate
|
||||
month = do
|
||||
m <- choice $ map string months
|
||||
let i = maybe 0 (+1) $ (map toLower m) `elemIndex` months
|
||||
return ("",show i,"1")
|
||||
|
||||
mon :: Parser SmartDate
|
||||
mon = do
|
||||
m <- choice $ map string mons
|
||||
let i = maybe 0 (+1) $ (map toLower m) `elemIndex` mons
|
||||
return ("",show i,"1")
|
||||
|
||||
today',yesterday,tomorrow :: Parser SmartDate
|
||||
today' = string "today" >> return ("","","today")
|
||||
yesterday = string "yesterday" >> return ("","","yesterday")
|
||||
tomorrow = string "tomorrow" >> return ("","","tomorrow")
|
||||
|
||||
lastthisnextthing :: Parser SmartDate
|
||||
lastthisnextthing = do
|
||||
r <- choice [
|
||||
string "last"
|
||||
,string "this"
|
||||
,string "next"
|
||||
]
|
||||
many1 spacenonewline
|
||||
p <- choice [
|
||||
string "day"
|
||||
,string "week"
|
||||
,string "month"
|
||||
,string "quarter"
|
||||
,string "year"
|
||||
]
|
||||
return ("",r,p)
|
||||
|
||||
|
||||
@ -9,6 +9,7 @@ module Ledger.Entry
|
||||
where
|
||||
import Ledger.Utils
|
||||
import Ledger.Types
|
||||
import Ledger.Dates
|
||||
import Ledger.RawTransaction
|
||||
import Ledger.Amount
|
||||
|
||||
|
||||
119
Ledger/Parse.hs
119
Ledger/Parse.hs
@ -15,6 +15,7 @@ import System.IO
|
||||
import qualified Data.Map as Map
|
||||
import Ledger.Utils
|
||||
import Ledger.Types
|
||||
import Ledger.Dates
|
||||
import Ledger.Amount
|
||||
import Ledger.Entry
|
||||
import Ledger.Commodity
|
||||
@ -412,18 +413,6 @@ numberpartsstartingwithpoint = do
|
||||
return ("",frac)
|
||||
|
||||
|
||||
spacenonewline :: Parser Char
|
||||
spacenonewline = satisfy (\c -> c `elem` " \v\f\t")
|
||||
|
||||
restofline :: Parser String
|
||||
restofline = anyChar `manyTill` newline
|
||||
|
||||
whiteSpace1 :: Parser ()
|
||||
whiteSpace1 = do space; whiteSpace
|
||||
|
||||
nonspace = satisfy (not . isSpace)
|
||||
|
||||
|
||||
{-| Parse a timelog file. Here is the timelog grammar, from timeclock.el 2.6:
|
||||
|
||||
@
|
||||
@ -483,111 +472,6 @@ ledgerfromtimelog = do
|
||||
|
||||
-- misc parsing
|
||||
|
||||
{-|
|
||||
Parse a date in any of the formats allowed in ledger's period expressions,
|
||||
and maybe some others:
|
||||
|
||||
> 2004
|
||||
> 2004/10
|
||||
> 2004/10/1
|
||||
> 10/1
|
||||
> 21
|
||||
> october, oct
|
||||
> yesterday, today, tomorrow
|
||||
> (not yet) this/next/last week/day/month/quarter/year
|
||||
|
||||
Returns a FuzzyDate, to be converted to a full date later, in the IO
|
||||
layer. Note: assumes any text in the parse stream has been lowercased.
|
||||
-}
|
||||
smartdate :: Parser FuzzyDate
|
||||
smartdate = do
|
||||
let dateparsers = [ymd, ym, md, y, d, month, mon, today', yesterday, tomorrow]
|
||||
(y,m,d) <- choice $ map try dateparsers
|
||||
return $ (y,m,d)
|
||||
|
||||
datesepchar = oneOf "/-."
|
||||
|
||||
ymd :: Parser FuzzyDate
|
||||
ymd = do
|
||||
y <- many1 digit
|
||||
datesepchar
|
||||
m <- many1 digit
|
||||
guard (read m <= 12)
|
||||
datesepchar
|
||||
d <- many1 digit
|
||||
guard (read d <= 31)
|
||||
return (y,m,d)
|
||||
|
||||
ym :: Parser FuzzyDate
|
||||
ym = do
|
||||
y <- many1 digit
|
||||
guard (read y > 12)
|
||||
datesepchar
|
||||
m <- many1 digit
|
||||
guard (read m <= 12)
|
||||
return (y,m,"1")
|
||||
|
||||
y :: Parser FuzzyDate
|
||||
y = do
|
||||
y <- many1 digit
|
||||
guard (read y >= 1000)
|
||||
return (y,"1","1")
|
||||
|
||||
d :: Parser FuzzyDate
|
||||
d = do
|
||||
d <- many1 digit
|
||||
guard (read d <= 31)
|
||||
return ("","",d)
|
||||
|
||||
md :: Parser FuzzyDate
|
||||
md = do
|
||||
m <- many1 digit
|
||||
guard (read m <= 12)
|
||||
datesepchar
|
||||
d <- many1 digit
|
||||
guard (read d <= 31)
|
||||
return ("",m,d)
|
||||
|
||||
months = ["january","february","march","april","may","june",
|
||||
"july","august","september","october","november","december"]
|
||||
|
||||
mons = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"]
|
||||
|
||||
month :: Parser FuzzyDate
|
||||
month = do
|
||||
m <- choice $ map string months
|
||||
let i = maybe 0 (+1) $ (map toLower m) `elemIndex` months
|
||||
return ("",show i,"1")
|
||||
|
||||
mon :: Parser FuzzyDate
|
||||
mon = do
|
||||
m <- choice $ map string mons
|
||||
let i = maybe 0 (+1) $ (map toLower m) `elemIndex` mons
|
||||
return ("",show i,"1")
|
||||
|
||||
today',yesterday,tomorrow :: Parser FuzzyDate
|
||||
today' = string "today" >> return ("","","today")
|
||||
yesterday = string "yesterday" >> return ("","","yesterday")
|
||||
tomorrow = string "tomorrow" >> return ("","","tomorrow")
|
||||
|
||||
lastthisnextthing :: Parser FuzzyDate
|
||||
lastthisnextthing = do
|
||||
r <- choice [
|
||||
string "last"
|
||||
,string "this"
|
||||
,string "next"
|
||||
]
|
||||
many1 spacenonewline
|
||||
p <- choice [
|
||||
string "day"
|
||||
,string "week"
|
||||
,string "month"
|
||||
,string "quarter"
|
||||
,string "year"
|
||||
]
|
||||
return ("",r,p)
|
||||
|
||||
|
||||
-- | Parse a --display expression which is a simple date predicate, like
|
||||
-- "d>[DATE]" or "d<=[DATE]", and return a transaction-matching predicate.
|
||||
datedisplayexpr :: Parser (Transaction -> Bool)
|
||||
@ -609,3 +493,4 @@ datedisplayexpr = do
|
||||
return matcher
|
||||
|
||||
compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
|
||||
|
||||
|
||||
@ -10,6 +10,7 @@ module Ledger.TimeLog
|
||||
where
|
||||
import Ledger.Utils
|
||||
import Ledger.Types
|
||||
import Ledger.Dates
|
||||
import Ledger.Commodity
|
||||
import Ledger.Amount
|
||||
|
||||
|
||||
@ -9,6 +9,7 @@ module Ledger.Transaction
|
||||
where
|
||||
import Ledger.Utils
|
||||
import Ledger.Types
|
||||
import Ledger.Dates
|
||||
import Ledger.Entry
|
||||
import Ledger.RawTransaction
|
||||
import Ledger.Amount
|
||||
|
||||
@ -1,7 +1,8 @@
|
||||
{-|
|
||||
|
||||
All the main data types, defined here to avoid import cycles.
|
||||
See the corresponding modules for documentation.
|
||||
This is the next layer up from Ledger.Utils. All main data types are
|
||||
defined here to avoid import cycles; see the corresponding modules for
|
||||
documentation.
|
||||
|
||||
-}
|
||||
|
||||
@ -11,6 +12,10 @@ import Ledger.Utils
|
||||
import qualified Data.Map as Map
|
||||
|
||||
|
||||
newtype Date = Date UTCTime deriving (Ord, Eq)
|
||||
newtype DateTime = DateTime UTCTime deriving (Ord, Eq)
|
||||
type SmartDate = (String,String,String)
|
||||
|
||||
type AccountName = String
|
||||
|
||||
data Side = L | R deriving (Eq,Show,Ord)
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
{-|
|
||||
|
||||
Provide a number of standard modules and utilities.
|
||||
Provide a number of standard modules and utilities needed everywhere (or
|
||||
somewhere low in the module tree). The "hledger prelude".
|
||||
|
||||
-}
|
||||
|
||||
@ -20,7 +21,6 @@ module Text.Printf,
|
||||
module Text.Regex,
|
||||
module Text.RegexPR,
|
||||
module Test.HUnit,
|
||||
module Ledger.Dates,
|
||||
)
|
||||
where
|
||||
import Char
|
||||
@ -34,12 +34,10 @@ import Data.Time.Clock
|
||||
import Data.Time.Calendar
|
||||
import Debug.Trace
|
||||
import Test.HUnit
|
||||
-- import Test.QuickCheck hiding (test, Testable)
|
||||
import Text.Printf
|
||||
import Text.Regex
|
||||
import Text.RegexPR
|
||||
import Text.ParserCombinators.Parsec (parse)
|
||||
import Ledger.Dates
|
||||
import Text.ParserCombinators.Parsec
|
||||
|
||||
|
||||
-- strings
|
||||
@ -203,8 +201,20 @@ p = putStr
|
||||
assertequal e a = assertEqual "" e a
|
||||
assertnotequal e a = assertBool "expected inequality, got equality" (e /= a)
|
||||
|
||||
-- parsewith :: Parser a
|
||||
-- parsing
|
||||
|
||||
parsewith :: Parser a -> String -> Either ParseError a
|
||||
parsewith p ts = parse p "" ts
|
||||
|
||||
fromparse :: Either ParseError a -> a
|
||||
fromparse = either (\_ -> error "parse error") id
|
||||
|
||||
nonspace :: Parser Char
|
||||
nonspace = satisfy (not . isSpace)
|
||||
|
||||
spacenonewline :: Parser Char
|
||||
spacenonewline = satisfy (\c -> c `elem` " \v\f\t")
|
||||
|
||||
restofline :: Parser String
|
||||
restofline = anyChar `manyTill` newline
|
||||
|
||||
|
||||
44
Options.hs
44
Options.hs
@ -5,8 +5,9 @@ import System.Console.GetOpt
|
||||
import System.Directory
|
||||
import Text.Printf
|
||||
import Ledger.Parse
|
||||
import Ledger.Dates
|
||||
import Ledger.Utils
|
||||
import Ledger.Types
|
||||
import Ledger.Dates
|
||||
|
||||
|
||||
defaultfile = "~/.ledger"
|
||||
@ -84,51 +85,24 @@ parseArguments = do
|
||||
args <- getArgs
|
||||
let order = if "--options-anywhere" `elem` args then Permute else RequireOrder
|
||||
case (getOpt order options args) of
|
||||
(opts,cmd:args,[]) -> do {opts' <- fixDates opts; return (opts',cmd,args)}
|
||||
(opts,[],[]) -> do {opts' <- fixDates opts; return (opts',[],[])}
|
||||
(opts,cmd:args,[]) -> do {opts' <- fixOptDates opts; return (opts',cmd,args)}
|
||||
(opts,[],[]) -> do {opts' <- fixOptDates opts; return (opts',[],[])}
|
||||
(opts,_,errs) -> ioError (userError (concat errs ++ usage))
|
||||
|
||||
-- | Convert any fuzzy dates within these option values to explicit ones,
|
||||
-- based on today's date.
|
||||
fixDates :: [Opt] -> IO [Opt]
|
||||
fixDates opts = do
|
||||
fixOptDates :: [Opt] -> IO [Opt]
|
||||
fixOptDates opts = do
|
||||
t <- today
|
||||
return $ map (fixopt t) opts
|
||||
where
|
||||
fixopt t (Begin s) = Begin $ fixdatestr t s
|
||||
fixopt t (End s) = End $ fixdatestr t s
|
||||
fixopt t (Begin s) = Begin $ fixSmartDateStr t s
|
||||
fixopt t (End s) = End $ fixSmartDateStr t s
|
||||
fixopt t (Display s) = -- hacky
|
||||
Display $ gsubRegexPRBy "\\[.+?\\]" fixbracketeddatestr s
|
||||
where fixbracketeddatestr s = "[" ++ (fixdatestr t $ init $ tail s) ++ "]"
|
||||
where fixbracketeddatestr s = "[" ++ (fixSmartDateStr t $ init $ tail s) ++ "]"
|
||||
fixopt _ o = o
|
||||
|
||||
-- | Convert a fuzzy date string to an explicit yyyy/mm/dd string using
|
||||
-- the provided date as reference point.
|
||||
fixdatestr :: Date -> String -> String
|
||||
fixdatestr t s = printf "%04d/%02d/%02d" y m d
|
||||
where
|
||||
pdate = fromparse $ parsewith smartdate $ map toLower s
|
||||
(y,m,d) = dateComponents $ fixFuzzyDate t pdate
|
||||
|
||||
-- | Convert a FuzzyDate to an absolute date using the provided date as
|
||||
-- reference point.
|
||||
fixFuzzyDate :: Date -> FuzzyDate -> Date
|
||||
fixFuzzyDate refdate pdate = mkDate $ fromGregorian y m d
|
||||
where
|
||||
(y,m,d) = fix pdate
|
||||
fix :: FuzzyDate -> (Integer,Int,Int)
|
||||
fix ("","","today") = (ry, rm, rd)
|
||||
fix ("","","yesterday") = dateComponents $ lastday refdate
|
||||
fix ("","","tomorrow") = dateComponents $ nextday refdate
|
||||
fix ("","",d) = (ry, rm, read d)
|
||||
fix ("",m,d) = (ry, read m, read d)
|
||||
fix (y,m,d) = (read y, read m, read d)
|
||||
(ry,rm,rd) = dateComponents refdate
|
||||
|
||||
lastday, nextday :: Date -> Date
|
||||
lastday = mkDate . (addDays (-1)) . utctDay . dateToUTC
|
||||
nextday = mkDate . (addDays 1) . utctDay . dateToUTC
|
||||
|
||||
-- | Get the ledger file path from options, an environment variable, or a default
|
||||
ledgerFilePathFromOpts :: [Opt] -> IO String
|
||||
ledgerFilePathFromOpts opts = do
|
||||
|
||||
5
Tests.hs
5
Tests.hs
@ -100,7 +100,7 @@ misc_tests = TestList [
|
||||
"smartparsedate" ~: do
|
||||
t <- today
|
||||
let (ty,tm,td) = dateComponents t
|
||||
let str `gives` datestr = assertequal datestr (fixdatestr t str)
|
||||
let str `gives` datestr = assertequal datestr (fixSmartDateStr t str)
|
||||
"1999-12-02" `gives` "1999/12/02"
|
||||
"1999.12.02" `gives` "1999/12/02"
|
||||
"1999/3/2" `gives` "1999/03/02"
|
||||
@ -112,10 +112,13 @@ misc_tests = TestList [
|
||||
"January" `gives` (printf "%04d/01/01" ty)
|
||||
"feb" `gives` (printf "%04d/02/01" ty)
|
||||
"today" `gives` (printf "%04d/%02d/%02d" ty tm td)
|
||||
-- "this day" `gives` (printf "%04d/%02d/%02d" ty tm td)
|
||||
let (y,m,d) = toGregorian $ addDays (-1) $ fromGregorian ty tm td
|
||||
"yesterday" `gives` (printf "%04d/%02d/%02d" y m d)
|
||||
-- "last day" `gives` (printf "%04d/%02d/%02d" y m d)
|
||||
let (y,m,d) = toGregorian $ addDays 1 $ fromGregorian ty tm td
|
||||
"tomorrow" `gives` (printf "%04d/%02d/%02d" y m d)
|
||||
-- "next day" `gives` (printf "%04d/%02d/%02d" y m d)
|
||||
]
|
||||
|
||||
balancereportacctnames_tests = TestList
|
||||
|
||||
Loading…
Reference in New Issue
Block a user