parsedate (empty) → 2006.6.4
raw patch · 4 files changed
+347/−0 lines, 4 filesdep +basedep +haskell98dep +parsecbuild-type:Customsetup-changed
Dependencies added: base, haskell98, parsec
Files
- Setup.hs +4/−0
- System/Time/Parse.hs +292/−0
- examples/Parsec.hs +37/−0
- parsedate.cabal +14/−0
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runghc++import Distribution.Simple+main = defaultMain
+ System/Time/Parse.hs view
@@ -0,0 +1,292 @@+module System.Time.Parse (parseCalendarTime,parsecCalendarTime) where++import Control.Monad+import Data.Char (isSpace)+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++-- | A Parsec combinator version of 'parseCalendarTime'.+parsecCalendarTime :: TimeLocale -- ^ Time locale+ -> String -- ^ Date format, see 'parseCalendarTime'.+ -> Parser CalendarTime+parsecCalendarTime l fmt = parserWithState epoch (pCalendarTime l fmt)++-- FIXME: hackety-hack-hack+parserWithState :: st -> GenParser tok st a -> GenParser tok st' st+parserWithState st p = + do pst <- getParserState+ let pos = statePos pst+ let p' = setPosition pos >> p >> getParserState+ r = runParser p' st (sourceName pos) (stateInput pst)+ case r of+ Left err -> fail $ show err -- FIXME: hack, there is no way + -- to fail with a given ParseError+ Right pst' -> do setParserState (pst { stateInput = stateInput pst',+ statePos = statePos pst' })+ return (stateUser pst')+++-- 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)++-- | The Parsec parser used by 'parseCalendarTime'.+pCalendarTime :: TimeLocale -- ^ Time locale+ -> String -- ^ Date format, see 'parseCalendarTime'.+ -> CharParser 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 :: CharParser 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 -> CharParser st Int+readN n = + liftM read (spaces >> choice [try (count m digit) | m <- [n,n-1..1]])++int :: CharParser st Int+int = liftM read (many1 digit)++sign :: CharParser st Int+sign = (char '+' >> return 1) <|> (char '-' >> return (-1))
+ examples/Parsec.hs view
@@ -0,0 +1,37 @@+import System.Locale+import System.Time+import System.Time.Parse+import Text.ParserCombinators.Parsec++iso8601DateTimeFormat :: String+iso8601DateTimeFormat = "%Y-%m-%d %H:%M:%S"++parseISO8601DateTime :: Parser CalendarTime+parseISO8601DateTime = + parsecCalendarTime defaultTimeLocale iso8601DateTimeFormat++showISO8601DateTime :: CalendarTime -> String+showISO8601DateTime = + formatCalendarTime defaultTimeLocale iso8601DateTimeFormat++parseEmptyDate :: Parser CalendarTime+parseEmptyDate = parsecCalendarTime defaultTimeLocale ""++timeNow :: IO CalendarTime+timeNow = getClockTime >>= toCalendarTime++p :: Parser a -> String -> IO a+p parser s = case parse parser s s of+ Left err -> fail $ show err+ Right x -> return x++test :: Parser CalendarTime -> String -> IO ()+test parser s = do t <- p parser s+ putStrLn (s ++ " => " ++ showISO8601DateTime t)++main = do t <- timeNow+ let s = showISO8601DateTime t+ test parseISO8601DateTime s+ test parseEmptyDate ""+ test (string "date: " >> parseEmptyDate) ("date: ")+ test (string "date: " >> parseISO8601DateTime) ("date: " ++ s)
+ parsedate.cabal view
@@ -0,0 +1,14 @@+Name: parsedate+Version: 2006.6.4+Copyright: Bjorn Bringert+Maintainer: bjorn@bringert.net+Author: Bjorn Bringert+Homepage: http://www.cs.chalmers.se/~bringert/darcs/parsedate/doc/+License: BSD3+build-depends: haskell98, base, parsec+Synopsis: Haskell library for parsing dates and times+Description:+ This library provides a function for parsing dates and times+ given a date format string.+Exposed-Modules: System.Time.Parse+Ghc-options: -O2