[darcs-users] date/time parser (was: File name too long)

[Peter Simons]

I wrote:

 > I have code that parses date specs into 'CalendarTime' in
 > my parser for RFC 2822. It should be trivial to modify
 > that to read darcs' format.

It was. Here we go:

\begin{code}
import Text.ParserCombinators.Parsec
import System.Time
import Data.Char ( toUpper, ord )
import Control.Monad ( liftM2 )

main            :: IO ()
main             = print $ parse date_time "" input
    where
    input = "Sun_May_11_06.13.27_EDT_2003"


----- Parser Combinators ---------------------------------------------

-- |Case-insensitive variant of Parsec's 'char' function.

caseChar        :: Char -> GenParser Char a Char
caseChar c       = satisfy (\x -> toUpper x == toUpper c)

-- |Case-insensitive variant of Parsec's 'string' function.

caseString      :: String -> GenParser Char a ()
caseString cs    = mapM_ caseChar cs <?> cs

-- |Match a parser at least @n@ times.

manyN           :: Int -> GenParser a b c -> GenParser a b [c]
manyN n p
    | n <= 0     = return []
    | otherwise  = liftM2 (++) (count n p) (many p)

-- |Match a parser at least @n@ times, but no more than @m@ times.

manyNtoM        :: Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM n m p
    | n < 0      = return []
    | n > m      = return []
    | n == m     = count n p
    | n == 0     = foldr (<|>) (return []) (map (\x -> try $ count x p) (reverse [1..m]))
    | otherwise  = liftM2 (++) (count n p) (manyNtoM 0 (m-n) p)


----- Date/Time Parser -----------------------------------------------

date_time       :: CharParser a CalendarTime
date_time        = do wd <- day_name
                      char '_'
                      mon <- month_name
                      char '_'
                      d <- day
                      char '_'
                      h <- hour
                      char '.'
                      m <- minute
                      char '.'
                      s <- second
                      char '_'
                      z <- zone
                      char '_'
                      y <- year
                      return (CalendarTime y mon d h m s 0 wd 0 "" z False)

day_name        :: CharParser a Day
day_name         = choice
                       [ caseString "Mon"       >> return Monday
                       , try (caseString "Tue") >> return Tuesday
                       , caseString "Wed"       >> return Wednesday
                       , caseString "Thu"       >> return Thursday
                       , caseString "Fri"       >> return Friday
                       , try (caseString "Sat") >> return Saturday
                       , caseString "Sun"       >> return Sunday
                       ]

year            :: CharParser a Int
year             = do y <- manyN 4 digit
                      return (read y :: Int)

month_name      :: CharParser a Month
month_name       = choice
                       [ try (caseString "Jan") >> return January
                       , caseString "Feb"       >> return February
                       , try (caseString "Mar") >> return March
                       , try (caseString "Apr") >> return April
                       , caseString "May"       >> return May
                       , try (caseString "Jun") >> return June
                       , caseString "Jul"       >> return July
                       , caseString "Aug"       >> return August
                       , caseString "Sep"       >> return September
                       , caseString "Oct"       >> return October
                       , caseString "Nov"       >> return November
                       , caseString "Dec"       >> return December
                       ]

day             :: CharParser a Int
day              = do d <- manyNtoM 1 2 digit
                      return (read d :: Int)

hour            :: CharParser a Int
hour             = do r <- count 2 digit
                      return (read r :: Int)

minute          :: CharParser a Int
minute           = do r <- count 2 digit
                      return (read r :: Int)

second          :: CharParser a Int
second           = do r <- count 2 digit
                      return (read r :: Int)

zone            :: CharParser a Int
zone             = choice
                       [ do { char '+'; h <- hour; m <- minute; return (((h*60)+m)*60) }
                       , do { char '-'; h <- hour; m <- minute; return (-((h*60)+m)*60) }
                       , mkZone "UT"  0
                       , mkZone "GMT" 0
                       , mkZone "EST" (-5)
                       , mkZone "EDT" (-4)
                       , mkZone "CST" (-6)
                       , mkZone "CDT" (-5)
                       , mkZone "MST" (-7)
                       , mkZone "MDT" (-6)
                       , mkZone "PST" (-8)
                       , mkZone "PDT" (-7)
                       , do { r <- oneOf ['A'..'I']; return $ (ord r - 64) * 60*60 }
                       , do { r <- oneOf ['K'..'M']; return $ (ord r - 65) * 60*60 }
                       , do { r <- oneOf ['N'..'Y']; return $ -(ord r - 77) * 60*60 }
                       , do { char 'Z'; return 0 }
                       ]
     where mkZone n o  = try $ do { caseString n; return (o*60*60) }
\end{code}