xsd 0.1 → 0.2
raw patch · 2 files changed
+65/−16 lines, 2 filesdep +time
Dependencies added: time
Files
- Text/XML/XSD/DateTime.hs +62/−13
- xsd.cabal +3/−3
Text/XML/XSD/DateTime.hs view
@@ -2,19 +2,26 @@ module Text.XML.XSD.DateTime( DateTime, dateTime',- dateTime+ dateTime,+ toZonedTime,+ zonedTime',+ zonedTime ) where import Text.ParserCombinators.Parsec import Data.Maybe+import Data.Char+import Data.Time import Control.Monad+import Control.Monad.Instances -data DateTime = DateTime Bool Int Int Int Int Int Int Int Offset+-- | XSD @dateTime@ data structure <http://www.w3.org/TR/xmlschema-2/#dateTime>+data DateTime = DateTime Bool Int Int Int Int Int Int (Maybe String) 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]+ show (DateTime neg yy mm dd hhh mmm sss ssss tz) =+ join [if neg then "-" else [], showy yy, "-", showi mm, "-", showi dd, "T", showi hhh, ":", showi mmm, ":", showi sss, seconds ssss,show tz] -- | Parses the string into a @dateTime@ or may fail with a parse error. dateTime' :: String -> Either ParseError DateTime@@ -24,6 +31,18 @@ dateTime :: String -> Maybe DateTime dateTime = either (const Nothing) Just . dateTime' +-- | Converts a @dateTime@ to a zoned time.+toZonedTime :: DateTime -> ZonedTime+toZonedTime (DateTime neg yy mm dd hhh mmm sss ssss tz) = ZonedTime (LocalTime (fromGregorian (fromIntegral ((if neg then negate else id) yy)) mm dd) (TimeOfDay hhh mmm (realToFrac (read (show sss ++ seconds ssss) :: Double)))) (timeZone tz)++-- | Parses the string in a @dateTime@ then converts to a zoned time and may fail with a parse error.+zonedTime' :: String -> Either ParseError ZonedTime+zonedTime' = fmap toZonedTime . dateTime'++-- | Parses the string in a @dateTime@ then converts to a zoned time and may fail.+zonedTime :: String -> Maybe ZonedTime+zonedTime = fmap toZonedTime . dateTime+ -- not exported data Offset = Offset Bool (Maybe Bool) (Maybe Int) (Maybe Int)@@ -35,41 +54,71 @@ show (Offset False (Just neg) (Just hh) (Just mm)) = join [if neg then "-" else "+", showi hh, ":", showi mm] show _ = error "Offset invariant not met" +timeZone :: Offset -> TimeZone+timeZone (Offset False Nothing Nothing Nothing) = TimeZone 0 False "undetermined"+timeZone (Offset True Nothing Nothing Nothing) = TimeZone 0 False "UTC"+timeZone (Offset False (Just neg) (Just hh) (Just mm)) = TimeZone ((if neg then negate else id) hh * 60 + mm) False (join ["UTC", if neg then "-" else "+", showi hh, ":", showi mm])+timeZone _ = error "Offset invariant not met"++seconds :: Maybe String -> String+seconds (Just d) = '.' : d+seconds Nothing = []+ 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"]+showy :: (Num a, Ord a) => a -> String+showy n = let k t = if n < t then ('0':) else id+ in k 1000 (k 100 (k 10 (show n))) 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+ hh <- p2imax 14 char ':'- mm <- p2imax 59+ mm <- p2imax (if hh == 14 then 0 else 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+ yy <- yearParser char '-' mm <- p2imax 12 char '-'- dd <- p2imax 31+ dd <- p2imax ([31, if isLeapYear (fromIntegral mm) then 29 else 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] !! (mm - 1)) char 'T' hhh <- p2imax 23 char ':' mmm <- p2imax 59 char ':' sss <- p2imax 59+ ssss <- optionMaybe fractionalSeconds o <- parseOffset- return (DateTime neg cc yy mm dd hhh mmm sss o)+ return (DateTime neg yy mm dd hhh mmm sss ssss o) +yearParser :: GenParser Char st Int+yearParser = do d1 <- digit+ d2 <- digit+ d3 <- digit+ d4 <- digit+ ds <- many digit+ if not (null ds) && d1 == '0'+ then unexpected "leading zero in year"+ else return (read ([d1, d2, d3, d4] ++ ds))++fractionalSeconds :: GenParser Char st String+fractionalSeconds = do char '.'+ d <- many1 digit+ if last d == '0'+ then unexpected "zero digit"+ else return d+ 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)+p2imax m = p2i >>= \n -> if n > m then unexpected ("value " ++ show n ++ " exceeded maximum " ++ show m) else return n++-- examples = ["2009-10-10T03:10:10-05:00", "2119-10-10T03:10:10.4-15:26", "0009-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"]
xsd.cabal view
@@ -1,5 +1,5 @@ Name: xsd-Version: 0.1+Version: 0.2 License: BSD3 License-File: LICENSE Synopsis: XML Schema data structures@@ -17,9 +17,9 @@ Library if flag(small_base)- Build-Depends: base < 4 && >= 3, parsec+ Build-Depends: base < 4 && >= 3, parsec, time else- Build-Depends: base < 3, parsec+ Build-Depends: base < 3, parsec, time GHC-Options: -Wall Exposed-Modules: Text.XML.XSD.DateTime