[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
gwern0
gwern0 at gmail.com
Fri Apr 23 15:22:18 UTC 2010
The following commit has been merged in the master branch:
commit 365bd92098ca465a0c3940871cfd5d9f0a7206ee
Author: gwern0 <gwern0 at gmail.com>
Date: Fri Nov 30 12:37:57 2007 +0100
-Wall police for System.Time.ParseDate - lots of type sigs needed
diff --git a/src/System/Time/ParseDate.hs b/src/System/Time/ParseDate.hs
index 6e8e642..354b7c0 100644
--- a/src/System/Time/ParseDate.hs
+++ b/src/System/Time/ParseDate.hs
@@ -11,130 +11,126 @@ Utility for parsing dates.
-}
module System.Time.ParseDate (parseCalendarTime) where
-import Control.Monad
+import Control.Monad (liftM)
import Data.Char (isSpace)
-import Data.List (elemIndex)
-import Data.Maybe (fromJust)
import System.Locale
import System.Time
import Text.ParserCombinators.Parsec
+{- | Parse a date string as formatted by 'formatCalendarTime'.
--- | Parse a date string as formatted by 'formatCalendarTime'.
---
--- The resulting 'CalendarTime' will only have those fields set that
--- are represented by a format specifier in the format string, and those
--- fields will be set to the values given in the date string.
--- If the same field is specified multiple times, the rightmost
--- occurence takes precedence.
---
--- The resulting date is not neccessarily a valid date. For example,
--- if there is no day of the week specifier in the format string,
--- the value of 'ctWDay' will most likely be invalid.
---
--- Format specifiers are % followed by some character. All other
--- characters are treated literally. Whitespace in the format string
--- matches zero or more arbitrary whitespace characters.
---
--- Format specifiers marked with * are matched, but do not set any
--- field in the output.
---
--- Some of the format specifiers are marked as space-padded or
--- zero-padded. Regardless of this, space-padded, zero-padded
--- or unpadded inputs are accepted. Note that strings using
--- unpadded fields without separating the fields may cause
--- strange parsing.
---
--- Supported format specfiers:
---
--- [%%] a % character.
---
--- [%a] locale's abbreviated weekday name (Sun ... Sat)
---
--- [%A] locale's full weekday name (Sunday .. Saturday)
---
--- [%b] locale's abbreviated month name (Jan..Dec)
---
--- [%B] locale's full month name (January..December)
---
--- [%c] locale's date and time format (Thu Mar 25 17:47:03 CET 2004)
---
--- [%C] century [00-99]
---
--- [%d] day of month, zero padded (01..31)
---
--- [%D] date (%m\/%d\/%y)
---
--- [%e] day of month, space padded ( 1..31)
---
--- [%h] same as %b
---
--- [%H] hour, 24-hour clock, zero padded (00..23)
---
--- [%I] hour, 12-hour clock, zero padded (01..12)
---
--- [%j] day of the year, zero padded (001..366)
---
--- [%k] hour, 24-hour clock, space padded ( 0..23)
---
--- [%l] hour, 12-hour clock, space padded ( 1..12)
---
--- [%m] month, zero padded (01..12)
---
--- [%M] minute, zero padded (00..59)
---
--- [%n] a newline character
---
--- [%p] locale's AM or PM indicator
---
--- [%r] locale's 12-hour time format (hh:mm:ss AM\/PM)
---
--- [%R] hours and minutes, 24-hour clock (hh:mm)
---
--- [%s] * seconds since '00:00:00 1970-01-01 UTC'
---
--- [%S] seconds, zero padded (00..59)
---
--- [%t] a horizontal tab character
---
--- [%T] time, 24-hour clock (hh:mm:ss)
---
--- [%u] numeric day of the week (1=Monday, 7=Sunday)
---
--- [%U] * week number, weeks starting on Sunday, zero padded (01-53)
---
--- [%V] * week number (as per ISO-8601),
--- week 1 is the first week with a Thursday,
--- zero padded, (01-53)
---
--- [%w] numeric day of the week, (0=Sunday, 6=Monday)
---
--- [%W] * week number, weeks starting on Monday, zero padded (01-53)
---
--- [%x] locale's preferred way of printing dates (%m\/%d\/%y)
---
--- [%X] locale's preferred way of printing time. (%H:%M:%S)
---
--- [%y] year, within century, zero padded (00..99)
---
--- [%Y] year, including century. Not padded
--- (this is probably a bug, but formatCalendarTime does
--- it this way). (0-9999)
---
--- [%Z] time zone abbreviation (e.g. CET) or RFC-822 style numeric
--- timezone (-0500)
-parseCalendarTime ::
+ The resulting 'CalendarTime' will only have those fields set that
+ are represented by a format specifier in the format string, and those
+ fields will be set to the values given in the date string.
+ If the same field is specified multiple times, the rightmost
+ occurence takes precedence.
+
+ The resulting date is not neccessarily a valid date. For example,
+ if there is no day of the week specifier in the format string,
+ the value of 'ctWDay' will most likely be invalid.
+
+ Format specifiers are % followed by some character. All other
+ characters are treated literally. Whitespace in the format string
+ matches zero or more arbitrary whitespace characters.
+
+ Format specifiers marked with * are matched, but do not set any
+ field in the output.
+
+ Some of the format specifiers are marked as space-padded or
+ zero-padded. Regardless of this, space-padded, zero-padded
+ or unpadded inputs are accepted. Note that strings using
+ unpadded fields without separating the fields may cause
+ strange parsing.
+
+ Supported format specfiers:
+
+ [%%] a % character.
+
+ [%a] locale's abbreviated weekday name (Sun ... Sat)
+
+ [%A] locale's full weekday name (Sunday .. Saturday)
+
+ [%b] locale's abbreviated month name (Jan..Dec)
+
+ [%B] locale's full month name (January..December)
+
+ [%c] locale's date and time format (Thu Mar 25 17:47:03 CET 2004)
+
+ [%C] century [00-99]
+
+ [%d] day of month, zero padded (01..31)
+
+ [%D] date (%m\/%d\/%y)
+
+ [%e] day of month, space padded ( 1..31)
+
+ [%h] same as %b
+
+ [%H] hour, 24-hour clock, zero padded (00..23)
+
+ [%I] hour, 12-hour clock, zero padded (01..12)
+
+ [%j] day of the year, zero padded (001..366)
+
+ [%k] hour, 24-hour clock, space padded ( 0..23)
+
+ [%l] hour, 12-hour clock, space padded ( 1..12)
+
+ [%m] month, zero padded (01..12)
+
+ [%M] minute, zero padded (00..59)
+
+ [%n] a newline character
+
+ [%p] locale's AM or PM indicator
+
+ [%r] locale's 12-hour time format (hh:mm:ss AM\/PM)
+
+ [%R] hours and minutes, 24-hour clock (hh:mm)
+
+ [%s] * seconds since '00:00:00 1970-01-01 UTC'
+
+ [%S] seconds, zero padded (00..59)
+
+ [%t] a horizontal tab character
+
+ [%T] time, 24-hour clock (hh:mm:ss)
+
+ [%u] numeric day of the week (1=Monday, 7=Sunday)
+
+ [%U] * week number, weeks starting on Sunday, zero padded (01-53)
+
+ [%V] * week number (as per ISO-8601),
+ week 1 is the first week with a Thursday,
+ zero padded, (01-53)
+
+ [%w] numeric day of the week, (0=Sunday, 6=Monday)
+
+ [%W] * week number, weeks starting on Monday, zero padded (01-53)
+
+ [%x] locale's preferred way of printing dates (%m\/%d\/%y)
+
+ [%X] locale's preferred way of printing time. (%H:%M:%S)
+
+ [%y] year, within century, zero padded (00..99)
+
+ [%Y] year, including century. Not padded
+ (this is probably a bug, but formatCalendarTime does
+ it this way). (0-9999)
+
+ [%Z] time zone abbreviation (e.g. CET) or RFC-822 style numeric
+ timezone (-0500) -}
+parseCalendarTime ::
TimeLocale -- ^ Time locale
-> String -- ^ Date format
-> String -- ^ String to parse
-> Maybe CalendarTime -- ^ 'Nothing' if parsing failed.
-parseCalendarTime l fmt s =
+parseCalendarTime l fmt s =
case runParser parser epoch "<date string>" s of
- Left err -> Nothing
- Right p -> Just p
+ Left _ -> Nothing
+ Right p -> Just p
where parser = pCalendarTime l fmt >> getState
-
-- FIXME: verify input
-- FIXME: years outside 1000-9999 probably don't work
-- FIXME: what about extra whitespace in input?
@@ -159,7 +155,7 @@ pCalendarTime l fmt = doFmt fmt
doFmt ('%':c:cs) = decode c >> doFmt cs
doFmt (c:cs) = char c >> doFmt cs
doFmt "" = return ()
-
+
decode '%' = char '%' >> return ()
decode 'a' = (parseEnum $ map snd $ wDays l) >>= setWDay
decode 'A' = (parseEnum $ map fst $ wDays l) >>= setWDay
@@ -185,12 +181,12 @@ pCalendarTime l fmt = doFmt fmt
-- FIXME: strptime(3) accepts "arbitrary whitespace" for %n
decode 'n' = char '\n' >> return ()
decode 'p' = do
- x <- (string am >> return 0) <|> (string pm >> return 12)
- updateHour (\h -> x + h `rem` 12)
- where (am,pm) = amPm l
+ x <- (string am >> return 0) <|> (string pm >> return 12)
+ updateHour (\h -> x + h `rem` 12)
+ where (am,pm) = amPm l
decode 'r' = doFmt (time12Fmt l)
decode 'R' = doFmt "%H:%M"
- -- FIXME: implement %s.
+ -- FIXME: implement %s.
-- FIXME: implement %s in formatCalendarTime
decode 's' = int >> return ()
decode 'S' = read2 >>= setSec
@@ -198,16 +194,16 @@ pCalendarTime l fmt = doFmt fmt
decode 't' = char '\t' >> return ()
decode 'T' = doFmt "%H:%M:%S"
decode 'u' = readN 1 >>= setWDay . toEnum . (\w -> if w == 7 then 0 else w)
- -- FIXME: implement %U.
+ -- FIXME: implement %U.
decode 'U' = read2 >> return ()
- -- FIXME: implement %V.
+ -- FIXME: implement %V.
decode 'V' = read2 >> return ()
decode 'w' = readN 1 >>= setWDay . toEnum
-- FIXME: implement %W.
decode 'W' = read2 >> return ()
decode 'x' = doFmt (dateFmt l)
decode 'X' = doFmt (timeFmt l)
- -- FIXME: should probably be zero padded,
+ -- FIXME: should probably be zero padded,
-- need to change formatCalendarTime too
decode 'Y' = int >>= setYear
-- FIXME: maybe 04 should be 2004, not 1904?
@@ -216,53 +212,56 @@ pCalendarTime l fmt = doFmt fmt
-- FIXME: set ctTZ when parsing timezone name and
-- ctTZName when parsing offset
decode 'Z' = tzname <|> tzoffset
- where tzname = many1 (oneOf ['A'..'Z']) >>= setTZName
- tzoffset = do
- s <- sign
- h <- read2
- m <- read2
- setTZ (s * (h * 3600 + m * 60))
+ where tzname = many1 (oneOf ['A'..'Z']) >>= setTZName
+ tzoffset = do
+ s <- sign
+ h <- read2
+ m <- read2
+ setTZ (s * (h * 3600 + m * 60))
-- following the example of strptime(3),
-- whitespace matches zero or more whitespace
-- characters in the input string
decode c | isSpace c = spaces >> return ()
decode c = char c >> return ()
-
-
epoch :: CalendarTime
epoch = CalendarTime {
- ctYear = 1970,
- ctMonth = January,
- ctDay = 1,
- ctHour = 0,
- ctMin = 0,
- ctSec = 0,
- ctPicosec = 0,
- ctWDay = Thursday,
- ctYDay = 1,
- ctTZName = "UTC",
- ctTZ = 0,
- ctIsDST = False
- }
+ ctYear = 1970,
+ ctMonth = January,
+ ctDay = 1,
+ ctHour = 0,
+ ctMin = 0,
+ ctSec = 0,
+ ctPicosec = 0,
+ ctWDay = Thursday,
+ ctYDay = 1,
+ ctTZName = "UTC",
+ ctTZ = 0,
+ ctIsDST = False
+ }
parseEnum :: Enum a => [String] -> CharParser st a
parseEnum ss = choice (zipWith tryString ss (enumFrom (toEnum 0)))
where tryString s x = try (string s) >> return x
-
+setYear,setDay,setHour,setHour12,setMin,setSec,setYDay,setTZ :: Int -> GenParser tok CalendarTime ()
setYear x = updateState (\t -> t{ ctYear = x })
+setMonth :: Month -> GenParser tok CalendarTime ()
setMonth x = updateState (\t -> t{ ctMonth = x })
setDay x = updateState (\t -> t{ ctDay = x })
setHour x = updateState (\t -> t{ ctHour = x })
setMin x = updateState (\t -> t{ ctMin = x })
setSec x = updateState (\t -> t{ ctSec = x })
+setWDay :: Day -> GenParser tok CalendarTime ()
setWDay x = updateState (\t -> t{ ctWDay = x })
setYDay x = updateState (\t -> t{ ctYDay = x })
+setTZName :: String -> GenParser tok CalendarTime ()
setTZName x = updateState (\t -> t{ ctTZName = x })
setTZ x = updateState (\t -> t{ ctTZ = x })
+updateYear :: (Int -> Int) -> GenParser tok CalendarTime ()
updateYear f = updateState (\t -> t{ ctYear = f (ctYear t) })
+updateHour :: (Int -> Int) -> GenParser tok CalendarTime ()
updateHour f = updateState (\t -> t{ ctHour = f (ctHour t) })
setHour12 x = updateHour (\h -> (h `quot` 12) * 12 + from12 x)
@@ -272,10 +271,10 @@ read2, read3 :: GenParser Char st Int
read2 = readN 2
read3 = readN 3
--- | Read up to a given number of digits, optionally left-padded
+-- | Read up to a given number of digits, optionally left-padded
-- with whitespace and interpret them as an 'Int'.
readN :: Int -> GenParser Char st Int
-readN n =
+readN n =
liftM read (spaces >> choice [try (count m digit) | m <- [n,n-1..1]])
int :: GenParser Char st Int
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list