dates 0.2.1.2 → 0.2.2.0

raw patch · 4 files changed

+121/−82 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Dates.hs +35/−32
• Data/Dates/Formats.hs +72/−37
• Data/Dates/Internal.hs +13/−12
• dates.cabal +1/−1

@@ -1,4 +1,4 @@-{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable #-}+{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, FlexibleContexts #-} -- | Operations with dates module Data.Dates   (DateTime (..),@@ -30,7 +30,6 @@ import Data.Time.Calendar.WeekDate import Data.Time.LocalTime import Text.Parsec-import Text.Parsec.String import Data.Generics import Data.Char (toLower) @@ -121,7 +120,7 @@                  minute = tMinute t + minute dt,                  second = tSecond t + second dt } -euroNumDate ∷ Parsec String st DateTime+euroNumDate ∷ Stream s m Char => ParsecT s st m DateTime euroNumDate = do   d ← pDay   char '.'@@ -130,7 +129,7 @@   y ← pYear   return $ date y m d -americanDate ∷ Parsec String st DateTime+americanDate ∷ Stream s m Char => ParsecT s st m DateTime americanDate = do   y ← pYear   char '/'@@ -139,21 +138,21 @@   d ← pDay   return $ date y m d -euroNumDate' ∷ Int → Parsec String st DateTime+euroNumDate' ∷ Stream s m Char => Int → ParsecT s st m DateTime euroNumDate' year = do   d ← pDay   char '.'   m ← pMonth   return $ date year m d -americanDate' ∷ Int → Parsec String st DateTime+americanDate' ∷ Stream s m Char => Int → ParsecT s st m DateTime americanDate' year = do   m ← pMonth   char '/'   d ← pDay   return $ date year m d -strDate ∷ Parsec String st DateTime+strDate ∷ Stream s m Char => ParsecT s st m DateTime strDate = do   d ← pDay   space@@ -166,7 +165,7 @@       notFollowedBy $ char ':'       return $ date y m d -strDate' ∷ Int → Parsec String st DateTime+strDate' ∷ Stream s m Char => Int → ParsecT s st m DateTime strDate' year = do   d ← pDay   space@@ -175,7 +174,7 @@     Nothing → fail $ "unknown month: "++ms     Just m  → return $ date year m d -time24 ∷ Parsec String st Time+time24 ∷ Stream s m Char => ParsecT s st m Time time24 = do   h ← number 2 23   char ':'@@ -188,7 +187,7 @@       notFollowedBy letter       return $ Time h m s -ampm ∷ Parsec String st Int+ampm ∷ Stream s m Char => ParsecT s st m Int ampm = do   s ← many1 letter   case map toUpper s of@@ -196,7 +195,7 @@     "PM" → return 12     _ → fail "AM/PM expected" -time12 ∷ Parsec String st Time+time12 ∷ Stream s m Char => ParsecT s st m Time time12 = do   h ← number 2 12   char ':'@@ -209,10 +208,10 @@   hd ← ampm   return $ Time (h+hd) m s -pTime ∷ Parsec String st Time+pTime ∷ Stream s m Char => ParsecT s st m Time pTime = choice $ map try [time12, time24] -pAbsDateTime ∷ Int → Parsec String st DateTime+pAbsDateTime ∷ Stream s m Char => Int → ParsecT s st m DateTime pAbsDateTime year = do   date ← choice $ map try $ map ($ year) $ [                               const euroNumDate,@@ -229,7 +228,7 @@       t ← pTime       return $ date `addTime` t -pAbsDate ∷ Int → Parsec String st DateTime+pAbsDate ∷ Stream s m Char => Int → ParsecT s st m DateTime pAbsDate year =   choice $ map try $ map ($ year) $ [                           const euroNumDate,@@ -251,7 +250,11 @@  -- | Modify DateTime with pure function on Day modifyDate ∷  (t → Day → Day) → t → DateTime → DateTime-modifyDate fn x dt = dayToDateTime $ fn x $ dateTimeToDay dt+modifyDate fn x dt =+  let date = dayToDateTime $ fn x $ dateTimeToDay dt+  in  date {hour   = hour   dt,+            minute = minute dt,+            second = second dt}  -- | Add date interval to DateTime addInterval ∷  DateTime → DateInterval → DateTime@@ -277,13 +280,13 @@   abs $ toModifiedJulianDay (dateTimeToDay d1) -         toModifiedJulianDay (dateTimeToDay d2) -maybePlural ∷ String → Parsec String st String+maybePlural ∷ Stream s m Char => String → ParsecT s st m String maybePlural str = do   r ← string str   optional $ char 's'   return (capitalize r) -pDateIntervalType ∷ Parsec String st DateIntervalType+pDateIntervalType ∷ Stream s m Char => ParsecT s st m DateIntervalType pDateIntervalType = do   s ← choice $ map maybePlural ["day", "week", "month", "year"]   case toLower (head s) of@@ -293,7 +296,7 @@     'y' → return Year     _ → fail $ "Unknown date interval type: " ++ s -pDateInterval ∷ Parsec String st DateInterval+pDateInterval ∷ Stream s m Char => ParsecT s st m DateInterval pDateInterval = do   n ← many1 digit   spaces@@ -304,7 +307,7 @@     Month → Months `fmap` tryReadInt n     Year →  Years  `fmap` tryReadInt n -pRelDate ∷ DateTime → Parsec String st DateTime+pRelDate ∷ Stream s m Char => DateTime → ParsecT s st m DateTime pRelDate date = do   offs ← try futureDate      <|> try passDate@@ -313,7 +316,7 @@      <|> yesterday   return $ date `addInterval` offs -lastDate ∷ DateTime → Parsec String st DateTime+lastDate ∷ Stream s m Char => DateTime → ParsecT s st m DateTime lastDate now = do     string "last"     spaces@@ -335,7 +338,7 @@       string "year"       return $ now {month = 1, day = 1} -nextDate ∷ DateTime → Parsec String st DateTime+nextDate ∷ Stream s m Char => DateTime → ParsecT s st m DateTime nextDate now = do     string "next"     spaces@@ -357,7 +360,7 @@       string "year"       return (now `addInterval` Years 1) {month = 1, day = 1} -pWeekDay ∷ Parsec String st WeekDay+pWeekDay ∷ Stream s m Char => ParsecT s st m WeekDay pWeekDay = do   w ← many1 (oneOf "mondaytueswnhrfi")   case map toLower w of@@ -370,7 +373,7 @@     "sunday"    → return Sunday     _           → fail $ "Unknown weekday: " ++ w -futureDate ∷ Parsec String st DateInterval+futureDate ∷ Stream s m Char => ParsecT s st m DateInterval futureDate = do   string "in "   n ← many1 digit@@ -382,7 +385,7 @@     Month → Months `fmap` tryReadInt n     Year →  Years  `fmap` tryReadInt n -passDate ∷ Parsec String st DateInterval+passDate ∷ Stream s m Char => ParsecT s st m DateInterval passDate = do   n ← many1 digit   char ' '@@ -394,36 +397,36 @@     Month → (Months . negate) `fmap` tryReadInt n     Year →  (Years  . negate) `fmap` tryReadInt n -today ∷ Parsec String st DateInterval+today ∷ Stream s m Char => ParsecT s st m DateInterval today = do   string "today" <|> string "now"   return $ Days 0 -tomorrow ∷ Parsec String st DateInterval+tomorrow ∷ Stream s m Char => ParsecT s st m DateInterval tomorrow = do   string "tomorrow"   return $ Days 1 -yesterday ∷ Parsec String st DateInterval+yesterday ∷ Stream s m Char => ParsecT s st m DateInterval yesterday = do   string "yesterday"   return $ Days (-1) -pByWeek ∷ DateTime → Parsec String st DateTime+pByWeek ∷ Stream s m Char => DateTime → ParsecT s st m DateTime pByWeek date =   try (lastDate date) <|> nextDate date  -- | Parsec parser for DateTime.-pDateTime ∷ DateTime       -- ^ Current date / time, to use as base for relative dates-          → Parsec String st DateTime+pDateTime ∷ Stream s m Char => DateTime       -- ^ Current date / time, to use as base for relative dates+          → ParsecT s st m DateTime pDateTime date =       (try $ pRelDate date)   <|> (try $ pByWeek date)   <|> (try $ pAbsDateTime $ year date)  -- | Parsec parser for Date only.-pDate ∷ DateTime       -- ^ Current date / time, to use as base for relative dates-          → Parsec String st DateTime+pDate ∷ Stream s m Char => DateTime       -- ^ Current date / time, to use as base for relative dates+          → ParsecT s st m DateTime pDate date =       (try $ pRelDate date)   <|> (try $ pByWeek date)

@@ -1,4 +1,4 @@-{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable #-}+{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, FlexibleContexts, FlexibleInstances #-} -- | This module allows to parse arbitrary date formats. -- Date formats are specified as strings: --@@ -8,11 +8,14 @@ -- --  * "DD\/MM\/YYYY, HH:mm:SS" --+--  * "YY.MM.DD[, HH:mm:SS]"+-- --  * and so on. -- module Data.Dates.Formats   (FormatElement (..), Format,-   pFormat, formatParser,+   FormatParser,+   parseFormat, pFormat, formatParser,    parseDateFormat   ) where @@ -25,86 +28,118 @@  -- | Date\/time format element data FormatElement =-    YEAR   Int-  | MONTH  Int-  | DAY    Int-  | HOUR   Int-  | MINUTE Int-  | SECOND Int-  | Fixed String+    YEAR   Bool Int+  | MONTH  Bool Int+  | DAY    Bool Int+  | HOUR   Bool Int+  | MINUTE Bool Int+  | SECOND Bool Int+  | Whitespace Bool+  | Fixed  Bool String   deriving (Eq, Show) +type FormatParser a = Parsec String Bool a+ -- | Date\/time format type Format = [FormatElement] -nchars ∷ Char → Parsec String st Int+nchars ∷ Char → FormatParser Int nchars c = do   s ← many1 $ char c   return $ length s --- | Parser for date\/time format.-pFormat ∷ Parsec String st Format-pFormat = many1 $ choice $ map try [pYear, pMonth, pDay,-                                    pHour, pMinute, pSecond,-                                    pFixed]+brackets :: FormatParser a -> FormatParser a+brackets p = do+  char '['+  setState False+  result <- p+  char ']'+  setState True+  return result++pFormat :: FormatParser Format+pFormat = do+    elems <- many1 $ try (brackets format) <|> format+    return $ concat elems+   where-    pYear   = YEAR   <$> nchars 'Y'-    pMonth  = MONTH  <$> nchars 'M'-    pDay    = DAY    <$> nchars 'D'-    pHour   = HOUR   <$> nchars 'H'-    pMinute = MINUTE <$> nchars 'm'-    pSecond = SECOND <$> nchars 'S'-    pFixed  = Fixed <$> (many1 $ noneOf "YMDHmS")+    format :: FormatParser Format+    format =+      many1 $ choice $ map try [element YEAR 'Y', element MONTH 'M',+                                         element DAY  'D', element HOUR  'H',+                                         element MINUTE 'm', element SECOND 'S',+                                         whitespaces, fixed] -pYear ∷ Int → Parsec String st DateTime+    element constr c = do+      mandatory <- getState+      constr mandatory <$> nchars c++    whitespaces = do+      many1 $ oneOf " \r\n\t"+      mandatory <- getState+      return $ Whitespace mandatory++    fixed = do+      mandatory <- getState+      Fixed mandatory <$> (many1 $ noneOf "YMDHmS[] \t\r\n")++pYear ∷ Stream s m Char => Int → ParsecT s st m DateTime pYear n = do   y ← number n 10000   if y < 2000     then return $ mempty {year = y+2000}     else return $ mempty {year = y} -pMonth ∷ Int → Parsec String st DateTime+pMonth ∷ Stream s m Char => Int → ParsecT s st m DateTime pMonth n = do   m ← number n 12   return $ mempty {month = m} -pDay ∷ Int → Parsec String st DateTime+pDay ∷ Stream s m Char => Int → ParsecT s st m DateTime pDay n = do   d ← number n 31   return $ mempty {day = d} -pHour ∷ Int → Parsec String st DateTime+pHour ∷ Stream s m Char => Int → ParsecT s st m DateTime pHour n = do   h ← number n 23   return $ mempty {hour = h} -pMinute ∷ Int → Parsec String st DateTime+pMinute ∷ Stream s m Char => Int → ParsecT s st m DateTime pMinute n = do   m ← number n 59   return $ mempty {minute = m} -pSecond ∷ Int → Parsec String st DateTime+pSecond ∷ Stream s m Char => Int → ParsecT s st m DateTime pSecond n = do   s ← number n 59   return $ mempty {second = s} +opt :: Stream s m Char => Monoid a => Bool -> ParsecT s st m a -> ParsecT s st m a+opt True  p = p+opt False p = option mempty p++parseFormat :: String -> Either ParseError Format+parseFormat formatStr = runParser pFormat True "(date format string)" formatStr+ -- | Make Parser for specified date format.-formatParser ∷ Format → Parsec String st DateTime+formatParser ∷ Stream s m Char => Format → ParsecT s st m DateTime formatParser format = mconcat <$> mapM parser format   where-    parser (YEAR   n) = pYear n-    parser (MONTH  n) = pMonth n-    parser (DAY    n) = pDay n-    parser (HOUR   n) = pHour n-    parser (MINUTE n) = pMinute n-    parser (SECOND n) = pSecond n-    parser (Fixed s) = string s >> return mempty+    parser (YEAR   m n) = opt m $ pYear n+    parser (MONTH  m n) = opt m $ pMonth n+    parser (DAY    m n) = opt m $ pDay n+    parser (HOUR   m n) = opt m $ pHour n+    parser (MINUTE m n) = opt m $ pMinute n+    parser (SECOND m n) = opt m $ pSecond n+    parser (Whitespace m) = opt m ((many1 $ oneOf " \t\r\n") >> return mempty)+    parser (Fixed  m s) = opt m ( string s >> return mempty )  -- | Parse date\/time in specified format. parseDateFormat :: String  -- ^ Format string, i.e. "DD.MM.YY"                 -> String  -- ^ String to parse                 -> Either ParseError DateTime parseDateFormat formatStr str = do-  format <- runParser pFormat () "(date format string)" formatStr+  format <- parseFormat formatStr    runParser (formatParser format) () "(date)" str 

@@ -1,29 +1,29 @@-{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable #-}+{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, FlexibleContexts #-}  module Data.Dates.Internal where  import Data.Char  import Text.Parsec-import Text.Parsec.String  -- | Parser version of Prelude.read-tryRead :: Read a => String -> Parsec String st a+tryRead :: (Read a, Stream s m Char) => String -> ParsecT s st m a tryRead str =   case reads str of     [(res, "")] -> return res     _ -> fail $ "Cannot read: " ++ str -tryReadInt ∷ Num a ⇒ String → Parsec String st a+tryReadInt ∷ (Stream s m Char, Num a) ⇒ String → ParsecT s st m a tryReadInt str =   if all isDigit str     then return $ fromIntegral $ foldl (\a b → 10*a+b) 0 $ map digitToInt str     else fail $ "Cannot read: " ++ str  -- | Apply parser N times-times ∷ Int-     → Parsec String st t-     → Parsec String st [t]+times ∷ (Stream s m Char)+     ⇒ Int+     → ParsecT s st m t+     → ParsecT s st m [t] times 0 _ = return [] times n p = do   ts ← times (n-1) p@@ -34,25 +34,26 @@                                 -- | Parse natural number of N digits -- which is not greater than M-number ∷ Int   -- ^ Number of digits+number ∷ Stream s m Char+       ⇒ Int   -- ^ Number of digits        → Int   -- ^ Maximum value-       → Parsec String st Int+       → ParsecT s st m Int number n m = do   t ← tryReadInt =<< (n `times` digit)   if t > m     then fail "number too large"     else return t -pYear ∷ Parsec String st Int+pYear ∷ Stream s m Char => ParsecT s st m Int pYear = do   y ← number 4 10000   if y < 2000     then return (y+2000)     else return y -pMonth ∷ Parsec String st Int+pMonth ∷ Stream s m Char => ParsecT s st m Int pMonth = number 2 12 -pDay ∷ Parsec String st Int+pDay ∷ Stream s m Char => ParsecT s st m Int pDay = number 2 31 

@@ -1,5 +1,5 @@ name:                dates-version:             0.2.1.2+version:             0.2.2.0 synopsis:            Small library for parsing different dates formats. description:         This package allows to parse many different formats                      of dates. Both absolute and relative dates are supported.