split up fieldJsonFormat and sumJsonFormat into to/from versions, bump version to 0.7.1.0

composite-aeson-refined/package.yaml

 name:                composite-aeson-refined
-version:             0.7.0.0
+version:             0.7.1.0
 synopsis:            composite-aeson support for Refined from the refined package
 description:         JsonFormat and DefaultJsonFormat for Refined
 homepage:            https://github.com/ConferOpenSource/composite#readme

composite-aeson/package.yaml

 name:                composite-aeson
-version:             0.7.0.0
+version:             0.7.1.0
 synopsis:            JSON for Vinyl records
 description:         Integration between Aeson and Vinyl records allowing records to be easily converted to JSON using automatic derivation, explicit formats, or a mix of both.
 homepage:            https://github.com/ConferOpenSource/composite#readme

composite-aeson/src/Composite/Aeson/CoRecord.hs

 module Composite.Aeson.CoRecord
-  ( JsonFormatField, DefaultJsonFormatField(defaultJsonFormatField)
-  , fieldJsonFormat
+  ( ToJsonFormatField, FromJsonFormatField, JsonFormatField
+  , DefaultJsonFormatField(defaultJsonFormatField)
+  , fieldToJson, fieldFromJson, fieldJsonFormat
   ) where
 
-import Composite.Aeson.Base (FromJson(FromJson), JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor), wrappedJsonFormat)
+import Composite.Aeson.Base (FromJson(FromJson), JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor), ToJson(ToJson), wrappedJsonFormat)
 import Composite.Aeson.Formats.Default (DefaultJsonFormat, defaultJsonFormat)
-import Composite.Aeson.Formats.Generic (SumStyle, jsonSumFormat)
+import Composite.Aeson.Formats.Generic (SumStyle, jsonSumFormat, sumToJson, sumFromJson)
 import Composite.CoRecord (CoRec(CoVal), Field, fieldToRec)
 import Composite.Record ((:->), Rec((:&), RNil), RecWithContext(rmapWithContext), recordToNonEmpty, ReifyNames, reifyNames)
 import Data.Aeson (Value)
+import qualified Data.Aeson.BetterErrors as ABE
 import Data.Functor.Identity (Identity(Identity))
 import Data.List.NonEmpty (NonEmpty)
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
@@ -18,6 +20,12 @@ import Data.Vinyl.Functor (Compose(Compose), (:.), Const(Const), Lift(Lift))
 import Data.Vinyl.Lens (type (∈))
 import Data.Proxy (Proxy(Proxy))
 
+-- |Type of records which contain JSON encoders for each element of @rs@.
+type ToJsonFormatField rs = Rec ToJson rs
+
+-- |Type of records which contain JSON decoders for each element of @rs@.
+type FromJsonFormatField e rs = Rec (FromJson e) rs
+
 -- |Type of records which contain JSON formats for each element of @rs@.
 type JsonFormatField e rs = Rec (JsonFormat e) rs
 
@@ -32,6 +40,46 @@ instance DefaultJsonFormatField '[] where
 instance forall s a rs. (DefaultJsonFormat a, DefaultJsonFormatField rs) => DefaultJsonFormatField (s :-> a ': rs) where
   defaultJsonFormatField = wrappedJsonFormat defaultJsonFormat :& (defaultJsonFormatField :: JsonFormatField e rs)
 
+-- |Make a @'Field' rs -> 'Value'@ given how to map the sum type to JSON along with a record with encoders for each value the field could have.
+fieldToJson
+  :: forall (rs :: [*]) r' (rs' :: [*]).
+     ( rs ~ (r' ': rs'), RApply rs, RMap rs
+     , RecApplicative rs, RecWithContext rs rs, RecordToList rs', ReifyNames rs )
+  => SumStyle -> ToJsonFormatField rs -> Field rs -> Value
+fieldToJson sumStyle fmts = sumToJson sumStyle o
+  where
+    namedFmts :: Rec ((,) Text :. ToJson) rs
+    namedFmts = reifyNames fmts
+
+    o :: Field rs -> (Text, Value)
+    o = fromMaybe (error "fieldToRec somehow produced all Nothings")
+      . listToMaybe . catMaybes
+      . (recordToList :: Rec (Const (Maybe (Text, Value))) rs -> [Maybe (Text, Value)])
+      . rapply outputs
+      . fieldToRec
+
+    outputs :: Rec (Lift (->) Maybe (Const (Maybe (Text, Value)))) rs
+    outputs = namedFmts <<&>> \ (Compose (name, ToJson oa)) ->
+      Lift $ Const . fmap ((name,) . oa)
+
+-- |Make a @'ABE.Parse' e (Field rs)@ given how to map the sum type from JSON along with a record with decoders for each value the field could have.
+fieldFromJson
+  :: forall (rs :: [*]) r' (rs' :: [*]) e.
+     ( rs ~ (r' ': rs'), RApply rs, RMap rs
+     , RecApplicative rs, RecWithContext rs rs, RecordToList rs', ReifyNames rs )
+  => SumStyle -> FromJsonFormatField e rs -> ABE.Parse e (Field rs)
+fieldFromJson sumStyle fmts = sumFromJson sumStyle i
+  where
+    namedFmts :: Rec ((,) Text :. FromJson e) rs
+    namedFmts = reifyNames fmts
+
+    i :: NonEmpty (Text, FromJson e (Field rs))
+    i = recordToNonEmpty $ rmapWithContext (Proxy @rs) oneCase namedFmts
+      where
+        oneCase :: forall r. r ∈ rs => ((,) Text :. FromJson e) r -> Const (Text, FromJson e (Field rs)) r
+        oneCase (Compose (name, FromJson ia)) =
+          Const (name, FromJson (CoVal . Identity <$> ia))
+
 -- |Make a @'JsonFormat' e (Field rs)@ given how to map the sum type to JSON along with a record with formatters for each value the field could have.
 fieldJsonFormat
   :: forall (rs :: [*]) r' (rs' :: [*]) e.

composite-aeson/src/Composite/Aeson/Formats/Generic.hs

 module Composite.Aeson.Formats.Generic
   ( abeJsonFormat, aesonJsonFormat, jsonArrayFormat, jsonObjectFormat
-  , SumStyle(..), jsonSumFormat
+  , SumStyle(..), sumFromJson, sumToJson, jsonSumFormat
   ) where
 
 import Composite.Aeson.Base (JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor), FromJson(FromJson))
@@ -156,65 +156,78 @@ expectedFieldsForInputs ((f, _) :| rest) =
     Just (prefix, (fLast, _)) -> unpack $ f <> ", " <> intercalate ", " (map fst prefix) <> ", or " <> fLast
     Nothing                   -> unpack f
 
+-- |'JsonFormat' which maps sum types to JSON according to 'SumStyle', given a pair of functions to decompose and recompose the sum type.
+sumFromJson :: SumStyle -> NonEmpty (Text, FromJson e a) -> ABE.Parse e a
+sumFromJson = \ case
+  SumStyleFieldName     -> fieldNameSumFromJson
+  SumStyleTypeValue t v -> typeValueSumFromJson t v
+  SumStyleMergeType t   -> mergeTypeSumFromJson t
+
+-- |'JsonFormat' which maps sum types to JSON according to 'SumStyle', given a pair of functions to decompose and recompose the sum type.
+sumToJson :: SumStyle -> (a -> (Text, Aeson.Value)) -> a -> Aeson.Value
+sumToJson = \ case
+  SumStyleFieldName     -> fieldNameSumToJson
+  SumStyleTypeValue t v -> typeValueSumToJson t v
+  SumStyleMergeType t   -> mergeTypeSumToJson t
+
 -- |'JsonFormat' which maps sum types to JSON according to 'SumStyle', given a pair of functions to decompose and recompose the sum type.
 jsonSumFormat :: SumStyle -> (a -> (Text, Aeson.Value)) -> NonEmpty (Text, FromJson e a) -> JsonFormat e a
-jsonSumFormat = \ case
-  SumStyleFieldName     -> jsonFieldNameSumFormat
-  SumStyleTypeValue t v -> jsonTypeValueSumFormat t v
-  SumStyleMergeType t   -> jsonMergeTypeSumFormat t
-
--- |'JsonFormat' which maps sum types to JSON in the 'SumStyleFieldName' style.
-jsonFieldNameSumFormat :: (a -> (Text, Aeson.Value)) -> NonEmpty (Text, FromJson e a) -> JsonFormat e a
-jsonFieldNameSumFormat oA iAs =
-  JsonFormat (JsonProfunctor o i)
+jsonSumFormat style oA iAs = JsonFormat (JsonProfunctor (sumToJson style oA) (sumFromJson style iAs))
+
+-- |Map a sum type from JSON in the 'SumStyleFieldName' style.
+fieldNameSumFromJson :: NonEmpty (Text, FromJson e a) -> ABE.Parse e a
+fieldNameSumFromJson iAs = do
+  fields <- ABE.withObject $ pure . StrictHashMap.keys
+  case fields of
+    [f] ->
+      case lookup f (NEL.toList iAs) of
+        Just (FromJson iA) -> ABE.key f iA
+        Nothing -> fail $ "unknown field " <> unpack f <> ", expected one of " <> expected
+    [] ->
+      fail $ "expected an object with one field (" <> expected <> ") not an empty object"
+    _ ->
+      fail $ "expected an object with one field (" <> expected <> ") not many fields"
   where
     expected = expectedFieldsForInputs iAs
-    o a = let (t, v) = oA a in Aeson.object [t .= v]
-    i = do
-      fields <- ABE.withObject $ pure . StrictHashMap.keys
-      case fields of
-        [f] ->
-          case lookup f (NEL.toList iAs) of
-            Just (FromJson iA) -> ABE.key f iA
-            Nothing -> fail $ "unknown field " <> unpack f <> ", expected one of " <> expected
-        [] ->
-          fail $ "expected an object with one field (" <> expected <> ") not an empty object"
-        _ ->
-          fail $ "expected an object with one field (" <> expected <> ") not many fields"
-
-
--- |'JsonFormat' which maps sum types to JSON in the 'SumStyleTypeValue' style.
-jsonTypeValueSumFormat :: Text -> Text -> (a -> (Text, Aeson.Value)) -> NonEmpty (Text, FromJson e a) -> JsonFormat e a
-jsonTypeValueSumFormat typeField valueField oA iAs =
-  JsonFormat (JsonProfunctor o i)
+
+-- |Map a sum type to JSON in the 'SumStyleFieldName' style.
+fieldNameSumToJson :: (a -> (Text, Aeson.Value)) -> a -> Aeson.Value
+fieldNameSumToJson oA = \ (oA -> (t, v)) -> Aeson.object [t .= v]
+
+-- |Map a sum type from JSON in the 'SumStyleTypeValue' style.
+typeValueSumFromJson :: Text -> Text -> NonEmpty (Text, FromJson e a) -> ABE.Parse e a
+typeValueSumFromJson typeField valueField iAs = do
+  t <- ABE.key typeField ABE.asText
+  case lookup t (NEL.toList iAs) of
+    Just (FromJson iA) -> ABE.key valueField iA
+    Nothing -> toss $ "expected " <> unpack typeField <> " to be one of " <> expected
   where
     expected = expectedFieldsForInputs iAs
-    o a = let (t, v) = oA a in Aeson.object [typeField .= t, valueField .= v]
-    i = do
-      t <- ABE.key typeField ABE.asText
-      case lookup t (NEL.toList iAs) of
-        Just (FromJson iA) -> ABE.key valueField iA
-        Nothing -> toss $ "expected " <> unpack typeField <> " to be one of " <> expected
     toss = throwError . ABE.BadSchema [] . ABE.FromAeson
 
--- |'JsonFormat' which maps sum types to JSON in the 'SumStyleMergeType' style.
-jsonMergeTypeSumFormat :: Text -> (a -> (Text, Aeson.Value)) -> NonEmpty (Text, FromJson e a) -> JsonFormat e a
-jsonMergeTypeSumFormat typeField oA iAs =
-  JsonFormat (JsonProfunctor o i)
+-- |Map a sum type to JSON in the 'SumStyleTypeValue' style.
+typeValueSumToJson :: Text -> Text -> (a -> (Text, Aeson.Value)) -> a -> Aeson.Value
+typeValueSumToJson typeField valueField oA = \ (oA -> (t, v)) -> Aeson.object [typeField .= t, valueField .= v]
+
+-- |Map a sum type from JSON in the 'SumStyleMergeType' style.
+mergeTypeSumFromJson :: Text -> NonEmpty (Text, FromJson e a) -> ABE.Parse e a
+mergeTypeSumFromJson typeField iAs = do
+  t <- ABE.key typeField ABE.asText
+  case lookup t (NEL.toList iAs) of
+    Just (FromJson iA) -> iA
+    Nothing -> toss $ "expected " <> unpack typeField <> " to be one of " <> expected
   where
     expected = expectedFieldsForInputs iAs
-    o a = case oA a of
-      (t, Aeson.Object fields) | StrictHashMap.member typeField fields ->
-        error $ "PRECONDITION VIOLATED: encoding a value with merge type sum style yielded "
-             <> "(" <> unpack t <> ", " <> show (Aeson.Object fields) <> ") which already contains the field " <> unpack typeField
-      (t, Aeson.Object fields) ->
-        Aeson.Object (StrictHashMap.insert typeField (Aeson.String t) fields)
-      (t, other) ->
-        error $ "PRECONDITION VIOLATED: encoding a value with merge type sum style yielded "
-             <> "(" <> unpack t <> ", " <> show other <> ") which isn't an object"
-    i = do
-      t <- ABE.key typeField ABE.asText
-      case lookup t (NEL.toList iAs) of
-        Just (FromJson iA) -> iA
-        Nothing -> toss $ "expected " <> unpack typeField <> " to be one of " <> expected
     toss = throwError . ABE.BadSchema [] . ABE.FromAeson
+
+-- |Map a sum type to JSON in the 'SumStyleMergeType' style.
+mergeTypeSumToJson :: Text -> (a -> (Text, Aeson.Value)) -> a -> Aeson.Value
+mergeTypeSumToJson typeField oA = \ a -> case oA a of
+  (t, Aeson.Object fields) | StrictHashMap.member typeField fields ->
+    error $ "PRECONDITION VIOLATED: encoding a value with merge type sum style yielded "
+         <> "(" <> unpack t <> ", " <> show (Aeson.Object fields) <> ") which already contains the field " <> unpack typeField
+  (t, Aeson.Object fields) ->
+    Aeson.Object (StrictHashMap.insert typeField (Aeson.String t) fields)
+  (t, other) ->
+    error $ "PRECONDITION VIOLATED: encoding a value with merge type sum style yielded "
+         <> "(" <> unpack t <> ", " <> show other <> ") which isn't an object"

composite-base/package.yaml

 name:                composite-base
-version:             0.7.0.0
+version:             0.7.1.0
 synopsis:            Shared utilities for composite-* packages.
 description:         Shared helpers for the various composite packages.
 homepage:            https://github.com/ConferOpenSource/composite#readme

composite-ekg/package.yaml

 name:                composite-ekg
-version:             0.7.0.0
+version:             0.7.1.0
 synopsis:            EKG Metrics for Vinyl records
 description:         Integration between EKG and Vinyl records allowing records holding registered metrics to be easily constructed from a type declaration.
 homepage:            https://github.com/ConferOpenSource/composite#readme

composite-opaleye/package.yaml

 name:                composite-opaleye
-version:             0.7.0.0
+version:             0.7.1.0
 synopsis:            Opaleye SQL for Vinyl records
 description:         Integration between Vinyl records and Opaleye SQL, allowing records to be stored, retrieved, and queried from PostgreSQL.
 homepage:            https://github.com/ConferOpenSource/composite#readme

composite-reflex/package.yaml

 name:                composite-reflex
-version:             0.7.00
+version:             0.7.1.0
 synopsis:            Utilities for using composite records and corecords with Reflex
 description:         Utilities for using composite records and corecords with Reflex
 homepage:            https://github.com/ConferOpenSource/composite#readme

composite-swagger/package.yaml

 name:                composite-swagger
-version:             0.7.0.0
+version:             0.7.1.0
 synopsis:            Swagger for Vinyl records
 description:         Integration between Swagger and Vinyl records allowing easily derivable/explicit Swagger definitions for records.
 homepage:            https://github.com/ConferOpenSource/composite#readme