Marten: F#: Discriminated Unions are not supported for aggregates

[kerry-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.

[kerry-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.

[kerry-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

[kerry-perret]

@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

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

[kerry-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()));

[kerry-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.

[kerry-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 👍

[kerry-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.

[kerry-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.

[kerry-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.