diff --git a/Data/Aeson/Diff/Generic.hs b/Data/Aeson/Diff/Generic.hs
new file mode 100644
--- /dev/null
+++ b/Data/Aeson/Diff/Generic.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, MultiWayIf,
+   ExistentialQuantification #-}
+{-| This library allows you to apply a json-patch document
+  (<https://tools.ietf.org/html/rfc6902 rfc6902>) directly to a
+  haskell datatype.  It's based on the "Data.Aeson.Diff" module.
+-}
+
+module Data.Aeson.Diff.Generic
+  ( -- * patch operations
+    Data.Aeson.Diff.Generic.patch, applyOperation, JsonPatch(..),
+   getDynamic, getValueAtPointer, getDataAtPointer,
+   -- * the fieldLens class
+   -- | `FieldLens` provides a simpler way to create `JsonPatch` instances.
+   GetSet(..), FieldLens(..)
+  ) where
+
+import Data.Aeson.Types
+import Data.Aeson.Patch
+import qualified Data.Aeson.Diff as Diff
+import Data.Aeson.Pointer as Pointer
+import Control.Monad
+import qualified Data.Text as T
+import Data.Aeson.Diff.Generic.Types
+import Data.Aeson.Diff.Generic.Instances()
+
+-- | Apply a json patch document to the data.
+patch :: JsonPatch a => Patch -> a -> Result a
+patch = foldr (>=>) pure . map applyOperation . patchOperations
+{-# NOINLINE patch #-}
+{-# RULES "patch/Value" patch = Diff.patch #-} 
+
+-- | Apply a single operation to the data.
+applyOperation :: JsonPatch a => Operation -> a -> Result a
+applyOperation op v = case patchOp op v of
+  Error msg -> Error $ opError op ++ msg
+  Success ret -> Success ret
+{-# INLINE [1] applyOperation #-}
+{-# RULES "applyOperation/Value" applyOperation = Diff.applyOperation #-} 
+
+opError :: Operation -> String
+opError op = mconcat [
+  "Operation ", opname op, " on ",
+  T.unpack $ formatPointer $ changePointer op,
+  " failed: " ]
+  where opname (Add _ _) = "Add"
+        opname (Cpy _ _) = "Copy"
+        opname (Mov _ _) = "Move"
+        opname (Rem _)   = "Remove"
+        opname (Rep _ _) = "Replace"
+        opname (Tst _ _) = "Test"
+
+patchOp :: JsonPatch a => Operation -> a -> Result a
+patchOp (Add ptr val) s = addAtPointer ptr s val fromJSON
+patchOp (Rem ptr) s = snd <$> deleteAtPointer ptr s (const ())
+patchOp (Cpy toPath fromPath) s = copyPath fromPath toPath s
+patchOp (Mov toPath fromPath) s = movePath fromPath toPath s
+patchOp (Rep ptr val) s = replaceAtPointer ptr s val fromJSON
+patchOp (Tst ptr val) s = testAtPointer ptr s val fromJSON
diff --git a/Data/Aeson/Diff/Generic/Instances.hs b/Data/Aeson/Diff/Generic/Instances.hs
new file mode 100644
--- /dev/null
+++ b/Data/Aeson/Diff/Generic/Instances.hs
@@ -0,0 +1,546 @@
+{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, MultiWayIf,
+  ExistentialQuantification, TemplateHaskell, StandaloneDeriving,
+  GeneralizedNewtypeDeriving#-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-| Instances are put into this module to avoid circular dependencies
+  with the TH module.  There is no need to import this module, since
+  it is already re-exported in "Data.Aeson.Diff.Generic".  This module
+  is only exported for documentation purpose.
+-}
+
+module Data.Aeson.Diff.Generic.Instances
+  () where
+
+import Data.Aeson.Types
+import Data.Aeson.Patch
+import qualified Data.Aeson.Diff as Diff
+import Data.Aeson.Pointer as Pointer
+import Control.Monad
+import Data.Functor.Identity
+import qualified Data.Text as T
+import qualified Data.Text.Lazy
+import Data.Dynamic
+import qualified Data.Set as Set
+import qualified Data.Sequence as Seq
+import qualified Data.Vector.Unboxed as UVector
+import qualified Data.Vector as Vector
+import qualified Data.Vector.Storable as SVector
+import qualified Data.Vector.Primitive as PVector
+import qualified Data.HashMap.Lazy as HashMap
+import qualified Data.HashSet as HashSet
+import qualified Data.Map as Map
+import Data.Word
+import Data.Int
+import Numeric.Natural
+import Data.Version
+import Foreign.C.Types
+import qualified Data.IntSet
+import Data.Scientific
+import Data.Time.LocalTime
+import Data.Time.Clock
+import Data.Time.Calendar
+import Data.UUID.Types
+import Data.Ratio
+import Data.Fixed
+import Data.Semigroup hiding (Sum, Product)
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.DList as DList
+import Data.Hashable
+import Data.Proxy
+import Data.Tagged
+import Unsafe.Coerce
+import Data.Aeson.Diff.Generic.TH
+import Data.Aeson.Diff.Generic.Types
+import Data.IntMap (IntMap)
+import Data.Functor.Compose
+import Data.Functor.Product
+import Data.Functor.Sum
+import Data.Functor.Const
+import Data.Functor.Classes
+import Data.Tree (Tree(..))
+
+instance FieldLens Bool
+instance FieldLens Char
+instance FieldLens Double
+instance FieldLens Float
+instance FieldLens Int
+instance FieldLens Int8
+instance FieldLens Int16
+instance FieldLens Int32
+instance FieldLens Int64
+instance FieldLens Integer
+instance FieldLens Natural
+instance FieldLens Ordering
+instance FieldLens Word
+instance FieldLens Word8
+instance FieldLens Word16
+instance FieldLens Word32
+instance FieldLens Word64
+instance FieldLens ()
+instance FieldLens T.Text
+instance FieldLens Data.Text.Lazy.Text
+instance FieldLens Version
+instance FieldLens CTime
+instance FieldLens Data.IntSet.IntSet
+instance FieldLens Scientific
+instance FieldLens LocalTime
+instance FieldLens TimeOfDay
+instance FieldLens UTCTime
+instance FieldLens NominalDiffTime
+instance FieldLens DiffTime
+instance FieldLens Day
+instance FieldLens UUID
+instance FieldLens DotNetTime
+instance (Hashable a, Eq a, FromJSON a, Typeable a, ToJSON a) =>
+         FieldLens (HashSet.HashSet a)
+instance (Typeable a, Integral a, ToJSON a, FromJSON a, Eq a)  =>
+         FieldLens (Ratio a)
+instance (HasResolution a, Typeable a, FromJSON a, ToJSON a) =>
+         FieldLens (Fixed a)
+instance (JsonPatch a) => FieldLens (IntMap a)
+instance Typeable a => FieldLens (Proxy a)
+
+instance JsonPatch Bool
+instance JsonPatch Char
+instance JsonPatch Double
+instance JsonPatch Float
+instance JsonPatch Int
+instance JsonPatch Int8
+instance JsonPatch Int16
+instance JsonPatch Int32
+instance JsonPatch Int64
+instance JsonPatch Integer
+instance JsonPatch Natural
+instance JsonPatch Ordering
+instance JsonPatch Word
+instance JsonPatch Word8
+instance JsonPatch Word16
+instance JsonPatch Word32
+instance JsonPatch Word64
+instance JsonPatch ()
+instance JsonPatch T.Text
+instance JsonPatch Data.Text.Lazy.Text
+instance JsonPatch Version
+instance JsonPatch CTime
+instance JsonPatch Data.IntSet.IntSet
+instance JsonPatch Scientific
+instance JsonPatch LocalTime
+instance JsonPatch TimeOfDay
+instance JsonPatch UTCTime
+instance JsonPatch NominalDiffTime
+instance JsonPatch DiffTime
+instance JsonPatch Day
+instance JsonPatch UUID
+instance JsonPatch DotNetTime
+-- no indexing possible into hashset, since it is unordered.
+instance (Hashable a, Eq a, FromJSON a, Typeable a, ToJSON a) =>
+         JsonPatch (HashSet.HashSet a)
+instance (Typeable a, Integral a, ToJSON a, FromJSON a, Eq a)  =>
+         JsonPatch (Ratio a)
+instance (HasResolution a, Typeable a, FromJSON a, ToJSON a) =>
+         JsonPatch (Fixed a)
+-- IntMap is also a terminal instance, because it is represented by an
+-- Array rather than an Object, which makes indexing not possible.
+instance JsonPatch a => JsonPatch (IntMap a)         
+
+deriveJsonPatch (defaultOptions {sumEncoding = ObjectWithSingleField}) ''Either
+deriveJsonPatch (defaultOptions {sumEncoding = UntaggedValue}) ''Maybe
+deriveJsonPatch defaultOptions ''(,)
+deriveJsonPatch defaultOptions ''(,,)
+deriveJsonPatch defaultOptions ''(,,,)
+deriveJsonPatch defaultOptions ''(,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,,,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,,,,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,,,,,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,,,,,,,,,)
+deriveJsonPatch defaultOptions ''(,,,,,,,,,,,,,,)
+
+instance Typeable a => JsonPatch (Proxy a)
+deriving instance JsonPatch a => JsonPatch (Min a)
+deriving instance JsonPatch a => JsonPatch (Max a)
+deriving instance JsonPatch a => JsonPatch (First a)
+deriving instance JsonPatch a => JsonPatch (Last a)
+deriving instance JsonPatch a => JsonPatch (WrappedMonoid a)
+deriving instance JsonPatch a => JsonPatch (Option a)
+deriving instance JsonPatch a => JsonPatch (Identity a)
+deriving instance JsonPatch a => JsonPatch (Dual a)
+deriving instance (Typeable b, JsonPatch a) => JsonPatch (Const a b)
+deriving instance (Eq1 f, Eq1 g, FromJSON1 f, FromJSON1 g, Typeable f,
+                   Typeable g, JsonPatch a, ToJSON1 f,
+                   ToJSON1 g, JsonPatch (f (g a)))
+                  => JsonPatch (Compose f g a)
+deriving instance (Typeable a, JsonPatch b) => JsonPatch (Tagged a b)
+
+intKey :: Key -> Result Int
+intKey (OKey _) = Error "expected Array Key."
+intKey (AKey i) = pure i
+
+strKey :: Key -> T.Text
+strKey (OKey s) = s
+strKey (AKey i) = T.pack $ show i
+
+isEndKey :: Key -> Bool
+isEndKey = (== OKey "-")
+
+-- instance FieldLens (Tree a)
+
+splitList :: Int -> [a] -> Maybe ([a], [a])
+splitList i _ | i < 0 = Nothing
+splitList 0 xs = Just ([], xs)
+splitList _ [] = Nothing
+splitList n (x:xs) = do
+  (l, r) <- splitList (n-1) xs
+  pure (x:l, r)
+
+instance (JsonPatch a) => JsonPatch (Tree a)
+instance (JsonPatch a) => FieldLens (Tree a) where
+  fieldLens key (Node x t) = do
+    i <- intKey key
+    case i of
+      0 -> pure $ GetSet x (\v -> pure $ Node v t)
+      1 -> pure $ GetSet t (\v -> pure $ Node x v)
+      _ -> Error "Invalid path"
+
+instance (ToJSON1 f, ToJSON1 g, FromJSON1 f, FromJSON1 g, Eq1 f, Eq1 g,
+          JsonPatch a, Typeable f, Typeable g, JsonPatch (f a), JsonPatch (g a))
+         => JsonPatch (Product f g a)
+instance (ToJSON1 f, ToJSON1 g, FromJSON1 f, FromJSON1 g, Eq1 f, Eq1 g,
+          JsonPatch a, Typeable f, Typeable g, JsonPatch (f a), JsonPatch (g a))
+          => FieldLens (Product f g a) where
+  fieldLens key (Pair l r) = do
+    i <- intKey key
+    case i of
+      0 -> pure $ GetSet l (\v -> pure $ Pair v r)
+      1 -> pure $ GetSet r (\v -> pure $ Pair l v)
+      _ -> Error "Invalid path"
+
+instance (ToJSON1 f, ToJSON1 g, FromJSON1 f, FromJSON1 g, Eq1 f, Eq1 g,
+          JsonPatch a, Typeable f, Typeable g, JsonPatch (f a), JsonPatch (g a))
+         => JsonPatch (Sum f g a)
+instance (ToJSON1 f, ToJSON1 g, FromJSON1 f, FromJSON1 g, Eq1 f, Eq1 g,
+          JsonPatch a, Typeable f, Typeable g, JsonPatch (f a), JsonPatch (g a))
+          => FieldLens (Sum f g a) where
+  fieldLens key (InL x) =
+    case strKey key of
+      "InL" -> pure $ GetSet x (pure . InL)
+      _ -> Error "Invalid path"
+
+  fieldLens key (InR x) =
+    case strKey key of
+      "InR" -> pure $ GetSet x (pure . InR)
+      _ -> Error "Invalid path"
+
+instance JsonPatch a => JsonPatch [a]
+instance JsonPatch a => FieldLens [a] where
+  fieldLens key lst = do
+    i <- intKey key
+    case splitList i lst of
+      Just (l, r1:rs) ->
+        pure $ GetSet r1 (\v -> pure $ l ++ v:rs)
+      _ -> Error "Index out of bounds"
+  {-# INLINE fieldLens #-}
+
+  insertAt key lst v f
+    | isEndKey key = (lst ++) <$> f v
+    | otherwise = do
+        i <- intKey key
+        case splitList i lst of
+          Just (l, r) -> (\v' -> l ++ v':r) <$> f v
+          Nothing -> Error "Index out of bounds"
+  deleteAt key lst f = do
+    i <- intKey key
+    case splitList i lst of
+      Just (l, r1:rs) -> pure (f r1, l ++ rs)
+      _ -> Error "Index out of bounds"
+
+instance JsonPatch a => JsonPatch (NonEmpty.NonEmpty a)
+instance JsonPatch a => FieldLens (NonEmpty.NonEmpty a) where
+  fieldLens key ne = do
+    GetSet v f <- fieldLens key (NonEmpty.toList ne)
+    pure $ GetSet v (fmap NonEmpty.fromList . f)
+  {-# INLINE fieldLens #-}
+
+  insertAt key ne v f =
+    NonEmpty.fromList <$> insertAt key (NonEmpty.toList ne) v f
+  deleteAt key ne f = do
+    (r, l) <- deleteAt key (NonEmpty.toList ne) f
+    case NonEmpty.nonEmpty l of
+      Nothing -> Error "Cannot delete last element of NonEmpty"
+      Just ne2 -> pure (r, ne2)
+
+instance JsonPatch a => JsonPatch (DList.DList a)
+instance JsonPatch a => FieldLens (DList.DList a) where
+  fieldLens key dl = do
+    GetSet v f <- fieldLens key (DList.toList dl)
+    pure $ GetSet v (fmap DList.fromList . f)
+  {-# INLINE fieldLens #-}
+
+  insertAt key dl v f =
+    DList.fromList <$> insertAt key (DList.toList dl) v f
+  deleteAt key dl f = 
+    fmap DList.fromList <$> deleteAt key (DList.toList dl) f
+    
+      
+instance (Ord a, JsonPatch a) => JsonPatch (Set.Set a) 
+instance (Ord a, JsonPatch a) => FieldLens (Set.Set a) where
+  fieldLens key st = do
+    i <- intKey key
+    when (i < 0 || i >= Set.size st) $
+      Error "Index out of bounds"
+    pure $ GetSet (Set.elemAt i st) $ 
+      \v -> pure $ Set.insert v $ Set.deleteAt i st
+  {-# INLINE fieldLens #-}
+    
+  insertAt key st v f
+    | isEndKey key =
+        (`Set.insert` st) <$> f v
+    | otherwise = do
+        i <- intKey key
+        when (i < 0 || i >= Set.size st) $
+          Error "Index out of bounds"
+        (`Set.insert` st) <$> f v
+
+  deleteAt key st f = do
+    i <- intKey key
+    when (i < 0 || i >= Set.size st) $
+      Error "Index out of bounds"
+    pure (f $ Set.elemAt i st, Set.deleteAt i st)
+
+instance (Ord a, JsonPatch a) => JsonPatch (Seq.Seq a) where
+instance (Ord a, JsonPatch a) => FieldLens (Seq.Seq a) where
+  fieldLens key sq = do
+    i <- intKey key
+    case Seq.lookup i sq of
+      Nothing -> Error "Index out of bounds"
+      Just v -> pure $ GetSet v $
+        \v' -> pure $ Seq.update i v' sq
+  {-# INLINE fieldLens #-}
+
+  insertAt key sq v f
+    | isEndKey key = (sq Seq.|>) <$> f v
+    | otherwise = do
+        i <- intKey key
+        (\v'-> Seq.insertAt i v' sq) <$> f v
+
+  deleteAt key sq f = do
+    i <- intKey key
+    case Seq.lookup i sq of
+      Nothing -> Error "Index out of bounds"
+      Just v -> pure (f v, Seq.deleteAt i sq)
+  {-# INLINE deleteAt #-}
+
+instance (JsonPatch a) => FieldLens (Vector.Vector a) where
+  fieldLens key v = do
+    i <- intKey key
+    when (i < 0 || i >= Vector.length v) $
+      Error "Index out of bounds"
+    let (l, r) = Vector.splitAt i v
+    pure $ GetSet (Vector.head r) $
+      \v' -> pure $ l Vector.++ Vector.cons v' (Vector.tail r)
+      
+  {-# INLINE fieldLens #-}
+  
+  insertAt key vec v f
+    | isEndKey key = Vector.snoc vec <$> f v
+    | otherwise = do
+        i <- intKey key
+        when (i < 0 || i >= Vector.length vec) $
+          Error "Index out of bounds"
+        let (l, r) = Vector.splitAt i vec
+        (\v' -> l Vector.++ Vector.cons v' r) <$> f v
+
+  deleteAt key vec f = do
+    i <- intKey key
+    when (i < 0 || i >= Vector.length vec) $
+      Error "Index out of bounds"
+    let (l, r) = Vector.splitAt i vec
+    pure (f $ Vector.head r, l Vector.++ Vector.tail r)
+
+instance (UVector.Unbox a, JsonPatch a) => JsonPatch (UVector.Vector a)
+instance (UVector.Unbox a, JsonPatch a) => FieldLens (UVector.Vector a) where
+  fieldLens key v = do
+    i <- intKey key
+    when (i < 0 || i >= UVector.length v) $
+      Error "Index out of bounds"
+    let (l, r) = UVector.splitAt i v
+    pure $ GetSet (UVector.head r) $
+      \v' -> pure $ l UVector.++ UVector.cons v' (UVector.tail r)
+  {-# INLINE fieldLens #-}
+
+  insertAt key vec v f
+    | isEndKey key = UVector.snoc vec <$> f v
+    | otherwise = do
+        i <- intKey key
+        when (i < 0 || i >= UVector.length vec) $
+          Error "Index out of bounds"
+        let (l, r) = UVector.splitAt i vec
+        (\v' -> l UVector.++ UVector.cons v' r) <$> f v
+
+  deleteAt key vec f = do
+    i <- intKey key
+    when (i < 0 || i >= UVector.length vec) $
+      Error "Index out of bounds"
+    let (l, r) = UVector.splitAt i vec
+    pure (f $ UVector.head r, l UVector.++ UVector.tail r)
+
+instance (SVector.Storable a, JsonPatch a) => JsonPatch (SVector.Vector a) 
+instance (SVector.Storable a, JsonPatch a) => FieldLens (SVector.Vector a) where
+  fieldLens key v = do
+    i <- intKey key
+    when (i < 0 || i >= SVector.length v) $
+      Error "Index out of bounds"
+    let (l, r) = SVector.splitAt i v
+    pure $ GetSet (SVector.head r) $
+      \v' -> pure $ l SVector.++ SVector.cons v' (SVector.tail r)
+  {-# INLINE fieldLens #-}
+
+  insertAt key vec v f
+    | isEndKey key = SVector.snoc vec <$> f v
+    | otherwise = do
+        i <- intKey key
+        when (i < 0 || i >= SVector.length vec) $
+          Error "Index out of bounds"
+        let (l, r) = SVector.splitAt i vec
+        (\v' -> l SVector.++ SVector.cons v' r) <$> f v
+
+  deleteAt key vec f = do
+    i <- intKey key
+    when (i < 0 || i >= SVector.length vec) $
+      Error "Index out of bounds"
+    let (l, r) = SVector.splitAt i vec
+    pure (f $ SVector.head r, l SVector.++ SVector.tail r)
+
+instance (PVector.Prim a, JsonPatch a) => JsonPatch (PVector.Vector a) 
+instance (PVector.Prim a, JsonPatch a) => FieldLens (PVector.Vector a) where
+  fieldLens key v = do
+    i <- intKey key
+    when (i < 0 || i >= PVector.length v) $
+      Error "Index out of bounds"
+    let (l, r) = PVector.splitAt i v
+    pure $ GetSet (PVector.head r) $
+      \v' -> pure $ l PVector.++ PVector.cons v' (PVector.tail r)
+  {-# INLINE fieldLens #-}
+
+  insertAt key vec v f
+    | isEndKey key = PVector.snoc vec <$> f v
+    | otherwise = do
+        i <- intKey key
+        when (i < 0 || i >= PVector.length vec) $
+          Error "Index out of bounds"
+        let (l, r) = PVector.splitAt i vec
+        (\v' -> l PVector.++ PVector.cons v' r) <$> f v
+
+  deleteAt key vec f = do
+    i <- intKey key
+    when (i < 0 || i >= PVector.length vec) $
+      Error "Index out of bounds"
+    let (l, r) = PVector.splitAt i vec
+    pure (f $ PVector.head r, l PVector.++ PVector.tail r)
+
+getMapKey :: FromJSONKey a => T.Text -> Result (Maybe a)
+getMapKey s = case fromJSONKey of
+  FromJSONKeyCoerce _ -> pure $ Just $ unsafeCoerce s
+  FromJSONKeyText fromTxt -> pure $ Just $ fromTxt  s
+  FromJSONKeyTextParser parser -> Just <$> parse parser s
+  FromJSONKeyValue _ -> pure Nothing
+
+getHashMapKey :: FromJSONKey a => Key -> Result a
+getHashMapKey key =
+  maybe (Error "Invalid path") pure =<<
+  getMapKey (strKey key) 
+
+instance (ToJSONKey k, Typeable k, Eq k, Hashable k, FromJSONKey k, JsonPatch a)
+         => JsonPatch (HashMap.HashMap k a)
+instance (ToJSONKey k, Typeable k, Eq k, Hashable k, FromJSONKey k, JsonPatch a)
+         => FieldLens (HashMap.HashMap k a) where
+  fieldLens key hm = do
+    k <- getHashMapKey key
+    case HashMap.lookup k hm of
+      Nothing -> Error "Invalid Pointer"
+      Just val ->
+        pure $ GetSet val (\v -> pure $ HashMap.insert k v hm)
+  {-# INLINE fieldLens #-}
+
+  insertAt key hm v f = do
+    k <- getHashMapKey key
+    (\v' -> HashMap.insert k v' hm) <$> f v
+  
+  deleteAt key hm f = do
+    k <- getHashMapKey key
+    case HashMap.lookup k hm of
+      Nothing -> Error "Invalid Pointer"
+      Just val -> pure (f val, HashMap.delete k hm)
+
+instance (FromJSONKey k, ToJSONKey k, Eq k, Ord k, JsonPatch k, JsonPatch a)
+         => JsonPatch (Map.Map k a)
+instance (FromJSONKey k, ToJSONKey k, Eq k, Ord k, JsonPatch a, JsonPatch k)
+         => FieldLens (Map.Map k a) where
+  fieldLens key map1 = do
+    k <- getMapKey $ strKey key
+    case k of
+      Nothing -> do
+        i <- intKey key
+        when (i < 0 || i >= Map.size map1) $
+          Error "Invalid Pointer"
+        let val = Map.elemAt i map1
+        pure $ GetSet val
+           (\(k2, v) -> pure $ Map.insert k2 v $ 
+                        Map.deleteAt i map1)
+      Just s ->
+        case Map.lookup s map1 of
+          Nothing -> Error "Invalid Pointer"
+          Just val ->
+            pure $ GetSet val (\v -> pure $ Map.insert s v map1)
+  {-# INLINE fieldLens #-}
+
+  insertAt key map1 val f = do
+    k <- getMapKey $ strKey key
+    case k of
+      Nothing -> do
+        if isEndKey key then pure () else do
+          i <- intKey key
+          when (i < 0 || i >= Map.size map1) $
+            Error "Invalid Pointer"
+        (k2, v) <- f val
+        pure $ Map.insert k2 v map1
+      Just s ->
+        (\v -> Map.insert s v map1) <$> f val
+        
+  deleteAt key map1 f = do
+    k <- getMapKey $ strKey key
+    case k of
+      Nothing -> do
+        i <- intKey key
+        when (i < 0 || i >= Map.size map1) $
+          Error "Invalid Pointer"
+        pure (f $ Map.elemAt i map1, Map.deleteAt i map1)
+      Just s -> case Map.lookup s map1 of
+        Nothing -> Error "Invalid Pointer"
+        Just v -> pure (f v, Map.delete s map1)
+
+instance JsonPatch Value where
+  getAtPointer ptr val f =
+    f <$> Pointer.get ptr val
+  deleteAtPointer ptr val f =
+    (,) <$> getAtPointer ptr val f <*>
+    Diff.applyOperation (Rem ptr) val
+  addAtPointer ptr val val2 f = do
+    val3 <- f val2
+    Diff.applyOperation (Add ptr val3) val
+  copyPath from to =
+    Diff.applyOperation (Cpy to from)
+  movePath from to =
+    Diff.applyOperation (Mov to from)
+  replaceAtPointer ptr val val2 f = do
+    val3 <- f val2
+    Diff.applyOperation (Rep ptr val3) val
+  testAtPointer ptr val val2 f = do
+    val3 <- f val2
+    Diff.applyOperation (Tst ptr val3) val
+
diff --git a/Data/Aeson/Diff/Generic/TH.hs b/Data/Aeson/Diff/Generic/TH.hs
new file mode 100644
--- /dev/null
+++ b/Data/Aeson/Diff/Generic/TH.hs
@@ -0,0 +1,431 @@
+{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, MultiWayIf,
+    ExistentialQuantification, TemplateHaskell, PatternGuards #-}
+{-|
+This module contains functions to automatically derive `JsonPatch` instances.
+-}
+
+
+module Data.Aeson.Diff.Generic.TH (deriveJsonPatch)
+  where
+
+import Data.Aeson.Types
+import Data.Aeson.Pointer as Pointer
+import Data.Dynamic
+import Language.Haskell.TH
+import Language.Haskell.TH.Datatype
+import Data.List
+import Data.Aeson.Diff.Generic.Types
+import Text.Read
+import qualified Data.Text as T
+import Control.Monad
+import Data.Maybe
+import Control.Applicative
+
+
+data GetSetPure s = forall v. JsonPatch v => GetSetPure Bool v (v -> s)
+type PathLens s = s -> Path -> Result (Path, Path, GetSetPure s)
+
+data GetSetMaybe s = forall v. JsonPatch (Maybe v) =>
+                     GetSetMaybe (Maybe v) (Maybe v -> s)
+-- a lens which only works on record fields which have type Maybe
+type PathLensMaybe s = s -> Path -> Result (GetSetMaybe s)
+
+-- | Derive a JsonPatch instance, using the given aeson `Options`.
+-- This should work with a `ToJSON` and `FromJSON` instance that uses the
+-- same options.
+deriveJsonPatch :: Options -> Name -> DecsQ
+deriveJsonPatch options name = do
+  (pathLensName, pathLensDecl) <- makePathLens options name
+  (mbLensName, mbLensDecl) <- makeMaybeLens options name
+  sigVars <- datatypeVars <$> reifyDatatype name
+  vars <- mapM (const $ newName "a") sigVars
+  let appliedType = foldl appT (conT name) $ map varT vars
+      constrained =
+        forallT (map plainTV vars) $ 
+        mapM (\v -> [t| JsonPatch $(varT v) |])
+        vars
+  pathLensSig <- sigD pathLensName $ constrained 
+    [t| $(appliedType) -> Path ->
+        Result (Path, Path, GetSetPure $(appliedType)) |]
+  mbLensSig <- sigD mbLensName $ constrained
+    [t| $(appliedType) -> Path -> Result (GetSetMaybe $(appliedType)) |]
+  context <- mapM (\v -> [t| JsonPatch $(varT v) |]) vars
+  classDecl <- instanceD (pure context)
+               [t| JsonPatch $(appliedType) |]
+    [ funD 'getAtPointer [
+        clause [] (normalB [| getAtPointerTH $(varE pathLensName) |]) []]
+    , funD 'deleteAtPointer [
+        clause [] (normalB [| deleteAtPointerTH $(varE pathLensName)
+                             $(varE mbLensName) |]) []]
+    , funD 'addAtPointer [
+        clause [] (normalB [| addAtPointerTH $(varE pathLensName) |]) []]
+    , funD 'movePath [
+        clause [] (normalB [| movePathTH $(varE pathLensName) |]) []]
+    , funD 'copyPath [
+        clause [] (normalB [| copyPathTH $(varE pathLensName) |]) []]
+    , funD 'replaceAtPointer [
+        clause [] (normalB [| replaceAtPointerTH $(varE pathLensName) |]) []]
+    , funD 'testAtPointer [
+        clause [] (normalB [| testAtPointerTH $(varE pathLensName) |]) []]
+    ]
+  pure [pathLensSig, pathLensDecl, mbLensSig, mbLensDecl, classDecl]
+
+
+getAtPointerTH :: (JsonPatch s) => PathLens s -> Pointer -> s
+                     -> (forall v.JsonPatch v => v -> r) -> Result r
+getAtPointerTH _ (Pointer []) s f = pure $ f s
+getAtPointerTH l (Pointer path) s f = do
+  (_, subPath, GetSetPure _ subS _) <- l s path
+  getAtPointer (Pointer subPath) subS f
+
+movePathTH :: (JsonPatch s) => PathLens s -> Pointer -> Pointer -> s
+                 -> Result s
+movePathTH _ (Pointer []) (Pointer []) s = pure s
+movePathTH _ (Pointer []) (Pointer _) _ =
+  Error "Cannot move to subpath"
+movePathTH l (Pointer fromPath) (Pointer toPath) s = do
+  (pref, toSubPath, GetSetPure _ x setr) <- l s toPath
+  if pref `isPrefixOf` toPath
+    then setr <$> movePath (Pointer (take (length pref) fromPath))
+         (Pointer toSubPath) x
+    else do (v, s') <- deleteAtPointer (Pointer fromPath) s toDyn
+            addAtPointer (Pointer toPath) s' v getDynamic
+
+copyPathTH :: (JsonPatch s) => PathLens s -> Pointer -> Pointer -> s
+                 -> Result s
+copyPathTH _ (Pointer []) (Pointer []) s = pure s
+copyPathTH l (Pointer fromPath) (Pointer toPath) s = do
+  v <- getAtPointerTH l (Pointer fromPath) s toDyn
+  addAtPointer (Pointer toPath) s v getDynamic
+
+replaceAtPointerTH :: (JsonPatch s) => PathLens s -> Pointer -> s -> r ->
+                            (forall v.JsonPatch v => r -> Result v) -> Result s
+replaceAtPointerTH _ (Pointer []) _ v f = f v
+replaceAtPointerTH l (Pointer path) s val f = do
+  (_, subPath, GetSetPure _ x setr) <- l s path
+  setr <$> replaceAtPointer (Pointer subPath) x val f
+
+addAtPointerTH :: (JsonPatch s) => PathLens s -> Pointer -> s -> r ->
+                  (forall v.JsonPatch v => r -> Result v) -> Result s
+addAtPointerTH _ (Pointer []) _ v f = f v                  
+addAtPointerTH l (Pointer path) s val f = do
+  (_, subPath, GetSetPure isRecord x setr) <- l s path
+  if null subPath && not isRecord
+    then Error "Cannot add value to non record field"
+    else setr <$> addAtPointer (Pointer subPath) x val f
+
+deleteAtPointerTH :: JsonPatch s => PathLens s -> PathLensMaybe s
+                  -> Pointer -> s -> (forall v.JsonPatch v => v -> r)
+                  -> Result (r, s)
+deleteAtPointerTH _ _ (Pointer []) _ _ =
+  Error "Invalid path"
+deleteAtPointerTH l1 l2 (Pointer path) s f =
+  (do GetSetMaybe v setr <- l2 s path
+      if isNothing v
+        then Error "fallthrough"
+        else pure (f v, setr Nothing)) <|>
+  (do (_, subPath, GetSetPure _ x setr) <- l1 s path
+      fmap setr <$> deleteAtPointer (Pointer subPath) x f)
+      
+testAtPointerTH :: (JsonPatch s) => PathLens s -> Pointer -> s -> r ->
+              (forall v.JsonPatch v => r -> Result v) -> Result s
+testAtPointerTH _ (Pointer []) s r f = do
+  v <- f r
+  if v == s then pure s
+    else Error "Test failed"
+testAtPointerTH l (Pointer path) s val f = do
+  (_, subPath, GetSetPure _ x _) <- l s path
+  _ <- testAtPointer (Pointer subPath) x val f
+  pure s
+
+-- match against the key and the rest of the list
+matchKey :: Key -> PatQ -> ExpQ -> MatchQ
+matchKey (OKey str) rest e = do
+  strVar <- newName "str"
+  match (conP 'OKey [varP strVar] `consP` rest)
+    (guardedB [liftA2 (,)
+               (normalG [| $(varE strVar) ==
+                          T.pack $(litE $ stringL $ T.unpack str)
+                         |])
+                e])
+    []
+
+matchKey (AKey i) rest e =
+  match (conP 'AKey [litP $ integerL $ fromIntegral i] `consP` rest)
+  (normalB e) []
+
+keyExp :: Key -> ExpQ
+keyExp (OKey str) =  [| OKey $ T.pack $(litE $ stringL $ T.unpack str) |]
+keyExp (AKey i) = [| AKey i |]
+                
+makeKey :: String -> Key
+makeKey str = case readMaybe str of
+  Nothing -> OKey $ T.pack str
+  Just i -> AKey i
+
+consP :: PatQ -> PatQ -> PatQ
+consP x y = conP '(:) [x, y]
+
+select :: [a] -> [([a], a, [a])]
+select [] = []
+select l@(_:lt) = zip3 (inits l) l (tails lt)
+
+appListE :: ExpQ -> [ExpQ] -> ExpQ
+appListE = foldl appE
+
+invalidMatch :: MatchQ
+invalidMatch = match wildP (normalB [| Error "Invalid path" |]) []
+
+-- create matches for positional fields
+makePosCases :: Name -> Maybe Key -> Name -> Int -> MatchQ
+makePosCases pathVar prefix consName nFields = do
+  vs <- replicateM nFields $ newName "var"
+  v2 <- newName "var"
+  subPath <- newName "path"
+  let mkPosMatch :: ([Name], Name, [Name]) -> Integer -> MatchQ
+      mkPosMatch (p, v, n) i =
+        matchKey (AKey $ fromIntegral i) (varP subPath)
+        [| pure ( $(listE $ maybeToList (keyExp <$> prefix) ++ [
+                       appE (conE 'AKey) (litE $ IntegerL i)])
+                , $(varE subPath)
+                , GetSetPure False $(varE v)
+                  $(lamE [varP v2] $
+                    appListE (conE consName) $
+                    varE <$> (p ++ v2 : n))
+                )
+         |]
+      casePrefix f = case prefix of
+        Nothing -> f pathVar 
+        Just key -> do
+          subPathVar <- newName "subPath"
+          caseE (varE pathVar)
+            [matchKey key (varP subPathVar) (f subPathVar), invalidMatch]
+
+  match (conP consName $ map varP vs)
+    (normalB $ casePrefix $ \subPathVar ->
+        caseE (varE subPathVar) $
+        zipWith mkPosMatch (select vs) [0..] ++ [invalidMatch] )
+    []
+
+-- create matches for record fields
+makeRecCases :: Name -> Maybe Key -> [String] -> Name -> MatchQ
+makeRecCases pathVar prefix recordFields consName = do
+  vs <- mapM (const $ newName "var") recordFields
+  v2 <- newName "var"
+  subPath <- newName "path"
+  let mkRecMatch :: ([Name], Name, [Name]) -> String -> MatchQ
+      mkRecMatch (p, v, n) fieldName =
+        matchKey (makeKey fieldName) (varP subPath)
+        [| pure ( $(listE $ maybeToList (keyExp <$> prefix) ++
+                    [keyExp $ makeKey fieldName])
+                , $(varE subPath)
+                , GetSetPure True $(varE v)
+                  $(lamE [varP v2] $
+                    appListE (conE consName) $
+                    varE <$> (p ++ v2 : n))
+                )
+         |]
+      casePrefix f = case prefix of
+        Nothing -> f pathVar 
+        Just key -> do
+          subPathVar <- newName "subPath"
+          caseE (varE pathVar)
+            [matchKey key (varP subPathVar) (f subPathVar), invalidMatch]
+
+  match (conP consName $ map varP vs)
+    (normalB $ casePrefix $ \subPathVar ->
+        caseE (varE subPathVar) $
+        zipWith mkRecMatch (select vs) recordFields ++ [invalidMatch])
+    []
+
+isMaybe :: Type -> Bool
+isMaybe (AppT (ConT name) _) = name == ''Maybe 
+isMaybe _ = False
+
+getMaybeVars :: [Type] -> [Name] -> [([Name], Name, [Name])]
+getMaybeVars types vars =
+  map snd $ filter (isMaybe . fst) $
+  zip types $ select vars
+
+makePathLensName :: String -> String -> String
+makePathLensName prefix ('(':r)
+  | (n, ")") <- span (== ',') r = 
+      prefix ++ "Tuple" ++ show (length n)
+makePathLensName prefix s = prefix ++ s
+ 
+-- create matches for record fields
+makeMaybeRecCases :: Name -> Maybe Key -> [String] -> [Type] -> Name -> Maybe MatchQ
+makeMaybeRecCases _ _ _ types _
+  | not $ any isMaybe types = Nothing
+makeMaybeRecCases pathVar prefix recordFields types consName = Just $ do
+  vs <- mapM (const $ newName "var") recordFields
+  v2 <- newName "var"
+  let mkRecMatch :: ([Name], Name, [Name]) -> String -> MatchQ
+      mkRecMatch (p, v, n) fieldName =
+        matchKey (makeKey fieldName) (listP [])
+        [| pure ( GetSetMaybe $(varE v)
+                  $(lamE [varP v2] $
+                    appListE (conE consName) $
+                    varE <$> (p ++ v2 : n))
+                ) |]
+      casePrefix f = case prefix of
+        Nothing -> f pathVar 
+        Just key -> do
+          subPathVar <- newName "subPath"
+          caseE (varE pathVar)
+            [matchKey key (varP subPathVar) (f subPathVar), invalidMatch]
+
+  match (conP consName $ map varP vs)
+    (normalB $ casePrefix $ \subPathVar ->
+        caseE (varE subPathVar) $
+     zipWith mkRecMatch (getMaybeVars types vs) recordFields ++ [invalidMatch])
+    []
+
+-- create a match for a single positional field
+makeSingleCase :: Name -> Maybe Key -> Name -> MatchQ
+makeSingleCase pathVar prefix consName = do
+  v <- newName "var"
+  v2 <- newName "var"
+  subPath <- newName "path"
+  match (conP consName [varP v])
+    (normalB $ case prefix of
+         Nothing ->
+           [| pure ( $(listE [])
+                   , $(varE pathVar)
+                   , GetSetPure False $(varE v)
+                     $(lamE [varP v2] $
+                       appE (conE consName) $
+                       varE v2)) |]
+         Just key ->
+           caseE (varE pathVar) [
+           matchKey key (varP subPath)
+             [| pure ( $(listE [keyExp key])
+                     , $(varE subPath)
+                     , GetSetPure False $(varE v)
+                       $(lamE [varP v2] $
+                         appE (conE consName) $
+                         varE v2)) |]
+           , invalidMatch]
+    ) []
+
+makePathLens :: Options -> Name -> Q (Name, Dec)
+makePathLens options name = do
+  typeInfo <- reifyDatatype name
+  let funName = mkName $ makePathLensName "generatedPathLensFor" $
+                nameBase name
+  struc <- newName "struc"
+  pathVar <- newName "path"
+  let nConstructors = length $ datatypeCons typeInfo
+      isTaggedObject = case sumEncoding options of
+        TaggedObject _ _ -> True
+        _ -> False
+
+      makeCase :: ConstructorInfo -> Maybe MatchQ
+      makeCase consInfo =
+        let prefix
+              | (nConstructors == 1) &&
+                not (tagSingleConstructors options) = Nothing
+              | otherwise = case sumEncoding options of
+                  UntaggedValue -> Nothing
+                  TaggedObject _ contentsName ->
+                    Just $ makeKey contentsName
+                  TwoElemArray -> Just $ AKey 1
+                  ObjectWithSingleField ->
+                    Just $ makeKey $ constructorTagModifier options $
+                    nameBase $ constructorName consInfo
+        in case constructorVariant consInfo of
+          RecordConstructor [] -> Nothing
+          RecordConstructor [_]
+            | unwrapUnaryRecords options &&
+              -- unwrapping is not done for taggedObject with multiple
+              -- constructors
+              (nConstructors == 1 || not isTaggedObject) ->
+                Just $ makeSingleCase pathVar prefix $
+                constructorName consInfo
+          RecordConstructor fieldNames ->
+            Just $ makeRecCases pathVar
+            -- fields are unpacked into the object with TaggedObject
+            (if isTaggedObject then Nothing else prefix)
+            (map (fieldLabelModifier options . nameBase) fieldNames) $
+            constructorName consInfo
+          _ -> case length $ constructorFields consInfo of
+                 0 -> Nothing
+                 1 -> Just $ makeSingleCase pathVar prefix $
+                      constructorName consInfo
+                 n -> Just $ makePosCases pathVar prefix
+                      (constructorName consInfo) n
+
+      cases :: [MatchQ]
+      cases = mapMaybe makeCase (datatypeCons typeInfo)
+
+      lensClause = case cases of
+        [] -> clause [wildP, wildP] (normalB [| Error "Invalid Path" |]) []
+        _ -> clause [varP struc, varP pathVar] (
+          normalB $
+          caseE (varE struc) $
+          cases ++ if length cases == nConstructors
+            then [] else  [invalidMatch]
+          ) []
+
+  lensDecl <- funD funName [lensClause]
+  pure (funName, lensDecl)
+
+-- return a lens that only works on maybe fields.  Ugh, so much duplication...
+makeMaybeLens :: Options -> Name -> Q (Name, Dec)
+makeMaybeLens options name = do
+  typeInfo <- reifyDatatype name
+  let funName = mkName $ makePathLensName "generatedMaybePathLensFor" $
+                nameBase name
+  struc <- newName "struc"
+  pathVar <- newName "path"
+  let nConstructors = length $ datatypeCons typeInfo
+      isTaggedObject = case sumEncoding options of
+        TaggedObject _ _ -> True
+        _ -> False
+
+      makeCase :: ConstructorInfo -> Maybe MatchQ
+      makeCase consInfo =
+        let prefix
+              | (nConstructors == 1) &&
+                not (tagSingleConstructors options) = Nothing
+              | otherwise = case sumEncoding options of
+                  UntaggedValue -> Nothing
+                  TaggedObject _ contentsName ->
+                    Just $ makeKey contentsName
+                  TwoElemArray -> Just $ AKey 1
+                  ObjectWithSingleField ->
+                    Just $ makeKey $ constructorTagModifier options $
+                     nameBase $ constructorName consInfo
+        in case constructorVariant consInfo of
+          RecordConstructor [] -> Nothing
+          RecordConstructor [_]
+            | unwrapUnaryRecords options &&
+              -- unwrapping is not done for taggedObject with multiple
+              -- constructors
+              (nConstructors == 1 || not isTaggedObject) ->
+                Nothing
+          RecordConstructor fieldNames ->
+            if omitNothingFields options then 
+              makeMaybeRecCases pathVar
+              -- fields are unpacked into the object with TaggedObject
+              (if isTaggedObject then Nothing else prefix)
+              (map (fieldLabelModifier options . nameBase) fieldNames)
+              (constructorFields consInfo)
+              (constructorName consInfo)
+            else Nothing
+          _ -> Nothing
+
+      cases :: [MatchQ]
+      cases = mapMaybe makeCase (datatypeCons typeInfo)
+
+      lensClause = case cases of
+        [] -> clause [wildP, wildP] (normalB [| Error "Invalid Path" |]) []
+        _ -> clause [varP struc, varP pathVar] (
+          normalB $
+          caseE (varE struc) $
+          cases ++ if length cases == nConstructors
+            then [] else  [invalidMatch]
+          ) []
+          
+  lensDecl <- funD funName [lensClause]
+  pure (funName, lensDecl)
diff --git a/Data/Aeson/Diff/Generic/Types.hs b/Data/Aeson/Diff/Generic/Types.hs
new file mode 100644
--- /dev/null
+++ b/Data/Aeson/Diff/Generic/Types.hs
@@ -0,0 +1,172 @@
+{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts, DefaultSignatures,
+    MultiWayIf, ExistentialQuantification, TemplateHaskell #-}
+module Data.Aeson.Diff.Generic.Types where
+
+import Data.Aeson.Types
+import Data.Aeson.Pointer as Pointer
+import Control.Monad
+import Data.Dynamic
+
+-- | An existentially quantified getter and setter.  The data inside
+-- is manipulated using json conversion functions (`toJSON`,
+-- `fromJSON`), or "Data.Dynamic" (`getDynamic`, `toDyn`, etc...).
+data GetSet s = forall v. JsonPatch v => GetSet v (v -> Result s)
+
+class (Eq s, ToJSON s, FromJSON s, Typeable s) => FieldLens s where
+  -- | Map a key to a getter and setter on the given data.
+  fieldLens :: Key -> s -> Result (GetSet s)
+  fieldLens _ _ = Error "Invalid pointer"
+
+  -- | Delete and return the data at the given key.  The helper
+  -- function determines which value to return: `toJSON` to return an
+  -- aeson `Value`, `toDyn` to return a `Dynamic`.
+  deleteAt :: Key -> s -> (forall v.(JsonPatch v) => v -> r)
+           -> Result (r, s)
+  deleteAt _ _ _ = Error "Illegal operation"
+
+  -- | Insert a value at the given key.  The helper function
+  -- determines how to convert the value: `fromJSON` to convert from
+  -- an aeson `Value`, `getDynamic` to convert from a `Dynamic`.
+  insertAt :: Key -> s -> r -> (forall v.(JsonPatch v) => r -> Result v)
+           -> Result s
+  insertAt _ _ _ _ = Error "Illegal operation"
+
+-- | This class defines all operations necessary for applying patches.
+-- Instances can be written by hand, however it's easier to use the
+-- `fieldLens` class instead, or to derive it automatically using the
+-- template haskell functions from the "Data.Aeson.Diff.Generic.TH"
+-- module. The default implementation is based on `fieldLens`, which
+-- matches a string to a existentially quantified getter and setter
+-- (the `GetSet` datatype).  The Instances can be found in the
+-- "Data.Aeson.Diff.Generic.Instances" module, which this module
+-- exports.
+class (Eq s, ToJSON s, FromJSON s, Typeable s) => JsonPatch s where
+  -- | Retrieve the value at the pointer.  To get back a json `Value`
+  -- use `toJSON` as the helper function, to get back a `Dynamic` use
+  -- `toDyn`.
+  getAtPointer :: Pointer -> s -> (forall v.JsonPatch v => v -> r) -> Result r
+  default getAtPointer :: FieldLens s => Pointer -> s
+                       -> (forall v.JsonPatch v => v -> r) -> Result r
+  getAtPointer (Pointer []) s f = pure $ f s
+  getAtPointer (Pointer (key:path)) s f = do
+    GetSet s2 _ <- fieldLens key s
+    getAtPointer (Pointer path) s2 f
+
+  -- | Remove the value at pointer from the data.  The original
+  -- value is returned.  To get back a json `Value` use `toJSON` as
+  -- the helper function, to get back a `Dynamic` use `toDyn`.
+  deleteAtPointer :: Pointer -> s -> (forall v.JsonPatch v => v -> r)
+                  -> Result (r, s)
+  default deleteAtPointer :: FieldLens s => Pointer -> s
+                          -> (forall v.JsonPatch v => v -> r) -> Result (r, s)
+  deleteAtPointer (Pointer []) _ _ = Error "Invalid pointer"
+  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
+
+  -- | Add a value at the pointer.  To insert a json `Value`, use
+  -- `fromJSON` as the helper function, to insert a `Dynamic` use `getDynamic`.
+  addAtPointer :: Pointer -> s -> r ->
+               (forall v.JsonPatch v => r -> Result v) -> Result s
+  default addAtPointer :: FieldLens s => Pointer -> s -> r
+                       -> (forall v.JsonPatch v => r -> Result v) -> Result s
+  addAtPointer (Pointer []) _ v f = f v
+  addAtPointer (Pointer [key]) s val f =
+    insertAt key s val f
+  addAtPointer (Pointer (key:path)) s val f =
+    updateAtKey key s $ \v ->
+    addAtPointer (Pointer path) v val f
+
+  -- | copyPath @src@ @dst@ s.  Copy the value at src to dest in s.
+  -- If the types don't match an error is returned
+  copyPath :: Pointer -> Pointer -> s -> Result s
+  default copyPath :: FieldLens s => Pointer -> Pointer -> s -> Result s
+  copyPath (Pointer (fromKey: fromPath)) (Pointer (toKey: toPath)) s
+    | fromKey == toKey =
+      updateAtKey toKey s $
+      copyPath (Pointer fromPath) (Pointer toPath)
+  copyPath from to_ s = do
+    v <- getAtPointer from s toDyn
+    addAtPointer to_ s v getDynamic
+
+  -- | movePath @src@ @dst@ s.  Move the value from src to dest in
+  -- s. If the types don't match an error is returned
+  movePath :: Pointer -> Pointer -> s -> Result s
+  default movePath :: FieldLens s => Pointer -> Pointer -> s -> Result s
+  movePath (Pointer []) (Pointer []) s = pure s
+  movePath (Pointer []) _ _ = Error "cannot move to child"
+  movePath (Pointer (fromKey: fromPath)) (Pointer (toKey: toPath)) s
+    | fromKey == toKey =
+      updateAtKey toKey s $
+      movePath (Pointer fromPath) (Pointer toPath)
+  movePath from to_ s = do
+    (v, s') <- deleteAtPointer from s toDyn
+    addAtPointer to_ s' v getDynamic
+
+  -- | Replace the value at the pointer with the new value. To replace
+  -- using a json `Value`, use `fromJSON` as the helper function, to
+  -- insert a `Dynamic` use `getDynamic`.
+  replaceAtPointer :: Pointer -> s -> r ->
+                      (forall v.JsonPatch v => r -> Result v) -> Result s
+  default replaceAtPointer :: FieldLens s => Pointer -> s -> r
+                           -> (forall v.JsonPatch v => r -> Result v)
+                           -> Result s
+  replaceAtPointer (Pointer []) _ v f = f v
+  replaceAtPointer (Pointer [key]) s val f =
+    setAtKey key s val f
+  replaceAtPointer (Pointer (key:path)) s val f =
+    updateAtKey key s (\v -> replaceAtPointer (Pointer path) v val f)
+  {-# INLINABLE replaceAtPointer #-}  
+
+  -- | Test if the value at the pointer matches the given value (after
+  -- conversion).  Return the data if they match, give an error
+  -- otherwise.
+  testAtPointer :: Pointer -> s -> r ->
+                (forall v.JsonPatch v => r -> Result v) -> Result s
+  default testAtPointer :: FieldLens s => Pointer -> s -> r
+                        -> (forall v.JsonPatch v => r -> Result v) -> Result s
+  testAtPointer (Pointer []) s r f = do
+    v <- f r
+    if v == s then pure s
+      else Error "Test failed"
+  testAtPointer (Pointer (key:path)) s val f = do
+    _ <- updateAtKey key s $ \v ->
+      testAtPointer (Pointer path) v val f
+    pure s
+  {-# INLINABLE testAtPointer #-}    
+
+-- | Get the json value at the pointer.  Gives an error if the
+-- destination doesn't exist.
+getValueAtPointer :: JsonPatch s => Pointer -> s -> Result Value
+getValueAtPointer p s = getAtPointer p s toJSON
+{-# INLINE [1] getValueAtPointer #-}
+{-# RULES "getValueAtPointer/Value" getValueAtPointer = Pointer.get #-} 
+
+-- | Get the value at the pointer.  Gives and error If the types don't
+-- match or if the destination doesn't exist.
+getDataAtPointer :: (JsonPatch s, Typeable a) => Pointer -> s
+                 -> Result a
+getDataAtPointer p s = getDynamic =<< getAtPointer p s toDyn
+{-# INLINE [1] getDataAtPointer #-}  
+{-# RULES "getDataAtPointer/Value" getDataAtPointer = Pointer.get #-} 
+
+-- | Read a `Dynamic` value into the `Result` Monad.  Gives a type error if
+-- the results don't match.
+getDynamic ::(Typeable a) => Dynamic -> Result a
+getDynamic = maybe (Error "Couldn't match types") pure . fromDynamic
+
+updateAtKey :: FieldLens s => Key -> s
+            -> (forall v.JsonPatch v => v -> Result v)
+            -> Result s
+updateAtKey key s f = do
+  GetSet v setr <- fieldLens key s
+  setr =<< f v
+{-# INLINE updateAtKey #-}
+
+setAtKey :: FieldLens s => Key -> s -> r
+         -> (forall v.JsonPatch v => r -> Result v)
+         -> Result s
+setAtKey k s a f = updateAtKey k s $ const (f a)
+{-# INLINE setAtKey #-}
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+BSD 3-Clause License
+
+Copyright (c) 2018, Kristof Bastiaensen
+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 the copyright holder nor the names of its
+  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 HOLDER 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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/aeson-diff-generic.cabal b/aeson-diff-generic.cabal
new file mode 100644
--- /dev/null
+++ b/aeson-diff-generic.cabal
@@ -0,0 +1,31 @@
+Name:		aeson-diff-generic
+Version: 	0.0.1
+Synopsis:	Apply a json-patch to any haskell datatype.
+Category: 	Graphics, Geometry, Typography
+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
+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.
+ 
+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
+  Exposed-Modules: Data.Aeson.Diff.Generic
+                   Data.Aeson.Diff.Generic.TH
+                   Data.Aeson.Diff.Generic.Instances
+  Other-Modules: Data.Aeson.Diff.Generic.Types
+                 
+