attoparsec-time 0.1.4 → 1

raw patch · 8 files changed

+767/−430 lines, 8 filesdep +bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

API changes (from Hackage documentation)

Files

• attoparsec-time.cabal +19/−17
• library/Attoparsec/Time.hs +0/−332
• library/Attoparsec/Time/ByteString.hs +318/−0
• library/Attoparsec/Time/Constructors.hs +0/−38
• library/Attoparsec/Time/Pure.hs +55/−0
• library/Attoparsec/Time/Text.hs +332/−0
• library/Attoparsec/Time/Validation.hs +43/−0
• library/Attoparsec/Time/Validators.hs +0/−43

@@ -1,7 +1,7 @@ name:   attoparsec-time version:-  0.1.4+  1 synopsis:   Attoparsec parsers of time description:@@ -25,7 +25,7 @@ build-type:   Custom cabal-version:-  >= 1.24+  >=1.10  source-repository head   type:@@ -35,7 +35,7 @@  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 @@   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 @@   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

@@ -1,332 +0,0 @@-module Attoparsec.Time-(-  timeOfDayInISO8601,-  dayInISO8601,-  timeZoneInISO8601,-  utcTimeInISO8601,-  diffTime,-  nominalDiffTime,-)-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 Data.Text as C---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 =-  anyChar >>= \case-    '+' -> return True-    '-' -> return False-    _ -> empty--decimalChar :: Parser Int-decimalChar =-  satisfyWith ((subtract 48) . ord) ((&&) <$> (>= 0) <*> (<= 9))--decimalOfLength :: Num a => Int -> Parser a-decimalOfLength length =-  foldl' (\a b -> a * 10 + b) 0 <$>-  replicateM length (fmap fromIntegral decimalChar) <|>-  fail "Invalid decimal length"--shortMonth :: Parser Int-shortMonth =-  liftM C.toLower (take 3) >>= \case-    "jan" -> return 1-    "feb" -> return 2-    "mar" -> return 3-    "apr" -> return 4-    "may" -> return 5-    "jun" -> return 6-    "jul" -> return 7-    "aug" -> return 8-    "sep" -> return 9-    "oct" -> return 10-    "nov" -> return 11-    "dec" -> return 12-    _ -> empty--picoWithBasisOfLength :: Int -> Parser Pico-picoWithBasisOfLength basisLength =-  (\a b -> MkFixed (foldl' (\a b -> a * 10 + fromIntegral b) 0 (a ++ b))) <$> beforePoint <*> afterPoint-  where-    resolution =-      12-    beforePoint =-      replicateM basisLength decimalChar-    afterPoint =-      padListFromRight 0 [] resolution <$> ((char '.' *> many decimalChar) <|> pure [])-      where-        padListFromRight padding accumulator length list =-          case length of-            0 -> reverse accumulator-            _ -> case list of-              head : tail -> padListFromRight padding (head : accumulator) (pred length) tail-              _ -> reverse accumulator ++ replicate length padding--{-# 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: Invalid decimal length"-->>> parseOnly timeOfDayInISO8601 "01:1:00"-Left "timeOfDayInISO8601 > minute: Failed reading: Invalid decimal length"--}-{-# INLINE timeOfDayInISO8601 #-}-timeOfDayInISO8601 :: Parser TimeOfDay-timeOfDayInISO8601 =-  unnamedParser <?> "timeOfDayInISO8601"-  where-    unnamedParser =-      A.timeOfDay <$>-      (hour <* char ':') <*>-      (minute <* char ':') <*>-      (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-        char '-'-        month <- decimalOfLength 2-        char '-'-        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 =-          char 'Z' $> utc-        offset =-          A.timeZone <$> sign <*> decimalOfLength 2 <*> (char ':' *> 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-        char 'T'-        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-->>> parseOnly diffTime "10μs"-Right 0.00001s-->>> 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 <- 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-->>> parseOnly nominalDiffTime "10μs"-Right 0.00001s-->>> 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 <- scientific-        factor <- timeUnitFactor-        return (factor (realToFrac amount))--timeUnitFactor :: Fractional a => Parser (a -> a)-timeUnitFactor =-  takeWhile isAlpha >>= \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)

@@ -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)

@@ -1,38 +0,0 @@--- |--- Efficient construction functions for values of the \"time\" library.-module Attoparsec.Time.Constructors where--import Attoparsec.Time.Prelude---{-# INLINE timeZone #-}-timeZone :: Bool -> Int -> Int -> TimeZone-timeZone positive hour minute =-  minutesToTimeZone $-  bool negate id positive $-  hour * 60 + minute--{-# INLINE day #-}-day :: Int -> Int -> Int -> Day-day y m d =-  fromGregorian (fromIntegral y) m d--{-# INLINE timeOfDay #-}-timeOfDay :: Int -> Int -> Pico -> TimeOfDay-timeOfDay =-  TimeOfDay--{-# INLINE zonedTime #-}-zonedTime :: Day -> TimeOfDay -> TimeZone -> ZonedTime-zonedTime day tod tz =-  ZonedTime (LocalTime day tod) tz--{-# INLINE utcTimeFromDayAndTimeOfDay #-}-utcTimeFromDayAndTimeOfDay :: Day -> TimeOfDay -> TimeZone -> UTCTime-utcTimeFromDayAndTimeOfDay day tod tz =-  zonedTimeToUTC (zonedTime day tod tz)--{-# INLINE utcTimeFromComponents #-}-utcTimeFromComponents :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> TimeZone -> UTCTime-utcTimeFromComponents year month day hour minute second millisecond timeZone =-  undefined

@@ -0,0 +1,55 @@+module Attoparsec.Time.Pure where++import Attoparsec.Time.Prelude+import qualified Data.ByteString as A+++{-# INLINE timeZone #-}+timeZone :: Bool -> Int -> Int -> TimeZone+timeZone positive hour minute =+  minutesToTimeZone $+  bool negate id positive $+  hour * 60 + minute++{-# INLINE day #-}+day :: Int -> Int -> Int -> Day+day y m d =+  fromGregorian (fromIntegral y) m d++{-# INLINE timeOfDay #-}+timeOfDay :: Int -> Int -> Pico -> TimeOfDay+timeOfDay =+  TimeOfDay++{-# INLINE zonedTime #-}+zonedTime :: Day -> TimeOfDay -> TimeZone -> ZonedTime+zonedTime day tod tz =+  ZonedTime (LocalTime day tod) tz++{-# INLINE utcTimeFromDayAndTimeOfDay #-}+utcTimeFromDayAndTimeOfDay :: Day -> TimeOfDay -> TimeZone -> UTCTime+utcTimeFromDayAndTimeOfDay day tod tz =+  zonedTimeToUTC (zonedTime day tod tz)++{-# INLINE utcTimeFromComponents #-}+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) 

@@ -0,0 +1,332 @@+module Attoparsec.Time.Text+(+  timeOfDayInISO8601,+  dayInISO8601,+  timeZoneInISO8601,+  utcTimeInISO8601,+  diffTime,+  nominalDiffTime,+)+where++import Attoparsec.Time.Prelude hiding (take, takeWhile)+import Data.Attoparsec.Text+import qualified Attoparsec.Time.Pure as A+import qualified Attoparsec.Time.Validation as B+import qualified Data.Text as C+++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 =+  anyChar >>= \case+    '+' -> return True+    '-' -> return False+    _ -> empty++decimalChar :: Parser Int+decimalChar =+  satisfyWith ((subtract 48) . ord) ((&&) <$> (>= 0) <*> (<= 9))++decimalOfLength :: Num a => Int -> Parser a+decimalOfLength length =+  foldl' (\a b -> a * 10 + b) 0 <$>+  replicateM length (fmap fromIntegral decimalChar) <|>+  fail "Invalid decimal length"++shortMonth :: Parser Int+shortMonth =+  liftM C.toLower (take 3) >>= \case+    "jan" -> return 1+    "feb" -> return 2+    "mar" -> return 3+    "apr" -> return 4+    "may" -> return 5+    "jun" -> return 6+    "jul" -> return 7+    "aug" -> return 8+    "sep" -> return 9+    "oct" -> return 10+    "nov" -> return 11+    "dec" -> return 12+    _ -> empty++picoWithBasisOfLength :: Int -> Parser Pico+picoWithBasisOfLength basisLength =+  (\a b -> MkFixed (foldl' (\a b -> a * 10 + fromIntegral b) 0 (a ++ b))) <$> beforePoint <*> afterPoint+  where+    resolution =+      12+    beforePoint =+      replicateM basisLength decimalChar+    afterPoint =+      padListFromRight 0 [] resolution <$> ((char '.' *> many decimalChar) <|> pure [])+      where+        padListFromRight padding accumulator length list =+          case length of+            0 -> reverse accumulator+            _ -> case list of+              head : tail -> padListFromRight padding (head : accumulator) (pred length) tail+              _ -> reverse accumulator ++ replicate length padding++{-# 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: Invalid decimal length"++>>> parseOnly timeOfDayInISO8601 "01:1:00"+Left "timeOfDayInISO8601 > minute: Failed reading: Invalid decimal length"+-}+{-# INLINE timeOfDayInISO8601 #-}+timeOfDayInISO8601 :: Parser TimeOfDay+timeOfDayInISO8601 =+  unnamedParser <?> "timeOfDayInISO8601"+  where+    unnamedParser =+      A.timeOfDay <$>+      (hour <* char ':') <*>+      (minute <* char ':') <*>+      (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+        char '-'+        month <- decimalOfLength 2+        char '-'+        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 =+          char 'Z' $> utc+        offset =+          A.timeZone <$> sign <*> decimalOfLength 2 <*> (char ':' *> 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+        char 'T'+        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++>>> parseOnly diffTime "10μs"+Right 0.00001s++>>> 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 <- 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++>>> parseOnly nominalDiffTime "10μs"+Right 0.00001s++>>> 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 <- scientific+        factor <- timeUnitFactor+        return (factor (realToFrac amount))++timeUnitFactor :: Fractional a => Parser (a -> a)+timeUnitFactor =+  takeWhile isAlpha >>= \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)

@@ -0,0 +1,43 @@+module Attoparsec.Time.Validation where++import Attoparsec.Time.Prelude+++data Validator a =+  Validator String (a -> Bool)++run :: Show a => Validator a -> b -> (String -> b) -> a -> b+run (Validator name predicate) onNoError onError input =+  if predicate input+    then+      onNoError+    else+      onError $+      showString "Validator " $+      shows name $+      showString " failed on the following input: " $+      show input++month :: (Num a, Ord a) => Validator a+month =+  Validator "month" (liftA2 (&&) (>= 1) (<= 12))++monthDay :: (Num a, Ord a) => Validator a+monthDay =+  Validator "monthDay" (liftA2 (&&) (>= 1) (<= 31))++weekDay :: (Num a, Ord a) => Validator a+weekDay =+  Validator "weekDay" (liftA2 (&&) (>= 1) (<= 7))++hour :: (Num a, Ord a) => Validator a+hour =+  Validator "hour" (liftA2 (&&) (>= 0) (< 24))++minute :: (Num a, Ord a) => Validator a+minute =+  Validator "minute" (liftA2 (&&) (>= 0) (< 60))++second :: (Num a, Ord a) => Validator a+second =+  Validator "second" (liftA2 (&&) (>= 0) (< 60))

@@ -1,43 +0,0 @@-module Attoparsec.Time.Validators where--import Attoparsec.Time.Prelude---data Validator a =-  Validator String (a -> Bool)--run :: Show a => Validator a -> b -> (String -> b) -> a -> b-run (Validator name predicate) onNoError onError input =-  if predicate input-    then-      onNoError-    else-      onError $-      showString "Validator " $-      shows name $-      showString " failed on the following input: " $-      show input--month :: (Num a, Ord a) => Validator a-month =-  Validator "month" (liftA2 (&&) (>= 1) (<= 12))--monthDay :: (Num a, Ord a) => Validator a-monthDay =-  Validator "monthDay" (liftA2 (&&) (>= 1) (<= 31))--weekDay :: (Num a, Ord a) => Validator a-weekDay =-  Validator "weekDay" (liftA2 (&&) (>= 1) (<= 7))--hour :: (Num a, Ord a) => Validator a-hour =-  Validator "hour" (liftA2 (&&) (>= 0) (< 24))--minute :: (Num a, Ord a) => Validator a-minute =-  Validator "minute" (liftA2 (&&) (>= 0) (< 60))--second :: (Num a, Ord a) => Validator a-second =-  Validator "second" (liftA2 (&&) (>= 0) (< 60))