module Text.XML.XSD.DateTime(
DateTime,
dateTime',
dateTime
) where
import Text.ParserCombinators.Parsec
import Data.Maybe
import Control.Monad
data DateTime = DateTime Bool Int Int Int Int Int Int Int Offset
deriving Eq
instance Show DateTime where
show (DateTime neg cc yy mm dd hhh mmm sss tz) =
join [if neg then "-" else [], showi cc, showi yy, "-", showi mm, "-", showi dd, "T", showi hhh, ":", showi mmm, ":", showi sss, show tz]
dateTime' :: String -> Either ParseError DateTime
dateTime' = parse parseDateTime "DateTime parser"
dateTime :: String -> Maybe DateTime
dateTime = either (const Nothing) Just . dateTime'
data Offset = Offset Bool (Maybe Bool) (Maybe Int) (Maybe Int)
deriving Eq
instance Show Offset where
show (Offset False Nothing Nothing Nothing) = []
show (Offset True Nothing Nothing Nothing) = "Z"
show (Offset False (Just neg) (Just hh) (Just mm)) = join [if neg then "-" else "+", showi hh, ":", showi mm]
show _ = error "Offset invariant not met"
showi :: (Num a, Ord a) => a -> String
showi n = (if n < 10 then ('0':) else id) (show n)
examples :: [String]
examples = ["2009-10-10T03:10:10-05:00", "2009-10-10T03:10:10+15:00", "2009-10-10T03:10:10Z", "-2009-05-10T21:08:59-05:00", "-9399-12-31T13:10:10+15:00", "-2009-10-10T03:10:10Z"]
parseOffset :: GenParser Char st Offset
parseOffset = let e = const (Offset False Nothing Nothing Nothing) `fmap` eof
z = const (Offset True Nothing Nothing Nothing) `fmap` char 'Z'
o = do neg <- fmap (== '-') (char '+' <|> char '-')
hh <- p2imax 23
char ':'
mm <- p2imax 59
return (Offset False (Just neg) (Just hh) (Just mm))
in e <|> z <|> o
parseDateTime :: GenParser Char st DateTime
parseDateTime = do neg <- isJust `fmap` optionMaybe (char '-')
cc <- p2i
yy <- p2i
char '-'
mm <- p2imax 12
char '-'
dd <- p2imax 31
char 'T'
hhh <- p2imax 23
char ':'
mmm <- p2imax 59
char ':'
sss <- p2imax 59
o <- parseOffset
return (DateTime neg cc yy mm dd hhh mmm sss o)
p2i :: GenParser Char st Int
p2i = liftM2 (\a b -> read [a, b]) digit digit
p2imax :: Int -> GenParser Char st Int
p2imax m = p2i >>= (\n -> if n > m then unexpected ("expecting <= " ++ show m) else return n)