summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--attoparsec-time.cabal36
-rw-r--r--library/Attoparsec/Time/ByteString.hs318
-rw-r--r--library/Attoparsec/Time/Pure.hs (renamed from library/Attoparsec/Time/Constructors.hs)23
-rw-r--r--library/Attoparsec/Time/Text.hs (renamed from library/Attoparsec/Time.hs)6
-rw-r--r--library/Attoparsec/Time/Validation.hs (renamed from library/Attoparsec/Time/Validators.hs)2
5 files changed, 361 insertions, 24 deletions
diff --git a/attoparsec-time.cabal b/attoparsec-time.cabal
index 44c0d39..98207ff 100644
--- a/attoparsec-time.cabal
+++ b/attoparsec-time.cabal
@@ -1,7 +1,7 @@
name:
attoparsec-time
version:
- 0.1.4
+ 1
synopsis:
Attoparsec parsers of time
description:
@@ -25,7 +25,7 @@ license-file:
build-type:
Custom
cabal-version:
- >= 1.24
+ >=1.10
source-repository head
type:
@@ -35,7 +35,7 @@ source-repository head
custom-setup
setup-depends:
- base, Cabal, cabal-doctest >= 1.0.2 && < 1.1
+ base, Cabal, cabal-doctest >=1.0.2 && <1.1
library
hs-source-dirs:
@@ -45,21 +45,23 @@ library
default-language:
Haskell2010
exposed-modules:
- Attoparsec.Time
+ Attoparsec.Time.ByteString
+ Attoparsec.Time.Text
other-modules:
Attoparsec.Time.Prelude
- Attoparsec.Time.Validators
- Attoparsec.Time.Constructors
+ Attoparsec.Time.Validation
+ Attoparsec.Time.Pure
build-depends:
--
- attoparsec >= 0.13 && < 0.15,
+ attoparsec >=0.13 && <0.15,
--
- time >= 1.4 && < 2,
- scientific == 0.3.*,
- text >= 1 && < 2,
+ time >=1.4 && <2,
+ scientific ==0.3.*,
+ text >=1 && <2,
+ bytestring ==0.10.*,
--
- base-prelude < 2,
- base >= 4.7 && < 5
+ base-prelude <2,
+ base >=4.7 && <5
test-suite doctests
type:
@@ -75,8 +77,8 @@ test-suite doctests
default-language:
Haskell2010
build-depends:
- doctest == 0.13.*,
- directory >= 1.2 && < 2,
- filepath >= 1.4 && < 2,
- base-prelude < 2,
- base < 5
+ doctest ==0.13.*,
+ directory >=1.2 && <2,
+ filepath >=1.4 && <2,
+ base-prelude <2,
+ base <5
diff --git a/library/Attoparsec/Time/ByteString.hs b/library/Attoparsec/Time/ByteString.hs
new file mode 100644
index 0000000..c31999f
--- /dev/null
+++ b/library/Attoparsec/Time/ByteString.hs
@@ -0,0 +1,318 @@
+{-|
+ASCII ByteString Parsers.
+-}
+module Attoparsec.Time.ByteString
+(
+ timeOfDayInISO8601,
+ dayInISO8601,
+ timeZoneInISO8601,
+ utcTimeInISO8601,
+ diffTime,
+ nominalDiffTime,
+)
+where
+
+import Attoparsec.Time.Prelude hiding (take, takeWhile)
+import Data.Attoparsec.ByteString
+import qualified Attoparsec.Time.Pure as A
+import qualified Attoparsec.Time.Validation as B
+import qualified Data.ByteString as C
+import qualified Data.Attoparsec.ByteString.Char8 as D
+
+
+validated :: Show a => B.Validator a -> Parser a -> Parser a
+validated validator parser =
+ parser >>= \x -> B.run validator (pure x) fail x
+
+sign :: Parser Bool
+sign =
+ anyWord8 >>= \case
+ 43 -> return True
+ 45 -> return False
+ _ -> empty
+
+decimalOfLength :: Integral a => Int -> Parser a
+decimalOfLength length =
+ do
+ bytes <- take length
+ if C.all A.word8IsAsciiDigit bytes
+ then return (A.decimalFromBytes bytes)
+ else fail "Not all chars are valid decimals"
+
+picoWithBasisOfLength :: Int -> Parser Pico
+picoWithBasisOfLength basisLength =
+ MkFixed <$> ((+) <$> beforePoint <*> ((word8 46 *> afterPoint) <|> pure 0))
+ where
+ beforePoint =
+ (* (10 ^ 12)) <$> decimalOfLength basisLength
+ afterPoint =
+ fmap (updater . C.take 12) (takeWhile1 A.word8IsAsciiDigit)
+ where
+ updater bytes =
+ let
+ afterPoint =
+ A.decimalFromBytes bytes
+ afterPointLength =
+ C.length bytes
+ paddedAfterPoint =
+ if afterPointLength < 12
+ then afterPoint * (10 ^ (12 - afterPointLength))
+ else afterPoint
+ in paddedAfterPoint
+
+{-# INLINE hour #-}
+hour :: Parser Int
+hour =
+ validated B.hour (decimalOfLength 2) <?> "hour"
+
+{-# INLINE minute #-}
+minute :: Parser Int
+minute =
+ validated B.minute (decimalOfLength 2) <?> "minute"
+
+{-# INLINE second #-}
+second :: Parser Pico
+second =
+ validated B.second (picoWithBasisOfLength 2) <?> "second"
+
+{-|
+>>> parseOnly timeOfDayInISO8601 "05:03:58"
+Right 05:03:58
+
+>>> parseOnly timeOfDayInISO8601 "05:03:58.02"
+Right 05:03:58.02
+
+>>> parseOnly timeOfDayInISO8601 "05:03:58.020"
+Right 05:03:58.02
+
+Checks the elements to be within a proper range:
+
+>>> parseOnly timeOfDayInISO8601 "24:00:00"
+Left "timeOfDayInISO8601 > hour: Failed reading: Validator \"hour\" failed on the following input: 24"
+
+>>> parseOnly timeOfDayInISO8601 "00:00:60"
+Left "timeOfDayInISO8601 > second: Failed reading: Validator \"second\" failed on the following input: 60.000000000000"
+
+Checks the elements to be of proper length:
+
+>>> parseOnly timeOfDayInISO8601 "1:00:00"
+Left "timeOfDayInISO8601 > hour: Failed reading: Not all chars are valid decimals"
+
+>>> parseOnly timeOfDayInISO8601 "01:1:00"
+Left "timeOfDayInISO8601 > minute: Failed reading: Not all chars are valid decimals"
+-}
+{-# INLINE timeOfDayInISO8601 #-}
+timeOfDayInISO8601 :: Parser TimeOfDay
+timeOfDayInISO8601 =
+ unnamedParser <?> "timeOfDayInISO8601"
+ where
+ unnamedParser =
+ A.timeOfDay <$>
+ (hour <* word8 58) <*>
+ (minute <* word8 58) <*>
+ (second)
+
+{-|
+>>> parseOnly dayInISO8601 "2017-02-01"
+Right 2017-02-01
+
+Checks the elements to be in proper range:
+
+>>> parseOnly dayInISO8601 "2017-13-01"
+Left "dayInISO8601: Failed reading: Invalid combination of year month and day: (2017,13,1)"
+
+That is accounting for leap year:
+
+>>> parseOnly dayInISO8601 "2017-02-29"
+Left "dayInISO8601: Failed reading: Invalid combination of year month and day: (2017,2,29)"
+
+>>> parseOnly dayInISO8601 "2016-02-29"
+Right 2016-02-29
+-}
+{-# INLINE dayInISO8601 #-}
+dayInISO8601 :: Parser Day
+dayInISO8601 =
+ unnamedParser <?> "dayInISO8601"
+ where
+ unnamedParser =
+ do
+ year <- decimalOfLength 4
+ word8 45
+ month <- decimalOfLength 2
+ word8 45
+ day <- decimalOfLength 2
+ case fromGregorianValid year month day of
+ Just day -> return day
+ Nothing -> fail (error year month day)
+ where
+ error year month day =
+ showString "Invalid combination of year month and day: " $
+ show (year, month, day)
+
+{-|
+>>> parseOnly timeZoneInISO8601 "+01:00"
+Right +0100
+
+>>> parseOnly timeZoneInISO8601 "+0100"
+Right +0100
+
+>>> parseOnly timeZoneInISO8601 "-0100"
+Right -0100
+
+>>> parseOnly timeZoneInISO8601 "Z"
+Right UTC
+-}
+timeZoneInISO8601 :: Parser TimeZone
+timeZoneInISO8601 =
+ unnamedParser <?> "timeZoneInISO8601"
+ where
+ unnamedParser =
+ z <|> offset
+ where
+ z =
+ word8 90 $> utc
+ offset =
+ A.timeZone <$> sign <*> decimalOfLength 2 <*> (word8 58 *> decimalOfLength 2 <|> decimalOfLength 2 <|> pure 0)
+
+{-|
+>>> parseOnly utcTimeInISO8601 "2017-02-01T05:03:58+01:00"
+Right 2017-02-01 04:03:58 UTC
+-}
+utcTimeInISO8601 :: Parser UTCTime
+utcTimeInISO8601 =
+ unnamedParser <?> "utcTimeInISO8601"
+ where
+ unnamedParser =
+ do
+ day <- dayInISO8601
+ word8 84
+ time <- timeOfDayInISO8601
+ zone <- timeZoneInISO8601
+ return (A.utcTimeFromDayAndTimeOfDay day time zone)
+
+{-|
+No suffix implies the "seconds" unit:
+
+>>> parseOnly diffTime "10"
+Right 10s
+
+Various units (seconds, minutes, hours, days):
+
+>>> parseOnly diffTime "10s"
+Right 10s
+
+>>> parseOnly diffTime "10m"
+Right 600s
+
+>>> parseOnly diffTime "10h"
+Right 36000s
+
+>>> parseOnly diffTime "10d"
+Right 864000s
+
+Metric prefixes to seconds (down to Pico):
+
+>>> parseOnly diffTime "10ms"
+Right 0.01s
+
+Notice that \"μs\" is not supported, because it's not ASCII.
+
+>>> parseOnly diffTime "10us"
+Right 0.00001s
+
+>>> parseOnly diffTime "10ns"
+Right 0.00000001s
+
+>>> parseOnly diffTime "10ps"
+Right 0.00000000001s
+
+Negative values:
+
+>>> parseOnly diffTime "-1s"
+Right -1s
+
+Unsupported units:
+
+>>> parseOnly diffTime "1k"
+Left "diffTime: Failed reading: Unsupported unit: \"k\""
+-}
+diffTime :: Parser DiffTime
+diffTime =
+ unnamedParser <?> "diffTime"
+ where
+ unnamedParser =
+ do
+ amount <- D.scientific
+ factor <- timeUnitFactor
+ return (factor (realToFrac amount))
+
+{-|
+No suffix implies the "seconds" unit:
+
+>>> parseOnly nominalDiffTime "10"
+Right 10s
+
+Various units (seconds, minutes, hours, days):
+
+>>> parseOnly nominalDiffTime "10s"
+Right 10s
+
+>>> parseOnly nominalDiffTime "10m"
+Right 600s
+
+>>> parseOnly nominalDiffTime "10h"
+Right 36000s
+
+>>> parseOnly nominalDiffTime "10d"
+Right 864000s
+
+Metric prefixes to seconds (down to Pico):
+
+>>> parseOnly nominalDiffTime "10ms"
+Right 0.01s
+
+Notice that \"μs\" is not supported, because it's not ASCII.
+
+>>> parseOnly nominalDiffTime "10us"
+Right 0.00001s
+
+>>> parseOnly nominalDiffTime "10ns"
+Right 0.00000001s
+
+>>> parseOnly nominalDiffTime "10ps"
+Right 0.00000000001s
+
+Negative values:
+
+>>> parseOnly nominalDiffTime "-1s"
+Right -1s
+
+Unsupported units:
+
+>>> parseOnly nominalDiffTime "1k"
+Left "nominalDiffTime: Failed reading: Unsupported unit: \"k\""
+-}
+nominalDiffTime :: Parser NominalDiffTime
+nominalDiffTime =
+ unnamedParser <?> "nominalDiffTime"
+ where
+ unnamedParser =
+ do
+ amount <- D.scientific
+ factor <- timeUnitFactor
+ return (factor (realToFrac amount))
+
+timeUnitFactor :: Fractional a => Parser (a -> a)
+timeUnitFactor =
+ takeWhile A.word8IsAsciiAlpha >>= \case
+ "" -> return id
+ "s" -> return id
+ "ms" -> return (/ 1000)
+ "μs" -> return (/ 1000000)
+ "us" -> return (/ 1000000)
+ "ns" -> return (/ 1000000000)
+ "ps" -> return (/ 1000000000000)
+ "m" -> return (* 60)
+ "h" -> return (* 3600)
+ "d" -> return (* 86400)
+ unit -> fail ("Unsupported unit: " <> show unit)
diff --git a/library/Attoparsec/Time/Constructors.hs b/library/Attoparsec/Time/Pure.hs
index fda9581..8de6348 100644
--- a/library/Attoparsec/Time/Constructors.hs
+++ b/library/Attoparsec/Time/Pure.hs
@@ -1,8 +1,7 @@
--- |
--- Efficient construction functions for values of the \"time\" library.
-module Attoparsec.Time.Constructors where
+module Attoparsec.Time.Pure where
import Attoparsec.Time.Prelude
+import qualified Data.ByteString as A
{-# INLINE timeZone #-}
@@ -36,3 +35,21 @@ utcTimeFromDayAndTimeOfDay day tod tz =
utcTimeFromComponents :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> TimeZone -> UTCTime
utcTimeFromComponents year month day hour minute second millisecond timeZone =
undefined
+
+{-# INLINE decimalFromBytes #-}
+decimalFromBytes :: Integral decimal => A.ByteString -> decimal
+decimalFromBytes =
+ A.foldl' step 0
+ where
+ step a b =
+ a * 10 + fromIntegral b - 48
+
+{-# INLINE word8IsAsciiDigit #-}
+word8IsAsciiDigit :: Word8 -> Bool
+word8IsAsciiDigit w =
+ w - 48 <= 9
+
+{-# INLINE word8IsAsciiAlpha #-}
+word8IsAsciiAlpha :: Word8 -> Bool
+word8IsAsciiAlpha x =
+ (x - 97 <= 25) || (x - 65 <= 25)
diff --git a/library/Attoparsec/Time.hs b/library/Attoparsec/Time/Text.hs
index 126fdb6..20b26a9 100644
--- a/library/Attoparsec/Time.hs
+++ b/library/Attoparsec/Time/Text.hs
@@ -1,4 +1,4 @@
-module Attoparsec.Time
+module Attoparsec.Time.Text
(
timeOfDayInISO8601,
dayInISO8601,
@@ -11,8 +11,8 @@ where
import Attoparsec.Time.Prelude hiding (take, takeWhile)
import Data.Attoparsec.Text
-import qualified Attoparsec.Time.Constructors as A
-import qualified Attoparsec.Time.Validators as B
+import qualified Attoparsec.Time.Pure as A
+import qualified Attoparsec.Time.Validation as B
import qualified Data.Text as C
diff --git a/library/Attoparsec/Time/Validators.hs b/library/Attoparsec/Time/Validation.hs
index 5ec8360..3c211ce 100644
--- a/library/Attoparsec/Time/Validators.hs
+++ b/library/Attoparsec/Time/Validation.hs
@@ -1,4 +1,4 @@
-module Attoparsec.Time.Validators where
+module Attoparsec.Time.Validation where
import Attoparsec.Time.Prelude