Abstract over all GenParser state types

This commit is contained in:
nick 2008-12-08 01:11:07 +00:00
parent 5a0156d5ee
commit 91f3b7faac
2 changed files with 23 additions and 23 deletions

View File

@ -227,7 +227,7 @@ and maybe some others:
Returns a SmartDate, to be converted to a full date later (see fixSmartDate). Returns a SmartDate, to be converted to a full date later (see fixSmartDate).
Assumes any text in the parse stream has been lowercased. Assumes any text in the parse stream has been lowercased.
-} -}
smartdate :: Parser SmartDate smartdate :: GenParser Char st SmartDate
smartdate = do smartdate = do
let dateparsers = [ymd, ym, md, y, d, month, mon, today', yesterday, tomorrow, let dateparsers = [ymd, ym, md, y, d, month, mon, today', yesterday, tomorrow,
lastthisnextthing lastthisnextthing
@ -237,7 +237,7 @@ smartdate = do
datesepchar = oneOf "/-." datesepchar = oneOf "/-."
ymd :: Parser SmartDate ymd :: GenParser Char st SmartDate
ymd = do ymd = do
y <- many1 digit y <- many1 digit
datesepchar datesepchar
@ -248,7 +248,7 @@ ymd = do
guard (read d <= 31) guard (read d <= 31)
return (y,m,d) return (y,m,d)
ym :: Parser SmartDate ym :: GenParser Char st SmartDate
ym = do ym = do
y <- many1 digit y <- many1 digit
guard (read y > 12) guard (read y > 12)
@ -257,19 +257,19 @@ ym = do
guard (read m <= 12) guard (read m <= 12)
return (y,m,"") return (y,m,"")
y :: Parser SmartDate y :: GenParser Char st SmartDate
y = do y = do
y <- many1 digit y <- many1 digit
guard (read y >= 1000) guard (read y >= 1000)
return (y,"","") return (y,"","")
d :: Parser SmartDate d :: GenParser Char st SmartDate
d = do d = do
d <- many1 digit d <- many1 digit
guard (read d <= 31) guard (read d <= 31)
return ("","",d) return ("","",d)
md :: Parser SmartDate md :: GenParser Char st SmartDate
md = do md = do
m <- many1 digit m <- many1 digit
guard (read m <= 12) guard (read m <= 12)
@ -287,24 +287,24 @@ weekdayabbrevs = ["mon","tue","wed","thu","fri","sat","sun"]
monthIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` months monthIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` months
monIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` monthabbrevs monIndex s = maybe 0 (+1) $ (lowercase s) `elemIndex` monthabbrevs
month :: Parser SmartDate month :: GenParser Char st SmartDate
month = do month = do
m <- choice $ map (try . string) months m <- choice $ map (try . string) months
let i = monthIndex m let i = monthIndex m
return $ ("",show i,"") return $ ("",show i,"")
mon :: Parser SmartDate mon :: GenParser Char st SmartDate
mon = do mon = do
m <- choice $ map (try . string) monthabbrevs m <- choice $ map (try . string) monthabbrevs
let i = monIndex m let i = monIndex m
return ("",show i,"") return ("",show i,"")
today',yesterday,tomorrow :: Parser 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")
lastthisnextthing :: Parser SmartDate lastthisnextthing :: GenParser Char st SmartDate
lastthisnextthing = do lastthisnextthing = do
r <- choice [ r <- choice [
string "last" string "last"
@ -324,7 +324,7 @@ lastthisnextthing = do
return ("",r,p) return ("",r,p)
periodexpr :: Day -> Parser (Interval, DateSpan) periodexpr :: Day -> GenParser Char st (Interval, DateSpan)
periodexpr rdate = choice $ map try [ periodexpr rdate = choice $ map try [
intervalanddateperiodexpr rdate, intervalanddateperiodexpr rdate,
intervalperiodexpr, intervalperiodexpr,
@ -332,7 +332,7 @@ periodexpr rdate = choice $ map try [
(return $ (NoInterval,DateSpan Nothing Nothing)) (return $ (NoInterval,DateSpan Nothing Nothing))
] ]
intervalanddateperiodexpr :: Day -> Parser (Interval, DateSpan) intervalanddateperiodexpr :: Day -> GenParser Char st (Interval, DateSpan)
intervalanddateperiodexpr rdate = do intervalanddateperiodexpr rdate = do
many spacenonewline many spacenonewline
i <- periodexprinterval i <- periodexprinterval
@ -340,19 +340,19 @@ intervalanddateperiodexpr rdate = do
s <- periodexprdatespan rdate s <- periodexprdatespan rdate
return (i,s) return (i,s)
intervalperiodexpr :: Parser (Interval, DateSpan) intervalperiodexpr :: GenParser Char st (Interval, DateSpan)
intervalperiodexpr = do intervalperiodexpr = do
many spacenonewline many spacenonewline
i <- periodexprinterval i <- periodexprinterval
return (i, DateSpan Nothing Nothing) return (i, DateSpan Nothing Nothing)
dateperiodexpr :: Day -> Parser (Interval, DateSpan) dateperiodexpr :: Day -> GenParser Char st (Interval, DateSpan)
dateperiodexpr rdate = do dateperiodexpr rdate = do
many spacenonewline many spacenonewline
s <- periodexprdatespan rdate s <- periodexprdatespan rdate
return (NoInterval, s) return (NoInterval, s)
periodexprinterval :: Parser Interval periodexprinterval :: GenParser Char st Interval
periodexprinterval = periodexprinterval =
choice $ map try [ choice $ map try [
tryinterval "day" "daily" Daily, tryinterval "day" "daily" Daily,
@ -365,7 +365,7 @@ periodexprinterval =
tryinterval s1 s2 v = tryinterval s1 s2 v =
choice [try (string $ "every "++s1), try (string s2)] >> return v choice [try (string $ "every "++s1), try (string s2)] >> return v
periodexprdatespan :: Day -> Parser DateSpan periodexprdatespan :: Day -> GenParser Char st DateSpan
periodexprdatespan rdate = choice $ map try [ periodexprdatespan rdate = choice $ map try [
doubledatespan rdate, doubledatespan rdate,
fromdatespan rdate, fromdatespan rdate,
@ -373,7 +373,7 @@ periodexprdatespan rdate = choice $ map try [
justdatespan rdate justdatespan rdate
] ]
doubledatespan :: Day -> Parser DateSpan doubledatespan :: Day -> GenParser Char st DateSpan
doubledatespan rdate = do doubledatespan rdate = do
optional (string "from" >> many spacenonewline) optional (string "from" >> many spacenonewline)
b <- smartdate b <- smartdate
@ -382,19 +382,19 @@ doubledatespan rdate = do
e <- smartdate e <- smartdate
return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e) return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
fromdatespan :: Day -> Parser DateSpan fromdatespan :: Day -> GenParser Char st DateSpan
fromdatespan rdate = do fromdatespan rdate = do
string "from" >> many spacenonewline string "from" >> many spacenonewline
b <- smartdate b <- smartdate
return $ DateSpan (Just $ fixSmartDate rdate b) Nothing return $ DateSpan (Just $ fixSmartDate rdate b) Nothing
todatespan :: Day -> Parser DateSpan todatespan :: Day -> GenParser Char st DateSpan
todatespan rdate = do todatespan rdate = do
string "to" >> many spacenonewline string "to" >> many spacenonewline
e <- smartdate e <- smartdate
return $ DateSpan Nothing (Just $ fixSmartDate rdate e) return $ DateSpan Nothing (Just $ fixSmartDate rdate e)
justdatespan :: Day -> Parser DateSpan justdatespan :: Day -> GenParser Char st DateSpan
justdatespan rdate = do justdatespan rdate = do
optional (string "in" >> many spacenonewline) optional (string "in" >> many spacenonewline)
d <- smartdate d <- smartdate

View File

@ -208,12 +208,12 @@ parsewith p ts = parse p "" ts
fromparse :: Either ParseError a -> a fromparse :: Either ParseError a -> a
fromparse = either (\_ -> error "parse error") id fromparse = either (\_ -> error "parse error") id
nonspace :: Parser Char nonspace :: GenParser Char st Char
nonspace = satisfy (not . isSpace) nonspace = satisfy (not . isSpace)
spacenonewline :: Parser Char spacenonewline :: GenParser Char st Char
spacenonewline = satisfy (\c -> c `elem` " \v\f\t") spacenonewline = satisfy (\c -> c `elem` " \v\f\t")
restofline :: Parser String restofline :: GenParser Char st String
restofline = anyChar `manyTill` newline restofline = anyChar `manyTill` newline