packages feed

prairie (empty) → 0.0.1.0

raw patch · 11 files changed

+919/−0 lines, 11 filesdep +aesondep +basedep +constraintssetup-changed

Dependencies added: aeson, base, constraints, containers, lens, prairie, template-haskell, text

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for prairie++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2020++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 Author name here 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,5 @@+# prairie++[![Build Status](https://travis-ci.org/parsonsmatt/prairie.svg?branch=main)](https://travis-ci.org/parsonsmatt/prairie)++A library for first class record fields.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ prairie.cabal view
@@ -0,0 +1,89 @@+cabal-version: 1.12++name:           prairie+version:        0.0.1.0+description:    Please see the README on GitHub at <https://github.com/parsonsmatt/prairie#readme>+homepage:       https://github.com/parsonsmatt/prairie#readme+bug-reports:    https://github.com/parsonsmatt/prairie/issues+author:         Matt Parsons+maintainer:     parsonsmatt@gmail.com+copyright:      2020 Matt Parsons+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md+synopsis: A first class record field library+category: Data++source-repository head+  type: git+  location: https://github.com/parsonsmatt/prairie++library+  exposed-modules:+      Prairie+      Prairie.Class+      Prairie.Update+      Prairie.Diff+      Prairie.TH++  build-depends:+      base              >= 4.13 && < 5+    , aeson             +    , constraints+    , containers+    , lens+    , template-haskell  >= 2.15 && < 2.17+    , text++  other-modules:+      Paths_prairie+  hs-source-dirs:+      src+  default-language: Haskell2010++  default-extensions:+    AllowAmbiguousTypes+    BlockArguments+    DataKinds+    DefaultSignatures+    DeriveGeneric+    DerivingStrategies+    ExplicitForAll+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    KindSignatures+    MultiParamTypeClasses+    NamedFieldPuns+    NoStarIsType+    OverloadedStrings+    QuantifiedConstraints+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    TemplateHaskell+    TypeApplications+    TypeFamilies+    TypeOperators+    StandaloneDeriving+    UndecidableInstances+    ConstraintKinds+    ViewPatterns++test-suite prairie-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_prairie+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , prairie+    , aeson+  default-language: Haskell2010
+ src/Prairie.hs view
@@ -0,0 +1,14 @@+-- | A library for first-class record fields.+--+-- @since 0.0.1.0+module Prairie+    ( module Prairie.Class+    , module Prairie.Update+    , module Prairie.Diff+    , module Prairie.TH+    ) where++import Prairie.Class+import Prairie.Update+import Prairie.Diff+import Prairie.TH
+ src/Prairie/Class.hs view
@@ -0,0 +1,353 @@+-- | This module defines the type class 'Record' which enables much of the+-- functionality of the library. You can define instances of this record+-- manually, or you may use the @TemplateHaskell@ deriving function in+-- "Prairie.TH".+--+-- We'll use an example type @User@ throughout the documentation in this+-- module.+--+-- @+-- data User = User+--  { name :: String+--  , age :: Int+--  }+-- @+--+-- @since 0.0.1.0+module Prairie.Class where++import Control.Lens (Lens', set, view)+import Data.Aeson (ToJSON(..), FromJSON(..), withText)+import Data.Constraint (Dict(..))+import Data.Kind (Constraint, Type)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Text (Text)+import Data.Typeable ((:~:)(..), Typeable, eqT)+import GHC.OverloadedLabels (IsLabel(..))+import GHC.TypeLits (Symbol)++-- | Instances of this class have a datatype 'Field' which allow you to+-- represent fields as a concrete datatype. This allows you to have+-- significant flexibility in working with data.+--+-- @since 0.0.1.0+class Record rec where+  -- | A datatype representing fields on the record.+  --+  -- This will be a @GADT@ with one constructor for each record field. By+  -- convention, it's best to name the constructors as with the type name+  -- leading and the field name following. This convention prevents any+  -- possible conflicts from different instances of 'Field'.+  --+  -- Using our example type @User@, we would define this as:+  --+  -- @+  -- data Field User ty where+  --   UserName :: Field User String+  --   UserAge :: Field User Int+  -- @+  --+  -- Now, we have a value @UserName@ that corresponds with the @name@ field+  -- on a @User@. The type of @User@ and @name@ are interesting to compare:+  --+  -- @+  -- UserName :: Field User    String+  -- name     ::       User -> String+  -- @+  --+  -- @since 0.0.1.0+  data Field rec :: Type -> Type++  -- | Given a 'Field' on the record, this function acts as a 'Lens'' into+  -- the record. This allows you to use a 'Field' as a getter or setter.+  --+  -- An example implementation for our 'User' type might look like this:+  --+  -- @+  -- recordFieldLens field =+  --   case field of+  --     UserName ->+  --       'lens' name (\\u n -> u { name = n })+  --     UserAge ->+  --      'lens' age (\\u a -> u { age = a })+  -- @+  --+  -- If you have derived lenses (either from Template Haskell or+  -- @generic-lens@, then you can provide those directly.+  --+  -- @since 0.0.1.0+  recordFieldLens :: Field rec ty -> Lens' rec ty++  -- | An enumeration of fields on the record.+  --+  -- This value uses the 'SomeField' existential wrapper, which allows+  -- 'Field's containing different types to be in the same list.+  --+  -- Our @User@ example would have this implementation:+  --+  -- @+  -- allFields = [SomeField UserAge, SomeField UserName]+  -- @+  --+  -- @since 0.0.1.0+  allFields :: [SomeField rec]++  -- | This function allows you to construct a 'Record' by providing+  -- a value for each 'Field' on the record.+  --+  -- Our @User@ would have an implementation like this:+  --+  -- @+  -- tabulateRecord fromField =+  --   User+  --     { name = fromField UserName+  --     , age = fromField UserAge+  --     }+  -- @+  --+  -- @since 0.0.1.0+  tabulateRecord :: (forall ty. Field rec ty -> ty) -> rec++  -- | Assign a 'Text' label for a record 'Field'.+  --+  -- This allows 'Field's to be converted to 'Text', which is useful for+  -- serialization concerns. For derserializing a 'Field', consider using+  -- @'fieldMap' :: 'Map' 'Text' ('SomeField' rec)@.+  --+  -- @since 0.0.1.0+  recordFieldLabel :: Field rec ty -> Text++-- | A mapping from 'Text' record field labels to the corresponding+-- 'SomeField' for that record.+--+-- @since 0.0.1.0+fieldMap :: Record rec => Map Text (SomeField rec)+fieldMap =+  foldMap+    (\sf@(SomeField f) -> Map.singleton (recordFieldLabel f) sf)+    allFields++-- | Use a 'Field' to access the corresponding value in the record.+--+-- @since 0.0.1.0+getRecordField :: Record rec => Field rec ty -> rec -> ty+getRecordField f = view (recordFieldLens f)++-- | Use a 'Field' to set the corresponding value in the record.+--+-- @since 0.0.1.0+setRecordField :: Record rec => Field rec ty -> ty -> rec -> rec+setRecordField f = set (recordFieldLens f)++-- | An existential wrapper on a 'Field'. This hides the type of the value+-- of the field. This wrapper allows you to have a collection of 'Field's+-- for a record, or to have useful instances for classes like 'Eq' where+-- the type of the values being compared must be the same.+--+-- @since 0.0.1.0+data SomeField rec where+  SomeField :: Field rec a -> SomeField rec++-- | You can write a standalone deriving instance for 'Field':+--+-- @+-- deriving stock instance 'Show' ('Field' User a)+-- @+--+-- This instance is derived, so it'll result in:+--+-- @+-- >>> show (SomeField UserAge)+-- SomeField UserAge+-- @+--+-- @since 0.0.1.0+deriving stock instance (forall a. Show (Field rec a)) => Show (SomeField rec)++instance+  ( forall a. Eq (Field rec a)+  , FieldDict Typeable rec+  )+ =>+  Eq (SomeField rec)+ where+  SomeField (f0 :: Field rec a) == SomeField (f1 :: Field rec b) =+    withFieldDict @Typeable f0 $+    withFieldDict @Typeable f1 $+    case eqT @a @b of+      Just Refl ->+          f0 == f1+      Nothing ->+        False++-- | This instance delegates to the underlying instance of 'ToJSON' for the+-- given field.+--+-- @since 0.0.1.0+instance (forall a. ToJSON (Field rec a)) => ToJSON (SomeField rec) where+  toJSON (SomeField f) = toJSON f++-- | This instance delegates to the underlying instance of 'FromJSON' for+-- the given field.+--+-- @since 0.0.1.0+instance (Record rec) => FromJSON (SomeField rec) where+  parseJSON = withText "Field" $ \txt ->+    case Map.lookup txt (fieldMap @rec) of+      Just field ->+        pure field+      Nothing ->+        fail "Field not"++-- | This delegates to 'recordFieldLabel'  from the 'Record' class.+--+-- @since 0.0.1.0+instance Record rec => ToJSON (Field rec a) where+  toJSON = toJSON . recordFieldLabel++-- | This parses a 'Field' from a 'Text' given by the function+-- 'recordFieldLabel'.+--+-- @since 0.0.1.0+instance (Record rec, FieldDict Typeable rec, Typeable a) => FromJSON (Field rec a) where+  parseJSON = withText "Field" $ \txt ->+    case Map.lookup txt (fieldMap @rec) of+      Just (SomeField (a :: Field rec b)) ->+        withFieldDict @Typeable a $+        case eqT @a @b of+          Just Refl ->+            pure a+          Nothing ->+            fail "types not same???"+      Nothing ->+        fail "Field not"++-- | This class allows you to summon a type class instance based on a 'Field'+-- of the record. Use this type class when you need to assert that all the+-- fields of a record satisfy some type class instance.+--+-- For example, suppose we want to write a generic logging utility for all+-- records where all fields on the record is loggable.+--+-- @+-- class Loggable a where+--   toLog :: a -> LogMessage+-- @+--+-- We can implement a function based on 'Record' to log it:+--+-- @+-- logRecord :: (FieldDict Loggable rec) => rec -> LogMessage+-- logRecord record = foldMap go 'allFields'+--   where+--     go ('SomeField' field) =+--       'withFieldDict' @Loggable $+--       toLog ('getRecordField' field record)+-- @+--+-- The second parameter to 'withFieldDict' will have the instance of+-- 'Loggable a' in scope.+--+-- You can define instances polymorphic in the constraint with the+-- @ConstraintKinds@ language extension.+--+-- @since 0.0.1.0+class (Record r) => FieldDict (c :: Type -> Constraint) (r :: Type) where+  -- | Return the 'Dict' for the given field.+  --+  -- An implementation of this for the 'User' type would case on each field+  -- and return 'Dict' in each branch.+  --+  -- @+  -- getFieldDict userField =+  --   case userField of+  --    UserName -> Dict+  --    UserAge -> Dict+  -- @+  --+  -- @since 0.0.1.0+  getFieldDict :: Field r a -> Dict (c a)++-- | Given a record @field :: 'Field' rec a@, this function brings the+-- type class instance @c a@ into scope for the third argument.+--+-- This function is intended to be used with a @TypeApplication@ for the+-- constraint you want to instantiate. It is most useful for working with+-- generic records in type class instances.+--+-- @since 0.0.1.0+withFieldDict+  :: forall c rec a r+   . FieldDict c rec+  => Field rec a+  -- ^ The record field we want to unpack. We need this value in order to+  -- know what type we want the constraint to apply to.+  -> (c a => r)+  -- ^ A value that assumes the constraint @c@ holds for the type @a@.+  -> r+withFieldDict l k =+  case getFieldDict @c l of+    Dict -> k++-- | This type class enables you to map a 'Symbol's to a record 'Field'.+--+-- To use this, you'll define an instance+--+-- @+-- instance 'SymbolToField' "age" User Int where+--   symbolToField = UserAge+--+-- instance 'SymbolToField' "name" User String where+--   symbolToField = UserName+-- @+--+-- The main utility here is that you can then write @OverloadedSymbols@+-- that correspond to record fields.+--+-- @+-- nameField :: ('SymbolToField'' "name" rec a) => 'Field' rec a+-- nameField = #name+--+-- userNameField :: 'Field' User String+-- userNameField = #name+-- @+--+-- Note that there's nothing forcing you to use a symbol that exactly+-- matches the type. You can write multiple instances of this for each+-- constructor. The following two instances are perfectly happy to live+-- together.+--+-- @+-- instance 'SymbolToField' "name" User String where+--   symbolToField = UserName+--+-- instance 'SymbolToField' "userName" User String where+--   symbolToField = UserName+-- @+--+-- @since 0.0.1.0+class Record rec => SymbolToField (sym :: Symbol) (rec :: Type) (a :: Type) | rec sym -> a where+  -- | This function is designed to be used with a type application:+  --+  -- @+  -- symbolToField @"age"+  -- @+  --+  -- @since 0.0.1.0+  symbolToField :: Field rec a++-- | If you've defined the relevant instances for 'SymbolToField', then you+-- can use @OverloadedLabels@ to write your labels. This can be convenient+-- if you want to avoid a lot of duplication and verbosity in the types.+--+-- Given the instances for the @User@ example type, we are able to write:+--+-- @+-- getUserName :: User -> String+-- getUserName = getRecordField #name+-- @+--+-- @since 0.0.1.0+instance (SymbolToField sym rec a) => IsLabel sym (Field rec a) where+  fromLabel = symbolToField @sym
+ src/Prairie/Diff.hs view
@@ -0,0 +1,41 @@+-- | This module contains a utility for diffing two records.+--+-- @since 0.0.1.0+module Prairie.Diff+  ( module Prairie.Diff+  , module Prairie.Update+  ) where++import Prairie.Update+import Prairie.Class++-- | Given two 'Record's, this function produces a list of 'Update's that+-- can be performed on the first record such that it will equal the second.+--+-- @+-- 'updateRecord' ('diffRecord' old new) old == new+-- @+--+-- A @['Update' rec]@ can be serialized with 'ToJSON', sent over the wire, and+-- parsed with 'FromJSON', so you can efficiently and easily represent+-- patches to 'Record's.+--+-- @since 0.0.1.0+diffRecord+  :: (Record rec, FieldDict Eq rec)+  => rec+  -- ^ The old record.+  -> rec+  -- ^ The new record.+  -> [Update rec]+diffRecord old new = foldMap go allFields+  where+    go (SomeField f) =+      withFieldDict @Eq f $+        let+          newVal = getRecordField f new+         in+          if getRecordField f old /= newVal+            then [SetField f newVal]+            else []+
+ src/Prairie/TH.hs view
@@ -0,0 +1,247 @@+-- | Helpers for generating instances of the 'Record' type class.+--+-- @since 0.0.1.0+module Prairie.TH where++import Data.Constraint (Dict(..))+import Language.Haskell.TH+import Control.Lens (lens)+import qualified Data.List as List+import Data.Traversable (for)+import Data.Char (toUpper, toLower)+import qualified Data.Text as Text++import Prairie.Class++-- | Create an instance of the 'Record' type class.+--+-- @+-- data User+--   = User+--   { name :: String+--   , age :: Int+--   }+--+-- mkRecord ''User+--+-- ====>+--+-- instance Record User where+--   data Field User a where+--     UserName :: String+--     UserAge :: Int+--+--   recordFieldLens fl =+--     case fl of+--       UserName -> lens name (\u n -> u { name = n)+--       UserAge -> lens age (\u n -> u { age = n)+--+-- instance SymbolToField "age" User Int where symbolToField = UserName+-- instance SymbolToField "name" User String where symbolToField = UserAge+-- @+--+-- If the fields are prefixed with the type's name, this function figures+-- it out and won't duplicate the field.+--+-- @+-- data User+--   = User+--   { userName :: String+--   , userAge :: Int+--   }+--+-- mkRecord ''User+--+-- ====>+--+-- instance Record User where+--   data Field User a where+--     UserName :: String+--     UserAge :: Int+--+--   recordFieldLens fl =+--     case fl of+--       UserName -> lens name (\u n -> u { name = n)+--       UserAge -> lens age (\u n -> u { age = n)+--+-- instance SymbolToField "name" User Int where symbolToField = UserName+-- instance SymbolToField "age" User String where symbolToField = UserAge+-- @+--+-- @since 0.0.1.0+mkRecord :: Name -> DecsQ+mkRecord u = do+  ty <- reify u+  (typeName, con) <-+    case ty of+      TyConI dec ->+        case dec of+          DataD _cxt name _tyvars _mkind [con] _derivs ->+            pure (name, con)+          NewtypeD _cxt name _tyvars _mkind con _derivs ->+            pure (name, con)+          _ ->+            fail "unsupported data structure"+      _ ->+        fail "unsupported type"++  let+    stripTypeName n =+      let+        typeNamePrefix =+          lowerFirst (nameBase typeName)+       in+        case List.stripPrefix typeNamePrefix (nameBase n) of+          Just xs -> mkName (lowerFirst xs)+          Nothing -> n++  (recordCon, names'types) <-+    case con of+      RecC conName varBangTypes ->+        pure $ (conName, map (\(n, _b, t) -> (n, t)) varBangTypes)+      _ ->+        fail "only supports records"++  let+    mkConstrFieldName fieldName =+      mkName (nameBase typeName <> upperFirst (nameBase (stripTypeName fieldName)))++  fieldLensClause <- do+    arg <- newName "field"+    let+      mkMatch (fieldName, _typ) = do+        recVar <- newName "rec"+        newVal <- newName "newVal"++        pure $+          Match+            (ConP (mkConstrFieldName fieldName) [])+            (NormalB $+            VarE 'lens+            `AppE` VarE fieldName+            `AppE`+              LamE [VarP recVar, VarP newVal]+                (RecUpdE (VarE recVar) [(fieldName, VarE newVal)])+            )+            []+    body <- CaseE (VarE arg) <$> traverse mkMatch names'types+    pure $ Clause [VarP arg] (NormalB body) []+  let+    recordFieldLensDec =+      FunD 'recordFieldLens [fieldLensClause]+    fieldConstructors =+      map (\(n, t) -> (mkConstrFieldName n, t)) names'types++  mkAllFields <- pure $+    ValD+      (VarP 'allFields)+      (NormalB $ ListE (map (AppE (ConE 'SomeField) . ConE . fst) fieldConstructors))+      []++  mkTabulateRecord <- do+    fromFieldName <- newName "fromField"+    body <- pure $+      RecConE recordCon $+        map+          (\(n, _) -> (n, VarE fromFieldName `AppE` ConE (mkConstrFieldName n)))+          names'types++    pure $+      FunD 'tabulateRecord+        [ Clause [VarP fromFieldName] (NormalB body) []+        ]++  mkRecordFieldLabel <- do+    fieldName <- newName "fieldName"+    body <- pure $+      CaseE (VarE fieldName)  $+        flip map names'types $ \(n, _) ->+          let+            constrFieldName =+              mkConstrFieldName n+            pat =+              ConP constrFieldName []+            bdy =+              AppE (VarE 'Text.pack) $ LitE $ StringL $ nameBase $ stripTypeName n++           in+            Match pat (NormalB bdy)  []+    pure $+      FunD 'recordFieldLabel+        [ Clause [VarP fieldName] (NormalB body) []+        ]++  let+    fieldConstrs =+      map mkFieldConstr fieldConstructors+    mkFieldConstr (fieldName, typ) =+      GadtC+        [ fieldName+        ]+        []+        (ConT ''Field `AppT` ConT typeName `AppT` typ)++    recordInstance =+      InstanceD+        Nothing+        []+        (ConT ''Record `AppT` ConT typeName)+        (+          [ DataInstD+              []+              Nothing+              (ConT ''Field `AppT` ConT typeName `AppT` VarT (mkName "a"))+              Nothing+              fieldConstrs+              []+          , recordFieldLensDec+          , mkAllFields+          , mkTabulateRecord+          , mkRecordFieldLabel+          ]+        )++  fieldDictInstance <- do+    constraintVar <- newName "c"+    fieldVar <- newName "field"+    let+      allFieldsC =+        map (VarT constraintVar `AppT`) (map snd names'types)+      fieldDictDecl =+        [ FunD 'getFieldDict [Clause [VarP fieldVar] (NormalB fieldDictBody) []]+        ]+      fieldDictBody =+        CaseE (VarE fieldVar) $ map mkFieldDictMatches fieldConstructors+      mkFieldDictMatches (name, _type) =+        Match (ConP name []) (NormalB (ConE 'Dict)) []++    pure $+      InstanceD+        Nothing -- maybe overlap+        allFieldsC+        (ConT ''FieldDict `AppT` VarT constraintVar `AppT` ConT typeName)+        fieldDictDecl++  symbolToFieldInstances <-+    fmap concat $ for names'types $ \(fieldName, typ) -> do+      [d|+        instance SymbolToField $(litT (strTyLit (nameBase fieldName))) $(conT typeName) $(pure typ) where+          symbolToField = $(conE (mkConstrFieldName fieldName))+        |]++  pure $+    [ recordInstance+    , fieldDictInstance+    ]+    +++      symbolToFieldInstances++overFirst :: (Char -> Char) -> String -> String+overFirst f str =+  case str of+    [] -> []+    (c:cs) -> f c : cs++upperFirst, lowerFirst :: String -> String+upperFirst = overFirst toUpper+lowerFirst = overFirst toLower
+ src/Prairie/Update.hs view
@@ -0,0 +1,99 @@+-- |  This cl+--+-- @since 0.0.1.0+module Prairie.Update where++import Data.Aeson (ToJSON(..), FromJSON(..), object, withObject, (.:), (.=))+import Control.Lens (set)+import Data.Typeable (Typeable, (:~:)(..), eqT)++import Prairie.Class++-- | An operation representing an update against the 'rec' in question.+--+-- This type is partially an example - you may want to have a more+-- sophisticated update type than merely setting fields.+--+-- @since 0.0.1.0+data Update rec where+  SetField :: Field rec a -> a -> Update rec++-- |+--+-- @since 0.0.1.0+instance (forall a. Eq (Field rec a), FieldDict Typeable rec, FieldDict Eq rec) => Eq (Update rec) where+  SetField f0 (a0 :: a0) == SetField f1 (a1 :: a1) =+    withFieldDict @Typeable f0 $+    withFieldDict @Typeable f1 $+    case eqT @a0 @a1 of+      Nothing ->+        False+      Just Refl ->+        withFieldDict @Eq f0 $+        f0 == f1 && a0 == a1++-- |+--+-- @since 0.0.1.0+instance (forall a. Show (Field rec a), FieldDict Show rec) => Show (Update rec) where+  showsPrec d (SetField field a) =+    withFieldDict @Show field $+      showParen (d > 10)+        $ showString "Update "+        . showsPrec 11 field+        . showString " "+        . showsPrec 11 a++-- |  Renders an 'Update' in the following format:+--+-- @+-- {+--    "field": 'toJSON' field,+--    "value": 'toJSON' newValue+--+-- }+-- @+--+-- @since 0.0.1.0+instance (FieldDict ToJSON rec, forall a. ToJSON (Field rec a)) => ToJSON (Update rec) where+  toJSON (SetField field newVal) =+    withFieldDict @ToJSON field $+      object [ "field" .= field, "value" .= newVal ]++-- | Parses an 'Update' with the following format:+--+-- @+-- {+--     "field": field,+--     "value": newValue+-- }+-- @+--+--+-- @since 0.0.1.0+instance (FieldDict FromJSON  rec, FieldDict Typeable rec, FromJSON (SomeField rec)) => FromJSON (Update rec) where+  parseJSON = withObject "Update" $ \o -> do+    field <- o .: "field"+    case field of+      SomeField field ->+        withFieldDict @FromJSON field $+          SetField field <$> o .: "value"++-- | Run an 'Update' against the record it is for.+--+-- @+-- >>> let user = User { name = "Bob", age = 30 }+-- >>> updateSingleField (SetField UserName "Alice") user+-- User { name = "Alice", age = 30 }+-- @+--+-- @since 0.0.1.0+updateSingleField :: Record rec => Update rec -> rec -> rec+updateSingleField (SetField field newValue) rec =+  set (recordFieldLens field) newValue rec++-- | Perform an list of updates against the 'Record'.+--+-- @since 0.0.1.0+updateRecord :: Record rec => [Update rec] -> rec -> rec+updateRecord upds rec = foldr updateSingleField rec upds
+ test/Spec.hs view
@@ -0,0 +1,36 @@+{-# language TypeApplications, StandaloneDeriving, ConstraintKinds, TemplateHaskell, DataKinds, OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies, GADTs #-}+module Main where++import Prairie++import Data.Aeson+import Control.Monad++data User = User { name :: String, age :: Int }+  deriving Eq++mkRecord ''User++deriving instance Eq (Field User a)++example = User "Alice" 30++assert :: String -> Bool -> IO ()+assert message success = unless success (error message)++main :: IO ()+main = do+  assert "getField" $ getRecordField UserName example == "Alice"+  assert "setField" $ setRecordField UserAge 32 example == User "Alice" 32+  assert "label" $ recordFieldLabel UserAge == "age"+  assert "label" $ recordFieldLabel UserName == "name"++  assert "update json" $+    encode (diffRecord example (setRecordField UserName "Bob" example))+    ==+    "[{\"field\":\"name\",\"value\":\"Bob\"}]"++  assert "decode update" $+    decode "[{\"field\":\"name\",\"value\":\"Bob\"}]"+    ==+    Just [SetField UserName "Bob"]