diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} + module Main (main) where #ifndef MIN_VERSION_cabal_doctest diff --git a/attoparsec-time.cabal b/attoparsec-time.cabal --- a/attoparsec-time.cabal +++ b/attoparsec-time.cabal @@ -1,36 +1,74 @@ -name: attoparsec-time -version: 1.0.3 -synopsis: Attoparsec parsers of time -description: A collection of Attoparsec parsers for the \"time\" library -category: Attoparsec, Parsers, Time -homepage: https://github.com/nikita-volkov/attoparsec-time -bug-reports: https://github.com/nikita-volkov/attoparsec-time/issues -author: Nikita Volkov -maintainer: Nikita Volkov -copyright: (c) 2017, Nikita Volkov -license: MIT -license-file: LICENSE -build-type: Simple -cabal-version: >=1.10 +cabal-version: 3.0 +name: attoparsec-time +version: 1.0.3.1 +synopsis: Attoparsec parsers of time +description: A collection of Attoparsec parsers for the \"time\" library +category: Attoparsec, Parsers, Time +homepage: https://github.com/nikita-volkov/attoparsec-time +bug-reports: https://github.com/nikita-volkov/attoparsec-time/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2017, Nikita Volkov +license: MIT +license-file: LICENSE source-repository head - type: git + type: git location: git://github.com/nikita-volkov/attoparsec-time.git library - hs-source-dirs: library - default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: Haskell2010 + hs-source-dirs: library + default-language: Haskell2010 + default-extensions: + NoImplicitPrelude + NoMonomorphismRestriction + Arrows + BangPatterns + ConstraintKinds + DataKinds + DefaultSignatures + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + EmptyDataDecls + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + LambdaCase + LiberalTypeSynonyms + MagicHash + MultiParamTypeClasses + MultiWayIf + OverloadedStrings + ParallelListComp + PatternGuards + QuasiQuotes + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TemplateHaskell + TupleSections + TypeFamilies + TypeOperators + UnboxedTuples + exposed-modules: Attoparsec.Time.ByteString Attoparsec.Time.Text + other-modules: Attoparsec.Time.Prelude - Attoparsec.Time.Validation Attoparsec.Time.Pure + Attoparsec.Time.Validation + build-depends: - attoparsec >=0.13 && <0.15, - base >=4.9 && <5, - bytestring >=0.10 && <0.12, - text >=1 && <3, - time >=1.4 && <2 + , attoparsec >=0.13 && <0.15 + , base >=4.9 && <5 + , bytestring >=0.10 && <0.13 + , text >=1 && <3 + , time >=1.4 && <2 diff --git a/library/Attoparsec/Time/ByteString.hs b/library/Attoparsec/Time/ByteString.hs --- a/library/Attoparsec/Time/ByteString.hs +++ b/library/Attoparsec/Time/ByteString.hs @@ -1,31 +1,27 @@ -{-| -ASCII ByteString Parsers. --} +-- | +-- ASCII ByteString Parsers. module Attoparsec.Time.ByteString -( - timeOfDayInISO8601, - dayInISO8601, - yearAndMonthInISO8601, - timeZoneInISO8601, - utcTimeInISO8601, - diffTime, - nominalDiffTime, - -- * - hour, - minute, - second, -) + ( timeOfDayInISO8601, + dayInISO8601, + yearAndMonthInISO8601, + timeZoneInISO8601, + utcTimeInISO8601, + diffTime, + nominalDiffTime, + hour, + minute, + second, + ) 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 Data.Attoparsec.ByteString import qualified Data.Attoparsec.ByteString.Char8 as D - +import qualified Data.ByteString as C -validated :: Show a => B.Validator a -> Parser a -> Parser a +validated :: (Show a) => B.Validator a -> Parser a -> Parser a validated validator parser = parser >>= \x -> B.run validator (pure x) fail x @@ -36,7 +32,7 @@ 45 -> return False _ -> empty -decimalOfLength :: Integral a => Int -> Parser a +decimalOfLength :: (Integral a) => Int -> Parser a decimalOfLength length = do bytes <- take length @@ -54,16 +50,15 @@ 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 + 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 @@ -80,60 +75,58 @@ 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" --} +-- | +-- >>> 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)" + A.timeOfDay + <$> (hour <* word8 58) + <*> (minute <* word8 58) + <*> (second) ->>> parseOnly dayInISO8601 "2016-02-29" -Right 2016-02-29 --} +-- | +-- >>> 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 = @@ -151,13 +144,12 @@ Nothing -> fail (error year month day) where error year month day = - showString "Invalid combination of year month and day: " $ - show (year, month, day) + showString "Invalid combination of year month and day: " + $ show (year, month, day) -{-| ->>> parseOnly yearAndMonthInISO8601 "2016-02" -Right (2016,2) --} +-- | +-- >>> parseOnly yearAndMonthInISO8601 "2016-02" +-- Right (2016,2) yearAndMonthInISO8601 :: Parser (Word, Word) yearAndMonthInISO8601 = unnamedParser "yearAndMonthInISO8601" @@ -169,19 +161,18 @@ month <- decimalOfLength 2 return (year, month) -{-| ->>> parseOnly timeZoneInISO8601 "+01:00" -Right +0100 - ->>> parseOnly timeZoneInISO8601 "+0100" -Right +0100 - ->>> parseOnly timeZoneInISO8601 "-0100" -Right -0100 - ->>> parseOnly timeZoneInISO8601 "Z" -Right UTC --} +-- | +-- >>> 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" @@ -194,10 +185,9 @@ 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 --} +-- | +-- >>> parseOnly utcTimeInISO8601 "2017-02-01T05:03:58+01:00" +-- Right 2017-02-01 04:03:58 UTC utcTimeInISO8601 :: Parser UTCTime utcTimeInISO8601 = unnamedParser "utcTimeInISO8601" @@ -210,52 +200,51 @@ 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\"" --} +-- | +-- 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" @@ -266,52 +255,51 @@ 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\"" --} +-- | +-- 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" @@ -322,7 +310,7 @@ factor <- timeUnitFactor return (factor (realToFrac amount)) -timeUnitFactor :: Fractional a => Parser (a -> a) +timeUnitFactor :: (Fractional a) => Parser (a -> a) timeUnitFactor = takeWhile A.word8IsAsciiAlpha >>= \case "" -> return id diff --git a/library/Attoparsec/Time/Prelude.hs b/library/Attoparsec/Time/Prelude.hs --- a/library/Attoparsec/Time/Prelude.hs +++ b/library/Attoparsec/Time/Prelude.hs @@ -1,20 +1,17 @@ module Attoparsec.Time.Prelude -( - module Exports, -) + ( module Exports, + ) where --- base -------------------------- import Control.Applicative as Exports import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports -import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM) -import Control.Monad.IO.Class as Exports +import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix) +import Control.Monad.IO.Class as Exports import Control.Monad.ST as Exports import Data.Bits as Exports import Data.Bool as Exports @@ -27,13 +24,13 @@ import Data.Fixed as Exports import Data.Foldable as Exports import Data.Function as Exports hiding (id, (.)) -import Data.Functor as Exports +import Data.Functor as Exports hiding (unzip) import Data.Functor.Compose as Exports -import Data.Int as Exports import Data.IORef as Exports +import Data.Int as Exports import Data.Ix as Exports hiding (index) -import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') -import Data.List.NonEmpty as Exports (NonEmpty(..)) +import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons) +import Data.List.NonEmpty as Exports (NonEmpty (..)) import Data.Maybe as Exports import Data.Monoid as Exports hiding (Alt) import Data.Ord as Exports @@ -41,6 +38,8 @@ import Data.Ratio as Exports import Data.STRef as Exports import Data.String as Exports +import Data.Text as Exports (Text) +import Data.Time as Exports import Data.Traversable as Exports import Data.Tuple as Exports import Data.Unique as Exports @@ -52,12 +51,11 @@ import Foreign.Ptr as Exports import Foreign.StablePtr as Exports import Foreign.Storable as Exports -import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead) -import GHC.Exts as Exports (sortWith, groupWith) +import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar) +import GHC.Exts as Exports (groupWith, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import Numeric as Exports -import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose) @@ -66,16 +64,7 @@ import System.Mem as Exports import System.Mem.StableName as Exports import System.Timeout as Exports -import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P) -import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec) -import Text.Printf as Exports (printf, hPrintf) -import Text.Read as Exports (Read(..), readMaybe, readEither) +import Text.Printf as Exports (hPrintf, printf) +import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports - --- text -------------------------- -import Data.Text as Exports (Text) - --- time -------------------------- -import Data.Time as Exports +import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) diff --git a/library/Attoparsec/Time/Pure.hs b/library/Attoparsec/Time/Pure.hs --- a/library/Attoparsec/Time/Pure.hs +++ b/library/Attoparsec/Time/Pure.hs @@ -3,13 +3,14 @@ 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 + minutesToTimeZone + $ bool negate id positive + $ hour + * 60 + + minute {-# INLINE day #-} day :: Int -> Int -> Int -> Day @@ -37,7 +38,7 @@ undefined {-# INLINE decimalFromBytes #-} -decimalFromBytes :: Integral decimal => A.ByteString -> decimal +decimalFromBytes :: (Integral decimal) => A.ByteString -> decimal decimalFromBytes = A.foldl' step 0 where @@ -52,4 +53,4 @@ {-# INLINE word8IsAsciiAlpha #-} word8IsAsciiAlpha :: Word8 -> Bool word8IsAsciiAlpha x = - (x - 97 <= 25) || (x - 65 <= 25) + (x - 97 <= 25) || (x - 65 <= 25) diff --git a/library/Attoparsec/Time/Text.hs b/library/Attoparsec/Time/Text.hs --- a/library/Attoparsec/Time/Text.hs +++ b/library/Attoparsec/Time/Text.hs @@ -1,29 +1,28 @@ +{-# OPTIONS_GHC -Wno-unused-top-binds #-} + module Attoparsec.Time.Text -( - timeOfDayInISO8601, - timeOfDayInDashes, - dayInISO8601, - yearAndMonthInISO8601, - timeZoneInISO8601, - utcTimeInISO8601, - utcTimeInDashes, - diffTime, - nominalDiffTime, - -- * - hour, - minute, - second, -) + ( timeOfDayInISO8601, + timeOfDayInDashes, + dayInISO8601, + yearAndMonthInISO8601, + timeZoneInISO8601, + utcTimeInISO8601, + utcTimeInDashes, + diffTime, + nominalDiffTime, + hour, + minute, + second, + ) 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 Data.Attoparsec.Text import qualified Data.Text as C - -validated :: Show a => B.Validator a -> Parser a -> Parser a +validated :: (Show a) => B.Validator a -> Parser a -> Parser a validated validator parser = parser >>= \x -> B.run validator (pure x) fail x @@ -38,11 +37,11 @@ decimalChar = satisfyWith ((subtract 48) . ord) ((&&) <$> (>= 0) <*> (<= 9)) -decimalOfLength :: Num a => Int -> Parser a +decimalOfLength :: (Num a) => Int -> Parser a decimalOfLength length = - foldl' (\a b -> a * 10 + b) 0 <$> - replicateM length (fmap fromIntegral decimalChar) <|> - fail "Invalid decimal length" + foldl' (\a b -> a * 10 + b) 0 + <$> replicateM length (fmap fromIntegral decimalChar) + <|> fail "Invalid decimal length" shortMonth :: Parser Int shortMonth = @@ -94,42 +93,41 @@ 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" --} +-- | +-- >>> 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) + A.timeOfDay + <$> (hour <* char ':') + <*> (minute <* char ':') + <*> (second) {-# INLINE timeOfDayInDashes #-} timeOfDayInDashes :: Parser TimeOfDay @@ -137,28 +135,27 @@ unnamedParser "timeOfDayInDashes" 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)" + A.timeOfDay + <$> (hour <* char '-') + <*> (minute <* char '-') + <*> (second) ->>> parseOnly dayInISO8601 "2016-02-29" -Right 2016-02-29 --} +-- | +-- >>> 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 = @@ -176,13 +173,12 @@ Nothing -> fail (error year month day) where error year month day = - showString "Invalid combination of year month and day: " $ - show (year, month, day) + showString "Invalid combination of year month and day: " + $ show (year, month, day) -{-| ->>> parseOnly yearAndMonthInISO8601 "2016-02" -Right (2016,2) --} +-- | +-- >>> parseOnly yearAndMonthInISO8601 "2016-02" +-- Right (2016,2) yearAndMonthInISO8601 :: Parser (Word, Word) yearAndMonthInISO8601 = unnamedParser "yearAndMonthInISO8601" @@ -194,19 +190,18 @@ month <- decimalOfLength 2 return (year, month) -{-| ->>> parseOnly timeZoneInISO8601 "+01:00" -Right +0100 - ->>> parseOnly timeZoneInISO8601 "+0100" -Right +0100 - ->>> parseOnly timeZoneInISO8601 "-0100" -Right -0100 - ->>> parseOnly timeZoneInISO8601 "Z" -Right UTC --} +-- | +-- >>> 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" @@ -219,10 +214,9 @@ 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 --} +-- | +-- >>> parseOnly utcTimeInISO8601 "2017-02-01T05:03:58+01:00" +-- Right 2017-02-01 04:03:58 UTC utcTimeInISO8601 :: Parser UTCTime utcTimeInISO8601 = unnamedParser "utcTimeInISO8601" @@ -235,10 +229,9 @@ zone <- timeZoneInISO8601 return (A.utcTimeFromDayAndTimeOfDay day time zone) -{-| ->>> parseOnly utcTimeInDashes "2017-02-01-05-03-58" -Right 2017-02-01 05:03:58 UTC --} +-- | +-- >>> parseOnly utcTimeInDashes "2017-02-01-05-03-58" +-- Right 2017-02-01 05:03:58 UTC utcTimeInDashes :: Parser UTCTime utcTimeInDashes = unnamedParser "utcTimeInDashes" @@ -250,53 +243,52 @@ time <- timeOfDayInDashes return (localTimeToUTC utc (LocalTime day time)) -{-| -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\"" --} +-- | +-- 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" @@ -307,53 +299,52 @@ 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\"" --} +-- | +-- 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" @@ -364,7 +355,7 @@ factor <- timeUnitFactor return (factor (realToFrac amount)) -timeUnitFactor :: Fractional a => Parser (a -> a) +timeUnitFactor :: (Fractional a) => Parser (a -> a) timeUnitFactor = takeWhile isAlpha >>= \case "" -> return id diff --git a/library/Attoparsec/Time/Validation.hs b/library/Attoparsec/Time/Validation.hs --- a/library/Attoparsec/Time/Validation.hs +++ b/library/Attoparsec/Time/Validation.hs @@ -2,21 +2,19 @@ import Attoparsec.Time.Prelude - -data Validator a = - Validator String (a -> Bool) +data Validator a + = Validator String (a -> Bool) -run :: Show a => Validator a -> b -> (String -> b) -> a -> b +run :: (Show a) => Validator a -> b -> (String -> b) -> a -> b run (Validator name predicate) onNoError onError input = if predicate input - then - onNoError + then onNoError else - onError $ - showString "Validator " $ - shows name $ - showString " failed on the following input: " $ - show input + onError + $ showString "Validator " + $ shows name + $ showString " failed on the following input: " + $ show input month :: (Num a, Ord a) => Validator a month =