diff --git a/.travis.yml b/.travis.yml new file mode 100644 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,89 @@ +# This file has been generated -- see https://github.com/hvr/multi-ghc-travis +language: c +sudo: false + +cache: + directories: + - $HOME/.cabsnap + - $HOME/.cabal/packages + +before_cache: + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar + +matrix: + include: + - env: CABALVER=1.22 GHCVER=7.10.2 + compiler: ": #GHC 7.10.2" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} + - env: CABALVER=1.24 GHCVER=8.0.2 + compiler: ": #GHC 8.0.2" + addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}} + - env: CABALVER=2.0 GHCVER=8.2.2 + compiler: ": #GHC 8.2.2" + addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}} + - env: CABALVER=head GHCVER=head + compiler: ": #GHC head" + addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} + + allow_failures: + - env: CABALVER=head GHCVER=head + +before_install: + - unset CC + - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH + +install: + - cabal --version + - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" + - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; + then + zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > + $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; + fi + - travis_retry cabal update -v + - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt + - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt + +# check whether current requested install-plan matches cached package-db snapshot + - if diff -u $HOME/.cabsnap/installplan.txt installplan.txt; + then + echo "cabal build-cache HIT"; + rm -rfv .ghc; + cp -a $HOME/.cabsnap/ghc $HOME/.ghc; + cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; + else + echo "cabal build-cache MISS"; + rm -rf $HOME/.cabsnap; + mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; + cabal install --only-dependencies --enable-tests --enable-benchmarks; + fi + +# snapshot package-db on cache miss + - if [ ! -d $HOME/.cabsnap ]; + then + echo "snapshotting package-db to build-cache"; + mkdir $HOME/.cabsnap; + cp -a $HOME/.ghc $HOME/.cabsnap/ghc; + cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; + fi + +# Here starts the actual work to be performed for the package under test; +# any command which exits with a non-zero exit code causes the build to fail. +script: + - if [ -f configure.ac ]; then autoreconf -i; fi + - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging + - cabal build # this builds all libraries and executables (including tests/benchmarks) + - cabal test + - cabal check + - cabal haddock # tests that documentation can be generated + - cabal sdist # tests that a source-distribution can be generated + +# Check that the resulting source distribution can be built & installed. +# If there are no other `.tar.gz` files in `dist`, this can be even simpler: +# `cabal install --force-reinstalls dist/*-*.tar.gz` + - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && + (cd dist && cabal install --force-reinstalls "$SRC_TGZ") + +# EOF diff --git a/Data/Aeson/Diff/Generic.hs b/Data/Aeson/Diff/Generic.hs --- a/Data/Aeson/Diff/Generic.hs +++ b/Data/Aeson/Diff/Generic.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, MultiWayIf, - ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, + ExistentialQuantification #-} {-| This library allows you to apply a json-patch document () directly to a - haskell datatype. It's based on the "Data.Aeson.Diff" module. + haskell datatype. A JSON Patch document is a sequence +of instructions to modify a JSON value. This library allows you to +modify the haskell datatype directly by matching it with its JSON +representation. It is suitable for use with the HTTP PATCH method. -} module Data.Aeson.Diff.Generic @@ -27,7 +30,7 @@ patch :: JsonPatch a => Patch -> a -> Result a patch = foldr (>=>) pure . map applyOperation . patchOperations {-# NOINLINE patch #-} -{-# RULES "patch/Value" patch = Diff.patch #-} +{-# RULES "patch/Value" patch = Diff.patch #-} -- | Apply a single operation to the data. applyOperation :: JsonPatch a => Operation -> a -> Result a diff --git a/Data/Aeson/Diff/Generic/Instances.hs b/Data/Aeson/Diff/Generic/Instances.hs --- a/Data/Aeson/Diff/Generic/Instances.hs +++ b/Data/Aeson/Diff/Generic/Instances.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, MultiWayIf, +{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, ExistentialQuantification, TemplateHaskell, StandaloneDeriving, GeneralizedNewtypeDeriving#-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -56,7 +56,7 @@ import Data.Functor.Compose import Data.Functor.Product import Data.Functor.Sum -import Data.Functor.Const +import Control.Applicative (Const(..)) import Data.Functor.Classes import Data.Tree (Tree(..)) diff --git a/Data/Aeson/Diff/Generic/TH.hs b/Data/Aeson/Diff/Generic/TH.hs --- a/Data/Aeson/Diff/Generic/TH.hs +++ b/Data/Aeson/Diff/Generic/TH.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, MultiWayIf, +{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, ConstraintKinds, ExistentialQuantification, TemplateHaskell, PatternGuards #-} {-| This module contains functions to automatically derive `JsonPatch` instances. @@ -15,7 +15,7 @@ import Language.Haskell.TH.Datatype import Data.List import Data.Aeson.Diff.Generic.Types -import Text.Read +import Text.Read.Compat import qualified Data.Text as T import Control.Monad import Data.Maybe @@ -41,7 +41,7 @@ vars <- mapM (const $ newName "a") sigVars let appliedType = foldl appT (conT name) $ map varT vars constrained = - forallT (map plainTV vars) $ + forallT (map PlainTV vars) $ mapM (\v -> [t| JsonPatch $(varT v) |]) vars pathLensSig <- sigD pathLensName $ constrained diff --git a/Data/Aeson/Diff/Generic/Types.hs b/Data/Aeson/Diff/Generic/Types.hs --- a/Data/Aeson/Diff/Generic/Types.hs +++ b/Data/Aeson/Diff/Generic/Types.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, DefaultSignatures, - MultiWayIf, ExistentialQuantification, TemplateHaskell #-} + ExistentialQuantification, TemplateHaskell, TupleSections #-} module Data.Aeson.Diff.Generic.Types where import Data.Aeson.Types import Data.Aeson.Pointer as Pointer -import Control.Monad import Data.Dynamic +import Control.Applicative ((<$>), pure) -- | An existentially quantified getter and setter. The data inside -- is manipulated using json conversion functions (`toJSON`, @@ -63,7 +63,8 @@ deleteAtPointer (Pointer [key]) s f = deleteAt key s f deleteAtPointer (Pointer (key:path)) s f = do GetSet v setr <- fieldLens key s - join $ traverse setr <$> deleteAtPointer (Pointer path) v f + (r, s2) <- deleteAtPointer (Pointer path) v f + (r, ) <$> setr s2 -- | Add a value at the pointer. To insert a json `Value`, use -- `fromJSON` as the helper function, to insert a `Dynamic` use `getDynamic`. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,155 @@ +# Welcom to `aeson-diff-generic` [![Hackage](https://img.shields.io/hackage/v/aeson-diff-generic.svg)](https://hackage.haskell.org/package/aeson-diff-generic) [![Build Status](https://travis-ci.org/kuribas/aeson-diff-generic.svg)](https://travis-ci.org/kuribas/aeson-diff-generic) + +aeson-diff-generic is a haskell library that allows you to apply a +JSON patch [rfc6902](https://tools.ietf.org/html/rfc6902) document +directly to a haskell datatype. A JSON Patch document is a sequence +of instructions to modify a JSON value. It is suitable for use with +the HTTP PATCH method. + +Suppose you are writing a client/server application with +auto-save. Every time the user makes a change to the document, the +client needs to tell the server about it. If the document being edited +is large, sending the entire updated document is impractical, so you +want to send a diff instead. JSON patch +[rfc6902](https://tools.ietf.org/html/rfc6902) is a standard format +for representing diffs, but it applies to JSON documents, not Haskell +values. Let's say our document is represented by a Haskell value of +type Doc: we need a Doc patch, not a json patch. + +The aeson library uses GHC.Generics or template haskell to define a +default json encoding for algebraic datatypes. The aeson-diff-generic +can generate code, using options given to aeson, to interpret a json +patch as a Doc patch. + +# Example + +Suppose we have a datatype for which we have a ToJSON and FromJSON instance: + +```haskell +{-# LANGUAGE DeriveGeneric, TemplateHaskell, OverloadedStrings #-} +import Data.Aeson +import Data.Aeson.Diff +import Data.Aeson.Diff.Generic +import GHC.Generics + +data Pet = Bird | Cat | Dog | Fish + deriving (Show, Eq, Generic) + +data Person = Person + { name :: String + , age :: Int + , pet :: Pet + } deriving (Show, Eq, Generic) + +instance ToJSON Pet where + toJSON = genericToJSON defaultOptions + toEncoding = genericToEncoding defaultOptions + +instance FromJSON Pet where + parseJSON = genericParseJSON defaultOptions + +instance ToJSON Person where + toJSON = genericToJSON defaultOptions + toEncoding = genericToEncoding defaultOptions + +instance FromJSON Person where + parseJSON = genericParseJSON defaultOptions +``` + +We can now create a JsonPatch instance for our datatypes. Creating +one by hand is tedious, so aeson-diff-generic gives two alternative +ways to create one: using the `FieldLens` class, or using template +haskell with the "Data.Aeson.Diff.Generic.TH" module. + +### Creating instances with fieldlens. + +A fieldlens maps a `Key` onto a getter and setter into the given data. + +For our Pet datatype we don't have any fields to index into, so it just returns an error: + +```haskell +instance FieldLens Pet where + fieldLens _ _ = Error "Invalid Path" +``` + +Since this is the default implementation, so we can do simply: + +```haskell +instance FieldLens Pet +``` + +For the Person datatype we map each field to the `GetSet` type: + +```haskell +instance FieldLens Person where + fieldLens (OKey field) (Person name_ age_ pet_) = + case field of + "name" -> pure $ GetSet name_ (\v -> pure $ Person v age_ pet_) + "age" -> pure $ GetSet age_ (\v -> pure $ Person name_ v pet_) + "pet" -> pure $ GetSet pet_ (\v -> pure $ Person name_ age_ v) + _ -> Error "Invalid Path" + fieldLens _ _ = Error "Invalid Path" +``` + +Now our `JsonPatch` instance will automatically use the `FieldLens` instance. + +```haskell +instance JsonPatch Person +instance JsonPatch Pet +``` + +### Creating instances with template haskell + +FieldLens still involves some boilerplate. We can avoid that by using +the template haskell functions from "Data.Aeson.Diff.Generic.TH": + +```haskell +instance JsonPatch Pet +instance FieldLens Pet + +deriveJsonPatch defaultOptions ''Person +``` + +### applying patches + +Now we can apply patches to our data: + +```haskell +> joe = Person "Joe" 32 Fish +> john = Person "John" 32 Bird +> patch = Data.Aeson.Diff.diff (toJSON joe) (toJSON john) + +> import qualified Data.ByteString.Lazy.Char8 as ByteString +> ByteString.putStrLn $ encode patch +[{"op":"replace","path":"/name","value":"John"},{"op":"replace","path":"/pet","value":"Bird"}] + +> Success json = Data.Aeson.Diff.patch patch (toJSON joe) +> ByteString.putStrLn $ encode json +{"age":32,"name":"John","pet":"Bird"} + +> Data.Aeson.Diff.Generic.patch patch joe +Success (Person {name = "John", age = 32, pet = Bird}) +``` + +# Join in! + +I am happy to receive bug reports, fixes, documentation enhancements, +and other improvements. + +Please report bugs via the +[github issue tracker](http://github.com/kuribas/aeson-diff-generic/issues). + +Master [git repository](http://github.com/kuribas/aeson-diff-generic): + +* `git clone git://github.com/kuribas/aeson-dif-generic.git` + +See what's changed in recent (and upcoming) releases: + +* https://github.com/kuribas/aeson-diff-generic/blob/master/changelog.md + +(You can create and contribute changes using git) + + +# Authors + +This library is written by Kristof Bastiaensen. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs diff --git a/aeson-diff-generic.cabal b/aeson-diff-generic.cabal --- a/aeson-diff-generic.cabal +++ b/aeson-diff-generic.cabal @@ -1,28 +1,66 @@ Name: aeson-diff-generic -Version: 0.0.1 +Version: 0.0.2 Synopsis: Apply a json-patch to any haskell datatype. -Category: Graphics, Geometry, Typography +Category: JSON, Web Copyright: Kristof Bastiaensen (2018) Stability: Unstable License: BSD3 License-file: LICENSE Author: Kristof Bastiaensen Maintainer: Kristof Bastiaensen -Bug-Reports: https://github.com/kuribas/cubicbezier/issues +Bug-Reports: https://github.com/kuribas/aeson-diff-generic/issues Build-type: Simple Cabal-version: >=1.8 -Description: Apply a json-patch to any haskell datatype. It extends the capabilities of the aeson-diff packages, and includes template haskell functions for automatically deriving the right instances. - +Tested-With: GHC == 7.10.2 + GHC == 8.0.2 + GHC == 8.2.2 +Description: Apply a json-patch directly to a haskell datatype. It extends the capabilities of the aeson-diff packages, and includes template haskell functions for automatically deriving the right instances. + +extra-source-files: .travis.yml + README.md + changelog.md + Source-repository head type: git location: https://github.com/kuribas/aeson-diff-generic Library Ghc-options: -Wall - Build-depends: base >= 4.8 && <= 5, aeson, aeson-diff, bytestring (>=0.10), - hashable, mtl, scientific, text, unordered-containers, containers, - vector, bytestring, time, uuid-types, dlist, tagged, template-haskell, - th-abstraction + build-depends: base >= 4.5 && <= 5, + base-compat >= 0.9.1 && < 0.10, + aeson >= 1.2.4.0 && < 1.3, + aeson-diff >= 1.1.0.0 && < 1.2, + bytestring >=0.10 && < 0.11, + hashable >= 1.1.2.0, + bytestring >= 0.10, + uuid-types >= 1.0.3 && <1.1, + dlist >= 0.6, + base >= 4.5 && < 5, + base-compat >= 0.9.1 && < 0.10, + containers >= 0.5.8, + dlist >= 0.6, + scientific >= 0.3.4.7 && < 0.4, + tagged >=0.8.3 && <0.9, + template-haskell >= 2.7, + text >= 1.1.1.0, + th-abstraction >= 0.2.2 && < 0.3, + time >= 1.1.1.4, + unordered-containers >= 0.2.5.0 && < 0.3, + uuid-types >= 1.0.3 && <1.1, + vector >= 0.8 + + if !impl(ghc >= 8.0) + -- `Data.Semigroup` and `Control.Monad.Fail` and `Control.Monad.IO.Class` are available in base only since GHC 8.0 / base 4.9 + build-depends: + semigroups >= 0.18.2 && < 0.19, + transformers >= 0.2.2.0, + transformers-compat >= 0.3, + fail == 4.9.* + + if !impl(ghc >= 7.10) + -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8 + build-depends: nats >= 1 && < 1.2 + Exposed-Modules: Data.Aeson.Diff.Generic Data.Aeson.Diff.Generic.TH Data.Aeson.Diff.Generic.Instances diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,15 @@ +# aeson-diff-generic 0.0.2 + +*April 2, 2018* + + - Better documentation. + - Tested builds + +# aeson-diff-generic 0.0.1 + +*April 1, 2018* + +Initial release of aeson-diff-generic. It has the implementations for +the `JsonPatch` and `fieldLens` classes, and `JsonPatch` instances for +all datatype supported by the aeson package. It also includes the +`deriveJsonPatch` template haskell function for generating `JsonPatch` instances.