Abstract over all GenParser state types
This commit is contained in:
parent
5a0156d5ee
commit
91f3b7faac
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user