diff --git a/Data/Time/Calendar/Days.hs b/Data/Time/Calendar/Days.hs --- a/Data/Time/Calendar/Days.hs +++ b/Data/Time/Calendar/Days.hs @@ -5,6 +5,8 @@ Day(..),addDays,diffDays ) where +import Data.Ix + -- | The Modified Julian Day is a standard count of days, with zero being the day 1858-11-17. newtype Day = ModifiedJulianDay {toModifiedJulianDay :: Integer} deriving (Eq,Ord) @@ -18,6 +20,13 @@ enumFromThen (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromThen a b) enumFromTo (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromTo a b) enumFromThenTo (ModifiedJulianDay a) (ModifiedJulianDay b) (ModifiedJulianDay c) = fmap ModifiedJulianDay (enumFromThenTo a b c) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Ix Day where + range (ModifiedJulianDay a,ModifiedJulianDay b) = fmap ModifiedJulianDay (range (a,b)) + index (ModifiedJulianDay a,ModifiedJulianDay b) (ModifiedJulianDay c) = index (a,b) c + inRange (ModifiedJulianDay a,ModifiedJulianDay b) (ModifiedJulianDay c) = inRange (a,b) c + rangeSize (ModifiedJulianDay a,ModifiedJulianDay b) = rangeSize (a,b) addDays :: Integer -> Day -> Day addDays n (ModifiedJulianDay a) = ModifiedJulianDay (a + n) diff --git a/Data/Time/Format/Parse.hs b/Data/Time/Format/Parse.hs --- a/Data/Time/Format/Parse.hs +++ b/Data/Time/Format/Parse.hs @@ -22,8 +22,24 @@ import Data.Maybe import Data.Ratio import System.Locale -import Text.ParserCombinators.ReadP +import Text.ParserCombinators.ReadP hiding (char, string) + +-- | Case-insensitive version of 'Text.ParserCombinators.ReadP.char'. +char :: Char -> ReadP Char +char c = satisfy (\x -> toUpper c == toUpper x) +-- | Case-insensitive version of 'Text.ParserCombinators.ReadP.string'. +string :: String -> ReadP String +string this = do s <- look; scan this s + where + scan [] _ = do return this + scan (x:xs) (y:ys) | toUpper x == toUpper y = do get; scan xs ys + scan _ _ = do pfail +-- | Convert string to upper case. +up :: String -> String +up = map toUpper + + -- | The class of types which can be parsed given a UNIX-style time format -- string. class ParseTime t where @@ -37,12 +53,12 @@ -> t -- | Parses a time value given a format string. Supports the same %-codes as --- 'formatTime'. Leading and trailing whitespace is accepted. --- Some variations in the input are accepted: +-- 'formatTime'. Leading and trailing whitespace is accepted. Case is not +-- significant. Some variations in the input are accepted: -- -- [@%z@] accepts any of @-HHMM@ or @-HH:MM@. -- --- [@%Z@] accepts any string of upper case letters, or any +-- [@%Z@] accepts any string of letters, or any -- of the formats accepted by @%z@. -- parseTime :: ParseTime t => @@ -116,11 +132,10 @@ parseValue l c = case c of 'z' -> numericTZ - 'Z' -> munch1 isUpper <++ + 'Z' -> munch1 isAlpha <++ numericTZ <++ return "" -- produced by %Z for LocalTime - 'P' -> oneOf (let (am,pm) = amPm l - in [map toLower am, map toLower pm]) + 'P' -> oneOf (let (am,pm) = amPm l in [am, pm]) 'p' -> oneOf (let (am,pm) = amPm l in [am, pm]) 'H' -> digits 2 'I' -> digits 2 @@ -191,9 +206,9 @@ -- %C: century (being the first two digits of the year), 00 - 99 'C' -> [Century (read x)] -- %B: month name, long form (fst from months locale), January - December - 'B' -> [Month (1 + fromJust (elemIndex x (map fst (months l))))] + 'B' -> [Month (1 + fromJust (elemIndex (up x) (map (up . fst) (months l))))] -- %b: month name, short form (snd from months locale), Jan - Dec - 'b' -> [Month (1 + fromJust (elemIndex x (map snd (months l))))] + 'b' -> [Month (1 + fromJust (elemIndex (up x) (map (up . snd) (months l))))] -- %m: month of year, leading 0 as needed, 01 - 12 'm' -> [Month (read x)] -- %d: day of month, leading 0 as needed, 01 - 31 @@ -213,9 +228,9 @@ -- %u: day for Week Date format, 1 - 7 'u' -> [WeekDay (read x)] -- %a: day of week, short form (snd from wDays locale), Sun - Sat - 'a' -> [WeekDay (1 + (fromJust (elemIndex x (map snd (wDays l))) + 6) `mod` 7)] + 'a' -> [WeekDay (1 + (fromJust (elemIndex (up x) (map (up . snd) (wDays l))) + 6) `mod` 7)] -- %A: day of week, long form (fst from wDays locale), Sunday - Saturday - 'A' -> [WeekDay (1 + (fromJust (elemIndex x (map fst (wDays l))) + 6) `mod` 7)] + 'A' -> [WeekDay (1 + (fromJust (elemIndex (up x) (map (up . fst) (wDays l))) + 6) `mod` 7)] -- %U: week number of year, where weeks start on Sunday (as sundayStartWeek), 01 - 53 'U' -> [Week SundayWeek (read x)] -- %w: day of week number, 0 (= Sunday) - 6 (= Saturday) @@ -248,8 +263,8 @@ where f t@(TimeOfDay h m s) (c,x) = case c of - 'P' -> if x == map toLower (fst (amPm l)) then am else pm - 'p' -> if x == fst (amPm l) then am else pm + 'P' -> if up x == fst (amPm l) then am else pm + 'p' -> if up x == fst (amPm l) then am else pm 'H' -> TimeOfDay (read x) m s 'I' -> TimeOfDay (read x) m s 'k' -> TimeOfDay (read x) m s @@ -280,10 +295,10 @@ case c of 'z' -> zone 'Z' | null x -> t - | isUpper (head x) -> - case lookup x _TIMEZONES_ of - Just (offset', dst') -> TimeZone offset' dst' x - Nothing -> TimeZone offset dst x + | isAlpha (head x) -> let y = up x in + case lookup y _TIMEZONES_ of + Just (offset', dst') -> TimeZone offset' dst' y + Nothing -> TimeZone offset dst y | otherwise -> zone _ -> t where zone = TimeZone (readTzOffset x) dst name diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -7,10 +7,13 @@ import Distribution.Simple.Utils import System.Cmd import System.Directory +import System.Info main :: IO () -main = do let hooks = autoconfUserHooks { runTests = runTestScript } - defaultMainWithHooks hooks +main = case os of + "windows" -> defaultMain + "mingw32" -> defaultMain + _ -> let hooks = autoconfUserHooks { runTests = runTestScript } in defaultMainWithHooks hooks withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory path f = do diff --git a/include/HsTime.h b/include/HsTime.h --- a/include/HsTime.h +++ b/include/HsTime.h @@ -1,6 +1,10 @@ #ifndef __HSTIME_H__ #define __HSTIME_H__ +#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) +#define HAVE_TIME_H 1 +#else + #include "HsTimeConfig.h" // Otherwise these clash with similar definitions from other packages: #undef PACKAGE_BUGREPORT @@ -8,6 +12,7 @@ #undef PACKAGE_STRING #undef PACKAGE_TARNAME #undef PACKAGE_VERSION +#endif #if HAVE_TIME_H #include diff --git a/time.cabal b/time.cabal --- a/time.cabal +++ b/time.cabal @@ -1,36 +1,42 @@ -Name: time -Version: 1.1.2.3 -Stability: stable -License: BSD3 -License-File: LICENSE -Author: Ashley Yakeley -Maintainer: -Homepage: http://semantic.org/TimeLib/ -Synopsis: A time library -Description: A time library -Category: System -Build-Type: Custom -Cabal-Version: >=1.2 +name: time +version: 1.1.2.4 +stability: stable +license: BSD3 +license-file: LICENSE +author: Ashley Yakeley +maintainer: +homepage: http://semantic.org/TimeLib/ +synopsis: A time library +description: A time library +category: System +build-type: Custom +cabal-version: >=1.2 x-follows-version-policy: -Extra-Source-Files: - aclocal.m4 configure.ac configure - include/HsTime.h include/HsTimeConfig.h.in -Extra-Tmp-Files: - config.log config.status autom4te.cache - include/HsTimeConfig.h +extra-source-files: + aclocal.m4 + configure.ac + configure + include/HsTime.h + include/HsTimeConfig.h.in +extra-tmp-files: + config.log + config.status + autom4te.cache + include/HsTimeConfig.h -Flag split-base +flag split-base -Library { - Build-Depends: base >= 2 +library +{ + build-depends: base >= 2 if flag(split-base) - Build-Depends: base >= 3, old-locale + Build-Depends: base >= 3, old-locale else - Build-Depends: base < 3 + Build-Depends: base < 3 if os(windows) Build-Depends: Win32 - Exposed-Modules: + exposed-modules: Data.Time.Calendar, Data.Time.Calendar.MonthDay, Data.Time.Calendar.OrdinalDate, @@ -43,9 +49,9 @@ Data.Time.LocalTime, Data.Time.Format, Data.Time - Extensions: ForeignFunctionInterface, CPP - C-Sources: cbits/HsTime.c - Other-Modules: + extensions: ForeignFunctionInterface, CPP + c-sources: cbits/HsTime.c + other-modules: Data.Time.Calendar.Private, Data.Time.Calendar.Days, Data.Time.Calendar.Gregorian, @@ -58,8 +64,13 @@ Data.Time.LocalTime.TimeOfDay, Data.Time.LocalTime.LocalTime, Data.Time.Format.Parse - Include-Dirs: include - Install-Includes: - HsTime.h HsTimeConfig.h + include-dirs: include + if os(windows) + install-includes: + HsTime.h + else + install-includes: + HsTime.h + HsTimeConfig.h }