time-parsers (empty) → 0.1.0.0
raw patch · 7 files changed
+341/−0 lines, 7 filesdep +attoparsecdep +basedep +bifunctorssetup-changed
Dependencies added: attoparsec, base, bifunctors, parsec, parsers, tasty, tasty-hunit, template-haskell, text, time, time-parsers
Files
- LICENSE +30/−0
- README.md +7/−0
- Setup.hs +3/−0
- src/Data/Time/Parsers.hs +164/−0
- src/Data/Time/TH.hs +23/−0
- test/Tests.hs +54/−0
- time-parsers.cabal +60/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (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.
+ README.md view
@@ -0,0 +1,7 @@+# time-parsers++[](https://travis-ci.org/phadej/time-parsers)+[](http://hackage.haskell.org/package/time-parsers)+[](http://stackage.org/lts-2/package/time-parsers)+[](http://stackage.org/lts-3/package/time-parsers)+[](http://stackage.org/nightly/package/time-parsers)
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main :: IO ()+main = defaultMain
+ src/Data/Time/Parsers.hs view
@@ -0,0 +1,164 @@+{-# 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 <oleg.grenrus@iki.fi>+--+-- Parsers for parsing dates and times.++module Data.Time.Parsers+ ( day+ , 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 date of the form @YYYY-MM-DD@.+day :: DateParsing m => m Day+day = do+ y <- decimal <* char '-'+ m <- twoDigits <* char '-'+ d <- twoDigits+ maybe (fail "invalid date") return (fromGregorianValid 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
+ src/Data/Time/TH.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell #-}+-- | Template Haskell extras for `Data.Time`.+module Data.Time.TH (mkUTCTime) where++import Data.Time (Day (..), UTCTime (..))+import Data.Time.Parsers (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")+--+-- /Since: 0.2.3.0/+mkUTCTime :: String -> Q Exp+mkUTCTime s =+ case 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+ _ -> error $ "Cannot parse date: " ++ s
+ test/Tests.hs view
@@ -0,0 +1,54 @@+{-# 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, timeTHTests]++utctimeTests :: TestTree+utctimeTests = testGroup "utcTime" $ map t timeStrings+ where+ t str = testCase str $ do+ assertBool str (isRight $ parseParsec str)+ assertEqual str (parseParsec str) (parseAttoParsec str)++isRight :: Either a b -> Bool+isRight (Left _) = False+isRight (Right _) = True++parseParsec :: String -> Either String UTCTime+parseParsec input = first show $ Parsec.parse utcTime"" input++parseAttoParsec :: String -> Either String UTCTime+parseAttoParsec = AT.parseOnly utcTime . T.pack++timeStrings :: [String]+timeStrings =+ [ "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"+ ]++timeTHTests :: TestTree+timeTHTests =+ testCase "time TH example" $ assertBool "should be equal" $ lhs == rhs+ where lhs = UTCTime (ModifiedJulianDay 56789) 123.456+ rhs = $(mkUTCTime "2014-05-12 00:02:03.456000Z")+
+ time-parsers.cabal view
@@ -0,0 +1,60 @@+-- This file has been generated from package.yaml by hpack version 0.8.0.+--+-- see: https://github.com/sol/hpack++name: time-parsers+version: 0.1.0.0+synopsis: Parsers for types in `time`.+description: Parsers for types in `time`.+category: Web+homepage: https://github.com/phadej/time-parsers#readme+bug-reports: https://github.com/phadej/time-parsers/issues+author: Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+license: BSD3+license-file: LICENSE+tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ 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.9+ , parsers >=0.12.2.1 && <0.13+ , template-haskell >=2.8.0.0 && <2.11+ , 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 >=4.6 && <4.9+ , parsers >=0.12.2.1 && <0.13+ , template-haskell >=2.8.0.0 && <2.11+ , time >=1.4.2 && <1.7+ , time-parsers+ , attoparsec >=0.12.1.6 && <0.14+ , bifunctors >=4.2.1 && <5.2+ , 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