time-parsers-0.2/0000755000000000000000000000000007346545000012157 5ustar0000000000000000time-parsers-0.2/CHANGELOG.md0000644000000000000000000000035707346545000013775 0ustar0000000000000000- 0.2 - Add `year` parser which requires at least four digits. Use it in `month`, `day` etc. - 0.1.2.1 - Use `unexpected` instead of `fail` - 0.1.2.0 - add `month` - fix pre BCE parsing - 0.1.1.0 - add `mkDay` time-parsers-0.2/LICENSE0000644000000000000000000000276207346545000013173 0ustar0000000000000000Copyright (c) 2015, Oleg Grenrus All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Oleg Grenrus nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. time-parsers-0.2/README.md0000644000000000000000000000115707346545000013442 0ustar0000000000000000# time-parsers [![Build Status](https://travis-ci.org/phadej/time-parsers.svg?branch=master)](https://travis-ci.org/phadej/time-parsers) [![Hackage](https://img.shields.io/hackage/v/time-parsers.svg)](http://hackage.haskell.org/package/time-parsers) [![Stackage LTS 2](http://stackage.org/package/time-parsers/badge/lts-2)](http://stackage.org/lts-2/package/time-parsers) [![Stackage LTS 3](http://stackage.org/package/time-parsers/badge/lts-3)](http://stackage.org/lts-3/package/time-parsers) [![Stackage Nightly](http://stackage.org/package/time-parsers/badge/nightly)](http://stackage.org/nightly/package/time-parsers) time-parsers-0.2/Setup.hs0000644000000000000000000000007407346545000013614 0ustar0000000000000000import Distribution.Simple main :: IO () main = defaultMain time-parsers-0.2/src/Data/Time/0000755000000000000000000000000007346545000014515 5ustar0000000000000000time-parsers-0.2/src/Data/Time/Parsers.hs0000644000000000000000000001364407346545000016500 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module: Data.Time.Parsers (Data.Aeson.Parser.Time) -- Copyright: (c) 2015 Bryan O'Sullivan, 2015 Oleg Grenrus -- License: BSD3 -- Maintainer: Oleg Grenrus -- -- Parsers for parsing dates and times. module Data.Time.Parsers ( day , month , year , localTime , timeOfDay , timeZone , utcTime , zonedTime , DateParsing ) where import Control.Applicative (optional, some, (<|>)) import Control.Monad (void, when) import Data.Bits ((.&.)) import Data.Char (isDigit, ord) import Data.Fixed (Pico) import Data.Int (Int64) import Data.List (foldl') import Data.Maybe (fromMaybe) import Data.Time.Calendar (Day, fromGregorianValid) import Data.Time.Clock (UTCTime (..)) import Text.Parser.Char (CharParsing (..), digit) import Text.Parser.Combinators (unexpected) import Text.Parser.LookAhead (LookAheadParsing (..)) import Unsafe.Coerce (unsafeCoerce) import qualified Data.Time.LocalTime as Local #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((*>), (<$), (<$>), (<*), (<*>)) #endif type DateParsing m = (CharParsing m, LookAheadParsing m, Monad m) toPico :: Integer -> Pico toPico = unsafeCoerce -- | Parse a year @YYYY@, with at least 4 digits. Does not include any sign. -- -- @since 0.2 year :: DateParsing m => m Integer year = do ds <- some digit if length ds < 4 then unexpected "expected year with at least 4 digits" else return (foldl' step 0 ds) where step a w = a * 10 + fromIntegral (ord w - 48) -- | Parse a month of the form @YYYY-MM@ month :: DateParsing m => m (Integer, Int) month = do s <- negate <$ char '-' <|> id <$ char '+' <|> return id y <- year _ <- char '-' m <- twoDigits if 1 <= m && m <= 12 then return (s y, m) else unexpected "Invalid month" {-# INLINE month #-} -- | Parse a date of the form @YYYY-MM-DD@. day :: DateParsing m => m Day day = do s <- negate <$ char '-' <|> id <$ char '+' <|> return id y <- year _ <- char '-' m <- twoDigits _ <- char '-' d <- twoDigits maybe (unexpected "invalid date") return (fromGregorianValid (s y) m d) -- | Parse a two-digit integer (e.g. day of month, hour). twoDigits :: DateParsing m => m Int twoDigits = do a <- digit b <- digit let c2d c = ord c .&. 15 return $! c2d a * 10 + c2d b -- | Parse a time of the form @HH:MM:SS[.SSS]@. timeOfDay :: DateParsing m => m Local.TimeOfDay timeOfDay = do h <- twoDigits <* char ':' m <- twoDigits <* char ':' s <- seconds if h < 24 && m < 60 && s < 61 then return (Local.TimeOfDay h m s) else unexpected "invalid time" data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64 -- | Parse a count of seconds, with the integer part being two digits -- long. seconds :: DateParsing m => m Pico seconds = do real <- twoDigits mc <- peekChar case mc of Just '.' -> do t <- anyChar *> some digit return $! parsePicos real t _ -> return $! fromIntegral real where parsePicos a0 t = toPico (fromIntegral (t' * 10^n)) where T n t' = foldl' step (T 12 (fromIntegral a0)) t step ma@(T m a) c | m <= 0 = ma | otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15) -- | Parse a time zone, and return 'Nothing' if the offset from UTC is -- zero. (This makes some speedups possible.) timeZone :: DateParsing m => m (Maybe Local.TimeZone) timeZone = do let maybeSkip c = do ch <- peekChar'; when (ch == c) (void anyChar) maybeSkip ' ' ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-' if ch == 'Z' then return Nothing else do h <- twoDigits mm <- peekChar m <- case mm of Just ':' -> anyChar *> twoDigits Just d | isDigit d -> twoDigits _ -> return 0 let off | ch == '-' = negate off0 | otherwise = off0 off0 = h * 60 + m case undefined of _ | off == 0 -> return Nothing | off < -720 || off > 840 || m > 59 -> unexpected "invalid time zone offset" | otherwise -> let !tz = Local.minutesToTimeZone off in return (Just tz) -- | Parse a date and time, of the form @YYYY-MM-DD HH:MM:SS@. -- The space may be replaced with a @T@. The number of seconds may be -- followed by a fractional component. localTime :: DateParsing m => m Local.LocalTime localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay where daySep = satisfy (\c -> c == 'T' || c == ' ') -- | Behaves as 'zonedTime', but converts any time zone offset into a -- UTC time. utcTime :: DateParsing m => m UTCTime utcTime = f <$> localTime <*> timeZone where f :: Local.LocalTime -> Maybe Local.TimeZone -> UTCTime f (Local.LocalTime d t) Nothing = let !tt = Local.timeOfDayToTime t in UTCTime d tt f lt (Just tz) = Local.localTimeToUTC tz lt -- | Parse a date with time zone info. Acceptable formats: -- -- @YYYY-MM-DD HH:MM:SS Z@ -- -- The first space may instead be a @T@, and the second space is -- optional. The @Z@ represents UTC. The @Z@ may be replaced with a -- time zone offset of the form @+0000@ or @-08:00@, where the first -- two digits are hours, the @:@ is optional and the second two digits -- (also optional) are minutes. zonedTime :: DateParsing m => m Local.ZonedTime zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone) utc :: Local.TimeZone utc = Local.TimeZone 0 False "" decimal :: (DateParsing m, Integral a) => m a decimal = foldl' step 0 `fmap` some digit where step a w = a * 10 + fromIntegral (ord w - 48) peekChar :: DateParsing m => m (Maybe Char) peekChar = optional peekChar' peekChar' :: DateParsing m => m Char peekChar' = lookAhead anyChar time-parsers-0.2/src/Data/Time/TH.hs0000644000000000000000000000264407346545000015372 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TemplateHaskellQuotes #-} #else {-# LANGUAGE TemplateHaskell #-} #endif -- | Template Haskell extras for `Data.Time`. module Data.Time.TH (mkUTCTime, mkDay) where import Data.List (nub) import Data.Time (Day (..), UTCTime (..)) import Data.Time.Parsers (day, utcTime) import Language.Haskell.TH (Exp, Q, integerL, litE, appE, sigE, rationalL) import Text.ParserCombinators.ReadP (readP_to_S) -- | Make a 'UTCTime'. Accepts the same strings as `utcTime` parser accepts. -- -- > t :: UTCTime -- > t = $(mkUTCTime "2014-05-12 00:02:03.456000Z") mkUTCTime :: String -> Q Exp mkUTCTime s = case nub $ readP_to_S utcTime s of [(UTCTime (ModifiedJulianDay d) dt, "")] -> ([| UTCTime |] `appE` ([| ModifiedJulianDay |] `appE` d') `appE` dt') `sigE` [t| UTCTime |] where d' = litE $ integerL d dt' = litE $ rationalL $ toRational dt ps -> error $ "Cannot parse date: " ++ s ++ " -- " ++ show ps -- | Make a 'Day'. Accepts the same strings as `day` parser accepts. -- -- > d :: Day -- > d = $(mkDay "2014-05-12") mkDay :: String -> Q Exp mkDay s = case nub $ readP_to_S day s of [(ModifiedJulianDay d, "")] -> ([| ModifiedJulianDay |] `appE` d') `sigE` [t| Day |] where d' = litE $ integerL d ps -> error $ "Cannot parse day: " ++ s ++ " -- " ++ show ps time-parsers-0.2/test/0000755000000000000000000000000007346545000013136 5ustar0000000000000000time-parsers-0.2/test/Tests.hs0000644000000000000000000000571207346545000014601 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Main (main) where import Test.Tasty import Test.Tasty.HUnit import Data.Bifunctor (first) import Data.Time (Day (..), UTCTime (..)) import qualified Data.Attoparsec.Text as AT import qualified Data.Text as T import qualified Text.Parsec as Parsec import Data.Time.Parsers import Data.Time.TH main :: IO () main = defaultMain $ testGroup "tests" [utctimeTests, monthTests, timeTHTests] utctimeTests :: TestTree utctimeTests = testGroup "utcTime" $ map t utctimeStrings where t str = testCase str $ do assertBool str (isRight $ parseParsec str) assertEqual str (parseParsec str) (parseAttoParsec str) monthTests :: TestTree monthTests = testGroup "month" $ [ testGroup "valid" $ map t monthStrings , testGroup "invalid" $ map i invalidMonthStrings ] where t str = testCase str $ do assertBool str (isRight $ parseParsecMonth str) assertEqual str (parseParsecMonth str) (parseAttoParsecMonth str) i str = testCase str $ assertBool str (isLeft $ parseParsecMonth str) isRight :: Either a b -> Bool isRight (Left _) = False isRight (Right _) = True isLeft :: Either a b -> Bool isLeft = not . isRight parseParsec :: String -> Either String UTCTime parseParsec input = first show $ Parsec.parse utcTime "" input parseAttoParsec :: String -> Either String UTCTime parseAttoParsec = AT.parseOnly utcTime . T.pack parseParsecMonth :: String -> Either String (Integer, Int) parseParsecMonth input = first show $ Parsec.parse month "" input parseAttoParsecMonth :: String -> Either String (Integer, Int) parseAttoParsecMonth = AT.parseOnly month . T.pack utctimeStrings :: [String] utctimeStrings = [ "2015-09-07T08:16:40.807Z" , "2015-09-07T11:16:40.807+0300" , "2015-09-07 08:16:40.807Z" , "2015-09-07 08:16:40.807 Z" , "2015-09-07 08:16:40.807 +0000" , "2015-09-07 08:16:40.807 +00:00" , "2015-09-07 11:16:40.807 +03:00" , "2015-09-07 05:16:40.807 -03:00" , "2015-09-07 05:16:40.807-03:00" , "2015-09-07T05:16:40Z" , "2015-09-07 05:16:40Z" , "2015-09-07 05:16:40 Z" , "2015-09-07 05:16:40+03:00" , "2015-09-07 05:16:40 +03:00" , "0000-09-07 05:16:40 +03:00" ] monthStrings :: [String] monthStrings = [ "2016-12" , "-0010-12" ] invalidMonthStrings :: [String] invalidMonthStrings = [ "2016-13" , "2016-00" , "2016-1" , "216-01" ] timeTHTests :: TestTree timeTHTests = testGroup "TH" [ testCase "time" $ assertBool "should be equal" $ lhs0 == rhs0 , testCase "time' " $ assertBool "should be equal" $ lhs1 == rhs1 , testCase "day" $ assertBool "should be equal" $ lhs2 == rhs2 ] where lhs0 = UTCTime (ModifiedJulianDay 56789) 123.456 rhs0 = $(mkUTCTime "2014-05-12 00:02:03.456Z") lhs1 = UTCTime (ModifiedJulianDay 56789) 123.0 rhs1 = $(mkUTCTime "2014-05-12 00:02:03Z") lhs2 = ModifiedJulianDay 56789 rhs2 = $(mkDay "2014-05-12") time-parsers-0.2/time-parsers.cabal0000644000000000000000000000356707346545000015571 0ustar0000000000000000cabal-version: >=1.10 name: time-parsers version: 0.2 synopsis: Parsers for types in `time`. category: Parsing description: Parsers for types in `time` using 'parser' library. . Originally forked from aeson parsers. . See also package. homepage: https://github.com/phadej/time-parsers#readme bug-reports: https://github.com/phadej/time-parsers/issues author: Oleg Grenrus maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE tested-with: GHC ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.4 || ==9.6.1 build-type: Simple extra-source-files: CHANGELOG.md README.md source-repository head type: git location: https://github.com/phadej/time-parsers library hs-source-dirs: src ghc-options: -Wall build-depends: base >=4.6 && <4.19 , parsers >=0.12.2.1 && <0.13 , template-haskell >=2.8.0.0 && <2.21 , time >=1.4.0.1 && <1.13 exposed-modules: Data.Time.Parsers Data.Time.TH default-language: Haskell2010 test-suite date-parsers-tests type: exitcode-stdio-1.0 main-is: Tests.hs hs-source-dirs: test ghc-options: -Wall build-depends: attoparsec >=0.12.1.6 && <0.15 , base , bifunctors >=4.2.1 && <5.7 , parsec >=3.1.9 && <3.2 , parsers >=0.12.3 && <0.13 , tasty >=0.10.1.2 && <1.5 , tasty-hunit >=0.9.2 && <0.11 , template-haskell , text , time , time-parsers default-language: Haskell2010