diff options
author | koral <> | 2020-11-21 22:08:00 (GMT) |
---|---|---|
committer | hdiff <hdiff@hdiff.luite.com> | 2020-11-21 22:08:00 (GMT) |
commit | ad53da128bb4cbaa409567d9eb82e8946988377d (patch) | |
tree | 370a1d8a40c755dfa25bd7202768851b43a89d3e | |
parent | 725734c5d5ee702ace4781cc4e97d72030e24ba4 (diff) |
-rwxr-xr-x[-rw-r--r--] | CHANGES.md | 0 | ||||
-rw-r--r-- | Data/Time/RFC3339.hs | 8 | ||||
-rw-r--r-- | Data/Time/Util.hs | 7 | ||||
-rwxr-xr-x[-rw-r--r--] | README.md | 0 | ||||
-rw-r--r-- | test/Main.hs | 13 | ||||
-rw-r--r-- | timerep.cabal | 6 |
6 files changed, 24 insertions, 10 deletions
diff --git a/CHANGES.md b/CHANGES.md index 7d7e825..7d7e825 100644..100755 --- a/CHANGES.md +++ b/CHANGES.md diff --git a/Data/Time/RFC3339.hs b/Data/Time/RFC3339.hs index efba34e..d5cd7e0 100644 --- a/Data/Time/RFC3339.hs +++ b/Data/Time/RFC3339.hs @@ -32,7 +32,7 @@ module Data.Time.RFC3339 ( -- * Basic type class -- $basic - formatTimeRFC3339, parseTimeRFC3339 + formatTimeRFC3339, formatDateRFC3339, parseTimeRFC3339, parseDateRFC3339 ) where import Control.Applicative @@ -55,6 +55,9 @@ formatTimeRFC3339 zt@(ZonedTime lt z) = fromString (formatTime defaultTimeLocale then "Z" else take 3 timeZoneStr <> ":" <> drop 3 timeZoneStr +formatDateRFC3339 :: (TextualMonoid t, FormatTime time) => time -> t +formatDateRFC3339 day = fromString (formatTime defaultTimeLocale "%F" day) + formatsRFC3339 :: [Text] formatsRFC3339 = do fraction <- ["%Q", ""] @@ -63,3 +66,6 @@ formatsRFC3339 = do parseTimeRFC3339 :: (TextualMonoid t) => t -> Maybe ZonedTime parseTimeRFC3339 = parseTimeUsing formatsRFC3339 + +parseDateRFC3339 :: (TextualMonoid t) => t -> Maybe Day +parseDateRFC3339 = parseTimeUsing ["%F" :: Text] diff --git a/Data/Time/Util.hs b/Data/Time/Util.hs index 6f1f581..daef4a0 100644 --- a/Data/Time/Util.hs +++ b/Data/Time/Util.hs @@ -6,13 +6,12 @@ import Data.Function import Data.Monoid (mempty) import Data.Monoid.Textual hiding (foldr, map) import Data.Time -import Data.Time.Format (defaultTimeLocale) +import Data.Time.Format (ParseTime, defaultTimeLocale) toString' :: (TextualMonoid t) => t -> String toString' = toString (maybe "?" (:[]) . characterPrefix) -parseTimeUsing :: (TextualMonoid t, TextualMonoid t') => [t] -> t' -> Maybe ZonedTime +parseTimeUsing :: (TextualMonoid t, TextualMonoid t', ParseTime time) => [t] -> t' -> Maybe time parseTimeUsing formats t = foldr (<|>) Nothing $ map parse formats - where parse :: (TextualMonoid t) => t -> Maybe ZonedTime - parse format = parseTime defaultTimeLocale (toString' format) (toString' t) + where parse format = parseTimeM True defaultTimeLocale (toString' format) (toString' t) diff --git a/README.md b/README.md index 342ecb1..342ecb1 100644..100755 --- a/README.md +++ b/README.md diff --git a/test/Main.hs b/test/Main.hs index 5e1448f..aff4205 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -75,6 +75,10 @@ casesRFC3339 = testCase "RFC 3339 cases" $ do isJust (parseTimeRFC3339 "1990-12-31T23:59:60Z") @?= True isJust (parseTimeRFC3339 "1990-12-31T15:59:60-08:00") @?= True isJust (parseTimeRFC3339 "1937-01-01T12:00:27.87+00:20") @?= True + isJust (parseDateRFC3339 "1985-04-12") @?= True + isJust (parseDateRFC3339 "1996-12-19") @?= True + isJust (parseDateRFC3339 "1990-12-31") @?= True + isJust (parseDateRFC3339 "1937-01-01") @?= True casesRFC2822 = testCase "RFC 2822 cases" $ do isJust (parseTimeRFC2822 "Fri, 21 Nov 1997 09:55:06 -0600") @?= True isJust (parseTimeRFC2822 "Tue, 15 Nov 1994 12:45:26 GMT") @?= True @@ -100,14 +104,17 @@ casesRFC822 = testCase "RFC 822 cases" $ do properties :: TestTree properties = testGroup "Properties" - [ inverseRFC3339Property + [ inverseTimeRFC3339Property + , inverseDateRFC3339Property , inverseRFC2822Property , inverseRFC822Property ] -inverseRFC3339Property, inverseRFC2822Property, inverseRFC822Property :: TestTree -inverseRFC3339Property = testProperty "parse . format = id (RFC3339)" $ \zonedTime -> +inverseTimeRFC3339Property, inverseDateRFC3339Property, inverseRFC2822Property, inverseRFC822Property :: TestTree +inverseTimeRFC3339Property = testProperty "parse . format = id (RFC3339 date-time)" $ \zonedTime -> (fmap zonedTimeToUTC . parseTimeRFC3339 . asText . formatTimeRFC3339) zonedTime == Just (zonedTimeToUTC zonedTime) +inverseDateRFC3339Property = testProperty "parse . format = id (RFC3339 date)" $ \day -> + (parseDateRFC3339 . asText . formatDateRFC3339) day == Just day inverseRFC2822Property = testProperty "parse . format = id (RFC2822)" $ \zonedTime -> (fmap zonedTimeToUTC . parseTimeRFC2822 . asText . formatTimeRFC2822) zonedTime == Just (zonedTimeToUTC zonedTime) inverseRFC822Property = testProperty "parse . format = id (RFC822)" $ \zonedTime -> diff --git a/timerep.cabal b/timerep.cabal index 97b7a93..65a2835 100644 --- a/timerep.cabal +++ b/timerep.cabal @@ -1,5 +1,5 @@ name: timerep -version: 2.0.0.2 +version: 2.0.1.0 category: Web, Time, Parser, Text synopsis: Parse and display time according to some RFCs (RFC3339, RFC2822, RFC822) description: @@ -18,7 +18,7 @@ build-type: Simple maintainer: Hugo Daniel Gomes <mr.hugo.gomes@gmail.com> author: Hugo Daniel Gomes <mr.hugo.gomes@gmail.com> copyright: (c) 2010-2015 Hugo Daniel Gomes -cabal-version: >= 1.8 +cabal-version: >= 1.10 homepage: https://github.com/HugoDaniel/timerep bug-reports: https://github.com/HugoDaniel/timerep/issues license: BSD3 @@ -32,6 +32,7 @@ source-repository head location: git://github.com/HugoDaniel/timerep.git library + default-language: Haskell2010 build-depends: base < 5, monoid-subclasses >= 0.4.1, @@ -50,6 +51,7 @@ library ghc-options: -Wall test-suite Tests + default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs |