aeson-combinators 0.0.3.0 → 0.0.4.0

raw patch · 9 files changed

+662/−35 lines, 9 filesdep −semigroupsPVP ok

version bump matches the API change (PVP)

Dependencies removed: semigroups

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−3
• DocTest.hs +1/−0
• README.md +3/−9
• aeson-combinators.cabal +4/−12
• lib/Data/Aeson/Combinators/Decode.hs +5/−1
• lib/Data/Aeson/Combinators/Encode.hs +566/−0
• test/JSONDecodeSpec.hs +9/−9
• test/JSONEncodeSpec.hs +67/−0
• test/Spec.hs +4/−1

@@ -1,5 +1,8 @@ # Revision history for aeson-combinators +## 0.0.4.0 -- 2020-10-24+* `Encode` module for encoding+ ## 0.0.3.0 -- 2020-10-11 * Combinators for dealing with failure * `oneOf` function@@ -10,14 +13,11 @@ * Add README to extra source files  ## 0.0.2.0 -- 2020-03-08- * GHCJS compatibility  ## 0.0.1.1 -- 2020-03-01- * Fixes and improvements in documentation * Add source-repository to cabal file  ## 0.0.1.0 -- 2020-02-29- * First version. Released on an unsuspecting world.

@@ -2,4 +2,5 @@ main = doctest [ "-isrc"                , "-XOverloadedStrings"                , "lib/Data/Aeson/Combinators/Decode.hs"+               , "lib/Data/Aeson/Combinators/Encode.hs"                ]

@@ -7,7 +7,7 @@ [**Low overhead**](#internals) value space `Decoder` on top of Aeson's Parser for combinator style decoding. -This library is compatible with GHC **7.6** and later as well as recent versions of **GHCJS**.+This library is compatible with GHC as well as recent versions of **GHCJS**.  __Encoding to JSON is currently not supported but might be added in the future version.__ @@ -18,14 +18,8 @@  `Decoder a` type is a function `Value -> Parser a` the same as `fromJSON` member function of `FromJSON` class. This means there should be near zero overhead.-Aeson types and functions are reused where possible.--## TODO--- [x] Documentation-- [x] Support for more GHC versions-- [x] Default decoders for Containers-- [ ] Encoding API+Aeson types and functions are reused where possible. Similarly `Encoder a` type+follow `toJSON` from `ToJSON` type class.  ## License 

@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                aeson-combinators-version:             0.0.3.0+version:             0.0.4.0 synopsis:            Aeson combinators for dead simple JSON decoding description:     Low overhead value space `Decoder`@@ -18,10 +18,7 @@ extra-source-files:  README.md                    , CHANGELOG.md homepage:            https://github.com/turboMaCk/aeson-combinators-tested-with:         GHC == 7.10.3-                   , GHC == 7.8.4-                   , GHC == 7.6.3-                   , GHC == 8.4.4+tested-with:         GHC == 8.4.4                    , GHC == 8.6.5                    , GHC == 8.8.3                    , GHC == 8.10.1@@ -33,6 +30,7 @@  library   exposed-modules:     Data.Aeson.Combinators.Decode+                     , Data.Aeson.Combinators.Encode   -- other-modules:   -- other-extensions:   build-depends:       base >= 4 && < 5@@ -54,15 +52,13 @@   default-language:    Haskell2010   hs-source-dirs:      lib -  if impl(ghc <= 8.0)-      build-depends:     semigroups - test-suite spec     type:              exitcode-stdio-1.0     hs-source-dirs:    test     main-is:           Spec.hs     other-modules:     JSONDecodeSpec+                     , JSONEncodeSpec     build-depends:     base                      , hspec                      , aeson-combinators@@ -84,10 +80,6 @@     else         build-depends:    base                         , doctest--    if impl(ghc <= 8.0)-       -- Older version has problem with CPP macros-       buildable: False   source-repository head

@@ -528,7 +528,7 @@ {-# INLINE void #-}  --- | Decode JSON null into '()'+-- | Decode JSON null into @()@ unit :: Decoder () unit = auto {-# INLINE unit #-}@@ -757,12 +757,14 @@   Parser.decodeWith ParserI.jsonEOF' (parse d) {-# INLINE decode' #-} + -- | Like 'decode' but returns an error message when decoding fails. eitherDecode :: Decoder a -> LB.ByteString -> Either String a eitherDecode (Decoder d) =   eitherFormatError . Parser.eitherDecodeWith ParserI.jsonEOF (AI.iparse d) {-# INLINE eitherDecode #-} + -- | Like 'decode'' but returns an error message when decoding fails. eitherDecode' :: Decoder a -> LB.ByteString -> Either String a eitherDecode' (Decoder d) =@@ -802,11 +804,13 @@   Parser.decodeStrictWith ParserI.jsonEOF' (parse d) {-# INLINE decodeStrict' #-} + -- | Like 'decodeStrict' but returns an error message when decoding fails. eitherDecodeStrict :: Decoder a -> B.ByteString -> Either String a eitherDecodeStrict (Decoder d) =   eitherFormatError . Parser.eitherDecodeStrictWith ParserI.jsonEOF (AI.iparse d) {-# INLINE eitherDecodeStrict #-}+  -- | Like 'decodeStrict'' but returns an error message when decoding fails. eitherDecodeStrict' :: Decoder a -> B.ByteString -> Either String a

@@ -0,0 +1,566 @@+{-# LANGUAGE CPP #-}++-- |+-- Module      : Data.Aeson.Cominators.Encode+-- Copyright   : (c) Marek Fajkus+-- License     : BSD3+--+-- Maintainer  : marek.faj@gmail.com+--+-- Functions in this module serve as an alternative+-- 'ToJSON' type class. This allows to define for mapping+-- from data type into multiple JSON representations.+-- type level wrapping.+--+-- There are two way of defining such encoder:+--+--     * Using simple function @a -> Value@ which doesn't require this library+--     * Using this library as DSL together with 'Contravariant'+--+module Data.Aeson.Combinators.Encode (+-- * Importing+-- $importing++-- * Aleternative to using 'Encode' Combinators+-- $alternative++-- * Example Usage+-- $usage++-- * Encoder+    Encoder(..)+  , auto+  , run+-- * Object Encoding+-- $objects+  , KeyValueEncoder+  , object+  , field+-- ** Alternative Object Encoding+  , KeyValueEncoder'+  , object'+  , field'+-- * Collections+  , list+  , vector+  , jsonArray+-- * Encoding Primitive Values+--+-- *** Void, Unit, Bool+  , void+  , unit, bool+-- *** Integers (and Natural)+  , int, integer, int8, int16, int32, int64+  , word, word8, word16, word32, word64+#if (MIN_VERSION_base(4,8,0))+  , natural+#endif+-- *** Floating Points+  , float, double+  , scientific+-- *** Strings+  , char, text, string+  , uuid, version+-- * Encoding Time+  , zonedTime, localTime, timeOfDay+  , utcTime+  , day+#if (MIN_VERSION_time_compat(1,9,2))+  , dayOfWeek+#endif+  -- * Evaluating Encoders+  , encode+  , toEncoding+) where++import           Control.Applicative+import           Control.Monad              (join)+import           Data.Functor.Contravariant++import           Data.Aeson                 (ToJSON, Value (..))+import qualified Data.Aeson                 as Aeson+import qualified Data.Aeson.Encoding        as E+import           Data.Aeson.Types           (Pair)+import qualified Data.ByteString.Lazy       as BS+import           Data.Text                  (Text)+import           Data.Vector                (Vector, fromList, (!?))+import qualified Data.Vector                as Vector++import           Data.Int                   (Int16, Int32, Int64, Int8)+import           Data.Time.Calendar         (Day)+#if (MIN_VERSION_time_compat(1,9,2))+import           Data.Time.Calendar.Compat  (DayOfWeek)+#endif+import           Data.Time.Clock            (UTCTime)+import           Data.Time.LocalTime        (LocalTime, TimeOfDay, ZonedTime)+import           Data.UUID.Types            (UUID)+import           Data.Version               (Version)+import           Data.Void                  (Void)+import           Data.Word                  (Word, Word16, Word32, Word64,+                                             Word8)+#if (MIN_VERSION_base(4,8,0))+import           GHC.Natural                (Natural)+#endif+import qualified Data.HashMap.Lazy          as HL+import qualified Data.HashMap.Strict        as HS+import qualified Data.Map.Lazy              as ML+import qualified Data.Map.Strict            as MS+import           Data.Scientific            (Scientific)+import           Data.Traversable           (traverse)++{- $importing+This module as meant to be import as @qualified@++> import Data.Aeson.Combinators.Encode as Encode+-}++{- $alternative+Be aware than in most cause you won't need to use this module.+you can utilize Aeson's 'Value' type and it's instance of 'ToJSON' directly.++>>> import qualified Data.Aeson as Aeson+>>> import Data.Aeson ((.=))++>>> data Object = Object { tag :: String, id :: Int }++Define custom encoding function:++>>> :{+encodeObject :: Object -> Value+encodeObject (Object tag id) =+        Aeson.object ["tag" .= tag, "id" .= id]+:}++>>> Aeson.encode (encodeObject (Object "foo" 42))+"{\"tag\":\"foo\",\"id\":42}"+-}++{- $usage++>>> :set -XOverloadedStrings+>>> :set -XDeriveGeneric++First lets define some type++>>> :{+data Person = Person+  { name :: String+  , age  :: Int+  } deriving (Show, Eq)+:}++And first encoder for this type:++>>> :{+personEncoder :: Encoder Person+personEncoder = object+  [ field "name" string name+  , field "age" int age+  ]+:}++We can use this 'Encoder' to encode value into JSON:++>>> encode personEncoder (Person "Jane" 42)+"{\"age\":42,\"name\":\"Jane\"}"++Now we can use 'Contravariant' to manipulate our encoder.++Our type might be wrap in some rither type like this one:++>>> import Data.Functor.Contravariant+>>> data Surrounding = S Person Bool++But we still want to be able to encode it:++>>> :{+surroundingEncoder :: Encoder Surrounding+surroundingEncoder = contramap (\(S person _) -> person) personEncoder+:}++-}+++{-|+Value describing encoding of @a@ into a JSON 'Value'.+This is essentially just a wrapper around function that+should be applied later.++=== Covariant to map function over input++Given:++>>> :{+data Person = Person+  { name :: String+  , age  :: Int+  } deriving (Show, Eq)+:}++>>> :{+personEncoder :: Encoder Person+personEncoder = object+  [ field "name" string name+  , field "age" int age+  ]+:}++We can extract person from any pair:++>>> :{+-- Using personEncoder definition from example above+pairEncoder2 :: Encoder (Person, a)+pairEncoder2 = contramap fst personEncoder+:}++>>> encode pairEncoder2 (Person "Jane" 42, Nothing)+"{\"age\":42,\"name\":\"Jane\"}"++=== Divisible and Decidable++Some of you might know library @covariant@ and ask what is a support for+other covariant typeclasses.+It's not possible to define lawful Divisble instance for JSON 'Value'+and by extension it's not possible to define Decidable either.+While it is posible to provide somewhat useful unlawful instances for these this+library opts to not to do that.++-}+newtype Encoder a = Encoder (a -> Value)+++instance Contravariant Encoder where+  contramap f (Encoder enc) = Encoder (enc . f)+  {-# INLINE contramap #-}+++-- | Run 'Encoder' given a value. this is essentially just a function application.+run :: Encoder a -> a -> Value+run (Encoder f) = f+{-# INLINE run #-}+++-- | "Grab" 'Encoder' from 'ToJSON' definition.+auto :: ToJSON a => Encoder a+auto = Encoder Aeson.toJSON+{-# INLINE auto #-}+++-- Combinators++{- $objects+There are two alternative ways of defining Object encodings.+Both provide "eqvivalent" types and functions with consistent naming.+Variants without and with @'@ suffix are meant to be used together.+-}++{-| Object Encoder++>>> :{+  data Object = Object+    { name :: Text+    , age  :: Int+    } deriving (Show, Eq)+:}++>>> :{+  objectEncoder :: Encoder Object+  objectEncoder = object+    [ field "name" text name+    , field "age" int age+    ]+:}++>>> encode objectEncoder $ Object "Joe" 30+"{\"age\":30,\"name\":\"Joe\"}"++-}+type KeyValueEncoder a = a -> Pair+++{-| Object combinators -}+object :: [KeyValueEncoder a] -> Encoder a+object xs = Encoder $ \val -> Aeson.object $ fmap (\f -> f val) xs+{-# INLINE object #-}+++{-| Define object field -}+field :: Text -> Encoder b -> (a -> b) -> KeyValueEncoder a+field name (Encoder enc) get v = (name, enc $ get v)+{-# INLINE field #-}+++{-| Object Encoder (alternative)++>>> :set -XRecordWildCards++>>> :{+  data Object = Object+    { name :: Text+    , age  :: Int+    } deriving (Show, Eq)+:}++>>> :{+  objectEncoder' :: Encoder Object+  objectEncoder' = object' $ \Object{..} ->+    [ field' "name" text name+    , field' "age" int age+    ]+:}++>>> encode objectEncoder' $ Object "Joe" 30+"{\"age\":30,\"name\":\"Joe\"}"+-}+type KeyValueEncoder' a = a -> [Pair]+++{-| Object combinators (alternative) -}+object' :: KeyValueEncoder' a -> Encoder a+object' f = Encoder $ \val -> Aeson.object $ f val+{-# INLINE object' #-}+++{-| Define object field (alternative) -}+field' :: Text -> Encoder a -> a -> (Text, Value)+field' name (Encoder enc) val = (name, enc val)+{-# INLINE field' #-}+++-- Collections+++{-| Encode 'Vector' -}+vector :: Encoder a -> Encoder (Vector a)+vector (Encoder f) = Encoder $ \val -> Aeson.Array $ f <$> val+{-# INLINE vector #-}+++{-| Encode 'List' -}+list :: Encoder a -> Encoder [a]+list (Encoder f) = Encoder $ \val -> Aeson.Array $ fromList $ f <$> val+{-# INLINE list #-}+++{-| Encode multiple values as array -}+jsonArray :: [Encoder a] -> Encoder a+jsonArray xs = Encoder $ \a -> Array $ Vector.fromList $ (\(Encoder f) -> f a) <$> xs+{-# INLINE jsonArray #-}+++-- Basic Encoders+++-- | Encode any JSON value to 'Void' value+-- which is impossible to construct.+--+-- __This Encoder is guarenteed to fail.__+void :: Encoder Void+void = auto+{-# INLINE void #-}+++-- | Encode JSON null into '()'+unit :: Encoder ()+unit = auto+{-# INLINE unit #-}+++-- | Encode JSON booleans to Haskell 'Data.Bool'+bool :: Encoder Bool+bool = auto+{-# INLINE bool #-}+++-- | Encode JSON number to 'Data.Int.Int'+int :: Encoder Int+int = auto+{-# INLINE int #-}+++-- | Encode JSON number to 'Data.Int.Int8'+int8 :: Encoder Int8+int8 = auto+{-# INLINE int8 #-}+++-- | Encode JSON number to 'Data.Int.Int16'+int16 :: Encoder Int16+int16 = auto+{-# INLINE int16 #-}+++-- | Encode JSON number to 'Data.Int.Int32'+int32 :: Encoder Int32+int32 = auto+{-# INLINE int32 #-}+++-- | Encode JSON number to 'Data.Int.Int64'+int64 :: Encoder Int64+int64 = auto+{-# INLINE int64 #-}+++-- | Encode JSON number to unbounded 'Integer'+integer :: Encoder Integer+integer = auto+{-# INLINE integer #-}+++#if (MIN_VERSION_base(4,8,0))+-- | Encode JSON number to GHC's 'GHC.Natural' (non negative)+--+-- This function requires 'base' >= 4.8.0+natural :: Encoder Natural+natural = auto+{-# INLINE natural #-}+#endif+++-- | Encode JSON number to bounded 'Data.Word.Word'+word :: Encoder Word+word = auto+{-# INLINE word #-}+++-- | Encode JSON number to bounded 'Data.Word.Word8'+word8 :: Encoder Word8+word8 = auto+{-# INLINE word8 #-}+++-- | Encode JSON number to bounded 'Data.Word.Word16'+word16 :: Encoder Word16+word16 = auto+{-# INLINE word16 #-}+++-- | Encode JSON number to bounded 'Data.Word.Word32'+word32 :: Encoder Word32+word32 = auto+{-# INLINE word32 #-}+++-- | Encode JSON number to bounded 'Data.Word.Word64'+word64 :: Encoder Word64+word64 = auto+{-# INLINE word64 #-}+++-- | Encode JSON number to 'Float'+float :: Encoder Float+float = auto+{-# INLINE float #-}+++-- | Encode JSON number to 'Double'+double :: Encoder Double+double = auto+{-# INLINE double #-}+++-- | Encode JSON number to arbitrary precision 'Scientific'+scientific :: Encoder Scientific+scientific = auto+{-# INLINE scientific #-}+++-- | Encode single character JSON string to 'Data.Char'+char :: Encoder Char+char = auto+{-# INLINE char #-}+++-- | Encode JSON string to 'Data.String'+string :: Encoder String+string = auto+{-# INLINE string #-}+++-- | Encode JSON string to 'Data.Text'+text :: Encoder Text+text = auto+{-# INLINE text #-}+++-- | Encode JSON string to 'Data.UUID.Types.UUID'+uuid :: Encoder UUID+uuid = auto+{-# INLINE uuid #-}+++-- | Encode JSON string to 'Data.Version'+version :: Encoder Version+version = auto+{-# INLINE version #-}+++-- | Encode JSON string to 'Data.Local.Time.ZonedTime'+-- using Aeson's instance implementation.+--+-- Supported string formats:+--+-- YYYY-MM-DD HH:MM Z YYYY-MM-DD HH:MM:SS Z YYYY-MM-DD HH:MM:SS.SSS Z+--+-- The first space may instead be a T, and the second space is optional. The Z represents UTC. The Z may be replaced with a time zone offset of the form +0000 or -08:00, where the first two digits are hours, the : is optional and the second two digits (also optional) are minutes.+zonedTime :: Encoder ZonedTime+zonedTime = auto+{-# INLINE zonedTime #-}+++-- | Encode JSON string to 'Data.Local.Time.LocalTime'+-- using Aeson's instance implementation.+localTime :: Encoder LocalTime+localTime = auto+{-# INLINE localTime #-}+++-- | Encode JSON string to 'Data.Local.Time.TimeOfDay'+-- using Aeson's instance implementation.+timeOfDay :: Encoder TimeOfDay+timeOfDay = auto+{-# INLINE timeOfDay #-}+++-- | Encode JSON string to 'Data.Time.Clock.UTCTime'+-- using Aesons's instance implementation+utcTime :: Encoder UTCTime+utcTime = auto+{-# INLINE utcTime #-}+++-- | Encode JSON string to 'Data.Time.Calendar.Day'+-- using Aesons's instance implementation+day :: Encoder Day+day = auto+{-# INLINE day #-}+++#if (MIN_VERSION_time_compat(1,9,2))+-- | Encode JSON string to 'Data.Time.Calendar.Compat.DayOfWeek'+-- using Aesons's instance implementation+--+-- This function requires 'time-compat' >= 1.9.2+dayOfWeek :: Encoder DayOfWeek+dayOfWeek = auto+{-# INLINE dayOfWeek #-}+#endif+++-- Encode+++{-| Encode value into (Lazy) @ByteString@+-}+encode :: Encoder a -> a -> BS.ByteString+encode encoder =+  E.encodingToLazyByteString . toEncoding encoder+{-# INLINE encode #-}+++{-| Convert value to encoding+-}+toEncoding :: Encoder a -> a -> E.Encoding+toEncoding (Encoder enc) = E.value . enc+{-# INLINE toEncoding #-}

@@ -87,11 +87,11 @@   describe "index" $ do     it "decode singleton by index" $ do       JD.decode (JD.index 0 decoder) "[{\"name\": \"Sanders\", \"nick\": \"bern\"}]"-        `shouldBe` (Just $ Object "Sanders" "bern")+        `shouldBe` Just (Object "Sanders" "bern")      it "should decode nth index" $ do       JD.decode (JD.index 1 decoder) "[false, {\"name\": \"Sanders\", \"nick\": \"bern\"}, true]"-        `shouldBe` (Just $ Object "Sanders" "bern")+        `shouldBe` Just (Object "Sanders" "bern")  monadSpec :: Spec monadSpec =@@ -104,15 +104,15 @@      it "should work as a dummy value" $ do       JD.decode (JD.string >>= pure) "\"foo\""-        `shouldBe` (Just "foo")+        `shouldBe` Just "foo"      it "should turn string to sum" $ do       JD.decode (JD.string >>= fromText) "\"foo\""-        `shouldBe` (Just Foo)+        `shouldBe` Just Foo      it "should fail with right error" $ do       JD.eitherDecode (JD.string >>= fromText) "\"foobar\""-        `shouldBe` (Left "Error in $: unknown")+        `shouldBe` Left "Error in $: unknown"  alternativeSpec :: Spec alternativeSpec =@@ -121,11 +121,11 @@           Left <$> JD.bool <|> Right <$> decoder      it "should decode first alternative" $ do-      JD.decode dec "false" `shouldBe` (Just $ Left False)+      JD.decode dec "false" `shouldBe` Just (Left False)      it "should decode second alternative" $ do       JD.decode dec "{\"name\": \"Joe\",\"nick\": \"jd\"}"-        `shouldBe` (Just $ Right $ Object "Joe" "jd")+        `shouldBe` Just (Right $ Object "Joe" "jd")  jsonNullSpec :: Spec jsonNullSpec =@@ -139,10 +139,10 @@           JD.jsonNull Foo <|> (barDec =<< JD.text)      it "should decode Foo from null" $ do-      JD.decode dec "null" `shouldBe` (Just Foo)+      JD.decode dec "null" `shouldBe` Just Foo      it "should decode Bar from string" $ do-      JD.decode dec "\"bar\"" `shouldBe` (Just Bar)+      JD.decode dec "\"bar\"" `shouldBe` Just Bar  spec :: Spec spec = do

@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}++module JSONEncodeSpec where++import qualified Data.Aeson.Combinators.Encode as JE+import           Data.Text+import           Test.Hspec+++data Object = Object+    { name :: Text+    , age  :: Int+    } deriving (Show, Eq)+++objectEncoder :: JE.Encoder Object+objectEncoder = JE.object+  [ JE.field "name" JE.text name+  , JE.field "age" JE.int age+  ]+++objectEncoder' :: JE.Encoder Object+objectEncoder' = JE.object' $ \Object {..} ->+  [ JE.field' "name" JE.text name+  , JE.field' "age" JE.int age+  ]+++encodePrimitives :: Spec+encodePrimitives = describe "primitives" $ do+  it "encode bool" $ do+    JE.encode JE.bool True `shouldBe` "true"+++objectEncoding :: Spec+objectEncoding = do+  let object = Object "Joe" 30+  let json = "{\"age\":30,\"name\":\"Joe\"}"++  describe "object encoding" $ do+    it "should encode using getter style encoding" $ do+      JE.encode objectEncoder object `shouldBe` json++    it "should encode using explicit style encoding" $ do+      JE.encode objectEncoder' object `shouldBe` json+++listSpec :: Spec+listSpec = describe "list encoding" $ do+  it "encodes list of bools" $ do+    JE.encode (JE.list JE.auto) [True, False] `shouldBe` "[true,false]"+++data MyRec = MyRec+  { recTitle :: String+  , recStart :: Int+  , recEnd   :: Int+  } deriving (Show, Eq)+++spec :: Spec+spec = do+  encodePrimitives+  objectEncoding+  listSpec

@@ -1,5 +1,8 @@ import qualified JSONDecodeSpec as Decode+import qualified JSONEncodeSpec as Encode import           Test.Hspec     (hspec)  main :: IO ()-main = hspec Decode.spec+main = hspec $ do+  Decode.spec+  Encode.spec