F#: Discriminated Unions are not supported for aggregates

[natalie-o-perret]

it seems that F# discriminated unions are not supported for aggregation / projection, example of code that does not work:

open System
open Marten
open Marten.Schema.Identity

type AccountCreation = {
    Owner: string
    AccountId: Guid
    CreatedAt: DateTimeOffset
    StartingBalance: decimal
}

type Transaction = {
    To: Guid
    From: Guid
    Description: string
    Time: DateTimeOffset
    Amount: decimal
}

type AccountEvent =
    | AccountCreated of AccountCreation
    | AccountCredited of Transaction
    | AccountDebited of Transaction

type Account() =
    member val Id = Unchecked.defaultof<Guid> with get,set
    member val Owner = Unchecked.defaultof<string> with get,set
    member val Balance = Unchecked.defaultof<decimal> with get,set
    member val CreatedAt = Unchecked.defaultof<DateTimeOffset> with get,set
    member val UpdatedAt = Unchecked.defaultof<DateTimeOffset> with get,set

    member this.Apply(accountEvent: AccountEvent) =
        printfn "I've been called %A" accountEvent

[<EntryPoint>]
let main argv =
    use store = DocumentStore.For(fun options ->
            let connectionString = sprintf "host=%s;database=%s;username=%s;password=%s"
                                       "localhost"
                                       "postgres"
                                       "root"
                                       "root"
            options.Connection(connectionString)
            options.Events.AddEventType(typeof<AccountEvent>)
            options.Events.InlineProjections.AggregateStreamsWith<Account>() |> ignore
        )

    use session = store.LightweightSession()

    let khalidId = CombGuidIdGeneration.NewGuid()
    let billId = CombGuidIdGeneration.NewGuid()

    let khalid = AccountEvent.AccountCreated({
        Owner = "Khalid Abuhakmeh"
        AccountId = khalidId
        StartingBalance = 1000m
        CreatedAt = DateTimeOffset.UtcNow
    })

    let bill = AccountEvent.AccountCreated({
        Owner = "Bill Boga"
        AccountId = billId
        StartingBalance = 0m
        CreatedAt = DateTimeOffset.UtcNow
    })

    let transaction = AccountEvent.AccountCredited({
        From = khalidId
        To = billId
        Amount = 100m
        Time = DateTimeOffset.UtcNow
        Description = "transfer to bill"
    })

    session.Events.Append(khalidId, khalid) |> ignore
    session.Events.Append(billId, bill) |> ignore
    session.Events.Append(khalidId, transaction) |> ignore

    session.SaveChangesAsync()
    |> Async.AwaitTask
    |> Async.RunSynchronously

    let account = session.LoadAsync<Account>(khalidId)
                    |> Async.AwaitTask
                    |> Async.RunSynchronously

    let stream = session.Events.FetchStream(khalidId)

    printfn "%A" account
    printfn "%A" stream

    0

Long story short:

• At the end, account is equal to null
• The method Apply(accountEvent: AccountEvent) is never called.

However if I am doing something more classic like:

open System
open Marten
open Marten.Schema.Identity

type AccountCreation = {
    Owner: string
    AccountId: Guid
    CreatedAt: DateTimeOffset
    StartingBalance: decimal
}

type Transaction = {
    To: Guid
    From: Guid
    Description: string
    Time: DateTimeOffset
    Amount: decimal
}

type AccountEvent =
    | AccountCreated of AccountCreation
    | AccountCredited of Transaction
    | AccountDebited of Transaction

type Account() =
    member val Id = Unchecked.defaultof<Guid> with get,set
    member val Owner = Unchecked.defaultof<string> with get,set
    member val Balance = Unchecked.defaultof<decimal> with get,set
    member val CreatedAt = Unchecked.defaultof<DateTimeOffset> with get,set
    member val UpdatedAt = Unchecked.defaultof<DateTimeOffset> with get,set

    member this.Apply(accountCreation: AccountCreation) =
        printfn "I've been called %A" accountCreation
        this.Id <- accountCreation.AccountId
        this.Owner <- accountCreation.Owner
        this.Balance <- accountCreation.StartingBalance
        this.CreatedAt <- accountCreation.CreatedAt
        this.UpdatedAt <- accountCreation.CreatedAt

[<EntryPoint>]
let main argv =
    use store = DocumentStore.For(fun options ->
            let connectionString = sprintf "host=%s;database=%s;username=%s;password=%s"
                                       "localhost"
                                       "postgres"
                                       "root"
                                       "root"
            options.Connection(connectionString)
            options.Events.AddEventType(typeof<AccountEvent>)
            options.Events.InlineProjections.AggregateStreamsWith<Account>() |> ignore
        )

    use session = store.LightweightSession()

    let khalidId = CombGuidIdGeneration.NewGuid()
    let billId = CombGuidIdGeneration.NewGuid()

    let khalid = {
        Owner = "Khalid Abuhakmeh"
        AccountId = khalidId
        StartingBalance = 1000m
        CreatedAt = DateTimeOffset.UtcNow
    }

    let bill = {
        Owner = "Bill Boga"
        AccountId = billId
        StartingBalance = 0m
        CreatedAt = DateTimeOffset.UtcNow
    }

    let transaction = {
        From = khalidId
        To = billId
        Amount = 100m
        Time = DateTimeOffset.UtcNow
        Description = "transfer to bill"
    }

    session.Events.Append(khalidId, khalid) |> ignore
    session.Events.Append(billId, bill) |> ignore
    session.Events.Append(khalidId, transaction) |> ignore

    session.SaveChangesAsync()
    |> Async.AwaitTask
    |> Async.RunSynchronously

    let account = session.LoadAsync<Account>(khalidId)
                    |> Async.AwaitTask
                    |> Async.RunSynchronously

    let stream = session.Events.FetchStream(khalidId)

    printfn "%A" account
    printfn "%A" stream

    0

account is properly loaded

What did I change between the two? I basically removed discriminated unions, in the events that are append to the stream:

From (AccountEvent.AccountCreated):

let khalid = AccountEvent.AccountCreated({
    Owner = "Khalid Abuhakmeh"
    AccountId = khalidId
    StartingBalance = 1000m
    CreatedAt = DateTimeOffset.UtcNow
})

To (AccountCreation type):

let khalid = {
    Owner = "Khalid Abuhakmeh"
    AccountId = khalidId
    StartingBalance = 1000m
    CreatedAt = DateTimeOffset.UtcNow
}

and change the parameter passed to Apply:

member this.Apply(accountEvent: AccountEvent) =

to

member this.Apply(accountCreation: AccountCreation) =

I think this is really frustrating in F# to not be able to use Discriminated Unions because of the possibility it offers in terms of pattern matching. It forces to aggregate from the whole stream without persisting the aggregation / projection, which can be an issue in terms of performances for queries.

AFAIK, this is not due Newtonsoft.Json cause it does support both the serialization and deserialization with discriminated unions:

[<EntryPoint>]
let main argv =
    let accountCreated = AccountEvent.AccountCreated({
        Owner = "Khalid Abuhakmeh"
        AccountId = Guid.NewGuid()
        StartingBalance = 1000m
        CreatedAt = DateTimeOffset.UtcNow
    })
    let serialized = JsonConvert.SerializeObject(accountCreated)
    let deserialized = JsonConvert.DeserializeObject<AccountEvent>(serialized)

    printfn "%A" (accountCreated = deserialized)

    0

It most likely resides in some reflection tasks performed by marten upon event appending.

I am not sure if someone could have a hint about a decent workaround or maybe a hint about where to lookup in the source code.

[natalie-o-perret]

Side note about types: In the code I previously posted:

[<EntryPoint>]
let main argv =
    let accountCreated = AccountEvent.AccountCreated({
        Owner = "Khalid Abuhakmeh"
        AccountId = Guid.NewGuid()
        StartingBalance = 1000m
        CreatedAt = DateTimeOffset.UtcNow
    })
    let serialized = JsonConvert.SerializeObject(accountCreated)
    let deserialized = JsonConvert.DeserializeObject<AccountEvent>(serialized)

    printfn "%A" (accountCreated = deserialized)

    0

serialized is equal to:

{Owner = "Khalid Abuhakmeh";
 AccountId = 2a81eb7c-2907-462f-bf15-222343f8582a;
 CreatedAt = 2019-06-06 11:12:16 PM +00:00;
 StartingBalance = 1000M;}

However it seems that when using discriminated unions, in the mt_events table I have:

1   016b2f00-db9e-4389-a150-7f118eaa4951    016b2f00-d8a1-4140-8bec-88f857a96104    1   {"Case": "AccountCreated", "Fields": [{"Owner": "Khalid Abuhakmeh", "AccountId": "016b2f00-d8a1-4140-8bec-88f857a96104", "CreatedAt": "2019-06-06T22:55:13.0596873+00:00", "StartingBalance": 1000.0}]} account_created 2019-06-06 22:55:13.974592  Program+AccountEvent+AccountCreated, Marten.FSharp  *DEFAULT*
2   016b2f00-dba0-437d-85c8-4433e0eb6723    016b2f00-d8a1-4140-8bec-88f857a96104    2   {"Case": "AccountCredited", "Fields": [{"To": "016b2f00-d8a3-45a4-9bb9-334a4e3e8484", "From": "016b2f00-d8a1-4140-8bec-88f857a96104", "Time": "2019-06-06T22:55:13.060011+00:00", "Amount": 100.0, "Description": "transfer to bill"}]} account_credited    2019-06-06 22:55:13.974592  Program+AccountEvent+AccountCredited, Marten.FSharp *DEFAULT*
3   016b2f00-db9f-486e-ba77-3f795e2c5b1b    016b2f00-d8a3-45a4-9bb9-334a4e3e8484    1   {"Case": "AccountCreated", "Fields": [{"Owner": "Bill Boga", "AccountId": "016b2f00-d8a3-45a4-9bb9-334a4e3e8484", "CreatedAt": "2019-06-06T22:55:13.0600103+00:00", "StartingBalance": 0.0}]}   account_created 2019-06-06 22:55:13.974592  Program+AccountEvent+AccountCreated, Marten.FSharp  *DEFAULT*

I am not sure the issue could be related to that but in the mt_dotnet_type:

• Program+AccountEvent+AccountCreated
• Program+AccountEvent+AccountCredited
• Program+AccountEvent+AccountCreated

I am not too sure but I found it weird that the type register is Program+AccountEvent+AccountCreated instead of Program+AccountEvent.

Knowing that Program+AccountEvent+AccountCreated is not a type that cannot be passed as a parameter of a function / method...

Now if I am taking the type of accountCreated at runtime in my first snippet:

let accountCreated = AccountEvent.AccountCreated({
    Owner = "Khalid Abuhakmeh"
    AccountId = Guid.NewGuid()
    StartingBalance = 1000m
    CreatedAt = DateTimeOffset.UtcNow
})

let accountCreatedType = accountCreated.GetType()

I have the following properties for accountCreatedType:

accountCreatedType = {RuntimeType} "Program+AccountEvent+AccountCreated"
 Assembly = {RuntimeAssembly} "ConsoleApp1, Version=1.0.0.0, Culture=neutral, PublicKeyToken=null"
 AssemblyQualifiedName = {string} "Program+AccountEvent+AccountCreated, ConsoleApp1, Version=1.0.0.0, Culture=neutral, PublicKeyToken=null"
 Attributes = {TypeAttributes} NestedPublic | SpecialName | Serializable | BeforeFieldInit
 BaseType = {RuntimeType} "Program+AccountEvent"
 Cache = {RuntimeTypeCache} {System.RuntimeType.RuntimeTypeCache}
 ContainsGenericParameters (RuntimeType) = {bool} false
 ContainsGenericParameters (Type) = {bool} false
 CustomAttributes = {ReadOnlyCollection<CustomAttributeData>} Count = 3
 DeclaredConstructors = {ConstructorInfo[]} Count = 1
 DeclaredEvents = {EventInfo[]} Count = 0
 DeclaredFields = {FieldInfo[]} Count = 1
 DeclaredMembers = {MemberInfo[]} Count = 4
 DeclaredMethods = {MethodInfo[]} Count = 1
 DeclaredNestedTypes = {<get_DeclaredNestedTypes>d__22} {System.Reflection.TypeInfo.<get_DeclaredNestedTypes>d__22}
 DeclaredProperties = {PropertyInfo[]} Count = 1
 DeclaringMethod (RuntimeType) = {System.InvalidOperationException} Exception of type 'System.InvalidOperationException' was thrown
 DeclaringMethod (Type) = {System.InvalidOperationException} Exception of type 'System.InvalidOperationException' was thrown
 DeclaringType (RuntimeType) = {RuntimeType} "Program+AccountEvent"
 DeclaringType (Type) = {RuntimeType} "Program+AccountEvent"
 DomainInitialized = {bool} false
 FullName = {string} "Program+AccountEvent+AccountCreated"
 GUID = {Guid} "d394093c-17e9-394e-bcd7-1c9ae1e379fb"
 GenericCache = {object} null
 GenericParameterAttributes (RuntimeType) = {System.InvalidOperationException} Exception of type 'System.InvalidOperationException' was thrown
 GenericParameterAttributes (Type) = {System.InvalidOperationException} Exception of type 'System.InvalidOperationException' was thrown
 GenericParameterPosition (RuntimeType) = {System.InvalidOperationException} Exception of type 'System.InvalidOperationException' was thrown
 GenericParameterPosition (Type) = {System.InvalidOperationException} Exception of type 'System.InvalidOperationException' was thrown
 GenericTypeArguments = {Type[]} Count = 0
 GenericTypeParameters = {Type[]} Count = 0
 HasElementType = {bool} false
 ImplementedInterfaces = {Type[]} Count = 5
 IsAbstract = {bool} false
 IsAnsiClass = {bool} true
 IsArray = {bool} false
 IsAutoClass = {bool} false
 IsAutoLayout = {bool} true
 IsByRef = {bool} false
 IsByRefLike (RuntimeType) = {bool} false
 IsByRefLike (Type) = {bool} false
 IsCOMObject = {bool} false
 IsClass = {bool} true
 IsCollectible (RuntimeType) = {bool} false
 IsCollectible (Type) = {bool} false
 IsConstructedGenericType (RuntimeType) = {bool} false
 IsConstructedGenericType (Type) = {bool} false
 IsContextful = {bool} false
 IsEnum = {bool} false
 IsExplicitLayout = {bool} false
 IsExportedToWindowsRuntime = {bool} false
 IsGenericMethodParameter = {bool} false
 IsGenericParameter (RuntimeType) = {bool} false
 IsGenericParameter (Type) = {bool} false
 IsGenericType (RuntimeType) = {bool} false
 IsGenericType (Type) = {bool} false
 IsGenericTypeDefinition (RuntimeType) = {bool} false
 IsGenericTypeDefinition (Type) = {bool} false
 IsGenericTypeParameter = {bool} false
 IsImport = {bool} false
 IsInterface = {bool} false
 IsLayoutSequential = {bool} false
 IsMarshalByRef = {bool} false
 IsNested = {bool} true
 IsNestedAssembly = {bool} false
 IsNestedFamANDAssem = {bool} false
 IsNestedFamORAssem = {bool} false
 IsNestedFamily = {bool} false
 IsNestedPrivate = {bool} false
 IsNestedPublic = {bool} true
 IsNotPublic = {bool} false
 IsPointer = {bool} false
 IsPrimitive = {bool} false
 IsPublic = {bool} false
 IsSZArray (RuntimeType) = {bool} false
 IsSZArray (Type) = {bool} false
 IsSealed = {bool} false
 IsSecurityCritical (RuntimeType) = {bool} true
 IsSecurityCritical (Type) = {bool} true
 IsSecuritySafeCritical (RuntimeType) = {bool} false
 IsSecuritySafeCritical (Type) = {bool} false
 IsSecurityTransparent (RuntimeType) = {bool} false
 IsSecurityTransparent (Type) = {bool} false
 IsSerializable = {bool} true
 IsSignatureType = {bool} false
 IsSpecialName = {bool} true
 IsTypeDefinition (RuntimeType) = {bool} true
 IsTypeDefinition (Type) = {bool} true
 IsUnicodeClass = {bool} false
 IsValueType = {bool} false
 IsVariableBoundArray = {bool} false
 IsVisible = {bool} true
 IsWindowsRuntimeObject = {bool} false
 MemberType (RuntimeType) = {MemberTypes} NestedType
 MemberType (Type) = {MemberTypes} NestedType
 MetadataToken (RuntimeType) = {int} 33554439
 MetadataToken (MemberInfo) = {int} 33554439
 Module (RuntimeType) = {RuntimeModule} "ConsoleApp1.exe"
 Module (MemberInfo) = {RuntimeModule} "ConsoleApp1.exe"
 Name = {string} "AccountCreated"
 Namespace = {string} null
 ReflectedType (RuntimeType) = {RuntimeType} "Program+AccountEvent"
 ReflectedType (Type) = {RuntimeType} "Program+AccountEvent"
 StructLayoutAttribute (RuntimeType) = {StructLayoutAttribute} {System.Runtime.InteropServices.StructLayoutAttribute}
 StructLayoutAttribute (Type) = {StructLayoutAttribute} {System.Runtime.InteropServices.StructLayoutAttribute}
 TypeHandle (RuntimeType) = {RuntimeTypeHandle} "System.RuntimeTypeHandle"
 TypeHandle (Type) = {RuntimeTypeHandle} "System.RuntimeTypeHandle"
 TypeInitializer = {ConstructorInfo} null
 UnderlyingSystemType = {RuntimeType} "Program+AccountEvent+AccountCreated"

It's interesting to notice that the type that can actually be passed as the parameter of Apply for the aggregate is considered as the parent type: BaseType = {RuntimeType} "Program+AccountEvent" and

• DeclaringType (RuntimeType) = {RuntimeType} "Program+AccountEvent"
• DeclaringType (Type) = {RuntimeType} "Program+AccountEvent"

Depending on which type marten is using to lookup the aggregate method / Apply pattern it may explain why nothing is triggered with discriminated unions.

It also worth mentioning that:

let serialized = JsonConvert.SerializeObject(accountCreated)
let deserialized = JsonConvert.DeserializeObject<AccountEvent>(serialized)
let rawDeserialized = JsonConvert.DeserializeObject(serialized, accountCreatedType)
let castedDeserialized = castAs<AccountEvent>(rawDeserialized).Value

printfn "%A" (accountCreated = deserialized)
printfn "%A" (deserialized = castedDeserialized)

shows that deserialization works either way, be it with AccountEvent or the runtime type Program+AccountEvent+AccountCreated

Also that question on SO: https://stackoverflow.com/questions/17832203/is-f-aware-of-its-discriminated-unions-compiled-forms

Helped me to realize that:

A discriminated union in F# is compiled to an abstract class and its options become nested concrete classes.

type DU = A | B`

DU is abstract while DU.A and DU.B are concrete.

Which echoes what I was writing just above about the base type.

[natalie-o-perret]

Source code that I probably need to go through:

• https://github.com/JasperFx/marten/blob/master/src/Marten/Events/EventGraph.cs
• https://github.com/JasperFx/marten/blob/master/src/Marten/Events/Projections/AggregatorLookup.cs
• https://github.com/JasperFx/marten/blob/master/src/Marten/Events/Projections/Aggregator.cs

[jeremydmiller]

@ehouarn-perret You know that you don't have to use the built in aggregator, right? You can use your own projection and/or aggregator if you just implement the interfaces. That might be easier than trying to force fit the F#isms into C#-centric reflection

[natalie-o-perret]

You know that you don't have to use the built in aggregator, right? You can use your own projection and/or aggregator if you just implement the interfaces. That might be easier than trying to force fit the F#isms into C#-centric reflection

Yea hence my comment about which source files to go through in order to know how to properly implement those interfaces and maybe provide a generic type / helper for discrimimated unions

[natalie-o-perret]

Out of curiosity I translated the C# version Aggregator<T> to F#:

type Aggregator<'T when 'T : (new : unit -> 'T) and 'T : not struct> (overrideMethodLookup : IEnumerable<MethodInfo>)=
    let aggregations : IDictionary<Type, obj> = (new Dictionary<Type, obj>() :> IDictionary<Type, obj>) 
    let aggregateType = typeof<'T>
    let mutable alias = Unchecked.defaultof<string>
    do
        alias <-  typeof<'T>.Name.ToTableAlias();
        overrideMethodLookup.Each(fun (method : MethodInfo) ->
            let mutable step = Unchecked.defaultof<obj>
            let mutable eventType = method.GetParameters().Single<ParameterInfo>().ParameterType;
            if eventType.Closes(typedefof<Event<_>>) then
                eventType <- eventType.GetGenericArguments().Single();
                step <- typedefof<EventAggregationStep<_,_>>.CloseAndBuildAs<obj>(method, [| typeof<'T>; eventType |]);
            else
                step <- typedefof<AggregationStep<_,_>>.CloseAndBuildAs<obj>(method, [| typeof<'T>; eventType |]);
            aggregations.Add(eventType, step)
        ) |> ignore

    static let ApplyMethod = "Apply"

    new() = new Aggregator<'T>(typeof<'T>.GetMethods()
                               |> Seq.where (fun x -> x.Name = ApplyMethod &&
                                                      x.GetParameters().Length = 1))

    member this.Add<'TEvent>(aggregation: IAggregation<'T, 'TEvent>) =
        if aggregations.ContainsKey(typeof<'TEvent>) then
            aggregations.[typeof<'TEvent>] <- aggregation
        else
            aggregations.Add(typeof<'TEvent>, aggregation)
        this

    member this.Add<'TEvent>(application: Action<'T, 'TEvent>) =
        this.Add(new AggregationStep<'T, 'TEvent>(application));

    interface IAggregator<'T> with

        member this.AggregatorFor<'TEvent>() =
            if aggregations.ContainsKey(typeof<'TEvent>) then
                aggregations.[typeof<'TEvent>].As<IAggregation<'T, 'TEvent>>()
            else
                null

        member this.Build(events, session, state) =
            events.Each(fun (x : IEvent) -> x.Apply(state, this)) |> ignore
            state

        member this.Build(events, session) =
            (this :> IAggregator<'T>).Build(events, session, new 'T());

        member this.EventTypes =
            aggregations.Keys.ToArray();

        member this.AggregateType =
            aggregateType

        member this.Alias =
            alias

        member this.AppliesTo(stream) =
            stream.Events.Any(fun x -> aggregations.ContainsKey(x.Data.GetType()));

[natalie-o-perret]

Update with a partial solution:

type MyEventAggregationStep<'T, 'TEvent>(apply: Action<'T, Event<'TEvent>>)=

    new(method: MethodInfo) =
        let parameters = method.GetParameters()
        let eventType = typeof<Event<'TEvent>>
        let parameter = parameters.SingleOrDefault()
        let parameterGenericType = parameter.ParameterType.GetGenericArguments().SingleOrDefault()
        let eventGenericType = eventType.GetGenericArguments().SingleOrDefault()
        if parameters.Length <> 1 ||
            not ((Reflection.FSharpType.IsUnion parameterGenericType
                 && eventGenericType.BaseType = parameterGenericType)
                <>
                (parameter.ParameterType = eventType)) ||
            (method.DeclaringType <> typeof<'T>) then
            let message = String.Format("Method {0} on {1} cannot be used as an aggregation method", method.Name, method.DeclaringType)
            raise(new ArgumentOutOfRangeException(message));
        let aggregateParameter = Expression.Parameter(typeof<'T>, "a");
        let eventParameter = Expression.Parameter(typeof<Event<'TEvent>>, "e");
        let body = Expression.Call(aggregateParameter, method, eventParameter);
        let lambda = Expression.Lambda<Action<'T, Event<'TEvent>>>(body, aggregateParameter, eventParameter);
        let compilation = lambda.Compile()
        // ExpressionCompiler is internal =/
        // let expressionCompiler = Type.GetType("Marten.Util.ExpressionCompiler, Marten")
        new MyEventAggregationStep<'T, 'TEvent>(compilation)

    interface IAggregationWithMetadata<'T, 'TEvent> with
        member this.Apply(aggregate, event) =
            apply.Invoke(aggregate, event)

    interface IAggregation<'T, 'TEvent> with
        member this.Apply(aggregate, event) =
            raise(new NotSupportedException("Should never be called"))

type MyAggregationStep<'T, 'TEvent>(apply: Action<'T, 'TEvent>)=

    new(method: MethodInfo) =
        let parameters = method.GetParameters()
        let eventType = typeof<'TEvent>
        let parameter = parameters.SingleOrDefault()
        if parameters.Length <> 1 ||
            not ((Reflection.FSharpType.IsUnion parameter.ParameterType
                 && eventType.BaseType = parameter.ParameterType)
                <>
                (parameter.ParameterType = eventType)) ||
            not (method.DeclaringType.IsAssignableFrom(typeof<'T>)) then
            let message = String.Format("Method {0} on {1} cannot be used as an aggregation method", method.Name, method.DeclaringType)
            raise(new ArgumentOutOfRangeException(message));
        let aggregateParameter = Expression.Parameter(typeof<'T>, "a");
        let eventParameter = Expression.Parameter(typeof<'TEvent>, "e");
        let body = Expression.Call(aggregateParameter, method, eventParameter);
        let lambda = Expression.Lambda<Action<'T, 'TEvent>>(body, aggregateParameter, eventParameter);
        let compilation = lambda.Compile()
        // ExpressionCompiler is internal =/
        // let expressionCompiler = Type.GetType("Marten.Util.ExpressionCompiler, Marten")
        new MyAggregationStep<'T, 'TEvent>(compilation)

    interface IAggregation<'T, 'TEvent> with

        member this.Apply(aggregate, event) =
            apply.Invoke(aggregate, event)

type MyAggregator<'T when 'T : (new : unit -> 'T) and 'T : not struct> (overrideMethodLookup : IEnumerable<MethodInfo>)=
    let aggregations : IDictionary<Type, obj> = (new Dictionary<Type, obj>() :> IDictionary<Type, obj>) 
    let aggregateType = typeof<'T>
    let mutable alias = Unchecked.defaultof<string>
    do
        alias <-  typeof<'T>.Name.ToTableAlias();
        overrideMethodLookup.Each(fun (method : MethodInfo) ->
            let mutable step = Unchecked.defaultof<obj>
            let mutable eventType = method.GetParameters().Single<ParameterInfo>().ParameterType;

            if eventType.Closes(typedefof<Event<_>>) then
                eventType <- eventType.GetGenericArguments().Single();
                if Reflection.FSharpType.IsUnion eventType then
                    Reflection.FSharpType.GetUnionCases(eventType)
                    |> Seq.map (fun x -> x.GetFields().[0].DeclaringType)
                    |> Seq.iter (fun x ->
                        step <- typedefof<MyEventAggregationStep<_,_>>.CloseAndBuildAs<obj>(method, [| aggregateType; x |]);
                        aggregations.Add(x, step))
                else 
                    step <- typedefof<MyEventAggregationStep<_,_>>.CloseAndBuildAs<obj>(method, [| aggregateType; eventType |]);
            else
                if Reflection.FSharpType.IsUnion eventType then
                    Reflection.FSharpType.GetUnionCases(eventType)
                    |> Seq.map (fun x -> x.GetFields().[0].DeclaringType)
                    |> Seq.iter (fun x ->
                        step <- typedefof<MyAggregationStep<_,_>>.CloseAndBuildAs<obj>(method, [| aggregateType; x |]);
                        aggregations.Add(x, step))
                else
                    step <- typedefof<MyAggregationStep<_,_>>.CloseAndBuildAs<obj>(method, [| aggregateType; eventType |]);
                    aggregations.Add(eventType, step)
        ) |> ignore

    static let ApplyMethod = "Apply"

    new() =
        new MyAggregator<'T>(typeof<'T>.GetMethods()
                             |> Seq.where (fun x ->
                                 x.Name = ApplyMethod &&
                                 x.GetParameters().Length = 1))

    member this.Add<'TEvent>(aggregation: IAggregation<'T, 'TEvent>) =
        if aggregations.ContainsKey(typeof<'TEvent>) then
            aggregations.[typeof<'TEvent>] <- aggregation
        else
            aggregations.Add(typeof<'TEvent>, aggregation)
        this

    member this.Add<'TEvent>(application: Action<'T, 'TEvent>) =
        this.Add(new AggregationStep<'T, 'TEvent>(application));

    interface IAggregator<'T> with

        member this.AggregatorFor<'TEvent>() =
            // Need to investigate here
            let typeEvent = typeof<'TEvent>
            if aggregations.ContainsKey(typeEvent) then
                let aggregation = aggregations.[typeEvent]
                aggregation.As<IAggregation<'T, 'TEvent>>()
            else
                null

        member this.Build(events, session, state) =
            events.Each(fun (x : IEvent) -> x.Apply(state, this)) |> ignore
            state

        member this.Build(events, session) =
            (this :> IAggregator<'T>).Build(events, session, new 'T());

        member this.EventTypes =
            aggregations.Keys.ToArray();

        member this.AggregateType =
            aggregateType

        member this.Alias =
            alias

        member this.AppliesTo(stream) =
            stream.Events.Any(fun x ->

                aggregations.ContainsKey(x.Data.GetType()));

type MyAggregatorLookup (factory: Func<Type, IAggregator>)=

    new() =
        new MyAggregatorLookup(Unchecked.defaultof<Func<Type, IAggregator>>)

    interface IAggregatorLookup with

        member this.Lookup<'T when 'T : (new : unit -> 'T) and 'T : not struct>() =
            let thisFactory = factory
            let mutable aggregator = Unchecked.defaultof<IAggregator<'T>>
            if thisFactory <> null then
                aggregator <- thisFactory.Invoke(typeof<'T>) :?> IAggregator<'T>
            else
                aggregator <- null
            if aggregator = null then
                aggregator <- new MyAggregator<'T>()
            aggregator

        member this.Lookup(aggregateType) =
            let thisFactory = factory
            let mutable aggregator = Unchecked.defaultof<IAggregator>
            if thisFactory <> null then 
                aggregator <- thisFactory.Invoke(aggregateType)
            else
                aggregator <- null
            typedefof<MyAggregator<_>>.CloseAndBuildAs<IAggregator>([| aggregateType |])

However there is an issue about Event<TDiscriminatedUnion>

[oskardudycz]

@ehouarn-perret I’ll try to check what we can do on that.

[natalie-o-perret]

@oskardudycz thanks! Newtonsoft has this class, might worth to have a look at it: https://github.com/JamesNK/Newtonsoft.Json/blob/master/Src/Newtonsoft.Json/Converters/DiscriminatedUnionConverter.cs

[oskardudycz]

Thanks for sharing this finding 👍

[natalie-o-perret]

Note: a potential workaround is to create a wrapper type that embeds the DU type. Sorry to have ghosted for a while: been busy working

[jokokko]

Depending on how well this can be addressed in Marten, think it (workarounds) could at least be documented e.g. under scenarios (https://jasperfx.github.io/marten/documentation/scenarios/), mentioning any possible caveats. Though no F# code in Marten.sln, so documenting them with unit tests (as opposed to just MD) would introduce new build requirements :(

[oskardudycz]

I have a plan to add new sample projects to our solution: one written with C# and other with F#, based on what @ehouarn-perret provided. It would be easier to check and verify if it's working also for F# and might be good starting point for our users. Thoughts? @jokokko I like the idea of updating also scenarios 👍

[jokokko]

@oskardudycz I absolutely prefer having the docs as code (so our docs won't go stale). Just a new build prerequisite (F#) for anybody wanting to build Marten. Unless they are not made part of the default build or build is otherwise tweaked.

[natalie-o-perret]

I have a plan to add new sample projects to our solution: one written with C# and other with F#, based on what @ehouarn-perret provided. It would be easier to check and verify if it's working also for F# and might be good starting point for our users. Thoughts? @jokokko I like the idea of updating also scenarios 👍

Might need a review, if @wastaz could have a look at it 👍

[oskardudycz]

For sure I'll add you and @wastaz as reviewers. I have plan to work on that during the weekend or at worst in the next week if my non-marten life won't mess with that ;)

I'll have also some learning curve, as I wasn't coding in F# much.

[natalie-o-perret]

A work-colleague showed me something the other day, some food for thoughts: https://github.com/Dzoukr/CosmoStore

Does not provide much (nothing from my understanding) for projections, but well this is something that may worth looking at.

Also about this issue, the main problem behind it is a reflection issue: https://github.com/JasperFx/marten/issues/1283#issuecomment-500151729

I asked something a while ago on SO: https://stackoverflow.com/questions/56502392/f-how-to-call-expression-call-for-a-method-with-discriminated-union-in-a-gener

Didn't get any proper answer, I may dig into that when I will have more time.

[oskardudycz]

Thank you @ehouarn-perret.

I'm just finishing Domain Modeling Made Functional by @swlaschin, last pages left - so I think that now I have the good basis to tackle this issue and make Marten more F# friendly.

After I finish my work on https://github.com/JasperFx/marten/issues/1302 I'll try to tackle that.

[johncj-improving]

One way to fix this issue is by adding the following bits of code to the original example

type WrappedAccountEvent = {
    Inner : AccountEvent
}    

type Events.IEventStore with 
    member this.Append(id : Guid, x: AccountEvent) = 
        let y = { Inner = x }
        this.Append(id, y)

type Account with
    member this.Apply(evt : WrappedAccountEvent) =
        let unwrapped = evt.Inner        
        this.Apply(unwrapped)       

That code creates an optional type extension for the Append method specific to AccountEvents. Then it adds an intrinsic type extension to the Account type. The distinction between the two type extensions actually matters because the extension to the Account method is visible via Reflection and from C#. Other than some extra object allocations, the technique is low impact. It's just boring and repetitive code to write for every aggregate and its DU of events. And the solution to boring and repetitive code is ... code generation.

I propose that we use F# build time code generation, a technique I have borrowed from Myriad (https://github.com/MoiraeSoftware/myriad).

For each aggregate and DU event you are using, you would add an empty file to your project after the file declaring the event and aggregate. At build time, command line utility would receive a list of .fs files and process the F# AST of those files looking for member methods named "Apply" that take a parameter that is a DU. It would then generate code like the example above for each one, putting that code into the empty file you added to your project. I've used this technique before and it worked out fairly well.

If the Marten/F# folks think this is a viable solution, I'm willing to create and open source the command line utility to make it work.

[AlexZeitler]

@johncj-improving That's quite similar to the solution I ended up with but I didn't know about the code generation stuff (F# noob).

If this works with low impact and I can have it quite soon, it would be a viable solution for me.

[johncj-improving]

Quick followup: I made a lot of progress on this over the weekend. I expect to have something for folks to look at in a week. The solution I came up with has some limitations. I think they are reasonable and I would like to hear feedback from folks:

• Each aggregate has a single DU for its events. - This seems like the natural F# way to me.
• Each aggregate/DU pair are declared in a single fs file. - I think this could be relaxed at the cost of code complexity that I would rather avoid.
• All these files are included in your project above any Marten implementation code.
• Your aggregate/DU pairs are in a namespace - This can be the same namespace for all of them or different namespaces.
• The Apply method has a type annotation on the DU variable. - This will requirement definitely go away as the more idiomatic F# code would allow type inference to do its thing. It's easier to process the AST if the variable has the type annotation.

Do these limitations sound onerous or unreasonable?

[AlexZeitler]

@johncj-improving that's great news!

Each aggregate has a single DU for its events. - This seems like the natural F# way to me.

That's the way I'm doing it right now - is the DU associated with the aggregate itself or is it just the DU?

Each aggregate/DU pair are declared in a single fs file. - I think this could be relaxed at the cost of code complexity that I would rather avoid.

That would be ok for me.

All these files are included in your project above any Marten implementation code.

I don't have Marten implementation Code above my domain code

Your aggregate/DU pairs are in a namespace - This can be the same namespace for all of them or different namespaces.

This seems to be a requirement anyway when using Marten right now

The Apply method has a type annotation on the DU variable. - This will requirement definitely go away as the more idiomatic F# code would allow type inference to do its thing. It's easier to process the AST if the variable has the type annotation.

That would be ok for me

[jeremydmiller]

@AlexZeitler I got the issue with types not being in a namespace blowing up the generated code fixed in the latest alpha. That's no longer a problem.

[AlexZeitler]

@jeremydmiller Thanks, will try it.

[natalie-o-perret]

Each aggregate/DU pair are declared in a single fs file. - I think this could be relaxed at the cost of code complexity that I would rather avoid.

That's a bugger, ihmo. That can work out in most scenarios but I'm afraid it will bite you sooner or later especially if errors are kinda cryptic or hard to debug.

My point is that, can you actually detect if there is more than one per file? Or if say, there is something missing?

[johncj-improving]

@AlexZeitler @mary-perret-1986

I got a chance to work on this a bit more last night and I see a way to ease up on some of these restrictions. I'll try post a sample of what the output will look like a bit later.

[AlexZeitler]

@johncj-improving just out of curiosity: how are things going with the sample? If you need some test feedback, just ping me 😉

[johncj-improving]

Thanks for the reminder! The only requirement is that all of your aggregates and DUs should be in one file with a namespace. At compile time, you pass the name of that file to my command line utility. It will generate a file that will be inserted in your project immediately below the file you passed in. For the example above, assuming you split the code into two files (above the [<EntryPoint>] attribute and specified Account as your namespace), the generated file would look like this:

module Martenizer
// Generated code
    open Marten
    open Marten.Events 
    open System 
    open Account 

// DU wrappers get written first
    type WrappedAccountEvent = {
        Inner : AccountEvent
    }    
// Aggregates are extended with an unwrapping member    
    type Account with
        member this.Apply(evt : WrappedAccountEvent) =
            let unwrapped = evt.Inner        
            this.Apply(unwrapped)     

// Various Marten interfaces/objects get specific extension methods (only visible from F#)
    type IEventStore with 
        member this.Append(id : Guid, x: AccountEvent) = 
            let y = { Inner = x }
            this.Append(id, y)
        member this.Append(id : Guid, xs : seq<AccountEvent>) =
            let y = xs |> Seq.map(fun a -> { Inner = a } :> obj) //|> Seq.toArray
            this.Append(id, y )
        member this.Append(id : Guid, [<ParamArray>] evts : AccountEvent[] ) =
            let y = evts |> Array.map(fun e -> { Inner = e } :> obj) |> Array.toSeq
            this.Append(id, y)

    type IDocumentSession with 
        member this.LoadAsync<'T when 'T :> Account>((id : Guid)) =
            async {
            let acct = new Account()
            let evts = this.Events.FetchStream(id)
            for evt in evts do
                acct.Apply(this.Events.Load<WrappedAccountEvent>(evt.Id).Data)
            return acct
            } |> Async.StartAsTask

//The typeof command gets hijacked
    let inline typeof< ^T when ^T :> System.Object> =
        match typeof< ^T> with
        | t when t = typeof<AccountEvent> -> typeof<WrappedAccountEvent>
        | _ -> typeof< ^T>

The end result is that you write your F# the way you expect and when you compile, a bunch of magic happens that automates the wrapping of your DUs. The code that generates the code above is pretty ugly, but I'm the only one who has to look at it. I'm waiting for the Marten 4.0 Event Sourcing API to be finalized so that I know the scope of the code I have to generate. As a side note, that bit of code that hijacks typeof is the nuttiest code I've every written. On the plus side, I finally understand SRTPs in F#. If anyone has samples of Aggregates and Event DUs they can share, you can post them here or email them to me at [FirstName].[LastName]@improving.com

Thanks, John Cavnar-Johnson

[natalie-o-perret]

@johncj-improving what about using a Type Provider?

[JacksonCribb]

It seems somewhere along the way this might have been resolved.

Following test passes:

type CounterEvent =
  | Increased of int
  | Decreased of int
  | ResetTo of int

type CounterState () =
  member val Id = Guid.Empty with get, set
  member val Total = 0 with get, set

type CounterAggregate () =
  inherit SingleStreamAggregation<CounterState> ()

  member _.Apply (e : CounterEvent, state : CounterState) =
    match e with
    | Increased i -> state.Total <- state.Total + i
    | Decreased i -> state.Total <- state.Total - i
    | ResetTo i -> state.Total <- i

[<Fact>]
let ``Can project a union`` () =
  let cfg (options : StoreOptions) =
    options.Connection ("...")
    options.Projections.Add<CounterAggregate> (ProjectionLifecycle.Inline)
    ()

  let store = DocumentStore.For cfg
  let session = store.LightweightSession ()
  let g = Guid.NewGuid ()

  session.Events.Append (g, Increased 12, Increased 1) |> ignore
  session.SaveChanges ()
  let doc = session.Load<CounterState> (g)
  Assert.Equal (13, doc.Total)

[oskardudycz]

@JacksonCribb, thank you a lot for the feedback. That'd be great if we accidentally fixed that 😅 I'll keep the issue open, as I'm planning to work more on the Marten F# experience soon, so I'll try to double-check if we have all the common use cases covered.

[AlexZeitler]

@JacksonCribb, thank you a lot for the feedback. That'd be great if we accidentally fixed that sweat_smile I'll keep the issue open, as I'm planning to work more on the Marten F# experience soon, so I'll try to double-check if we have all the common use cases covered.

I'll also try to update my failed F# experiments to the latest version and see what happens. I'm quite curious.

[natalie-o-perret]

I'm pretty done much covering all usecases as ive been working with Marten lately, a bit more things to cover and I think we can soon close the issue

[jannikbuschke]

It would be cool to see how you use marten within F# @natalie-o-perret. There is so little information online. Recently I wrote a little bit about my setup here: https://www.jannikbuschke.de/blog/fsharp-marten/

In general I think it would be cool to have more F# Marten content.

Also maybe a test suite in order to check which scenarios supported and future regressions are prevented. A little while ago I wrote some tests for different json serializers: https://github.com/jannikbuschke/marten-fsharp-experiments/blob/main/Tests.fs

@oskardudycz what would it take to add an F# testproject to this repo? I mean I would like to contribute here, but not sure how to get started. I.e. I could write tests with xunit for example as mentioned above.

[jeremydmiller]

@jannikbuschke Sounds like an awesome way to contribute to Marten! We've had F# contributors in the past, but not lately. I'd welcome some official F# docs and tests in the main codebase.

No recent activity, seems to work, and I'm finally closing this.

[nkosi23]

@natalie-o-perret Hello! i am not sure I understand the current status, have you been contributing the work you've done to cover all use cases to Marten, or was it something you've done on your side and the problem disappeared in Marten accidentally?