aeson-filthy 0.1.2 → 0.1.3

raw patch · 2 files changed

+76/−1 lines, 2 filesdep +timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: time

API changes (from Hackage documentation)

Files

• aeson-filthy.cabal +3/−1
• src/Data/Aeson/Filthy.hs +73/−0

@@ -1,5 +1,5 @@ name:                aeson-filthy-version:             0.1.2+version:             0.1.3 homepage:            https://github.com/deviant-logic/aeson-filthy bug-reports:         https://github.com/deviant-logic/aeson-filthy/issues license:             BSD3@@ -20,6 +20,7 @@                      , aeson                      , bytestring                      , text+                     , time                      , unordered-containers   if impl(ghc < 8.0)     build-depends:     semigroups@@ -36,6 +37,7 @@                      , aeson                      , bytestring                      , text+                     , time                      , unordered-containers   if impl(ghc < 8.0)     build-depends:     semigroups

@@ -24,6 +24,9 @@      , EmptyAsNothing(..) +    -- * Time+    , RFC2822Time(..)+     -- * Case Insensitive Keys      , (.:~)@@ -39,11 +42,13 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.HashMap.Lazy    as HM import           Data.Ix              (Ix)+import           Data.Monoid import           Data.Semigroup       (Semigroup) import           Data.String          (IsString) import           Data.Text            (Text) import qualified Data.Text            as T import qualified Data.Text.Encoding   as T+import           Data.Time import           Foreign.Storable     (Storable) import           GHC.Generics         (Generic, Generic1) @@ -178,6 +183,74 @@     parseJSON "" = pure $ EmptyAsNothing Nothing     parseJSON x  = EmptyAsNothing <$> parseJSON x +-- | A RFC 2822 encoded time value, allowing the modern RFC 2822 format.+-- These parsers do not currently handle the more messy whitespace and comments+-- allowed by the RFC.+--+-- The primary use for this if JSON APIs that dump JS datetimes as strings into the JSON.+--+-- Encoding follows the modern RFC 2822 recomended format:+--+-- >>> encode (RFC2822Time (read "2011-10-13 18:02:00 UTC"))+-- "\"Thu, 13 Oct 2011 18:02:00 +0000\""+--+-- Decoding though must be far more liberal:+--+-- >>> decode "\"Thu, 13 Oct 2011 18:02:00 GMT\"" :: Maybe RFC2822Time+-- Just (RFC2822Time {fromRFC2822Time = 2011-10-13 18:02:00 UTC})+-- >>> decode "\"Fri, 21 Nov 1997 09:55:06 -0600\"" :: Maybe RFC2822Time+-- Just (RFC2822Time {fromRFC2822Time = 1997-11-21 15:55:06 UTC})+-- >>> decode "\"Tue, 1 Jul 2003 10:52:37 +0200\"" :: Maybe RFC2822Time+-- Just (RFC2822Time {fromRFC2822Time = 2003-07-01 08:52:37 UTC})+-- >>> decode "\"Thu, 13 Feb 1969 23:32:54 -0330\"" :: Maybe RFC2822Time+-- Just (RFC2822Time {fromRFC2822Time = 1969-02-14 03:02:54 UTC})+--+-- RFC 822 obsolete dates:+--+-- >>> decode "\"21 Nov 97 09:55:06 GMT\"" :: Maybe RFC2822Time+-- Just (RFC2822Time {fromRFC2822Time = 0097-11-21 09:55:06 UTC})+--+-- Things that should parse but don't:+--+-- decode "\"Thu,\n      13\n        Feb\n          1969\n      23:32\n               -0330 (Newfoundland Time)\"" :: Maybe RFC2822Time+--+-- Just (RFC2822Time {fromRFC2822Time = 1969-02-14 03:02:00 UTC})+--+-- decode "\"Fri, 21 Nov 1997 09(comment):   55  :  06 -0600\"" :: Maybe RFC2822Time+--+-- Just (RFC2822Time {fromRFC2822Time = 1997-11-21 15:55:06 UTC})+newtype RFC2822Time+ = RFC2822Time { fromRFC2822Time :: UTCTime }+ deriving (Show, Eq, Ord, FormatTime)++instance FromJSON RFC2822Time where+  parseJSON = withText "RFC2822Time" $ \t ->+              -- Since RFC 2822 allows folding and optional whitespace, all whitespace is optional.+              -- Thus, to reduce the options, we parse the time stripped of whitespace.+              -- This allows some whitespace in places it isn't allowed. Also the RFC definition of+              -- whitespace is more permissive then spaces and newlines.+              let ts = T.unpack . T.replace " " "" . T.replace "\n" "" $ t+              in case getFirst . foldMap (\f -> parseTimeM True defaultTimeLocale f ts) $ (+                 do -- Generate the allows RFC2822 time format following its ABNF.+                   -- The day of week is optional+                   dow  <- ["", "%a,"]+                   date <- ["%e%b%Y", "%e%b%y"]+                   time <- ["%H:%M:%S", "%H:%M"]+                   zone <- ["%Z"]+                   pure (mconcat [dow, date, time, zone])) of+                        Just d -> pure (RFC2822Time d)+                        _      -> fail "could not parse RFC2822 format time"+  {-# INLINE parseJSON #-}++instance ToJSON RFC2822Time where+  toJSON = toJSON . rfc2822Time+  toEncoding = toEncoding . rfc2822Time++rfc2822Format :: String+rfc2822Format = "%a, %e %b %Y %T %z"++rfc2822Time :: RFC2822Time -> String+rfc2822Time = formatTime defaultTimeLocale rfc2822Format  -- | Some systems attempt to treat keys in JSON objects case-insensitively(ish).  Golang's JSON --   marshalling is a prominent example: <https://golang.org/pkg/encoding/json/#Marshal>. The