composite-aeson 0.4.1.0 → 0.4.2.0

raw patch · 7 files changed

+89/−9 lines, 7 filesdep +mmorphdep +mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: mmorph, mtl

API changes (from Hackage documentation)

Files

• composite-aeson.cabal +8/−1
• src/Composite/Aeson/Base.hs +43/−2
• src/Composite/Aeson/Enum.hs +3/−1
• src/Composite/Aeson/Formats/DateTime.hs +5/−2
• src/Composite/Aeson/Formats/Generic.hs +5/−2
• test/EnumSpec.hs +23/−0
• test/Main.hs +2/−1

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           composite-aeson-version:        0.4.1.0+version:        0.4.2.0 synopsis:       JSON for Vinyl/Frames records description:    Integration between Aeson and Vinyl/Frames records allowing records to be easily converted to JSON using automatic derivation, explicit formats, or a mix of both. category:       Records@@ -22,6 +22,7 @@   ghc-options: -Wall -O2   build-depends:       base >= 4.7 && < 5+    , mtl     , aeson     , aeson-better-errors     , composite-base@@ -30,6 +31,8 @@     , generic-deriving     , hashable     , lens+    , mmorph+    , mtl     , profunctors     , scientific     , tagged@@ -63,6 +66,7 @@   ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N -fno-warn-orphans   build-depends:       base >= 4.7 && < 5+    , mtl     , aeson     , aeson-better-errors     , composite-base@@ -71,6 +75,8 @@     , generic-deriving     , hashable     , lens+    , mmorph+    , mtl     , profunctors     , scientific     , tagged@@ -85,6 +91,7 @@     , composite-aeson     , hspec   other-modules:+      EnumSpec       RecordSpec       TupleSpec   default-language: Haskell2010

@@ -1,14 +1,17 @@ module Composite.Aeson.Base   ( ToJson(..), FromJson(..), JsonProfunctor(..), _JsonProfunctor, JsonFormat(..)   , toJsonWithFormat, fromJsonWithFormat, parseJsonWithFormat, parseJsonWithFormat'-  , dimapJsonFormat, jsonFormatWithIso, wrappedJsonFormat+  , dimapJsonFormat, jsonFormatWithIso, wrapJsonFormat, jsonFormatWithoutCustomError, wrappedJsonFormat   ) where -import Control.Lens (AnIso', Iso, Wrapped(type Unwrapped), _Wrapped', _Wrapped, iso, over, withIso)+import Control.Lens (AnIso', Iso, _2, Wrapped(type Unwrapped), _Wrapped', _Wrapped, iso, over, withIso) import Control.Lens.TH (makeWrapped)+import Control.Monad.Except (withExceptT)+import Control.Monad.Morph (hoist) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.Aeson.BetterErrors as ABE+import qualified Data.Aeson.BetterErrors.Internal as ABEI import Data.Functor.Contravariant (Contravariant, contramap) import Data.Profunctor (Profunctor(dimap)) import Data.Text (Text)@@ -83,6 +86,44 @@ -- |Wrap a 'JsonFormat' for type @a@ in a pair of functions representing an isomorphism between @a@ and @b@ to produce a new @JsonFormat@ for @b@. dimapJsonFormat :: (b -> a) -> (a -> b) -> JsonFormat e a -> JsonFormat e b dimapJsonFormat f g = over _Wrapped (dimap f g)++-- |Given a @'JsonFormat' e a@ and a pair of functions @b -> a@ and @a -> Either e b@, produce a @'JsonFormat' e b@.+--+-- This is for the common case of a @newtype@ wrapper which asserts some kind of validation has been done, e.g.:+--+-- @+--   newtype MyType = MyType { unMyType :: Int }+--+--   mkMyType :: Int -> Either Text MyType+--   mkMyType i | i <= 0    = Left "must be positive!"+--              | otherwise = Right (MyType i)+--+--   myTypeJsonFormat :: JsonFormat e MyType+--   myTypeJsonFormat = wrapJsonFormat intJsonFormat mkMyType unMyType+-- @+wrapJsonFormat :: JsonFormat e a -> (a -> Either e b) -> (b -> a) -> JsonFormat e b+wrapJsonFormat (JsonFormat (JsonProfunctor oa ia)) ab ba = JsonFormat (JsonProfunctor ob ib)+  where+    ob = oa . ba+    ib = either ABE.throwCustomError pure . ab =<< ia++-- |Take a 'JsonFormat' which produces some 'Show'-able custom error and convert any custom errors into Aeson 'fail' style errors. Since the custom errors+-- are never generated by the resulting 'JsonFormat', any custom error type can be assumed.+--+-- This is commonly used to take a more specific @'JsonFormat' MyError MyType@ and make it a more generic @'JsonFormat' e MyType@, e.g. to be used as a +-- 'Composite.Aeson.Default.defaultJsonFormat'.+jsonFormatWithoutCustomError :: Show e => JsonFormat e a -> JsonFormat e' a+jsonFormatWithoutCustomError =+  over (_Wrapped . _JsonProfunctor . _2 . _Wrapped) $+    ABEI.mapParseT $ hoist $ withExceptT $ \ case+        ABEI.BadSchema pos (ABEI.KeyMissing k)       -> ABEI.BadSchema pos (ABEI.KeyMissing k)+        ABEI.BadSchema pos (ABEI.OutOfBounds i)      -> ABEI.BadSchema pos (ABEI.OutOfBounds i)+        ABEI.BadSchema pos (ABEI.WrongType t v)      -> ABEI.BadSchema pos (ABEI.WrongType t v)+        ABEI.BadSchema pos (ABEI.ExpectedIntegral d) -> ABEI.BadSchema pos (ABEI.ExpectedIntegral d)+        ABEI.BadSchema pos (ABEI.FromAeson e)        -> ABEI.BadSchema pos (ABEI.FromAeson e)+        ABEI.BadSchema pos (ABEI.CustomError e)      -> ABEI.BadSchema pos (ABEI.FromAeson (show e))++        ABEI.InvalidJSON msg -> ABEI.InvalidJSON msg  -- |Wrap a 'JsonFormat' for type @a@ in an isomorphism to produce a new @JsonFormat@ for @b@. jsonFormatWithIso :: AnIso' b a -> JsonFormat e a -> JsonFormat e b

@@ -1,5 +1,6 @@ module Composite.Aeson.Enum where +import Control.Monad.Error.Class (throwError) import Composite.Aeson.Base (JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.BetterErrors as ABE@@ -48,6 +49,7 @@     fromJson = do       t <- ABE.asText       case lookupText t of-        Nothing -> fail $ "expected " ++ expectedText ++ ", not " ++ unpack t+        Nothing -> throwError $ ABE.BadSchema [] $ ABE.FromAeson $+                     "expected " ++ expectedText ++ ", not " ++ unpack t         Just v  -> pure v   

@@ -7,6 +7,8 @@ import Composite.Aeson.Base (JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor)) import Composite.Aeson.DateTimeFormatUtils (fixupTzIn, fixupTzOut, fixupMs) import Composite.Aeson.Formats.Provided (stringJsonFormat)+import Control.Monad.Error.Class (throwError)+import qualified Data.Aeson.BetterErrors as ABE import Data.Either (partitionEithers) import Data.Monoid ((<>)) import Data.List (intercalate)@@ -46,11 +48,12 @@         (_, a : _) ->           pure a         (es, _) | null otherInFormats ->-          fail $ "expected date/time string formatted as " <> dateTimeFormatExample outFormat <> ", but: " <> intercalate ", " es+          toss $ "expected date/time string formatted as " <> dateTimeFormatExample outFormat <> ", but: " <> intercalate ", " es         (es, _) ->-          fail $ "expected date/time string formatted as one of "+          toss $ "expected date/time string formatted as one of "               <> intercalate ", " (map dateTimeFormatExample formatsList)               <> ", but: " <> intercalate ", " es+    toss = throwError . ABE.BadSchema [] . ABE.FromAeson  -- |ISO8601 extended date format (@yyyy-mm-dd@). iso8601DateJsonFormat :: JsonFormat e Day

@@ -6,6 +6,7 @@ import Composite.Aeson.Base (JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor), FromJson(FromJson)) import Control.Arrow (second) import Control.Lens (_Wrapped, over, unsnoc)+import Control.Monad.Error.Class (throwError) import Data.Aeson (FromJSON, ToJSON, (.=), toJSON) import qualified Data.Aeson as Aeson import qualified Data.Aeson.BetterErrors as ABE@@ -185,7 +186,8 @@       t <- ABE.key typeField ABE.asText       case lookup t (NEL.toList iAs) of         Just (FromJson iA) -> ABE.key valueField iA-        Nothing -> fail $ "expected " <> unpack typeField <> " to be one of " <> expected+        Nothing -> toss $ "expected " <> unpack typeField <> " to be one of " <> expected+    toss = throwError . ABE.BadSchema [] . ABE.FromAeson  -- |'JsonFormat' which maps sum types to JSON in the 'SumStyleMergeType' style. jsonMergeTypeSumFormat :: Text -> (a -> (Text, Aeson.Value)) -> NonEmpty (Text, FromJson e a) -> JsonFormat e a@@ -206,4 +208,5 @@       t <- ABE.key typeField ABE.asText       case lookup t (NEL.toList iAs) of         Just (FromJson iA) -> iA-        Nothing -> fail $ "expected " <> unpack typeField <> " to be one of " <> expected+        Nothing -> toss $ "expected " <> unpack typeField <> " to be one of " <> expected+    toss = throwError . ABE.BadSchema [] . ABE.FromAeson

@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveGeneric #-}+module EnumSpec where++import Data.Void (Void)+import Data.Aeson (Value(String))+import GHC.Generics (Generic)+import Composite.Aeson.Base (JsonFormat, fromJsonWithFormat)+import Composite.Aeson.Enum (enumJsonFormat)+import qualified Data.Aeson.BetterErrors as ABE+import Test.Hspec (Spec, describe, it, shouldBe)++data TestEnum = A | B deriving (Show, Eq, Ord, Generic)++testEnumFormat :: JsonFormat Void TestEnum+testEnumFormat = enumJsonFormat ""++enumSuite :: Spec+enumSuite =+  describe "enumJsonFormat" $+    describe "when input value does not match any of enum constructors" $+      it "should return a parse error, not throw an exception" $+        ABE.parseValue (fromJsonWithFormat testEnumFormat) (String "C")+          `shouldBe` Left (ABE.BadSchema [] (ABE.FromAeson "expected one of A, B, not C"))

@@ -1,9 +1,10 @@ import RecordSpec (recordSuite) import TupleSpec (tupleSuite)+import EnumSpec (enumSuite) import Test.Hspec (hspec)  main :: IO () main = hspec $ do   recordSuite   tupleSuite-+  enumSuite