[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 14:56:29 UTC 2010
The following commit has been merged in the master branch:
commit feeb4ea9ff5efff63a8da7dfd36bd7a1eda8f070
Author: John Goerzen <jgoerzen at complete.org>
Date: Thu Apr 7 01:50:44 2005 +0100
Added ParseDate.hs
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.7--patch-223)
diff --git a/ChangeLog b/ChangeLog
index cb07eb1..0888f87 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,26 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
#
+2005-04-06 19:50:44 GMT John Goerzen <jgoerzen at complete.org> patch-223
+
+ Summary:
+ Added ParseDate.hs
+ Revision:
+ missingh--head--0.7--patch-223
+
+
+ new files:
+ MissingH/Time/.arch-ids/=id
+ MissingH/Time/.arch-ids/ParseDate.hs.id
+ MissingH/Time/ParseDate.hs
+
+ modified files:
+ ChangeLog
+
+ new directories:
+ MissingH/Time MissingH/Time/.arch-ids
+
+
2005-04-05 18:54:40 GMT John Goerzen <jgoerzen at complete.org> patch-222
Summary:
diff --git a/MissingH/Time/ParseDate.hs b/MissingH/Time/ParseDate.hs
new file mode 100644
index 0000000..eab7c49
--- /dev/null
+++ b/MissingH/Time/ParseDate.hs
@@ -0,0 +1,270 @@
+module ParseDate (parseCalendarTime) where
+
+import Control.Monad
+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'.
+--
+-- 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 =
+ case runParser parser epoch "<date string>" s of
+ Left err -> 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?
+-- FIXME: set ctYDay
+-- FIXME: set ctIsDST
+-- FIXME: missing formats from GNU date(1):
+-- %F same as %Y-%m-%d
+-- %g the 2-digit year corresponding to the %V week number
+-- %G the 4-digit year corresponding to the %V week number
+-- %N nanoseconds (000000000..999999999)
+-- %P locale's lower case am or pm indicator (blank in many locales)
+-- %z RFC-822 style numeric timezone (-0500) (a nonstandard extension)
+pCalendarTime :: TimeLocale -> String -> GenParser Char CalendarTime ()
+pCalendarTime l fmt = doFmt fmt
+ where
+ -- not padded
+ -- FIXME: implement
+ doFmt ('%':'-':cs) = doFmt ('%':cs)
+ -- space padded
+ -- FIXME: implement
+ doFmt ('%':'_':cs) = doFmt ('%':cs)
+ 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
+ decode 'b' = (parseEnum $ map snd $ months l) >>= setMonth
+ decode 'B' = (parseEnum $ map fst $ months l) >>= setMonth
+ decode 'c' = doFmt (dateTimeFmt l)
+ decode 'C' = read2 >>= \c -> updateYear (\y -> c * 100 + y `rem` 100)
+ decode 'd' = read2 >>= setDay
+ decode 'D' = doFmt "%m/%d/%y"
+ decode 'e' = read2 >>= setDay
+ decode 'h' = decode 'b'
+ decode 'H' = read2 >>= setHour
+ decode 'I' = read2 >>= setHour12
+ decode 'j' = read3 >>= setYDay
+ decode 'k' = read2 >>= setHour
+ decode 'l' = read2 >>= setHour12
+ decode 'm' = read2 >>= \mon -> setMonth (toEnum (mon-1))
+ decode 'M' = read2 >>= setMin
+ -- 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
+ decode 'r' = doFmt (time12Fmt l)
+ decode 'R' = doFmt "%H:%M"
+ -- FIXME: implement %s.
+ -- FIXME: implement %s in formatCalendarTime
+ decode 's' = int >> return ()
+ decode 'S' = read2 >>= setSec
+ -- FIXME: strptime(3) accepts "arbitrary whitespace" for %t
+ 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.
+ decode 'U' = read2 >> return ()
+ -- 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,
+ -- need to change formatCalendarTime too
+ decode 'Y' = int >>= setYear
+ -- FIXME: maybe 04 should be 2004, not 1904?
+ decode 'y' = read2 >>= \c -> updateYear (\y -> (y `quot` 100) * 100 + c)
+ -- FIXME: are timezone names always [A-Z]+ ?
+ -- 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))
+ -- 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
+ }
+
+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 x = updateState (\t -> t{ ctYear = x })
+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 x = updateState (\t -> t{ ctWDay = x })
+setYDay x = updateState (\t -> t{ ctYDay = x })
+setTZName x = updateState (\t -> t{ ctTZName = x })
+setTZ x = updateState (\t -> t{ ctTZ = x })
+
+updateYear f = updateState (\t -> t{ ctYear = f (ctYear t) })
+updateHour f = updateState (\t -> t{ ctHour = f (ctHour t) })
+
+setHour12 x = updateHour (\h -> (h `quot` 12) * 12 + from12 x)
+ where from12 h = if h == 12 then 0 else h
+
+read2, read3 :: GenParser Char st Int
+read2 = readN 2
+read3 = readN 3
+
+-- | 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 =
+ liftM read (spaces >> choice [try (count m digit) | m <- [n,n-1..1]])
+
+int :: GenParser Char st Int
+int = liftM read (many1 digit)
+
+sign :: GenParser Char st Int
+sign = (char '+' >> return 1) <|> (char '-' >> return (-1))
\ No newline at end of file
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list