Expose Map on TimelineEvent/EventData/EventCodec (#77)

Author: bartelink

CHANGELOG.md

@@ -9,6 +9,9 @@ The `Unreleased` section name is replaced by the expected version of next releas
 ## [Unreleased]
 
 ### Added
+
+- `Core.EventData/TimelineEvent/EventCodec.Map`: Exposed building blocks for mapping event envelopes and/or codecs over Body Format types [#77](https://github.com/jet/FsCodec/pull/77)
+
 ### Changed
 ### Removed
 ### Fixed
@@ -27,8 +30,8 @@ The `Unreleased` section name is replaced by the expected version of next releas
 - Updated build and tests to use `net6.0`, all test package dependencies
 - Updated `TypeShape` reference to v `10`, triggering min `FSharp.Core` target moving to `4.5.4`
 - `SystemTextJson.Codec`: Switched Event body type from `JsonElement` to `ReadOnlyMemory<byte>` [#75](https://github.com/jet/FsCodec/pull/75)
-- `NewtonsoftJson.Codec`: Switched Event body type from `byte[]` to `ReadOnlyMemory<byte>` [#75](https://github.com/jet/FsCodec/pull/75)
-- `ToByteArrayCodec`: now adapts a `ReadOnlyMemory<byte>` encoder (was from `JsonElement`) (to `byte[]` bodies); Moved from `FsCodec.SystemTextJson` to `FsCodec.Box` [#75](https://github.com/jet/FsCodec/pull/75)
+- `NewtonsoftJson.Codec`: Switched Event body type from `byte array` to `ReadOnlyMemory<byte>` [#75](https://github.com/jet/FsCodec/pull/75)
+- `ToByteArrayCodec`: now adapts a `ReadOnlyMemory<byte>` encoder (was from `JsonElement`) (to `byte array` bodies); Moved from `FsCodec.SystemTextJson` to `FsCodec.Box` [#75](https://github.com/jet/FsCodec/pull/75)
 
 ### Removed
 
@@ -199,7 +202,7 @@ The `Unreleased` section name is replaced by the expected version of next releas
 
 ### Changed
 
-- Generalized `Codec.Create` to no longer presume `Data` and `Metadata` should always be `byte[]` [#24](https://github.com/jet/FsCodec/pull/24)
+- Generalized `Codec.Create` to no longer presume `Data` and `Metadata` should always be `byte array` [#24](https://github.com/jet/FsCodec/pull/24)
 
 ### Removed
 

README.md

@@ -30,7 +30,7 @@ The purpose of the `FsCodec` package is to provide a minimal interface on which
 - [`FsCodec.IEventData`](https://github.com/jet/FsCodec/blob/master/src/FsCodec/FsCodec.fs#L4) represents a single event and/or related metadata in raw form (i.e. still as a UTF8 string etc, not yet bound to a specific Event Type)
 - [`FsCodec.ITimelineEvent`](https://github.com/jet/FsCodec/blob/master/src/FsCodec/FsCodec.fs#L23) represents a single stored event and/or related metadata in raw form (i.e. still as a UTF8 string etc, not yet bound to a specific Event Type). Inherits `IEventData`, adding `Index` and `IsUnfold` in order to represent the position on the timeline that the event logically occupies.
 - [`FsCodec.IEventCodec`](https://github.com/jet/FsCodec/blob/master/src/FsCodec/FsCodec.fs#L31) presents `Encode : 'Context option * 'Event -> IEventData` and `TryDecode : ITimelineEvent -> 'Event option` methods that can be used in low level application code to generate `IEventData`s or decode `ITimelineEvent`s based on a contract defined by `'Union`
-- [`FsCodec.Codec.Create`](https://github.com/jet/FsCodec/blob/master/src/FsCodec/Codec.fs#L27) implements `IEventCodec` in terms of supplied `encode : 'Event -> string * byte[]` and `tryDecode : string * byte[] -> 'Event option` functions (other overloads are available for advanced cases)
+- [`FsCodec.Codec.Create`](https://github.com/jet/FsCodec/blob/master/src/FsCodec/Codec.fs#L27) implements `IEventCodec` in terms of supplied `encode : 'Event -> string * byte array` and `tryDecode : string * byte array -> 'Event option` functions (other overloads are available for advanced cases)
 - [`FsCodec.Core.EventData.Create`](https://github.com/jet/FsCodec/blob/master/src/FsCodec/FsCodec.fs#L44) is a low level helper to create an `IEventData` directly for purposes such as tests etc.
 - [`FsCodec.Core.TimelineEvent.Create`](https://github.com/jet/FsCodec/blob/master/src/FsCodec/FsCodec.fs#L58) is a low level helper to create an `ITimelineEvent` directly for purposes such as tests etc.
 
@@ -94,7 +94,7 @@ The respective concrete Codec packages include relevant `Converter`/`JsonConvert
 ### `Newtonsoft.Json`-specific low level converters
 
   - [`OptionConverter`](https://github.com/jet/FsCodec/blob/master/src/FsCodec.NewtonsoftJson/OptionConverter.fs#L7) represents F#'s `Option<'t>` as a value or `null`; included in the standard `Options.Create` profile.
-  - [`VerbatimUtf8JsonConverter`](https://github.com/jet/FsCodec/blob/master/src/FsCodec.NewtonsoftJson/VerbatimUtf8JsonConverter.fs#L7) captures/renders known valid UTF8 JSON data into a `byte[]` without decomposing it into an object model (not typically relevant for application level code, used in `Equinox.Cosmos` versions prior to `3.0`).
+  - [`VerbatimUtf8JsonConverter`](https://github.com/jet/FsCodec/blob/master/src/FsCodec.NewtonsoftJson/VerbatimUtf8JsonConverter.fs#L7) captures/renders known valid UTF8 JSON data into a `byte array` without decomposing it into an object model (not typically relevant for application level code, used in `Equinox.Cosmos` versions prior to `3.0`).
 
 ### `System.Text.Json`-specific low level converters
 
@@ -637,7 +637,7 @@ The following helper (which uses the [`Serilog`](https://github.com/serilog/seri
 module EventCodec =
 
     // Uses the supplied codec to decode the supplied event record `x` (iff at LogEventLevel.Debug, detail fails to `log` citing the `stream` and content)
-    let tryDecode (codec : FsCodec.IEventCodec<_,_,_>) (log : Serilog.ILogger) streamName (x : FsCodec.ITimelineEvent<byte[]>) =
+    let tryDecode (codec : FsCodec.IEventCodec<_,_,_>) (log : Serilog.ILogger) streamName (x : FsCodec.ITimelineEvent<ReadOnlyMemory<byte>>) =
         match codec.TryDecode x with
         | None ->
             if log.IsEnabled Serilog.Events.LogEventLevel.Debug then
@@ -681,7 +681,7 @@ module Reactions =
 
     type Event = int64 * DateTimeOffset * Events.Event
     let codec =
-        let up (raw : FsCodec.ITimelineEvent<byte[]>, contract : Events.Event) : Event = raw.Index, raw.Timestamp, contract
+        let up (raw : FsCodec.ITimelineEvent<ReadOnlyMemory<byte>>, contract : Events.Event) : Event = raw.Index, raw.Timestamp, contract
         let down ((_index, timestamp, event) : Event) = event, None, Some timestamp
         FsCodec.NewtonsoftJson.Codec.Create(up, down)
         

src/FsCodec.Box/Interop.fs

@@ -4,50 +4,20 @@ open System.Runtime.CompilerServices
 open System
 
 [<Extension>]
-type InteropExtensions =
+type InteropHelpers =
 
-    static member public Adapt<'From, 'To, 'Event, 'Context>
-        (   native : FsCodec.IEventCodec<'Event, 'From, 'Context>,
-            up : 'From -> 'To,
-            down : 'To -> 'From) : FsCodec.IEventCodec<'Event, 'To, 'Context> =
-
-        { new FsCodec.IEventCodec<'Event, 'To, 'Context> with
-            member _.Encode(context, event) =
-                let encoded = native.Encode(context, event)
-                { new FsCodec.IEventData<_> with
-                    member _.EventType = encoded.EventType
-                    member _.Data = up encoded.Data
-                    member _.Meta = up encoded.Meta
-                    member _.EventId = encoded.EventId
-                    member _.CorrelationId = encoded.CorrelationId
-                    member _.CausationId = encoded.CausationId
-                    member _.Timestamp = encoded.Timestamp }
-
-            member _.TryDecode encoded =
-                let mapped =
-                    { new FsCodec.ITimelineEvent<_> with
-                        member _.Index = encoded.Index
-                        member _.IsUnfold = encoded.IsUnfold
-                        member _.Context = encoded.Context
-                        member _.EventType = encoded.EventType
-                        member _.Data = down encoded.Data
-                        member _.Meta = down encoded.Meta
-                        member _.EventId = encoded.EventId
-                        member _.CorrelationId = encoded.CorrelationId
-                        member _.CausationId = encoded.CausationId
-                        member _.Timestamp = encoded.Timestamp }
-                native.TryDecode mapped }
-
-    static member private BytesToReadOnlyMemory(x : byte[]) : ReadOnlyMemory<byte> =
+    static member BytesToReadOnlyMemory(x : byte array) : ReadOnlyMemory<byte> =
         if x = null then ReadOnlyMemory.Empty
         else ReadOnlyMemory x
-    static member private ReadOnlyMemoryToBytes(x : ReadOnlyMemory<byte>) : byte[] =
+
+    static member ReadOnlyMemoryToBytes(x : ReadOnlyMemory<byte>) : byte array =
         if x.IsEmpty then null
         else x.ToArray()
 
-    /// Adapt an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies to instead use byte[]
+    /// Adapt an IEventCodec that handles ReadOnlyMemory<byte> Event Bodies to instead use byte array
     /// Ideally not used as it makes pooling problematic; only provided for interop/porting scaffolding wrt Equinox V3 and EventStore.Client etc
     [<Extension>]
     static member ToByteArrayCodec<'Event, 'Context>(native : FsCodec.IEventCodec<'Event, ReadOnlyMemory<byte>, 'Context>)
-        : FsCodec.IEventCodec<'Event, byte[], 'Context> =
-        InteropExtensions.Adapt(native, InteropExtensions.ReadOnlyMemoryToBytes, InteropExtensions.BytesToReadOnlyMemory)
+        : FsCodec.IEventCodec<'Event, byte array, 'Context> =
+
+        FsCodec.Core.EventCodec.Map(native, InteropHelpers.ReadOnlyMemoryToBytes, InteropHelpers.BytesToReadOnlyMemory)

src/FsCodec.NewtonsoftJson/Codec.fs

@@ -35,6 +35,7 @@ module Core =
     type BytesEncoder(settings : JsonSerializerSettings) =
         let serializer = JsonSerializer.Create(settings)
         interface TypeShape.UnionContract.IEncoder<ReadOnlyMemory<byte>> with
+
             member _.Empty = ReadOnlyMemory.Empty
 
             member _.Encode (value : 'T) =

src/FsCodec.NewtonsoftJson/VerbatimUtf8Converter.fs

@@ -11,10 +11,10 @@ type VerbatimUtf8JsonConverter() =
     static let enc = System.Text.Encoding.UTF8
 
     override _.CanConvert(t : Type) =
-        typeof<byte[]>.Equals(t)
+        typeof<byte array>.Equals(t)
 
     override _.WriteJson(writer : JsonWriter, value : obj, serializer : JsonSerializer) =
-        let array = value :?> byte[]
+        let array = value :?> byte array
         if array = null || array.Length = 0 then serializer.Serialize(writer, null)
         else writer.WriteRawValue(enc.GetString(array))
 

src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj

@@ -12,9 +12,9 @@
     <Compile Include="TypeSafeEnumConverter.fs" />
     <Compile Include="UnionOrTypeSafeEnumConverterFactory.fs" />
     <Compile Include="Options.fs" />
+    <Compile Include="Interop.fs" />
     <Compile Include="Codec.fs" />
     <Compile Include="Serdes.fs" />
-    <Compile Include="Interop.fs" />
   </ItemGroup>
 
   <ItemGroup>

src/FsCodec.SystemTextJson/Interop.fs

@@ -6,27 +6,29 @@ open System
 open System.Text.Json
 
 [<Extension>]
-type InteropExtensions =
+type InteropHelpers =
 
-    static member private Utf8ToJsonElement(x : ReadOnlyMemory<byte>) : JsonElement =
+    static member Utf8ToJsonElement(x : ReadOnlyMemory<byte>) : JsonElement =
         if x.IsEmpty then JsonElement()
         else JsonSerializer.Deserialize<JsonElement>(x.Span)
 
-    static member private JsonElementToUtf8(x : JsonElement) : ReadOnlyMemory<byte> =
+    static member JsonElementToUtf8(x : JsonElement) : ReadOnlyMemory<byte> =
         if x.ValueKind = JsonValueKind.Undefined then ReadOnlyMemory.Empty
-        // Avoid introduction of HTML escaping for things like quotes etc (Options.Default uses Options.Create(), which defaults to unsafeRelaxedJsonEscaping=true)
+        // Avoid introduction of HTML escaping for things like quotes etc (Options.Default uses Options.Create(), which defaults to unsafeRelaxedJsonEscaping = true)
         else JsonSerializer.SerializeToUtf8Bytes(x, options = Options.Default) |> ReadOnlyMemory
 
     /// Adapts an IEventCodec that's rendering to <c>JsonElement</c> Event Bodies to handle <c>ReadOnlyMemory<byte></c> bodies instead.<br/>
     /// NOTE where possible, it's better to use <c>Codec</c> in preference to <c>CodecJsonElement</c> to encode directly in order to avoid this mapping process.
     [<Extension>]
     static member ToUtf8Codec<'Event, 'Context>(native : FsCodec.IEventCodec<'Event, JsonElement, 'Context>)
         : FsCodec.IEventCodec<'Event, ReadOnlyMemory<byte>, 'Context> =
-        FsCodec.Interop.InteropExtensions.Adapt(native, InteropExtensions.JsonElementToUtf8, InteropExtensions.Utf8ToJsonElement)
+
+        FsCodec.Core.EventCodec.Map(native, InteropHelpers.JsonElementToUtf8, InteropHelpers.Utf8ToJsonElement)
 
     /// Adapts an IEventCodec that's rendering to <c>ReadOnlyMemory<byte></c> Event Bodies to handle <c>JsonElement</c> bodies instead.<br/>
     /// NOTE where possible, it's better to use <c>CodecJsonElement</c> in preference to <c>Codec/c> to encode directly in order to avoid this mapping process.
     [<Extension>]
     static member ToJsonElementCodec<'Event, 'Context>(native : FsCodec.IEventCodec<'Event, ReadOnlyMemory<byte>, 'Context>)
         : FsCodec.IEventCodec<'Event, JsonElement, 'Context> =
-        FsCodec.Interop.InteropExtensions.Adapt(native, InteropExtensions.Utf8ToJsonElement, InteropExtensions.JsonElementToUtf8)
+
+        FsCodec.Core.EventCodec.Map(native, InteropHelpers.Utf8ToJsonElement, InteropHelpers.JsonElementToUtf8)

src/FsCodec/FsCodec.fs

@@ -48,7 +48,7 @@ type EventData<'Format> private (eventType, data, meta, eventId, correlationId,
         let eventId = match eventId with Some id -> id | None -> Guid.NewGuid()
         EventData(eventType, data, meta, eventId, correlationId, causationId, match timestamp with Some ts -> ts | None -> DateTimeOffset.UtcNow) :> _
 
-    interface FsCodec.IEventData<'Format> with
+    interface IEventData<'Format> with
         member _.EventType = eventType
         member _.Data = data
         member _.Meta = meta
@@ -57,6 +57,17 @@ type EventData<'Format> private (eventType, data, meta, eventId, correlationId,
         member _.CausationId = causationId
         member _.Timestamp = timestamp
 
+    static member Map<'Mapped>(f : 'Format -> 'Mapped) : IEventData<'Format> -> IEventData<'Mapped> =
+        fun x ->
+            { new IEventData<'Mapped> with
+                member _.EventType = x.EventType
+                member _.Data = f x.Data
+                member _.Meta = f x.Meta
+                member _.EventId = x.EventId
+                member _.CorrelationId = x.CorrelationId
+                member _.CausationId = x.CausationId
+                member _.Timestamp = x.Timestamp }
+
 /// An Event or Unfold that's been read from a Store and hence has a defined <c>Index</c> on the Event Timeline
 [<NoComparison; NoEquality>]
 type TimelineEvent<'Format> private (index, isUnfold, eventType, data, meta, eventId, correlationId, causationId, timestamp, context) =
@@ -78,3 +89,35 @@ type TimelineEvent<'Format> private (index, isUnfold, eventType, data, meta, eve
         member _.CorrelationId = correlationId
         member _.CausationId = causationId
         member _.Timestamp = timestamp
+
+    static member Map<'Mapped>(f : 'Format -> 'Mapped) : ITimelineEvent<'Format> -> ITimelineEvent<'Mapped> =
+        fun x ->
+            { new ITimelineEvent<'Mapped> with
+                member _.Index = x.Index
+                member _.IsUnfold = x.IsUnfold
+                member _.Context = x.Context
+                member _.EventType = x.EventType
+                member _.Data = f x.Data
+                member _.Meta = f x.Meta
+                member _.EventId = x.EventId
+                member _.CorrelationId = x.CorrelationId
+                member _.CausationId = x.CausationId
+                member _.Timestamp = x.Timestamp }
+
+[<NoComparison; NoEquality>]
+type EventCodec<'Event, 'Format, 'Context> private () =
+
+    static member Map<'TargetFormat>(native : IEventCodec<'Event, 'Format, 'Context>, up : 'Format -> 'TargetFormat, down : 'TargetFormat -> 'Format)
+        : IEventCodec<'Event, 'TargetFormat, 'Context> =
+
+        let upConvert = EventData.Map up
+        let downConvert = TimelineEvent.Map down
+
+        { new IEventCodec<'Event, 'TargetFormat, 'Context> with
+            member _.Encode(context, event) =
+                let encoded = native.Encode(context, event)
+                upConvert encoded
+
+            member _.TryDecode target =
+                let encoded = downConvert target
+                native.TryDecode encoded }

tests/FsCodec.NewtonsoftJson.Tests/Examples.fsx

@@ -119,7 +119,7 @@ des<Message2> """{"name":null,"outcome":"Discomfort"}"""
 module EventCodec =
 
     /// Uses the supplied codec to decode the supplied event record `x` (iff at LogEventLevel.Debug, detail fails to `log` citing the `stream` and content)
-    let tryDecode (codec : FsCodec.IEventCodec<_, _, _>) (log : Serilog.ILogger) streamName (x : FsCodec.ITimelineEvent<byte[]>) =
+    let tryDecode (codec : FsCodec.IEventCodec<_, _, _>) (log : Serilog.ILogger) streamName (x : FsCodec.ITimelineEvent<ReadOnlyMemory<byte>>) =
         match codec.TryDecode x with
         | None ->
             if log.IsEnabled Serilog.Events.LogEventLevel.Debug then
@@ -238,7 +238,7 @@ module Reactions =
     type Event = int64 * DateTimeOffset * Events.Event
 
     let codec =
-        let up (raw : FsCodec.ITimelineEvent<byte[]>, contract : Events.Event) : Event = raw.Index, raw.Timestamp, contract
+        let up (raw : FsCodec.ITimelineEvent<ReadOnlyMemory<byte>>, contract : Events.Event) : Event = raw.Index, raw.Timestamp, contract
         let down ((_index, timestamp, event) : Event) = event, None, Some timestamp
         FsCodec.NewtonsoftJson.Codec.Create(up, down)
 

tests/FsCodec.SystemTextJson.Tests/InteropTests.fs

@@ -11,7 +11,7 @@ type Batch = FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests.Batch
 type Union = FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests.Union
 let mkBatch = FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests.mkBatch
 
-let indirectCodec = FsCodec.SystemTextJson.CodecJsonElement.Create() |> FsCodec.SystemTextJson.Interop.InteropExtensions.ToUtf8Codec
+let indirectCodec = FsCodec.SystemTextJson.CodecJsonElement.Create() |> FsCodec.SystemTextJson.Interop.InteropHelpers.ToUtf8Codec
 let [<Fact>] ``encodes correctly`` () =
     let input = Union.A { embed = "\"" }
     let encoded = indirectCodec.Encode(None, input)
@@ -34,7 +34,7 @@ type U =
 
 let defaultSettings = FsCodec.NewtonsoftJson.Options.CreateDefault() // Test without converters, as that's what Equinox.Cosmos will do
 let defaultEventCodec = FsCodec.NewtonsoftJson.Codec.Create<U>(defaultSettings)
-let indirectCodecU = FsCodec.SystemTextJson.CodecJsonElement.Create<U>() |> FsCodec.SystemTextJson.Interop.InteropExtensions.ToUtf8Codec
+let indirectCodecU = FsCodec.SystemTextJson.CodecJsonElement.Create<U>() |> FsCodec.SystemTextJson.Interop.InteropHelpers.ToUtf8Codec
 
 let [<Property>] ``round-trips diverse bodies correctly`` (x: U, encodeDirect, decodeDirect) =
     let encoder = if encodeDirect then defaultEventCodec else indirectCodecU