composable-associations-aeson (empty) → 0.1.0.0

raw patch · 7 files changed

+346/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, composable-associations, composable-associations-aeson, doctest, tasty, tasty-hunit, tasty-quickcheck, text, unordered-containers

Files

LICENSE +30/−0
README.md +10/−0
Setup.hs +2/−0
composable-associations-aeson.cabal +53/−0
doctest/Main.hs +8/−0
src/Data/ComposableAssociation/Aeson.hs +151/−0
test/Main.hs +92/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Samuel Protas (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Samuel Protas nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,10 @@+# composable-associations-aeson++[![Build Status](https://travis-ci.org/SamProtas/composable-associations.svg?branch=master)](https://travis-ci.org/SamProtas/composable-associations)+[![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses)+[![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org)+[![Hackage](https://img.shields.io/hackage/v/composable-associations-aeson.svg)](https://hackage.haskell.org/package/composable-associations-aeson)++This package re-exports `composable-associations` and implements serialization/deserialization for JSON (via Aeson). ++Documentation available on Hackage.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ composable-associations-aeson.cabal view

@@ -0,0 +1,53 @@+name:                composable-associations-aeson+version:             0.1.0.0+synopsis:            Aeson ToJSON/FromJSON implementation for the types of composable-associations+description:+    This library provides the orphan instances implementation JSON serialization for the types in+    composiable-associations, as well as any other Aeson-specific implementation details.+homepage:            https://github.com/SamProtas/composable-associations#readme+license:             BSD3+license-file:        LICENSE+author:              Sam Protas+maintainer:          sam.protas@gmail.com+copyright:           2017 Samuel Protas+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.ComposableAssociation.Aeson+  build-depends:       base >= 4.7 && < 5+                     , composable-associations+                     , text+                     , unordered-containers+                     , aeson+  default-language:    Haskell2010++test-suite tests+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends: base >= 4.7 && < 5+               , aeson+               , composable-associations-aeson+               , tasty+               , tasty-quickcheck+               , tasty-hunit+               , bytestring++test-suite doctest+  type:              exitcode-stdio-1.0+  hs-source-dirs:    doctest+  main-is:           Main.hs+  build-depends:     base >= 4.7 && < 5+                   , composable-associations-aeson+                   , doctest >= 0.9.12+                   , bytestring+  default-language:  Haskell2010++source-repository head+  type:     git+  location: https://github.com/SamProtas/composable-associations/tree/master/composable-associations-aeson

+ doctest/Main.hs view

@@ -0,0 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Test.DocTest++main :: IO ()+main = doctest [ "-XOverloadedStrings", "-XDeriveGeneric", "-XDataKinds", "-XTypeOperators",+                 "src/Data/ComposableAssociation/Aeson.hs" ]

+ src/Data/ComposableAssociation/Aeson.hs view

@@ -0,0 +1,151 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+module Data.ComposableAssociation.Aeson+    ( -- * Quickstart+      -- $quickstart++      -- * Re-Exported Core Types\/Functions\/Lens+      module Data.ComposableAssociation++      -- * Invalid JSON Encoding Exception+    , JsonObjectEncodingException (..)+    ) where+++import GHC.TypeLits+import Data.Proxy+import Data.Typeable+import Control.Exception++import qualified Data.Text as T+import Data.Aeson+import Data.Aeson.Types+import qualified Data.HashMap.Lazy as HashMap++import Data.ComposableAssociation+++-- | More specific version of @ObjectEncodingException@ to only Aeson encoding issues.+newtype JsonObjectEncodingException = JsonObjectEncodingException Value deriving (Show, Typeable)+instance Exception JsonObjectEncodingException where+  toException = toException . ObjectEncodingException+  fromException x = do+    ObjectEncodingException e <- fromException x+    cast e++++instance (ToJSON obj, KnownSymbol key) => ToJSON (Association key obj) where+  toJSON (Association key obj) = object [keyName .= toJSON obj]+    where keyName = T.pack $ symbolVal key++instance (FromJSON obj, KnownSymbol key) => FromJSON (Association key obj) where+  parseJSON = withObject "Association" $ \v' -> Association proxy <$> (v' .:? key .!= Null >>= parseJSON)+      where proxy = Proxy :: Proxy key+            key = T.pack $ symbolVal proxy+++-- | Throws a @JsonObjectEncodingException@ if the base value isn't encoded as a JSON object+instance (ToJSON base, ToJSON obj, KnownSymbol key) => ToJSON (base :<> Association key obj) where+  toJSON (base :<> Association key obj) = Object $ HashMap.insert keyName objJson baseJsonMap+    where keyName = T.pack $ symbolVal key+          baseJsonMap = case toJSON base of (Object jsonObjVal) -> jsonObjVal+                                            notAnObject -> throw $ JsonObjectEncodingException notAnObject+          objJson = toJSON obj++instance (FromJSON base, FromJSON obj, KnownSymbol key) => FromJSON (base :<> Association key obj) where+  parseJSON = withObject "base :<> assoc" $ \v' -> (:<>) <$>+                                            parseJSON (Object $ HashMap.delete key v') <*>+                                            fmap (Association proxy) (v' .:? key .!= Null >>= parseJSON)+    where proxy = Proxy :: Proxy key+          key = T.pack $ symbolVal proxy++-- $setup+-- >>> import GHC.Generics++-- $quickstart+-- Assume some example data below:+--+-- >>> data ExampleUser = ExampleUser { name :: String, age :: Int } deriving (Show, Eq, Generic)+-- >>> instance ToJSON ExampleUser+-- >>> instance FromJSON ExampleUser+--+-- >>> let alice = ExampleUser { name = "Alice", age = 25 }+-- >>> encode alice+-- "{\"age\":25,\"name\":\"Alice\"}"+--+-- >>> let messageIds = [102, 305, 410]+-- >>> encode messageIds+-- "[102,305,410]"+--+-- Let's add those messages to the user JSON object without bothering to define another type.+--+-- >>> let aliceWithMessages = alice :<> (asValue messageIds :: Association "messages" [Int])+-- >>> encode aliceWithMessages+-- "{\"age\":25,\"name\":\"Alice\",\"messages\":[102,305,410]}"+--+-- Since "messages" is type (not value) information, we can decode as well.+--+-- >>> decode "{\"age\":25,\"name\":\"Alice\",\"messages\":[102,305,410]}" :: Maybe (ExampleUser :<> Association "messages" [Int])+-- Just (ExampleUser {name = "Alice", age = 25} :<> Association Proxy [102,305,410])+--+-- In the above, "Proxy" is the value of type "messages".+--+-- @Association Proxy a@ has a stand-alone encoding/decoding too+--+-- >>> encode $ Association (Proxy :: Proxy "one-off-key") [1, 2, 3]+-- "{\"one-off-key\":[1,2,3]}"+--+-- >>> decode "{\"one-off-key\":[1,2,3]}" :: Maybe (Association "one-off-key" [Int])+-- Just (Association Proxy [1,2,3])+--+-- These are chainable too!+--+-- >>> :{+-- let manyAssociations :: ExampleUser :<> Association "numbers" [Int] :<> Association "bools" [Bool]+--     manyAssociations = alice :<> asValue [1,2,3] :<> asValue [True, False]+-- in encode manyAssociations+-- :}+-- "{\"age\":25,\"name\":\"Alice\",\"bools\":[true,false],\"numbers\":[1,2,3]}"+--+-- You can build JSON objects from just values!+--+-- >>> :{+-- let allValues :: Association "a-bool" Bool :<> Association "a-string" String :<> Association "an-alice" ExampleUser+--     allValues = asValue True :<> asValue "Hello" :<> asValue alice+-- in encode allValues+-- :}+-- "{\"a-bool\":true,\"an-alice\":{\"age\":25,\"name\":\"Alice\"},\"a-string\":\"Hello\"}"+--+-- Decoding fails if you specify a non-existent key (standard Aeson behavior for failed decoding).+--+-- >>> decode "{\"one-off-key\":[1,2,3]}" :: Maybe (Association "wrong-key" [Int])+-- Nothing+--+-- If you try encoding with a "base" value that is itself not encoded to a JSON object you'll get a runtime exception.+--+-- >>> encode $ True :<> (asValue [1,2,3] :: Association "this-ends-poorly" [Int])+-- "*** Exception: JsonObjectEncodingException (Bool True)+-- >>> encode $ [1,2,3] :<> (asValue "will not work" :: Association "still" String)+-- "*** Exception: JsonObjectEncodingException (Array [Number 1.0,Number 2.0,Number 3.0])+--+-- GHC Extension Note:+--+-- * You'll need @DataKinds@ for this library (type level literals, no getting around this).+--+-- * You'll probably want @TypeOperators@ as well (although you can use @WithAssociation@ instead of @:<>@ to avoid this).+--+-- * You can avoid @PolyKinds@ if you use @asValue True :: Association "key" Bool@ or type inference instead of+-- @Association (Proxy :: Proxy "key") True@.++++++

+ test/Main.hs view

@@ -0,0 +1,92 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import GHC.Generics+import Data.Maybe+import Data.Either++import Data.Proxy+import Data.Aeson+import Data.ByteString.Lazy+import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit+import Control.Exception++import Data.ComposableAssociation.Aeson++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [properties, unitTests]++properties :: TestTree+properties = testGroup "Properties"+  [ testProperty "Just (x :: Association \"Some Key\" TestUser) == decode . encode x" $ \user ->+      let userAsKey = asValue user :: Association "user" TestUser+      in Just userAsKey == (decode . encode) userAsKey+  , testProperty "Just (x :: TestUser :<> Association \"Some Key\" [Int]) == decode . encode x" $+      \(user :: TestUser, messageIds) ->+      let userWithMessages = user :<> (asValue messageIds :: Association "message_ids" [Int])+      in Just userWithMessages == (decode . encode) userWithMessages+  , testProperty "Association encode/decode order doesn't matter" $ \(ids, results) ->+      let idsAndMessages = asValue ids :<> asValue results :: Association "ids" [Int] :<> Association "results" [Bool]+      in isJust ((decode . encode) idsAndMessages :: Maybe (Association "results" [Bool] :<> Association "ids" [Int]))+  , testProperty "Nested Association work" $ \(user :: TestUser, messageIds, results) ->+      let userWithMessagesAndResults :: TestUser :<> Association "messages" [Int] :<> Association "results" [Bool]+          userWithMessagesAndResults = user :<> asValue messageIds :<> asValue results+      in Just userWithMessagesAndResults == (decode . encode) userWithMessagesAndResults ]++unitTests :: TestTree+unitTests = testGroup "Unit Tests"+  [ testCase "Association ToJSON Instance" $ encode testUser1FriendsAssoc @?= "{\"message_ids\":[1,2,3]}"+  , testCase "Association FromJSON Instance" $ decode "{\"message_ids\":[1,2,3]}" @?= Just testUser1FriendsAssoc+  , testCase ":<> ToJSON" $+      encode (testUser1 :<> testUser1FriendsAssoc) @?= "{\"message_ids\":[1,2,3],\"userId\":1,\"name\":\"Sam\"}"+  , testCase ":<> FromJSON" $+      decode "{\"message_ids\":[1,2,3],\"userId\":1,\"name\":\"Sam\"}" @?= Just (testUser1 :<> testUser1FriendsAssoc)+  , testCase ":<> Invalid Encoding1" $ do+      res <- try (evaluate $ encode ([1 :: Int] :<> testUser1FriendsAssoc)) :: IO (Either JsonObjectEncodingException ByteString)+      assertBool "Non-Json-Obj base throws JsonObjectEncodingException" (isLeft res)+  , testCase ":<> Invalid Encoding2" $ do+      res <- try (evaluate $ encode ([1 :: Int] :<> testUser1FriendsAssoc)) :: IO (Either ObjectEncodingException ByteString)+      assertBool "Non-Json-Obj base throws ObjectEncodingException" (isLeft res)+  , testCase "Encode Association Null" $ encode testMissingMessages @?= "{\"message_ids\":null}"+  , testCase "Decode Association Null" $ decode "{\"message_ids\":null}" @?= Just testMissingMessages+  , testCase "Decode Association Missing Key" $ decode "{}" @?= Just testMissingMessages+  , testCase "Encode :<> Missing Association" $+      encode (testUser1 :<> testMissingMessages) @?= "{\"message_ids\":null,\"userId\":1,\"name\":\"Sam\"}"+  , testCase "Decode :<> Missing Association" $+      decode "{\"message_ids\":null,\"userId\":1,\"name\":\"Sam\"}" @?= Just (testUser1 :<> testMissingMessages)+  , testCase "Decode :<> Missing Association Key" $+      decode "{\"userId\":1,\"name\":\"Sam\"}" @?= Just (testUser1 :<> testMissingMessages)]+++-- Test Data:++data TestUser = TestUser { userId :: Int+                         , name :: String }+                         deriving (Show, Eq, Generic)+instance ToJSON TestUser+instance FromJSON TestUser++testUser1 :: TestUser+testUser1 = TestUser { userId = 1, name = "Sam" }++testUser1FriendsAssoc :: Association "message_ids" [Int]+testUser1FriendsAssoc = Association Proxy [1, 2, 3]++testAssoc :: TestUser :<> Association "message_ids" [Int] :<> Association "results" [Bool]+testAssoc = testUser1 :<> testUser1FriendsAssoc :<> Association Proxy [True, False, True]++testMissingMessages :: Association "message_ids" (Maybe [Int])+testMissingMessages = asValue Nothing+++instance Arbitrary TestUser where+  arbitrary = TestUser <$> arbitrary <*> arbitrary