time-parsers-0.1.2.0/0000755000000000000000000000000013024766640012461 5ustar0000000000000000time-parsers-0.1.2.0/CHANGELOG.md0000644000000000000000000000012313024766640014266 0ustar0000000000000000- 0.1.2.0 - add `month` - fix pre BCE parsing - 0.1.1.0 - add `mkDay` time-parsers-0.1.2.0/time-parsers.cabal0000644000000000000000000000307613024766640016066 0ustar0000000000000000name: time-parsers version: 0.1.2.0 synopsis: Parsers for types in `time`. description: Parsers for types in `time` using 'parser' library. . Originally forked from aeson parsers. category: Parsing 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, GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 build-type: Simple cabal-version: >= 1.10 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.10 , parsers >=0.12.2.1 && <0.13 , template-haskell >=2.8.0.0 && <2.12 , time >=1.4.2 && <1.7 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: base , parsers , template-haskell , time , time-parsers , attoparsec >=0.12.1.6 && <0.14 , bifunctors >=4.2.1 && <5.5 , parsec >=3.1.9 && <3.2 , parsers >=0.12.3 && <0.13 , tasty >=0.10.1.2 && <0.12 , tasty-hunit >=0.9.2 && <0.10 , text default-language: Haskell2010 time-parsers-0.1.2.0/LICENSE0000644000000000000000000000276213024766640013475 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.1.2.0/Setup.hs0000644000000000000000000000007413024766640014116 0ustar0000000000000000import Distribution.Simple main :: IO () main = defaultMain time-parsers-0.1.2.0/README.md0000644000000000000000000000115713024766640013744 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.1.2.0/src/0000755000000000000000000000000013024766640013250 5ustar0000000000000000time-parsers-0.1.2.0/src/Data/0000755000000000000000000000000013024766640014121 5ustar0000000000000000time-parsers-0.1.2.0/src/Data/Time/0000755000000000000000000000000013024766640015017 5ustar0000000000000000time-parsers-0.1.2.0/src/Data/Time/Parsers.hs0000644000000000000000000001300113024766640016765 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 , 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.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 month of the form @YYYY-MM@ month :: DateParsing m => m (Integer, Int) month = do s <- negate <$ char '-' <|> id <$ char '+' <|> return id y <- decimal _ <- char '-' m <- twoDigits if (1 <= m && m <= 12) then return (s y, m) else fail "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 <- decimal _ <- char '-' m <- twoDigits _ <- char '-' d <- twoDigits maybe (fail "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 fail "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 -> fail "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.1.2.0/src/Data/Time/TH.hs0000644000000000000000000000237513024766640015675 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- | 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, 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 (ModifiedJulianDay $(d')) $(dt') :: 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 $(d') :: Day |] where d' = litE $ integerL d ps -> error $ "Cannot parse day: " ++ s ++ " -- " ++ show ps time-parsers-0.1.2.0/test/0000755000000000000000000000000013024766640013440 5ustar0000000000000000time-parsers-0.1.2.0/test/Tests.hs0000644000000000000000000000563013024766640015102 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" ] monthStrings :: [String] monthStrings = [ "2016-12" , "-0010-12" ] invalidMonthStrings :: [String] invalidMonthStrings = [ "2016-13" , "2016-00" , "2016-1" ] 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")