Update: 2023-12-19

I added in the code and here in this article the reader monad. To be complete about this.
Also, there is a chapter "The Service" to explain, what is meant with the service implementation.

And I want to add, I mention here sometimes the phrase 'normal dependency injection'.
As you are aware, we use in many cases things like ASP.NET Core and the build in DI container with
the resulting constructor injection, I call 'normal dependency injection'.
(that seem to bother also some people, that wasn't clear about the term)

I see this all pragmatically and foremost I describe my journey here.

But at least I made a reader monad implementation.

Introduction

This article will show some examples or should I say more a small journey, how to manage the dependencies in a command-event architecture.
At least for me, these were the steps I took in order to solve the problem for myself.

To be honest all the ways I will describe here, are neither right nor wrong. (okay, the fist one feels totally wrong in F# XD)
Some of them will feel weird, some of these will break some rules about purity and testability of functions.
These points will be discussed also.

First at all I will try to establish here the example domain I use. And even example domain sound to huge for that.
Please be aware, that this is NOT an article about how to model a proper domain, proper commands and events.
Please shift your focus not on the domain and how we can improve it.
In order to avoid the problem I will describe and focus on the dependency management itself and
how we can deal with external dependencies from a programmer's perspective.

All the code you find here in this github repository: here

Prerequisite

You should be a little aware about a command-event architecture.
If you are not, please watch the videos from Greg Young about CQRS and Event Sourcing.
Also read the book from Scott Wlaschin (Domain Modelling Made Functional).
Also this one: here

The Example

So let's begin with an example:

Imagine, we have an 'invoice' and when you create this invoice,
there should be a customer assigned to it. Also, after we created the invoice,
we want to assign some products or services the customer bought plus the quantity of it.

With this small domain, we want to start. And keep in mind, that we don't want to improve the domain here,
we want to solve another problem.

Update: The Service (2023-12-19)

In the code samples you will see a service implementation.
Consider it as the application layer, application service, domain service or whatever you call it.
It's not important for the discussion here. But it seems, that some people get confused about it.
The service is not the API-Layer like Giraffe HttpHandler or MVC Controller or something like that.
And keep in mind, it's an example and not a real world application.

The Domain Description

You see here, when we create an invoice, we have to check, if the customer, even exists in our system.
Also, the nature of an invoice is, that an invoice can not carry a simple reference to our customer data,
you have to put in the (needed) customer data, name and address, as part of the invoice.
If you change the address of your customer later in your system,
your invoice is not allowed to change.
Invoices are immutable (like events in event sourcing) and there are legal things you have to consider. (at least here in Germany, but I think there are similar rules in other countries)

The second thing, we want to do, is assigning/adding some products with some quantity and a price to the invoice.
Also, here is the same rule, you can not use a reference to your products,
you have to add at least the name and the price to your invoice.

From a UI perspective, you click on a button 'Create Invoice'
and the system ask you for which customer you want to create the invoice.
After that, the system provides some invoice lines, where you select a product or service and enter a quantity.

That's it. And yes, this 'domain' can be solved simple with a CRUD implementation, but as I said, that's not the focus here.

The Problem

So, what's the problem here?

You see the invoice uses data, which is, in the most cases stored in your database in particular tables.
In this case, we have here a table with customer data and a table with products/services your 'company' provides.

And in your domain model, you have to look into the table and check, if the data event exists,
so it's valid to create an invoice for customer(id), you get from you UI. And if the customer exists,
we need the data, in order to fill the invoice.

The same is with the products. We can send the name, price and quantity right from the UI,
but in most cases we trigger the 'addition of a product' by sending a reference-id.

So the problem is, how to deal with the additional data we have, when do we call services or repos,
in order to check and get the data.

The (dependent) Data Structures in our System

Before we start, here are some data structures, we use in our examples:

type Product = { ProductId: string; Name: string; Price: decimal }

type Customer = { CustomerId: string; Name: string; Address: Address }
and Address = { Street: string; City: string }

We have a product and a customer.
And we have here some Interfaces for the repositories we will use to fetch the actual data.

type IProductRepository =
    abstract member GetProductById : string -> Task<Product option>

type ICustomerRepository =
    abstract member GetCustomerById : string -> Task<Customer option>

Our Domain DataTypes

Our commands, we have 2 of them:

type Command =
    | CreateInvoice of CreateInvoiceData
    | AddInvoiceLine of InvoiceLineData
    
and CreateInvoiceData = {
    InvoiceId: string
    CustomerId: string 
}

and InvoiceLineData = {
    InvoiceId: string
    ProductId: string
    Quantity: int
}

The Events:

type Event =
    | InvoiceCreated of InvoiceCreatedData
    | InvoiceLineAdded of InvoiceLineAddedData
    
and InvoiceCreatedData = {
    InvoiceId: InvoiceId
    CustomerId: CustomerId
    CustomerName: CustomerName
    CustomerStreet: CustomerStreet
    CustomerCity: CustomerCity
}

and InvoiceLineAddedData = {
    InvoiceId: InvoiceId
    ProductId: ProductId
    ProductName: ProductName
    ProductPrice: ProductPrice
    ProductQuantity: ProductQuantity
    TotalPrice: TotalPrice
}

And the missing value types, you see in the events (they are not important):

type InvoiceId = InvoiceId of string

type CustomerId = CustomerId of string
type CustomerName = CustomerName of string
type CustomerStreet = CustomerStreet of string
type CustomerCity = CustomerCity of string

type ProductId = ProductId of string
type ProductName = ProductName of string
type ProductPrice = ProductPrice of decimal
type ProductQuantity = ProductQuantity of int
type TotalPrice = TotalPrice of decimal

Before We Start

I will provide first the code, and then we talk about it.

01. The Classic OOP approach

The classic OOP approach with an aggregate root and an additional aggregate.
I kept it simple, no internal handling of already replayed and new events, like shown in the Greg Young example.
This approach is not important when your write F#, so you can skip it, if you want.

The Boilerplate:

type AggregateId = AggregateId of string  

type IAggregate =
    abstract member Id : AggregateId
    
type IAggregateRoot =
    inherit IAggregate

The Domain Code:

type InvoiceAggregateRoot(
    id : AggregateId,
    customerRepo: ICustomerRepository,
    productRepo: IProductRepository) =
    
    // the fields
    let mutable invoiceId = InvoiceId ""
    let mutable customerId = CustomerId ""
    let mutable customerName = CustomerName ""
    let mutable customerStreet = CustomerStreet ""
    let mutable customerCity = CustomerCity ""
    let mutable invoiceLines: InvoiceLineAggregate list = []
    
    let mutable events: Event list = []
    
    interface IAggregateRoot with
        member _.Id = id
    
    // the properties (state)
    member _.InvoiceId        with get() = invoiceId      
    member _.CustomerId       with get() = customerId    
    member _.CustomerName     with get() = customerName  
    member _.CustomerStreet   with get() = customerStreet
    member _.CustomerCity     with get() = customerCity  
    
    member _.InvoiceLines     with get() = invoiceLines 
    
    // the event list
    member _.Events           with get() = events
    
    
    // the methods
    member this.CreateInvoice(Command.CreateInvoice cmd) =
        task {
            let! customer = customerRepo.GetCustomerById cmd.CustomerId
            match customer with
            | None -> failwith "invalid customer id"
            | Some customer ->
                let newEvent =
                    Event.InvoiceCreated {
                        InvoiceId       = InvoiceId cmd.InvoiceId
                        CustomerId      = CustomerId customer.CustomerId
                        CustomerName    = CustomerName customer.Name
                        CustomerStreet  = CustomerStreet customer.Address.Street
                        CustomerCity    = CustomerCity customer.Address.City        
                    }
                events <- newEvent :: events
                this.Apply newEvent
        }
    
    
    member this.AddInvoiceLine (Command.AddInvoiceLine cmd) =
        task {
            let! product = productRepo.GetProductById cmd.ProductId
            match product with
            | None -> failwith "invalid product id"
            | Some product ->
                let newEvent =
                    Event.InvoiceLineAdded {
                        InvoiceId       = InvoiceId cmd.InvoiceId
                        ProductId       = ProductId cmd.ProductId
                        ProductName     = ProductName product.Name
                        ProductPrice    = ProductPrice product.Price
                        ProductQuantity = ProductQuantity cmd.Quantity
                        TotalPrice      = TotalPrice (product.Price * decimal cmd.Quantity)
                    }
                events <- newEvent :: events
                this.Apply newEvent
        }
        
        
    member this.Apply(event) =
        match event with
        | Event.InvoiceCreated ev ->
            invoiceId       <- ev.InvoiceId
            customerId      <- ev.CustomerId
            customerName    <- ev.CustomerName
            customerStreet  <- ev.CustomerStreet
            customerCity    <- ev.CustomerCity
            
        | Event.InvoiceLineAdded ev ->
            let invoiceLine = InvoiceLineAggregate(AggregateId <| Guid.NewGuid().ToString())
            invoiceLine.Apply event
            invoiceLines <- invoiceLine :: invoiceLines
            
            
    member this.ApplyEvents (events: Event list) =
        events |> List.iter (fun event -> this.Apply event)
    
    
and InvoiceLineAggregate(
    id : AggregateId) =
        
    // the fields
    let mutable productId = ProductId ""
    let mutable productName = ProductName ""
    let mutable productPrice = ProductPrice 0.0m
    let mutable productQuantity = ProductQuantity 0
    let mutable totalPrice = TotalPrice 0.0m
    
    interface IAggregate with
        member _.Id = id        
        
    // the properties
    member _.ProductId          with get() = productId       
    member _.ProductName        with get() = productName     
    member _.ProductPrice       with get() = productPrice    
    member _.ProductQuantity    with get() = productQuantity 
    member _.TotalPrice         with get() = totalPrice      
    
    // the methods
    
    member _.Apply (event:Event) =
        match event with
        | Event.InvoiceLineAdded event ->
            productId       <- event.ProductId
            productName     <- event.ProductName
            productPrice    <- event.ProductPrice
            productQuantity <- event.ProductQuantity
            totalPrice      <- event.TotalPrice
        | _ ->
            failwith "invalid event"

The Service Code:

    type IInvoiceRepository =
        abstract member GetInvoice : invoiceId:string -> Task<InvoiceAggregateRoot option>
        abstract member StoreInvoice : InvoiceAggregateRoot -> Task<unit>
    
    
    type IInvoiceService =
        abstract member CreateInvoice : invoiceId:string -> customerId:string -> Task<unit>
        abstract member AddInvoiceLine : invoiceId:string -> productId:string -> quantity:int -> Task<unit>
        
     
    type IInvoiceServiceAlternative =
        abstract member ExecuteInvoiceCommand : command:Command -> Task<unit>
    
    
    type InvoiceService(
        invoiceRepo: IInvoiceRepository,
        customerRepo: ICustomerRepository,
        productRepo: IProductRepository
        ) =
        interface IInvoiceService with
        
            member this.CreateInvoice invoiceId customerId =
                task {
                    let! invoice = invoiceRepo.GetInvoice invoiceId
                    let aggregateId = AggregateId (invoiceId)
                    let invoiceAggregate = InvoiceAggregateRoot(aggregateId, customerRepo, productRepo)
                    let command = Command.CreateInvoice { InvoiceId = invoiceId; CustomerId = customerId }
                    do! invoiceAggregate.CreateInvoice command
                    do! invoiceRepo.StoreInvoice invoiceAggregate
                }
                
                
            member this.AddInvoiceLine invoiceId productId quantity =
                task {
                    let! invoiceAggregate = invoiceRepo.GetInvoice invoiceId
                    match invoiceAggregate with
                    | None -> failwith "Invoice not found"
                    | Some invoiceAggregate ->
                        let command = Command.AddInvoiceLine { InvoiceId = invoiceId; ProductId = productId; Quantity = quantity }
                        do! invoiceAggregate.AddInvoiceLine command
                        do! invoiceRepo.StoreInvoice invoiceAggregate
                }
                
                
    type InvoiceServiceAlternative(
        invoiceRepo: IInvoiceRepository,
        customerRepo: ICustomerRepository,
        productRepo: IProductRepository
        ) =
        interface IInvoiceServiceAlternative with
        
            member this.ExecuteInvoiceCommand command =
                task {
                    let! invoice = invoiceRepo.GetInvoice command.InvoiceId
                    match command with
                    | Command.CreateInvoice cmd ->
                        match invoice with
                        | None ->
                            let aggregateId = AggregateId (cmd.InvoiceId)
                            let invoiceAggregate = InvoiceAggregateRoot(aggregateId, customerRepo, productRepo)
                            do! invoiceAggregate.CreateInvoice command
                            do! invoiceRepo.StoreInvoice invoiceAggregate
                        | Some _ ->
                            failwith "Invoice already exists"
                            
                    | Command.AddInvoiceLine _ ->
                        match invoice with
                        | None -> failwith "Invoice not found"
                        | Some invoiceAggregate ->
                            do! invoiceAggregate.AddInvoiceLine command
                            do! invoiceRepo.StoreInvoice invoiceAggregate
                        
                }

The Discussion:

Please be aware, that this is one way to implement a command-event driven domain in oop.
There are probably multiple ways.
It's a little based on Greg Young's 'simples-cqrs example' (here).

So let's discuss this approach from the perspective of handling the dependencies and the
additional data we need from the database in order to fill the events and out final state:

The 'classic OOP' has the 'advantage' that, it's pretty forward in handling the dependencies.
It uses classic dependency injection and injects the necessary repository interfaces into the constructor of the aggregate root itself.
The methods 'CreateInvoice' and 'AddInvoiceLine' in the domain code call the repositories to get the data and
if they don't get them, they throw an exception.
(I know and hope, this time around, the people will also work with results in C#, this example above is not idiomatic F# at all)

That's a pretty forward implementation. It's easy to achieve, beside the huge boilerplate code,
but if you implement that in C# it's a common approach.
(We will in the next approach, how we 'optimize' that approach and make it more 'functional')

What about testing?

You have to Mock all interfaces, you use.
That is in OOP a total normal approach.
But it's tedious to mock.
Also, it's also not a pure implementation of the domain, which can cause issues down the line.

Conclusion

It's not something I would ever implement in F#.
Also not in C# anymore, because I know better now.
I didn't like the whole encapsulation stuff and these Aggregate-Root and sub Aggregate stuff. So for me personal a no.
In my opinion the whole stuff came up, when someone in the OOP world said, that 'anemic domain model' are an anti-pattern.
Nevertheless, it's a valid approach for people who like it.
It's not wrong. I harder to test, maybe harder to understand and the injection of the interfaces can cause issues,
but it's easy and straight forward.

02. The More F# Idiomatic Way

So, let's see, how we can do that in a more F# idiomatic way.

The State:

type InvoiceState = {
    InvoiceId      : InvoiceId 
    CustomerId     : CustomerId
    CustomerName   : CustomerName
    CustomerStreet : CustomerStreet
    CustomerCity   : CustomerCity
    
    InvoiceLines   : InvoiceLine list
}
and InvoiceLine = {
    ProductId        : ProductId
    ProductName      : ProductName
    ProductPrice     : ProductPrice
    ProductQuantity  : ProductQuantity
    TotalPrice       : TotalPrice
}

The Domain Code:

// execute a command (decider)
let execute getCustomer getProduct command state =
    task {
        match state, command with
        | None, Command.CreateInvoice cmd ->
            let! (customer:DataTypes.Customer option) = getCustomer cmd.CustomerId
            match customer with
            | None ->
                return Error $"customer '{cmd.CustomerId}' does not exist"
            | Some customer ->
                return [
                    Event.InvoiceCreated {
                        InvoiceId      = InvoiceId cmd.InvoiceId
                        CustomerId     = CustomerId cmd.CustomerId
                        CustomerName   = CustomerName customer.Name
                        CustomerStreet = CustomerStreet customer.Address.Street
                        CustomerCity   = CustomerCity customer.Address.City
                    }
                ] |> Ok
            
        | Some state, Command.AddInvoiceLine cmd ->
            let! (product:DataTypes.Product option) = getProduct cmd.ProductId
            match product with
            | None ->
                return Error $"product '{cmd.ProductId}' does not exist"
            | Some product ->
                return [
                    Event.InvoiceLineAdded {
                        InvoiceId        = state.InvoiceId
                        ProductId        = ProductId cmd.ProductId
                        ProductName      = ProductName product.Name
                        ProductPrice     = ProductPrice product.Price
                        ProductQuantity  = ProductQuantity cmd.Quantity
                        TotalPrice       = TotalPrice (product.Price * decimal cmd.Quantity)
                    }
                ] |> Ok
            
        | Some state, Command.CreateInvoice _ ->
            return Error "invoice already exists"
        | None, Command.AddInvoiceLine _ ->
            return Error "invoice does not exist"
    }
    
    
// apply an event (state transition)
let apply event state =
    match event, state with
    | Event.InvoiceCreated ev, None ->
        Some {
            InvoiceId      = ev.InvoiceId
            CustomerId     = ev.CustomerId
            CustomerName   = ev.CustomerName
            CustomerStreet = ev.CustomerStreet
            CustomerCity   = ev.CustomerCity
            InvoiceLines   = []
        }
    | Event.InvoiceLineAdded ev, Some state ->
        Some {
            state with
                InvoiceLines = {
                    ProductId        = ev.ProductId
                    ProductName      = ev.ProductName
                    ProductPrice     = ev.ProductPrice
                    ProductQuantity  = ev.ProductQuantity
                    TotalPrice       = ev.TotalPrice
                } :: state.InvoiceLines
        }
    | _, _ ->
        None
        
        
let applyEvents events state =
    (events, state)
    ||> List.fold (fun state event -> apply event state)

The Service Code:

// somewhere we have our invoice repository, but here with a slightly different singature
type IInvoiceRepository =
    abstract member GetInvoice : invoiceId:string -> Task<InvoiceState option>
    abstract member StoreInvoice : InvoiceState -> Task<unit>

// i am using here my personal preferred way to have one execute function also in the service
type IInvoiceService =
    abstract member ExecuteInvoiceCommand : command:Command -> Task<unit>



let private executeCommand
    (invoiceRepo:IInvoiceRepository)
    (customerRepo:ICustomerRepository)
    (productRepo:IProductRepository)
    (command:Command) =
    task {
        // partial application of the execute function
        let executeCommand = execute customerRepo.GetCustomerById productRepo.GetProductById
        let! invoice = invoiceRepo.GetInvoice command.InvoiceId
        let! result = invoice |> executeCommand command
        match result with
        | Error e -> failwith e
        | Ok events ->
            let newInvoiceState = applyEvents invoice events
            match newInvoiceState with
            | None -> failwith "no state returned after events applied"
            | Some newInvoiceState ->
                do! invoiceRepo.StoreInvoice newInvoiceState
    }
    
    
    
let createInvoiceService (invoiceRepo:IInvoiceRepository) (customerRepo:ICustomerRepository) (productRepo:IProductRepository) =
    { new IInvoiceService with
        member this.ExecuteInvoiceCommand command =
            executeCommand invoiceRepo customerRepo productRepo command
    }
    
// or as an alternative
type InvoiceService(
    invoiceRepo:IInvoiceRepository,
    customerRepo:ICustomerRepository,
    productRepo:IProductRepository) =
    interface IInvoiceService with
        member this.ExecuteInvoiceCommand command =
            executeCommand invoiceRepo customerRepo productRepo command

The Discussion:

The first thing you see is, that we are not using any aggregate root or sub aggregates.
We are using a simple state, which is a record type.
You can argue about that and the whole aggregate id and not structural equality stuff, but that's not the focus here.

The domain code is pretty simple.
You have an 'execute' function, which decides, if a command is valid or not. It returns a list of events or an error.
We have an 'apply' function, which applies an event to a state and returns a new state.
And we have an 'applyEvents' function, which applies a list of events to a state and returns a new state.
In our further discussion, the 'apply' and 'applyEvents' function will not change any more, so I will leave them out of the code.

Let's focus on the 'execute' function. In order to generate the necessary events, we need, like in the OOP approach,
additional data from the database. Our customer and out product.
In this approach we inject the necessary functions to get the data from the database into the 'execute' function.

Later in the service code, we partially apply these functions with the help of your repository interfaces.

Did this approach help us with the dependency management? No. If you think about this approach, this approach tends to
get fast out of hands by using more and more parameters in the 'execute' function.
In the OOP approach these parameters inside the constructor feels more natural and
the execution methods do not have that many parameters.

What about testing?

So instead of mocking interfaces, we have to mock functions and injecting them into the 'execute' function. That doesn't feel better at all.

Conclusion

The idiomatic F# approach feels more comfortable and in it's core more elegant, then the OOP approach.
We using the functional way to separate data and functions. But we get this parameter problem, which gets out of hands pretty fast.
Also the execute function is not pure. We are using a task an call the repositories inside the execute function.

How we handle the problem with parameters, we will see in the next chapter. For the other problem, we have to wait.

03. Try Hiding The Dependencies (Mark I)

So, let's see, how we can hide the dependencies in the execute function in order to get rid of the parameter problem. At least partially.

The Domain Code:

type Dependencies = {
        GetCustomer : string -> Task<DataTypes.Customer option>
        GetProduct  : string -> Task<DataTypes.Product option>
    }

// execute a command (decider)
let execute dependencies command state =
    task {
        match state, command with
        | None, Command.CreateInvoice cmd ->
            let! (customer:DataTypes.Customer option) = dependencies.GetCustomer cmd.CustomerId
            match customer with
            | None ->
                return Error $"customer '{cmd.CustomerId}' does not exist"
            | Some customer ->
                return [
                    Event.InvoiceCreated {
                        InvoiceId      = InvoiceId cmd.InvoiceId
                        CustomerId     = CustomerId cmd.CustomerId
                        CustomerName   = CustomerName customer.Name
                        CustomerStreet = CustomerStreet customer.Address.Street
                        CustomerCity   = CustomerCity customer.Address.City
                    }
                ] |> Ok
            
        | Some state, Command.AddInvoiceLine cmd ->
            let! (product:DataTypes.Product option) = dependencies.GetProduct cmd.ProductId
            match product with
            | None ->
                return Error $"product '{cmd.ProductId}' does not exist"
            | Some product ->
                return [
                    Event.InvoiceLineAdded {
                        InvoiceId        = state.InvoiceId
                        ProductId        = ProductId cmd.ProductId
                        ProductName      = ProductName product.Name
                        ProductPrice     = ProductPrice product.Price
                        ProductQuantity  = ProductQuantity cmd.Quantity
                        TotalPrice       = TotalPrice (product.Price * decimal cmd.Quantity)
                    }
                ] |> Ok
            
        | Some state, Command.CreateInvoice _ ->
            return Error "invoice already exists"
        | None, Command.AddInvoiceLine _ ->
            return Error "invoice does not exist"
    }

The Service Code:

let private executeCommand
    (invoiceRepo:IInvoiceRepository)
    (dependencies:Dependencies)
    (command:Command) =
    task {
        // partial application of the execute function
        let executeCommand = execute dependencies
        let! invoice = invoiceRepo.GetInvoice command.InvoiceId
        let! result = invoice |> executeCommand command
        match result with
        | Error e -> failwith e
        | Ok events ->
            let newInvoiceState = applyEvents invoice events
            match newInvoiceState with
            | None -> failwith "no state returned after events applied"
            | Some newInvoiceState ->
                do! invoiceRepo.StoreInvoice newInvoiceState
    }
    
    // ...
    

The Discussion:

What we here did is to collect all the parameters to one record we call 'Dependencies'. Yes, I know, that sounds creative, I know.
Also there is nothing much to discuss. At least we reduced the dependencies to one parameter.
The Dependency record will grow fast and it has to be initialized fully before we can use it.

What about testing?

Nothing changed in this approach.

Conclusion

We didn't solve the problem, we just moved it to another place. But at least our code doesn't look too bad on the domain level. Now it's elsewhere in our code.

04. More Functional Purity and Testability

Okay, now that our execute function only takes 3 parameters and we can focus on testability.
A wonderful approach to get better testability is to make our domain a pure function.
With that we get always the same result for the same input.

The Domain Code:

type Dependencies = {
        NeededCustomerForCreateInvoice : DataTypes.Customer option
        NeededProductForAddInvoiceLine : DataTypes.Product option
    } with
        static member Empty = {
            NeededCustomerForCreateInvoice = None
            NeededProductForAddInvoiceLine  = None
        }

// execute a command (decider)
let execute dependencies command state =
    match state, command with
    | None, Command.CreateInvoice cmd ->
        match dependencies.NeededCustomerForCreateInvoice with
        | None ->
            Error $"customer '{cmd.CustomerId}' does not exist"
        | Some customer ->
            [
                Event.InvoiceCreated {
                    InvoiceId      = InvoiceId cmd.InvoiceId
                    CustomerId     = CustomerId cmd.CustomerId
                    CustomerName   = CustomerName customer.Name
                    CustomerStreet = CustomerStreet customer.Address.Street
                    CustomerCity   = CustomerCity customer.Address.City
                }
            ] |> Ok
        
    | Some state, Command.AddInvoiceLine cmd ->
        match dependencies.NeededProductForAddInvoiceLine with
        | None ->
            Error $"product '{cmd.ProductId}' does not exist"
        | Some product ->
            [
                Event.InvoiceLineAdded {
                    InvoiceId        = state.InvoiceId
                    ProductId        = ProductId cmd.ProductId
                    ProductName      = ProductName product.Name
                    ProductPrice     = ProductPrice product.Price
                    ProductQuantity  = ProductQuantity cmd.Quantity
                    TotalPrice       = TotalPrice (product.Price * decimal cmd.Quantity)
                }
            ] |> Ok
        
    | Some state, Command.CreateInvoice _ ->
        Error "invoice already exists"
    | None, Command.AddInvoiceLine _ ->
        Error "invoice does not exist"

The Service Code:

let private executeCommand
    (invoiceRepo:IInvoiceRepository)
    (customerRepo:ICustomerRepository)
    (productRepo:IProductRepository)
    (command:Command) =
    task {
        
        let! invoice = invoiceRepo.GetInvoice command.InvoiceId
        
        // build the dependencies record based on the incoming commands
        let! dependencies =
            task {
                match command with
                | Command.CreateInvoice cmd ->
                    let! customer = customerRepo.GetCustomerById cmd.CustomerId
                    return { Dependencies.Empty with NeededCustomerForCreateInvoice = customer }
                | Command.AddInvoiceLine cmd ->
                    let! product = productRepo.GetProductById cmd.ProductId
                    return { Dependencies.Empty with NeededProductForAddInvoiceLine = product }
            }
        
        // this one it pure and perfectly testable    
        let result = invoice |> execute dependencies command
        
        match result with
        | Error e -> failwith e
        | Ok events ->
            let newInvoiceState = applyEvents invoice events
            match newInvoiceState with
            | None -> failwith "no state returned after events applied"
            | Some newInvoiceState ->
                do! invoiceRepo.StoreInvoice newInvoiceState
    }
    
    

type InvoiceService(
    invoiceRepo:IInvoiceRepository,
    customerRepo:ICustomerRepository,
    productRepo:IProductRepository) =
    interface IInvoiceService with
        member this.ExecuteInvoiceCommand command =
            executeCommand invoiceRepo customerRepo productRepo command

The Discussion:

In order to get our 'execute' function pure, we removed all the external calls from the code and the 'dependencies' record.
It's also not a task computation anymore.
What we have here now, is the pure data inside the dependency record we need to execute the command.
With that the whole 'execute' function become pure and better testable.
We build our repositories, that they return option types, so we can easily left the check, if a customer or product exists,
like it already was. If it's none, then it's not there. Easy enough.

With that, we moved the external calls to the database up to the service implementation.
It's now a 'impure-pure-impure' sandwich on the service level.

You see there, that the dependencies are build based on the command, which came in. This is an impure part.
After that, we call the 'pure' execute function and get the result and after that,
we call the database to store our new state. This one is again 'impure'.

What's with the apply function? That's a good question. Because we throw in our example exceptions there,
the apply function is considered impure. I leave you to decide, which approach you want. The function can easily be made pure.
But keep in mind, that a missing application of an event to a state is, for me at least, considered an exceptional error in your system.
It shouldn't happen, if it is happening, your code is wrong and you have to fix it.
My personal opinion about that is to throw an exception.

Btw. the code of the 'apply' you see in the chapter '02. The More F# Idiomatic Way'. I left it out, because it's the same in part 2 to 5.

One thing, the dependency record can grow bigger and bigger and you will have problem, which property is for what command.
And that can became a problem. Use proper names in order to know which one blogs to which one.

What about testing?

Now that we have a pure function, we are basically in the testing heaven. Same input generates the same output. What do we want more?
We have to write test data nevertheless or use property based testing to generate the data for us. (I never tried property testing at all.)

Conclusion

We are almost at the end of our journey. We have now a pure function and only one additional parameter in our execute function.

But for me, we only moved the our problem one level up. And I am not satisfied with that. Because our dependency record can grow and grow
and for every additional data we need, wee need to add a property there. And that maybe become confusing over time.
Even if you use proper names for the properties. It feels like, that the dependency record should not be responsible for all the needed dependencies of you domain.

For small domains, with not that much additional data, it's totally fine in my option. But can we do better?

05. Try Hiding The Dependencies (Mark II)

So that's the last approach we discuss here for now. Here we want to solve the problem,
that we have basically one dependency record for all the commands in our domain.
And somehow every command should manage there own needed dependencies.

And that's what we will do here and not break the purity of our execute function.

The Domain Code:

// we putting our dependencies into our command, for that we add some "internal" commands
// we distinguish between commands which came through our api and command which we are using internally

// our external commands
[<RequireQualifiedAccess>]
type ExternalCommand =
    | CreateInvoice of ExternalCreateInvoiceData
    | AddInvoiceLine of ExternalInvoiceLineData
        
        member this.InvoiceId =
            match this with
            | CreateInvoice data -> data.InvoiceId
            | AddInvoiceLine data -> data.InvoiceId
    
and ExternalCreateInvoiceData = {
    InvoiceId: string
    CustomerId: string 
}

and ExternalInvoiceLineData = {
    InvoiceId: string
    ProductId: string
    Quantity: int
}


// our internal commands
[<RequireQualifiedAccess>]
type Command =
    | CreateInvoice of CreateInvoiceData
    | AddInvoiceLine of InvoiceLineData
        
        member this.InvoiceId =
            match this with
            | CreateInvoice data -> data.InvoiceId
            | AddInvoiceLine data -> data.InvoiceId
    
and CreateInvoiceData = {
    InvoiceId: string
    CustomerId: string
    Customer: Customer option
}

and InvoiceLineData = {
    InvoiceId: string
    ProductId: string
    Quantity: int
    Product: Product option
}

The Service Code:

// btw for the repository dependencies here, you can also use a dependency record. Or move this directly into the service class
let private executeCommand
    (invoiceRepo:IInvoiceRepository)
    (customerRepo:ICustomerRepository)
    (productRepo:IProductRepository)
    (command:ExternalCommand) =
    task {
        
        let! invoice = invoiceRepo.GetInvoice command.InvoiceId
        
        // build the internal commands
        let! internalCommand =
            task {
                match command with
                | ExternalCommand.CreateInvoice cmd ->
                    let! customer = customerRepo.GetCustomerById cmd.CustomerId
                    return Command.CreateInvoice {
                        InvoiceId = cmd.InvoiceId
                        CustomerId = cmd.CustomerId
                        Customer = customer
                    }
                | ExternalCommand.AddInvoiceLine cmd ->
                    let! product = productRepo.GetProductById cmd.ProductId
                    return Command.AddInvoiceLine {
                        InvoiceId = cmd.InvoiceId
                        ProductId = cmd.ProductId
                        Product = product
                        Quantity = cmd.Quantity
                    }
            }
        
        let result = invoice |> execute internalCommand
        
        match result with
        | Error e -> failwith e
        | Ok events ->
            let newInvoiceState = applyEvents invoice events
            match newInvoiceState with
            | None -> failwith "no state returned after events applied"
            | Some newInvoiceState ->
                do! invoiceRepo.StoreInvoice newInvoiceState
    }
    
    

type InvoiceService(
    invoiceRepo:IInvoiceRepository,
    customerRepo:ICustomerRepository,
    productRepo:IProductRepository) =
    interface IInvoiceService with
        member this.ExecuteInvoiceCommand command =
            executeCommand invoiceRepo customerRepo productRepo command

The Discussion:

What we here did is introduce the concept on an internal and external command.
The external commands, are the commands, you use in your api.
The internal commands have additional properties in their payload, which are relevant for the execution of the command.

That sound tedious, because now you have to maintain two command types. But the advantage you get, is that you have
the dependencies inside the command itself, so you didn't have to maintain the dependency record from the previous chapter.

I mentioned in the previous chapter that the dependency record approach is fine when you have a small amount of additional data.

But if when you get more, it makes sense to move the dependencies to the command itself and have clear 'responsibilities'.

And let's be honest, copy-pasting the commands you already have and extend them is not that much work.

Also some of you maybe already have dto's in you api, and do not use the commands we have here at all.
In that case, you have only one set of commands with the necessary dependencies and do the 'mapping' already on the service level.

What about testing?

We are already in testability heaven and that didn't change here.

Conclusion

As I mentioned, that's the approach I personally prefer.
It's a little more work (maybe), but it's more clear and you have a better separation of concerns.

And least for me, I am satisfied with this solution and it solves perfectly my problem to manage the dependencies and additional data I need in my domains.

The Previous Version: The Reader Monad

Yes, I know, I know. I didn't mention the reader monad at all. You see in the examples, that I use on service level
the classic oop dependency injection approach, because in practical terms I will use for these services asp.net core and for example giraffe or Azure Functions.
And the build in dependency injection container works fine and we didn't have to make it more complicated.

Also I didn't work out any solution with a reader monad. I invite you, I am curios, how you would exactly this example with a reader monad.
And which advantage you can in readability and testability.

I personally do not like to much 'magic*' in the code, where things are suddenly hidden. Someone has to maintain it.
But that's my personal opinion.

*I mean writing code with F# feels like magic, if you compare it to C# or Java.

BUT I really like to see a solution with a reader monad. So if you have one, please let me know.
(I found someone :D)

Updated: 06. The Reader Monad

With the help of two articles, one from Bartosz Sypytkowski (here) and one from Scott Wlaschin (here)
I made an implementation of a reader monad on the service level.
The domain code itself is pure and the reader monad didn't change there anything.

The Reader Monad Implementation (called here Dependency - call it whatever you want)

[<Struct>] type Dependency<'env, 'out> = Dependency of ('env -> 'out)
module Dependency =
    /// Create value with no dependency requirements.
    let inline value (x: 'out): Dependency<'env,'out> = Dependency (fun _ -> x)
    /// Create value which uses dependency.
    let inline apply (fn: 'env -> 'out): Dependency<'env,'out> = Dependency fn
    
    let run (env: 'env) (Dependency fn): 'out = fn env
    
    let inline bind (fn: 'a -> Dependency<'env,'b>) effect =
        Dependency (fun env ->
            let x = run env effect // compute result of the first effect
            run env (fn x) // run second effect, based on result of first one
        )
        
    let inline get<'a> = Dependency id
        
[<Struct>]
type DependencyBuilder =
    member inline __.Return value = Dependency.value value
    member inline __.Zero () = Dependency.value (Unchecked.defaultof<_>)
    member inline __.ReturnFrom (effect: Dependency<'env, 'out>) = effect
    member inline __.Bind(effect, fn) = Dependency.bind fn effect
    
let dependency = DependencyBuilder()

A New Interface

type IDependencies =
    inherit IInvoiceRepository
    inherit ICustomerRepository
    inherit IProductRepository

The Service Code:

// here we use instead of normal parameter injection, a reader monad (called dependency here)
let private executeCommand (command:ExternalCommand) =
    dependency {
        let! (env:IDependencies) = Dependency.get
        
        return task {
            let! invoice = env.GetInvoice command.InvoiceId
            // build the internal commands
            let! internalCommand =
                task {
                    match command with
                    | ExternalCommand.CreateInvoice cmd ->
                        let! customer = env.GetCustomerById cmd.CustomerId
                        return Command.CreateInvoice {
                            InvoiceId = cmd.InvoiceId
                            CustomerId = cmd.CustomerId
                            Customer = customer
                        }
                    | ExternalCommand.AddInvoiceLine cmd ->
                        let! product = env.GetProductById cmd.ProductId
                        return Command.AddInvoiceLine {
                            InvoiceId = cmd.InvoiceId
                            ProductId = cmd.ProductId
                            Product = product
                            Quantity = cmd.Quantity
                        }
                }
            
            let result = invoice |> execute internalCommand
            
            match result with
            | Error e -> failwith e
            | Ok events ->
                let newInvoiceState = applyEvents invoice events
                match newInvoiceState with
                | None -> failwith "no state returned after events applied"
                | Some newInvoiceState ->
                    do! env.StoreInvoice newInvoiceState
        }    
    }
    
    
    
type InvoiceService(dependencies:IDependencies) =
    interface IInvoiceService with
        member this.ExecuteInvoiceCommand command =
            Dependency.run dependencies (executeCommand command)

The Discussion:

Okay, I read some blog posts and tried to understand the reader monad.
(it seems to offend people, not to use one!)

So the implementation of the reader monad you see everywhere an I will not describe them.
But I encourage you to read the blog posts I mentioned above.

In the end you have a computation expression (here called 'dependency'),
which you can use to 'inject' your dependencies into your code.

A base thing here is that we unify all our dependencies into one interface.
And then hide the 'injection' with the help of the reader monad.

The cool thing here is, that I can call functions inside the reader monad,
which are also reader monads and so one, but for this simple example,
we only hide this one dependency interface.

I definitely have to got deeper in it and see the advantage of it.

What about testing?

same as before. We have a pure function and we can test it easily.

Conclusion

The reader monad is a cool thing. I changes how I inject the things.

And now came the BUT for this example and an implementation for a 'command executor'.

I can also inject this single interface as an additional parameter.

let private executeCommand
    (env:IDependencies)
    (command:ExternalCommand) =
    //...

(In the code you see it as the file 07)

Here you see, I did it! I injected the dependencies as an additional parameter.

Because I have here only this one function, which is not a composition of multiple functions with multiple dependencies.
And for this particular example, I don't see the advantage of the reader monad.

And again BUT: If the application grows and you have more and more dependencies,
then the reader monad is a cool thing to hide the dependencies and make the code more readable.
In the end you need only once some 'boilerplate' to have the code for the monad and then you can use it everywhere.

Also a reader monad makes you code not magically pure. If you inject async operations, then you are not pure at all.

Last word (your honor) :D

I hope you liked this little journey through the different approaches to handle dependencies in your domain.
For me I have found my personal favorite approach to handle additional data in my domain.

I am curios, what did you do in order to handle this problem. Please let me know.

Merry Christmas and a happy new year to all of you. You are an awesome community!

Twitter: @HardtITSolution
The Code: here

Hi. Today I tried the new version of Visual Studio and I immediately realized, that the old "Visual Studio Color Theme Editor" is not available. So how do I get my hard changed theme to VS 2022? This post will show you how you can convert your old .vstheme file to a new VSIX-Theme-Extension.

1. You need the then nuget package "Microsoft.VisualStudio.VsixColorCompiler". This nuget contains the VSixColorCompiler.exe which converts your .vstheme file to a .pkgdef file. With this file, we will build the VSIX to import your Theme into VS 2022.

   • create a new console or class project in VS 2022

   • Install the nuget package "Microsoft.VisualStudio.VsixColorCompiler" into this project.
     https://www.nuget.org/packages/Microsoft.VisualStudio.VsixColorCompiler/

   • now open a command line console or the VS Terminal (View > Terminal)

   • open the folder for the installed nuget package. You find it here: "C:\Users[Your Username].nuget\packages\17.0.31709.430\VsixColorCompiler.exe" (the version number can maybe differ, if is a new version of the nuget package released in the future.

   • run following command:

   VsixColorCompiler.exe [here your .vstheme file] [here the target folder and name of the oputput with.pkgdef]
   
   // example
   VsixColorCompiler.exe C:\somewhere\myTheme.vstheme c:\whatever\myTheme.pkgdef
   

• this part is done, we have out pkgdef file!

2. Now we need to create a VSIX Project inside VS 2022. (Don't forget to install the Extension Workflow, to get the Project)

   • Create an Empty VSIX Project Inside Visual Studio
     

   • use Add Existing Item to add you generated ".pkgdef" file to the project
     

   • change the file property setting as in this image:
     

   • optional: edit the manifest file in order to get a nice name for your extension! ;)

   • build the project!

   • go to the output directory and run the created VSIX-File.

Done!

I hope this helps you.

Daniel

Welcome to a new (short) tutorial about: "How to build a realtime thermometer with F#, the SAFE Stack and a RaspberryPi (GrovePi)"

In this tutorial we will cover 4 things.

• build a simple data stream for the temperature data in saturn

  • first with some random data, and as last step with the real data from my GrovePi

• use saturn channels to build a web socket connection which sends the data to the web clients

• use emlish to consume the web sockets messages and display the temperature and humidity

• build an elmish wrapper around a react component, to display the data in a fancy way.

I have to admit, it's the software part, not the hardware. The hardware was actually plugin the DHT-Sensor into the GrovePi Board. So Sorry if someone hoped for the hardware part.

Special Thanks to Zaid Ajaj, woh creates awesome stuff for Fable and Elmish.
Also Maxime Mangel for his work.
The Team of then SAFE-Stack, which makes it easy to start full stack web applictions.
The Creator of Saturn, for that easy wrapper around ASP.NET and Giraffe.
And Martin36 for this fancy gauge react control.

Resources:

The Project on Github:
https://github.com/hardt-coded/raspberrypi-safe-stack-thermometer-example

The Gauge Control:
https://github.com/Martin36/react-gauge-chart

in this tutorial I will show you how to build an electron desktop app with the F# SAFE Stack and the ElectronNET Project.

For this tutorial I used the Version 1.24.0 of the SAFE Stack. I know there will be a v2 in the near future, but you should be able to use the step described in the video as well.

Sadly I runn into an issue with paket, which I solved in there. It's possible, that all runs fine on your machine.

I use Visual Studio, but all other IDE should work fine to.

Resources:

This Tutorial App:
https://github.com/hardt-coded/safe-stack-electron-net-example

F# Safe-Stack:
https://safe-stack.github.io/

ElectronNET Project:
https://github.com/ElectronNET/Electron.NET

a sample electron manifest file:
https://github.com/hardt-coded/safe-stack-electron-net-example/blob/master/src/Server/electron.manifest.json

Twitter:
https://twitter.com/HardtITSolution

When I came the first time in contact with F#, a little more than a year ago, I work myself to some tutorial and code and stuff. And the first time I dicovered some kind of black magic spell, where some values, which are wrapped in a result-type or error-type and a function which uses the "normal" values and not the values wrapped in the result type, put together with some magic symbols and we get actually a result out of this. The Spell I mean is:

myfunction <!> resultValue1 <*> resultValue1 <*> resultValue2

I tried to get my head around this and I failed. It was to much to process as a beginner in F#. I think I used Scott's Blog Post to get it at this time.
https://fsharpforfunandprofit.com/posts/elevated-world/ But It didn't help me, because I was to new and maybe to stupid to get it.
I put my effort to learn in other stuff and forget about this topic.

Later I discovered the applicative stuff again (I think it was Scott's cheat sheet on gist and some other code example) and now I thought, maybe I get it now. I learned about Scott's ROP, Monads, computation expressions and all the awesome stuff, that F# has to offer.

So this blog post describe the way I get my head around this topic and how I understand, why this following Black Magic Spell actually works.

The Black Magic Spell:

myfunction <!> resultValue1 <*> resultValue1 <*> resultValue2

For someone who is new to the functional stuff, even if the developer is a senior in other programming paradigms, this line of code appears to be some kind of black magic.

On one side, we have our normal function like this:

let myfunction (a:int) (b:int) (c:int) =
    a + b + c

It doesn't take any kind of result-ish parameters. Like Ok 1 or Error "ups!", it uses the values, which are "hidden" in the Result itself. Here in this example 3 integer values.

On the other side, we have actually result-ish values:

let resultValue1 = Ok 2
let resultValue2 = Error "ups!"

Now we put this with some strange symbols together and we get actually our result, wrapped in Result-Datatype.

How?

To understand this, you need to know the concept of partial application. Partial application is the ability to put only a part of the arguments to a function and get a new function back. Also you need to know, how a map function works. In this case the Result.map function.

Quick recap:

// -------------------
// partial application
// -------------------
let add a b =
    a + b
    
// you get a new function with the missing second parameter b
let add10 = add 10  // int->int

add10 10 // result = 20


//----------------
// map function - Result.map
//----------------

let result1 = Ok 1
let result2 = Error "ups!"

let mappingFunction input =
    input + 10

// this inner Ok value of the Result is run thru the mapping function 
// and returns the result wrapped in an Ok
Result.map mappingFunction result // Result= Ok 11

As always Scott Wlashin has the reference material
partial application: https://fsharpforfunandprofit.com/posts/partial-application/

But let us continue...

the Symbols

to understand this "black magic", we need to know, what the symbols stand for.

1. <!> is the map function or in this case, it stands for the Result.map
2. <*>is the apply function. This function doesn't existis in the FSharp.Core library. This function we have to write on our own.

let (<!>) = Result.map
let (<*>) = apply

Okay, the Result.map function takes 2 parameters. The first one, is the mapping function with one parameter a' and the result b'. SO the signature is a' -> b'. The second parameter is the result, which we want to map. The type is Result<'a,error'>

With the ability to create our own operators, like <!> in F#, we actually move the parameters from the original Result.map function around this operator. On the left side of our operator, we have the mapping-function our first parameter and on the right side of our operator we have our input the second parameter.

let input = Ok 1
let mapping a = a + 10

let res1 = Result.map mapping input
// is the same as
let res2 = mapping <!> input

So what does this mean to the first part of our "black magic" expression from the beginning:

myfunction <!> resultValue1 <*> resultValue1 <*> resultValue2

where myfunction is actually:

let myfunction (a:int) (b:int) (c:int) =
    a + b + c

We did following:

// myfunnction <!> resultValue1
let firstPart = Result.map myfunction resultValue1

But stop, our myfunction does have 3 parameters and not one. Map function suppose to have 1 parameter as input, not 3 or more of them.

Here comes the partial application in place. We put a function with 3 paramters into a function with one and get as a result a function with 2 parameters left.
But first, let show how the map work by building a map function of our own:

let giveMeAMap (func:int -> 'b) input =
    let res = func input 
    res


giveMeAMap (fun i-> printfn "%i" i) 10 // returns a unit, and prints the 10 on the screen
giveMeAMap (fun i-> i + 100) 10 // returns 110 (it add 100 to our input)
giveMeAMap (fun i-> i.ToString()) 10 // return the string "10"

You see here our mapping function will be called with our input parameter. So what did we get, if we have a function with multiple parameters as a mapping function? Yes, we apply 1 parameter to this function, our input and get a function with the missing other parameters.

// a mapping function 
let mymap a b c = a + b + c // mapping function with 3 parameter
giveMeAMap mymap 10

// you get a function with following signature: int -> int -> int (2 input parameters)
// internally we are running our map function as following:
let res = mymap 10 // we use only one parameter

And now we have solved the first part of our magic spell from above:

myfunction <!> resultValue1 <*> resultValue1 <*> resultValue2

or more precisely

myfunction <!> resultValue1 ...

Let solve the first part:

let resultValue1 = Ok 10

let myfunction (a:int) (b:int) (c:int) =
    a + b + c
    
// Remember myfunction <!> resultValue1 is like:
let firstPart = Result.map myfunction resultValue1

we get:
Ok [some function with the signature int->int->int]
a function wrapped In a result-type

The FSI shows:
[<Struct>]
val firstStep : Result<(int -> int -> int),string> = Ok <fun:Invoke@2697-1>

Now to the second part of our black magic spell, the apply-function:

let apply func input =
    match func,input with
    | Ok f, Ok x -> Ok (func input)  // runs func with the parameter input
    | Error e, _ -> Error e  // return the error if func is already an error
    | _, Error e -> Error e // return the error if the input is an error

// like the map, we make out of the apply function an operator, 
// so the the first parameter, the wrapped function, 
// is on the left side and our second parameter the input is on the right side.
let (<*>) = apply

The apply-function takes 2 parameters. The first one is a function wrapped in a result-Type. The second one is a value also wrapped in a result-Type.
We check both parameters. If both are okay, we use the inner-function and call it with the value from our second parameters. A little bit, like our map function, but here the mapping-function is wrapped in the result-type.

Wait, a function wrapped in a result type. That is exactly the same thing our map function return in the first part of our "magic spell".

Okay, before we continue and to complete the apply-function, in case one of the parameters contains an error, the apply-function returns this error.

Now we have all to understand our black magic spell:

myfunction <!> resultValue1 <*> resultValue1 <*> resultValue2

Let's do it step by step now:

Step 1 (the map function):

let firstStep = myfunction <!> resultValue1
// or
let firstStep = Result.map myfunction resultValue1

we get, as mentions a function (int -> int -> int) wrapped in a result (OK)

Step 2 (the first appearence of our apply function):

let secondStep = myfunction <!> resultValue1 <*> resultValue1
// or
let secondStep = (myfunction <!> resultValue1) <*> resultValue1
// better
let secondStep = firstStep <*> resultValue1
// or, the same without the operator:
let secondStep = apply firstStep resultValue1

In this step our function, which came as a result from our first step, will be "unpacked" and called with the next value from the second parameter (our resultValue1). We make another partial application. Because our function from the firstStep has 2 parameters to work with and we apply only one of them. Like here:

// function with the signature: int -> int -> int
let nextFunc a b = 
    a + b

let nextFunc10 = nextFunc 10 // resturns a function int->int

The apply function here returns a new function with only one parameter left, wrapped in a result-type.

Step 3 (another apply - last step):

let thirdStep = myfunction <!> resultValue1 <*> resultValue1 <*> resultValue1
// or
let thirdStep = (myfunction <!> resultValue1 <*> resultValue1) <*> resultValue1
// better:
let thirdStep = secondStep <*> resultValue1
// or, the same without the operator:
let thirdStep = apply secondStep resultValue1

Here we doing the same, as in the step before. We unpack our function, which is return from the second step and which has one input parameter left, and we run it with the unpacked second parameter, our resultValue1.

And with this step our whole back magic spell from above is solved. We get actually our result wrapped in a result-type.

Here again the whole snippet, with all steps inside:

let apply f x =
    match f,x with
    | Ok f, Ok x -> Ok (f x)
    | Error e, _ -> Error e
    | _, Error e -> Error e


let (<!>) = Result.map
let (<*>) = apply

let myfunction (a:int) (b:int) (c:int) =
    a + b + c


let resultValue1 = Ok 2
let resultValue2 = Error "ups!"

// returns Error "ups!" because, one of the parameter is an error
let res1:Result<int,string> =
    myfunction <!> resultValue1 <*> resultValue1 <*> resultValue2

// return Ok 6, because 2 + 2 + 2 is 6 wrapped in an OK
let res2:Result<int,string> =
    myfunction <!> resultValue1 <*> resultValue1 <*> resultValue1


let firstStep:Result<int->int->int,string> =
    Result.map myfunction resultValue1

let secondStep:Result<int->int,string> =
    apply firstStep resultValue1

let thirdStep:Result<int,string> =
    apply secondStep resultValue2

I hope this explanation helps, it's the way I get my head around this applicative thing.

I know, maybe it is the same as Scott wrote in his blog post and likely he did a better job to describe this topic at all. But this is how I got my head around it later, without to check again the blog post from Scott.

How do I secure my web service or webapp with a json web token and use the service itself as the one, which also manages the user itself. (no oauth with google or something else.)

I do not explain the JWT at all. I show only step by step, how to implement it in saturn, an awesome mvc f# web framework.

I use the saturn template base app for this tutorial.

I put all the needed code in one module except for the routes. Feel free to order your code, how do you need. For example I use the module name AuthStuff.

module AuthStuff

What do we need.

Prepare, we need some namespaces to open in that file

open System
open System.Text
open Saturn
open System.Security.Claims
open System.IdentityModel.Tokens.Jwt
open Microsoft.IdentityModel.Tokens
open Microsoft.AspNetCore.Authentication.JwtBearer

1. We need 2 record types. One is the model for the login data and the other is the model for the token return data.

type LoginModel ={
    UserName : string
    Password : string
}

type TokenResult ={
    Token : string
}

2. Now we need some values, like the secret key, which signs our token. The key itself has to be at least 16 characters long (128 Bit). Also an value for the issuer and the audience. (feel free to search for yourself, what for are these values.)

// min 128 Bit - min 16 character
let secret = "ineeda128bitkey!"
let issuer = "myauthapp.de"
let audience = "myauthapp.de"

3. Then we need a saturn pipeline to activate the authentication for the routes, that needed to secured

open Saturn

let onlyLoggedIn = pipeline {
    requires_authentication  (Giraffe.Auth.challenge JwtBearerDefaults.AuthenticationScheme)
}

4. Also we need a function, which generates the JWT Token itself

let generateToken username claims =
    let claims = [|
        Claim(JwtRegisteredClaimNames.Sub, username);
        Claim(JwtRegisteredClaimNames.Jti, Guid.NewGuid().ToString()) 
        // here you can implement other claims, which are encoded in the token itself
        yield! claims
    |]

    let expires = Nullable(DateTime.UtcNow.AddHours(8.0))
    let notBefore = Nullable(DateTime.UtcNow)
    let securityKey = SymmetricSecurityKey(Encoding.UTF8.GetBytes(secret))
    let signingCredentials = SigningCredentials(key = securityKey, algorithm = SecurityAlgorithms.HmacSha256)

    let token =
        JwtSecurityToken(
            issuer = issuer,
            audience = audience,
            claims = claims,
            expires = expires,
            notBefore = notBefore,
            signingCredentials = signingCredentials)

    let tokenResult = {
        Token = JwtSecurityTokenHandler().WriteToken(token)
    }

    tokenResult

5. The next Step is to tell saturn to use JWT Token for authentication. To do this, we need to extend the Saturn ApplicationBuilder object with our own function

open Microsoft.AspNetCore.Builder
open Microsoft.Extensions.DependencyInjection

type Saturn.Application.ApplicationBuilder with

    [<CustomOperation("my_own_jwt_auth")>]
    member __.UseMyMehAuth(state: ApplicationState,secret:string) =
        let middleware (app : IApplicationBuilder) =
            app.UseAuthentication()

        let service (s : IServiceCollection) =
            s.AddAuthentication(JwtBearerDefaults.AuthenticationScheme)
                .AddJwtBearer(fun options ->
                    options.TokenValidationParameters <- TokenValidationParameters(
                        ValidateActor = true,
                        ValidateAudience = true,
                        ValidateLifetime = true,
                        ValidateIssuerSigningKey = true,
                        ValidIssuer = issuer,
                        ValidAudience = audience,
                        IssuerSigningKey = SymmetricSecurityKey(Encoding.UTF8.GetBytes(secret)))
                ) |> ignore
            s

        { state with
            ServicesConfig = service::state.ServicesConfig
            AppConfigs = middleware::state.AppConfigs
            CookiesAlreadyAdded = true
        }

As you see, I use the CustomOperation attribute with ne name my_own_jwt_auth, these is the expression we use in the application setup from you saturn app.
The function itself has 1 extra parameter beside the state (which is a necessary parameter to extend the ApplicationBuilder), and this is the secret. You can use more to make this more flexible, if you want.

6. Now we put our new ApplicationBuilder extension to the application setup. In this example you see the app setup from the saturn template.

open AuthStuff

let app = application {
    pipe_through endpointPipe
    
    // here! you see, this is our extension!
    my_own_jwt_auth AuthStuff.secret

    error_handler (fun ex _ -> pipeline { render_html (InternalError.layout ex) })
    use_router Router.appRouter
    url "http://0.0.0.0:8085/"

    memory_cache
    use_static "static"
    use_gzip
    use_config (fun _ -> {connectionString = "DataSource=database.sqlite"} ) //TODO: Set development time configuration
}

7. So next step is actually add a endpoint, where we can get our token and one endpoint, which we secure for testing purposes. This code I put in the file "Router.fs" from the basic saturn template, if you wonder.

The Token Endpoint:

let tokenRouter = router {
    post "/gettoken" (fun next ctx ->
        task {
            let! model = ctx.BindJsonAsync<LoginModel>()

            // handle the authentication here itself. So ask the db if the user and password is correct. What ever is needed.

            let tokenResult = 
                AuthStuff.generateToken model.UserName [| (* here add your claims *) |]

            return! json tokenResult next ctx
        })
}

The Test Endpoint:
Here you see, we are adding out onlyLoggedIn pipeline

let authRouter = router {
    pipe_through onlyLoggedIn
    get "/checksec" (fun next ctx ->
        task {
            
            let username = ctx.User.FindFirst ClaimTypes.NameIdentifier
            let txt = sprintf "Hello %s" username.Value

            return! text txt next ctx
        }
    )
}

8. And the last Step is to add the 2 endpoints

let appRouter = router {
    // here add the new endpoint
    forward "/hidden" authRouter
    forward "/token" tokenRouter

    forward "" browserRouter
}

Let's test our stuff:

Send the request to the topken endpoint:

Now copy the token and use it in the bearer token authentication header:

Havin fun!

I see tons of good examples in Fable and build nice web apps with Fable and Elmish and React. But I have a client, which needs to build WebComponents. So I've done some research, it should be possible to build web components with the nice way of Fable Elmish. And it is possible.

But there are some troubles to get t to work. So I write here the Steps to success. Maybe I or someone else can write an extension to Fable encapsulate all the boiler plate stuff.

1. Create new project with the fable-elmish-react app

Create an Fable-Elmish-React Example App with following commands:

dotnet new -i Fable.Template.Elmish.React
dotnet new fable-elmish-react -n mywebcomponent

cd mywebcomponent
yarn
dotnet restore

2. Now the importent stuff - now we build a webComponent

After some research, I find out, that you can actually render react stuff in the shadowDOM of a webComponent. In JS style, it looks like:

class WebComponent extends HTMLElement {
    const mountPoint = document.createElement("div");
    const shadowRoot = this.attachShadow({
      mode: "open"
    });
    shadowRoot.appendChild(mountPoint);
    ReactDOM.render(<a href={url}>{name}</a>, mountPoint);
}

customElements.define('web-component', WebComponent);

So, it should be possible to implement that only for the nice emlish-react stuff.

How would it look like. Something like this:

type WebComponent() =   
    inherit HTMLElement()    
     
    member this.connectedCallback() = 
        let shadowRoot = createShadowRoot()        
        let mountPoint = document.createElement "div"        
        shadowRoot.appendChild mountPoint
        
        // Look this familiar? Yes thats basically the code of the App-init-stuff
        Program.mkProgram init update root 
        |> Program.toNavigable (parseHash pageParser) urlUpdate               
        |> Program.withDebugger
        |> Program.withHMR        
        |> initReact mountPoint
        |> Program.run
        ()

CustomElements.define "web-component"

Okay, define a class which inherits from an HTMLElement.
The method connectCallback() is one of the life cycle methods of a webcomponent.
And what we do is run our Program stuff inside this method.

Easy isn't it? Okay, we need some boilerplate stuff. Like "createShadowRoot" or "initReact".

3. The Boilerplate Stuff to translate this into the right javascript

1. HTMLElement()
Fable has already an interface of HTMLElement. But we don't need this. We need an empty abstract class. We need to flag this as global to avoid that this class will be translated.

```fsharp
[<Global>]
type HTMLElement() = class end
```
If we inherit a class from this. Fable will translate this into "class MyClass extends HTMLElement"

2. createShadowRoot()
Here we use Emit to generate the matching javascript code to create a ShadowDOM root. There is also a createShadowRoot() function in Javascript, but the Polyfill for Browsers, that doesn't support custom elements only recognize this function. (Hint: the type ShadowRoot is defined on No. 4)
fsharp [<Emit("this.attachShadow({ mode: 'open' });")>] let createShadowRoot() : ShadowRoot = jsNative

3. document.creatElement is part of Fable

4. shadowRoot.appendChild
Here is the missing ShadowRoot type. Here we defint one member to append a HTMLElement (The Fable interface, not our placeholder in No. 1)
fsharp [<Global>] type ShadowRoot() = [<Emit("$0.appendChild($1);")>] member this.appendChild (el:Fable.Import.Browser.HTMLElement) = jsNative

5. |> initReact mountPoint
This function will be intiate the ReactDOM.render part. It's a little modified version of the react Program.withReact" function.
```fsharp
// Common for the "lazyView2With" function
open Elmish.React.Common

let initReact mountPoint (program:Elmish.Program<_,_,_,_>) =
    let mutable lastRequest = None
    let setState model dispatch =
        Fable.Import.ReactDom.render(
                lazyView2With (fun x y -> obj.ReferenceEquals(x,y)) program.view model dispatch,
                mountPoint
            )
    { program with setState = setState }
```

6. CustomElements.define
This one is also an "Emit".
fsharp module CustomElements = [<Emit("customElements.define($0,WebComponent);")>] let define (elementName:string) = jsNative

4. Let's run our code - first try

Before we run our code, we need to modify the index.html in the public folder. Instead of the <div id="elmish-app"></div> we replace this with: <web-component></web-component>

So letzt run this with:

cd src
dotnet fable yarn-start

and goto http://locahost:8080/

And what did we see? An Error in the console:

After some research, we need to link the "custom-elements-es5-adapter.js" library:

So add the following script tag to the head of the index.html

<script src="https://unpkg.com/@webcomponents/webcomponentsjs@2.0.3/custom-elements-es5-adapter.js"></script>

And now. We see some thing, that looks like our elmish app.

But wait, what's happen with the CSS.

After some research, the CSS doesn't leak into the ShadowDOM and vice versa. (The polyfill is maybe an exception to this. But Chrome...)

So what we need is to add our style sheets to the ShadowDOM.

5. Modify webpack.config.js to get a separate css file

At first we need a separate CSS file. Currently it's bundled to the bundle.js.

This is how we change that:

1. Install "extract-text-webpack-plugin" with

yarn add extract-text-webpack-plugin

2. now you have to modify the webpack.config.js

var path = require("path");
var webpack = require("webpack");
var fableUtils = require("fable-utils");

// Add these 2 line here !!!
const ExtractTextPlugin = require("extract-text-webpack-plugin");
const extractCSS = new ExtractTextPlugin('styles.min.css');

// ...
 ... stuff  ...
 
module: {
    rules: [
        // modify the sass RULE!!! to
        {
            test: /\.sass$/,
            use: extractCSS.extract([                                
                "css-loader",                    
                "sass-loader"
            ])
        }
    ]
},
plugins: isProduction ? [] : [
        new webpack.HotModuleReplacementPlugin(),
        new webpack.NamedModulesPlugin(),
        
        // Add these entry to the plugnis array!
        extractCSS
    ]
 

After the modifications, you have to restart dotnet fable yarn-start

Now we have our styles.min.css.

6. Add the CSS to the ShadowDOM, so that our WebComponent doesn't look like crap

Inside out connectedCallback function we need to add the CSS link.

After we create the ShadowRoot we put these lines into the method

member this.connectedCallback() =         
        let shadowRoot = createShadowRoot()   
        
        // Here these 5 lines !!!
        let style = createStyleSheetElement()        
        style.rel <- "stylesheet"
        style.``type`` <- "text/css"
        style.href <- "styles.min.css"

        shadowRoot.appendChild style
        
        // already in the method
        let mountPoint = document.createElement "div"

Now we had to define some additional boilerplate, so that Fable translate this for us correctly.
Please read the commentaries for further explanations.

// We need an placeholder for the HTMLLinkElement
// the 3 value members will be filled with the needed informations
[<Global>]
type HTMLLinkElement() =   
  member val rel : string = "" with get,set
  member val ``type`` : string = "" with get,set
  member val href : string = "" with get,set

// the create function
[<Emit("document.createElement('link');")>]
let createStyleSheetElement():HTMLLinkElement = jsNative


// Extend the ShadowRoot with the second method!
[<Global>]
type ShadowRoot() = 
    [<Emit("$0.appendChild($1);")>]
    member this.appendChild (el:Fable.Import.Browser.HTMLElement) = jsNative
    
    // Extend the ShadowRoot class with this member!
    member this.appendChild (el:HTMLLinkElement) = jsNative
      
      

Also add the following line to the index.html:

<link rel="stylesheet" href="styles.min.css" />

The font isn't getting right, if you do not add the styles to the index.html. This is something for further research.

So well ... It's looking nice.

If we go to the Counter and press plus or minus, than nothing will happen. Also if we enter our name on the home screen. But hey, we can navigate.

So what do we do now?

7. The problems with the events inside the ShadowDOM

After some research, again. It's a problem in React in the ShadowDOM. The React Event have to be retargeted.
Lucky for us, Lukas Bombach published a package to fix this error: (Lukas. Thank you: https://github.com/LukasBombach)

Here ist the package: https://www.npmjs.com/package/react-shadow-dom-retarget-events

So we have to import that library and run retargetEvents(shadowRoot); after we rendered the react stuff.

At first, we add a new line at the end of our WebComponent class:

let shadowRoot = createShadowRoot()        
let style = createStyleSheetElement()        

...
... Stuff ...


|> Program.run

// Here we fix the problem
retargetEvents(shadowRoot)

()

Hey, but we should install at first the missing package:

yarn add react-shadow-dom-retarget-events

Now we need some boilerplate, so that our little function will run.

[<Import("default","react-shadow-dom-retarget-events")>]
let retargetEvents shadowDom = jsNative

After restart dotnet fable yarn-start, it works like a charm. Pressing the buttons, our webcomponent works as it should.

If you add a new <web-component></web-component> tag in the index.html, you will see, that the web components works independently. With one exception. The navigation is synchronized, because the browser address will be used to navigate.

This (maybe) issue is for another day.

8. The attributes of a web component

As you know, you can also add attributes to a web component.
So the idea is, that we modify the init functions to accept parameter. So we can change the initial state of our component with attributes.
So add this "counter-start" attribute to the web-component tag.
And maybe add a second below that without an attribute. like this:

<web-component counter-start="999"></web-component>
<web-component></web-component>

For example the inital start value of the counter.

open the State.fs file and adjust the init function and add a new parameter:

let init counterStart result =
  let (counter, counterCmd) = Counter.State.init()
  // here we set the new counter value
  let counter = counterStart
  let (home, homeCmd) = Home.State.init()
  let (model, cmd) =
    urlUpdate result
      { currentPage = Home
        counter = counter
        home = home }
  model, Cmd.batch [ cmd
                     Cmd.map CounterMsg counterCmd
                     Cmd.map HomeMsg homeCmd ]

We can also edit the init function of the counter state itself, so that we give the start value to it. But for the demo purppose this little change is enough.

After we change the init function our code has an error.

Back to our App.fs

We add a new line in out web component function ("this.connectedCallback()")

let counterStart = getAttribute "counter-start"

This function gives us the value of the attribute.

As always, we nee some boilterplate to let this function work.

[<Emit("this.getAttribute($0);")>]
let getAttribute (name:string) : string = jsNative  

In this case I return a string.
We need to parse the string into an int, in order to work as out new init() function parameter.

let counterStart = getAttribute "counter-start"
let counterStart' =
    if counterStart = null then 0 else counterStart |> int

yeah, I know. NULL ! But hey, javascript returns sometimes null. So wrap it in an options or something. For the demo it's enough. (I said that before, or?)

Now we can build a new init function with the new parameter:

let counterStart = this.getAttribute "counter-start"
let counterStart' =
    if counterStart = null then 0 else counterStart |> int

// define a new init function 
let init = init counterStart'

Program.mkProgram init update root 

Now you should see this:

9. Polyfill

At the end I will also add to scripts to the index.html to polyfill the custom elements and the shadowDOM for browsers like Edge or IE, which aren't currently support web components natively.

<script src="https://unpkg.com/@webcomponents/custom-elements@1.2.0/custom-elements.min.js"></script>
<script src="https://unpkg.com/@webcomponents/shadydom@1.1.3/shadydom.min.js"></script>

10. All together ...

The new State.fs file:

module App.State

open Elmish
open Elmish.Browser.Navigation
open Elmish.Browser.UrlParser
open Fable.Import.Browser
open Global
open Types

let pageParser: Parser<Page->Page,Page> =
  oneOf [
    map About (s "about")
    map Counter (s "counter")
    map Home (s "home")
  ]

let urlUpdate (result: Option<Page>) model =
  match result with
  | None ->
    console.error("Error parsing url")
    model,Navigation.modifyUrl (toHash model.currentPage)
  | Some page ->
      { model with currentPage = page }, []

let init counterStart result =
  let (counter, counterCmd) = Counter.State.init()
  let counter = counterStart
  let (home, homeCmd) = Home.State.init()
  let (model, cmd) =
    urlUpdate result
      { currentPage = Home
        counter = counter
        home = home }
  model, Cmd.batch [ cmd
                     Cmd.map CounterMsg counterCmd
                     Cmd.map HomeMsg homeCmd ]

let update msg model =
  match msg with
  | CounterMsg msg ->
      let (counter, counterCmd) = Counter.State.update msg model.counter
      { model with counter = counter }, Cmd.map CounterMsg counterCmd
  | HomeMsg msg ->
      let (home, homeCmd) = Home.State.update msg model.home
      { model with home = home }, Cmd.map HomeMsg homeCmd

The new App.fs

module App.View

open Elmish
open Elmish.Browser.Navigation
open Elmish.Browser.UrlParser
open Fable.Core
open Fable.Core.JsInterop
open Fable.Import
open Fable.Import.Browser
open Types
open App.State
open Global

importAll "../sass/main.sass"

open Fable.Helpers.React
open Fable.Helpers.React.Props

let menuItem label page currentPage =
    li
      [ ]
      [ a
          [ classList [ "is-active", page = currentPage ]
            Href (toHash page) ]
          [ str label ] ]

let menu currentPage =
  aside
    [ ClassName "menu" ]
    [ p
        [ ClassName "menu-label" ]
        [ str "General" ]
      ul
        [ ClassName "menu-list" ]
        [ menuItem "Home" Home currentPage
          menuItem "Counter sample" Counter currentPage
          menuItem "About" Page.About currentPage ] ]

let root model dispatch =

  let pageHtml =
    function
    | Page.About -> Info.View.root
    | Counter -> Counter.View.root model.counter (CounterMsg >> dispatch)
    | Home -> Home.View.root model.home (HomeMsg >> dispatch)

  div
    []
    [ div
        [ ClassName "navbar-bg" ]
        [ div
            [ ClassName "container" ]
            [ Navbar.View.root ] ]
      div
        [ ClassName "section" ]
        [ div
            [ ClassName "container" ]
            [ div
                [ ClassName "columns" ]
                [ div
                    [ ClassName "column is-3" ]
                    [ menu model.currentPage ]
                  div
                    [ ClassName "column" ]
                    [ pageHtml model.currentPage ] ] ] ] ]

open Elmish.React
open Elmish.Debug
open Elmish.HMR

type WebComponent() =   
    inherit HTMLElement()    
     
    member this.connectedCallback() =         
        let shadowRoot = createShadowRoot()        
        let style = createStyleSheetElement()        
        style.rel <- "stylesheet"
        style.``type`` <- "text/css"
        style.href <- "styles.min.css"

        shadowRoot.appendChild style

        let mountPoint = document.createElement "div"        
        shadowRoot.appendChild mountPoint

        let counterStart = getAttribute "counter-start"
        let counterStart' =
            if counterStart = null then 0 else counterStart |> int
        
        let init = init counterStart'

        // Look this familiar? Yes thats basically the code of the App-init-stuff
        Program.mkProgram init update root 
        |> Program.toNavigable (parseHash pageParser) urlUpdate               
        |> Program.withDebugger
        |> Program.withHMR        
        |> initReact mountPoint
        |> Program.run

        retargetEvents(shadowRoot)
        ()

CustomElements.define "web-component"

The boilerplate stuff in the WebComponents.fs

module WebComponents

    open Fable.Core
    open Fable.Core.JsInterop
    open Fable.Import
    open Fable.Import.Browser
    open Elmish.React.Common
    open Fable.Import.React

    module CustomElements =    
        [<Emit("var res = customElements.define($0,WebComponent);console.log(res)")>]
        let define (elementName:string) = jsNative

    [<Global>]
    type HTMLElement() = class end

    [<Global>]
    type HTMLLinkElement() =   
      member val rel : string = "" with get,set
      member val ``type`` : string = "" with get,set
      member val href : string = "" with get,set

    [<Global>]
    type ShadowRoot() = 
        [<Emit("$0.appendChild($1);")>]
        member this.appendChild (el:Fable.Import.Browser.HTMLElement) = jsNative
        member this.appendChild (el:HTMLLinkElement) = jsNative

    // import retargetEvents from 'react-shadow-dom-retarget-events';
    [<Import("default","react-shadow-dom-retarget-events")>]
    let retargetEvents shadowDom = jsNative
    
    [<Emit("this.getAttribute($0);")>]
    let getAttribute (name:string) : string = jsNative    

    [<Emit("this.attachShadow({ mode: 'open' });")>]    
    let createShadowRoot() : ShadowRoot = jsNative      

    [<Emit("document.createElement('link');")>]
    let createStyleSheetElement():HTMLLinkElement = jsNative

    let initReact mountPoint (program:Elmish.Program<_,_,_,_>) =
        let mutable lastRequest = None
        let setState model dispatch =
            Fable.Import.ReactDom.render(
                    lazyView2With (fun x y -> obj.ReferenceEquals(x,y)) program.view model dispatch,
                    mountPoint
                )
        { program with setState = setState }

The new index.html

<!doctype html>
<html>
<head>
  <title>Elmish Fable App</title>
  <meta http-equiv='Content-Type' content='text/html; charset=utf-8'>
  <meta name="viewport" content="width=device-width, initial-scale=1">
  <link rel="shortcut icon" type="image/png" href="img/favicon-32x32.png" sizes="32x32" />
  <link rel="shortcut icon" type="image/png" href="img/favicon-16x16.png" sizes="16x16" />
  <link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/font-awesome/4.6.3/css/font-awesome.min.css" />
  <link rel="stylesheet" href="styles.min.css" />
  <script src="https://cdn.polyfill.io/v2/polyfill.js?features=es6"></script>
  <script src="https://unpkg.com/@webcomponents/webcomponentsjs@2.0.3/custom-elements-es5-adapter.js"></script>
  <script src="https://unpkg.com/@webcomponents/custom-elements@1.2.0/custom-elements.min.js"></script>
  <script src="https://unpkg.com/@webcomponents/shadydom@1.1.3/shadydom.min.js"></script>
</head>
<body>
  <web-component counter-start="999"></web-component>
  <web-component></web-component>
  <script src="bundle.js"></script>
</body>
</html>

11. Yeah!

So I hope I could helped someone with this. In my case, I maybe will try to develop this idea any further and mayber I can use it for a customer in the future.

And I hope that I will deploy the code on Github.

If you have any critics, questions or other things, please contact me.

Daniel

Recently I had a problem to deploy a F# WPF tool with ClickOnce. Yeah ClickOnce, old technology and it's still in use in some enterprises to deploy applications. The standard ClickOnce tab in the project are missing in the project template from Visual Studio. So I had to do some research and I found out, that with FAKE you can deploy a F# program via ClickOnce.

At first I want to thanks the authors of 2 blog entries...

https://fwaris.wordpress.com/2013/08/14/fake-script-for-clickonce-packaging-of-f-apps/

and

https://github.com/magicmonty/blog/blob/master/_posts/2016-04-15-creating-clickonce-installers-with-fake.md

... for doing all the heavy lifting.

But I won't write a blog article about it, when this was all to do.

I run into 2 Problems:

1. The FAKE Script doesn't find my MSBuild to build the project
2. The Installation of the programm ends with an error: "Reference in the manifest does not match the identity of the downloaded assembly your-app.exe."

The Solutions:

1. MSBuild not found

That's an easy one. Use the following line in your FAKE-Script:

setBuildParam "MSBuild" "<your-path-to-vs>\Microsoft Visual Studio/2017/MSBuild/15.0/Bin/MsBuild.exe"

2. The Reference in the manifest does not match ...

So this one was a little harder. The solution is to not add the manifest into the assembly.

Normally in the project setting you have a drop down in the "Application" tab, which says "Create application without a manifest".

See here: https://stackoverflow.com/questions/5337458/error-deploying-clickonce-application-reference-in-the-manifest-does-not-match

This option doesn't exist in the project settings of a F# project. So I look into a csproj file and find this following settings in the project file is there.

<PropertyGroup>
    <NoWin32Manifest>true</NoWin32Manifest>
</PropertyGroup>

I add this setting to the fsproj file and it doesn't work. Damn.

After some further research I find out, that you can also add a compiler flag to avoid that the manifest is embedded into the .exe file.

--nowin32manifest

So I add this flag in the "Build" tab under "other flags:".

Now it work, as it should.

Here is the ClickOnce Deployment Script

I do not use FAKE 5, I use FAKE 4. But maybe I migrate this script to FAKE 5 in the future.

#r @".\packages\FAKE.4.64.13\tools\FakeLib.dll"

open Fake

// project and version info
let projectName = "<your-app-name-without-.exe>"
// use your own version
let version = "1.0.0.0"

// Directories
let buildDir  = @".\build\"
let deployDir = @".\deploy\"
let applicationDirName = (sprintf "%s.%s" projectName version)
let publishDir = deployDir @@ applicationDirName

// here is set the ClickOnce sign certificate
let cert = @".\ClickOnce.pfx"
let certPwFile = @".\ClickOncePwd.txt"

// Set the MSBuild path
setBuildParam "MSBuild" "M:\Microsoft Visual Studio/2017/MSBuild/15.0/Bin/MsBuild.exe"

// Filesets
let appReferences  = !! "<your-project-to-publish-folder>/*.fsproj"


let EmptyMageParams =  { 
    // maybe the mage is in an other folder on your computer
    ToolsPath = @"C:\Program Files (x86)\Microsoft SDKs\Windows\v10.0A\bin\NETFX 4.7.1 Tools"
    Manifest = ""
    ApplicationFile = ""
    CertFile = None

    Name = projectName
    Version = version
    Processor = MSIL
    TrustLevel = None
    
    // Set here your company name
    Publisher = Some "MyAwesomeCompany"
    
    ProviderURL = ""
    SupportURL = None
    FromDirectory = ""

    ProjectFiles = []
    IconPath = ""
    IconFile = ""
    TmpCertFile = ""
    Password = None
    CertHash = None
    IncludeProvider = None
    Install = None
    UseManifest = None
    CodeBase = None }


#r "System.Xml.Linq.dll"
open System.Xml.Linq

let setUpdatePolicy (filename: string) =
    let n nameSpace name = XName.op_Implicit (nameSpace + name)

    let asmv1 = "{urn:schemas-microsoft-com:asm.v1}"
    let asmv2 = "{urn:schemas-microsoft-com:asm.v2}"
    let cov1 = "{urn:schemas-microsoft-com:clickonce.v1}"

    let removeNode name (node: XElement option) =
        match node with
        | None -> None
        | Some n ->
            match n.Element(name) with
            | null -> ()
            | e -> e.Remove()
            node

    let addNode (name: XName) (node: XElement option) =
        match node with
        | Some n -> n.Add(new XElement(name))
        | _ -> ()

    let element name (node: XElement option) : XElement option =
        match node with
        | None -> None
        | Some n ->
            match n.Element(name) with
            | null -> None
            | e -> Some e

    let doc = XDocument.Load(filename)

    Some doc.Root
    |> element (n asmv2 "deployment")
    |> element (n asmv2 "subscription")
    |> element (n asmv2 "update")
    |> removeNode (n asmv2 "expiration")
    |> addNode (n asmv2 "beforeApplicationStartup")

    doc.Save(filename)


Target "Clean" (fun _ ->
    CleanDirs [buildDir; deployDir; publishDir]
)

Target "Build" (fun _ ->
    MSBuildRelease buildDir "Build" appReferences
    |> Log "Release Build-Output: "
)

Target "Prepare Deployment" (fun _ ->
    !! (buildDir @@ "**/*.*")   
    -- "**/*.pdb"
    -- "**/*.xml"
    |> CopyFiles publishDir
)

Target "Create ClickOnce Installer" (fun _ ->
    let appManifest = publishDir @@ (sprintf "%s.exe.manifest" projectName)
    let deployManifest = sprintf "%s.application" projectName
    let appParams = { EmptyMageParams with Manifest = appManifest
                                           ApplicationFile = publishDir @@ (sprintf "%s.exe" projectName)
                                           TrustLevel = Some FullTrust
                                           FromDirectory = publishDir
                                           IconPath = publishDir
                                           IconFile = projectName + ".ico"
                                           IncludeProvider = Some false
                                           UseManifest = Some true
                                           CertFile = Some cert
                                           Password = Some certPwFile}

    

    let deployParams = { EmptyMageParams with Manifest = appManifest
                                              ApplicationFile = deployDir @@ deployManifest
                                              Install = Some true 
                                              CertFile = Some cert
                                              Password = Some certPwFile }
    
    // Create
    MageCreateApp appParams
    // Sign
    MageSignManifest appParams
    // Deploy
    MageDeployApp deployParams
    
    deployDir @@ deployManifest |> setUpdatePolicy
    // Sign
    MageSignDeploy deployParams

    (buildDir) |> CopyFile publishDir
)

Target "Deploy" (fun _ ->
    trace "Deploy the created ClickOnce installer wherever you want"
)

"Clean"
  ==> "Build"
  ==> "Prepare Deployment"
  ==> "Create ClickOnce Installer"
  ==> "Deploy"

RunTargetOrDefault "Deploy"

I hope it helps a little.

I recently worked with Scott Wlaschins (fsharpforfunandprofit.com) Railway-oriented programming.

I have a mapping function, which maps a eventDTO to a event. For handling the validation, i use also Scotts approach to define special types for the properties of my command. (look here)

So leave the fact, that a validation of events from the eventstore maybe makes no sence, because the stored events are defined and stored by the domain. But I went this way and walk right into a "problem".

For example I have an event like this:

    // event on domain layer
    type ProductCreated = {
        Id:ProductId
        Name:String100
        Description:String2000
        Price:Price
        Weight:Weight      
    }
    
    // event dto for storing in eventStore
    type ProductCreatedEvent = {
        Id:Guid
        Name:string
        Description:string
        Price:decimal
        Weight:decimal      
    }

So I have defined fitting contraints for ProductId, String50, String2000, Price and Weight. (You will see more in another article in later times)

Now I have a function which maps the raw event from the eventstore to the event of the domain:

let mapEventToDomain (dto:obj):Result<Event,string> =
    result {
        match dto with
        | :? ProductCreatedEvent as cmd -> 
            let! id = cmd.Id |> ProductId.create
            let! name = cmd.Name |> String100.create "Name"
            let! description = cmd.Description |> String2000.create  "Description"            
            let! weight = cmd.Weight |> Weight.create
            let! price = cmd.Price |> Price.create

            return ProductCreated {
                Id=id
                Name=name
                Description=description                
                Weight=weight
                Price=price                
            }
        | ... // and so on        
   }

As you see, the function returns a Result<Event,string>, where the "Event" is actually a discriminated union and the "string" is the error message.

So when I load the events from the eventstore and map the events into the events of the domain layer like this:

// results in seq<Result<Event,string>>
let events = loadFromEventFromEventStore
             |> Seq.map mapEventsToDomain
             

I get a sequence of results. So how map these to a Result<Event seq,string> (or in generic form Result<'a seq,'e>).

So i decided to fold this things like that:

    let resultFolder (state:Result<'a seq,'c>) (item:Result<'a,'c>) =
        match state,item with
        |Ok x,Ok y -> Ok (seq {yield! x;yield y })
        |Error x, Ok _ -> Error x
        |Ok _, Error y -> Error y
        |Error x,Error _ -> Error x


    let fold list =                
        (Ok Seq.empty,list) ||> Seq.fold resultFolder

The initial state of the fold is and "okay" empty sequence -> "Ok Seq.empty". This and the list of Results will be folded.

So the "Folder" function check via pattern match if the current state is okay and the next item is okay. If that's the case I concatenate the item to the state, which is in that case a sequence. In all other cases I will set to the state to an Error. If the actual state is already on "Error" than I leave this error in that case intact.

You can also modify the folder a little bit, to accumulate the validation errors. Maybe you return a seq of string as errors or you add the messages with a line feed or something:

    // with seq of error
    let resultFolder (state:Result<'a seq,'c seq>) (item:Result<'a,'c>) =
        match state,item with
        |Ok x,Ok y -> Ok (seq {yield! x;yield y })
        |Error x, Ok y -> Error (seq { yield! x })
        |Ok _, Error y -> Error (seq { yield y })
        |Error x,Error y -> Error (seq {yield! x;yield y })

    // with linefeed string
    let resultFolder (state:Result<'a seq,string>) (item:Result<'a,string>) =
        match state,item with
        |Ok x,Ok y -> Ok (seq {yield! x;yield y })
        |Error x, Ok y -> Error x
        |Ok _, Error y -> Error y
        |Error x,Error y -> Error (sprintf "%s\r\n%s" x y)   

So want I need to know is, how do I get my nice "fold" function as a CustomOperation into my "result" comutation expression. I tried this with the CustomOperation-Attribute, but than I don't know, how to use this nicely inside my result { }. Maybe someone of you has an idea.

Have a nice day or night or something.

As i earlier mentioned in my blog, F# is an awesome language and i want to try to build a domain logic with it. So I began to port an older ecommerce project of mine to F# with all the nice things like DDD, CQRS and Eventsourcing (or should I say "Ereignisquellenspeicherung" - at this current time Greg's favorite word, and i am responsible for that. :D )

Ereignisquellenspeicherung is my new favourite word.

— gregyoung (@gregyoung) May 19, 2018

Event-Sourcing = Ereignisquellenspeicherung :D
CQRS = Befehls- und Abfragenverantwortungsteilung :D

Muhahaha

— DieselMeister (@DieselMeister) April 25, 2018

Nevertheless, while i am porting my old project in my spare free time, i got to a requirement that the admin can add a formula to a product, which will set the actual price of the product, based on a so called "base price".

So for example: the awesome product hast a base price of 100 € and the admin will add some formula like "base * 1.05", so the actual price of the awesome product will be 105 €.

There are hundreds of math formula solvers i think and i had a open source F# math solver in the first place. but this wasn't compatible with .NET Core. So i decided, that it is a good lesson to write an math formula solver on my own. It is a good exercise and a I'll be able to blog about my experience.

I know there is nice parsing stuff in F#, but in that case I use Regex. But i will learn the parser later on.

So easy enough i thought and so i started to build a very simple formula solver in F#. The solver should work with plus, minus, multiply, divide and power. So my first approach was so simple, that it doesn't accept the simplest math rule: order before multiply and divide before plus and minus. So my second approach, which i describe soon in this post, should work with the simple math rule. And to complete this, yeah i add the support of brackets to it.

so what are the rules of the simple math solver?

• obey the simple order rule of math
• add the ability to use special "symbols/placeholders" like in the example "base" for the base price or something else like the exchange value of bitcoin or the current platin price or something.

First at all, i am new in F# and maybe i did something wrong or clumsy or dirty or way too complicated or even totally wrong. But it works and there is always room for improving. So please give me feedback.

Note: the solver has a problem with multiple power operations. So instead to resolve 2^2^3 to 256, it resolves it to 64. Because it resolves the formula from left to right and this edge case is not relevant in the domain. Maybe someone of you has a simple way to implement that.

So how should this solver works?

So basically and in my first try (the one without the order to solve math formula), i split the formula into pairs of a symbol and a value. And to be consistent, i add a leading "+" to the front of the formula, if there is a positive number. (in case of a negative first number, i had already a symbol)

1 + 2 * 3 - 4 / 5 ->
(+,1)
(+,2)
(*,3)
(-,4)
(/,5)

// or in case of a negative number

-1 + 2 * 3 ->
(-,1)
(+,2)
(*,3)

so this was it, if you don't want to have the correct order of operations in math. one function to replace any symbols like "base" with a value is not a problem.

I am using the RegexTypeProvider, if you wonder.

Listing split formula into pairs:

    type MathPairRegex = 
        Regex< @"(?<MathSymbol>[\+\-\*\/\^])(?<Number>[\-]*[0-9.]*)" >
    type IsMathSymbolRegex = 
        Regex< @"[\+\-\*\/\^\(\)]" >
    
    let isMathSymbol (input:char) =
            IsMathSymbolRegex().IsMatch(input.ToString())

    let tryAddLeadingPlus (formula:string) =
        let isFirstCharMath = formula.[0] |> isMathSymbol           
        if isFirstCharMath then formula 
        else "+" + formula
        
    let splitFormula (formula:string) = 
        formula        
        |> tryAddLeadingPlus
        |> MathPairRegex().TypedMatches        
        |> Seq.map (fun i -> (i.MathSymbol.Value,i.Number.Value)) 

As in F# you read from bottom to top. So the function at the bottom do what it's named for, and split the formula into the symbol and value pairs. In case of a mission math symbol at the front of the formula, the "tryAddLeadingPlus" function adds a + if it's necessary.

The nice thing of TypeProviders is, that it gives us property names from our data source. So in the SQL TypeProvider you get table names and table cloumns names as properties in your code.
In this case you get the named groups in the Regex as properties.

You will find "?<MathSymbol>" and "?<Number>" in the mapping function i.MathSymbol.Value and i.Number.Value. (Note: I called the value from the symbol and value pair here number, because it seems confusing, when i use "Value" as name in the Regex. It would end as i.Value.Value. That's not pretty.)

Now write a calculate function and the very simple solver is done.

Listing calculate sequence of symbol/value pairs:

    let usCulture = new CultureInfo("en-us")

    let (|ParsedDecimal|) value =
        Decimal.Parse(value,usCulture)

    let calculate (symbolValues:(string * string) seq) =
        (0.0m,symbolValues)
        ||> Seq.fold (fun state item ->
            match item with
            |("+",(ParsedDecimal value)) ->                
                state + value
            |("-",(ParsedDecimal value)) ->
                state - value
            |("*",(ParsedDecimal value)) ->
                state * value
            |("/",(ParsedDecimal value)) ->
                state / value
            |("^",(ParsedDecimal value)) ->
                (decimal ((float state) ** (float value)))
            | _ -> state
            
            )

So the calculate function gets a sequence of symbol/value pairs and fold it to the result.
The C# developer knows "fold" as the "Aggregate"-Function in LINQ. So fold iterate to the sequence and perform a function that return the next "state" for the next item in the sequence.
"fold" needs a initial "state" a list of items and the function to perform.
In the case of the fold function i love the ||> (double pipe) operator, because it make the fold function more readable.

// without pipe
Seq.fold (fun state item -> // bla ...) initialState sequence

// with single pipe
sequence |> Seq.fold (fun state item -> // bla ...) initialState

// with the double pipe
(initialState,sequence) ||> Seq.fold (fun state item -> // bla ...)

See it for your self: if i had to describe the behavior, i would say: "Take the initial state and the sequence and fold it with "bla"."

So the next thing I use is a ActivePattern. With an ActivePattern you are able to perform operation to a value you want to math in a pattern match.
In that case i parse the Value from string to decimal, so i can use it directly and do the needed operation. I also need the us-en culture, because here in germany the decimal parser will use our number system and would parse "1.00" into "100", because we use "," as decimal not "."

Hey, and the external symbols like "base" oder "bitcoinRate" or "PlatinRate" or something?

i almost forget but it is very simple to do that.

Listing replace external symbol with values:

    type SymbolToValue = SymbolToValue of string * decimal

    let replaceSymbols symbolToValueList formula =
        (formula,symbolToValueList) 
        ||> List.fold (fun (state:string) (item:SymbolToValue) ->
            let (SymbolToValue (symbol,value)) = item
            state.Replace(symbol,value.ToString(usCulture))
            ) 

So this function replaces all external symbols with values. So the input parameter is a list of symbol to values and the formula. This function iterates the list of symbols and fold with a string replace, so that in the end all symbols in the formula will be removed and replaced with actually values.

For example a list of symbols:

let symbols = [SymbolToValue ("base",100.0m);SymbolToValue ("BASE",100.0m);SymbolToValue ("Base",100.0m)]

The "Order" of rules of calculation

Yeah, the very simple formula solver is basically enough for very simple formulas, but there are rules and we want to obey them.
The strategy I want to use, is to reduce all higher operations than add and subtract to get a bunch of simple symbol/value pairs we put into our "calculate" method.

For example:

1 + 2 * (3 + 4) ^ 3

// first the brackets (3+4) -> 7
1 + 2 * 7 ^ 3

// now the power 7^3 -> 343
1 + 2 * 343

// now the multiply 2*343 -> 686
1 + 686

// we get the pairs
(+,1)
(+,686)

The Brackets

The Brackets are the first in line. So we need an Regex to extract all, what is inside a bracket and runs it to all other rules including the brackets rule. In the end, we want a list of symbols of plus and minus operation we can easily put into our "calculate" method, because in the end with only add and subtract operation we get to the point.

Listing of the function to resolve the Brackets:

        type BracketsFilter = Regex< @"\((?<InsideBrackets>[0-9.\+\-\*\/\^]*)\)" >

        let (|ContainsBrackets|NotContainsBrackets|) (str:string) =
            let is = str.Contains("(") || str.Contains(")")
            match is with
            |true -> ContainsBrackets
            |false -> NotContainsBrackets
            
        let rec resolveBrackets formula =
            let insideBracketsParts =
                formula            
                |> BracketsFilter().TypedMatches
                |> Seq.map (fun x -> x.InsideBrackets.Value)
        
            let calculatedParts =
                insideBracketsParts
                |> Seq.map (fun formulaPart -> 
                    (formulaPart |> sprintf "(%s)" ,formulaPart |> resolvePower |> resolveMultiply))
                |> Seq.map (fun (part,multiresolved) -> 
                    (part,multiresolved |> splitFormula))
                |> Seq.map (fun (part,split) -> 
                    (part,split |> calculate))

            let resolvedFormula =
                (formula,calculatedParts)
                ||> Seq.fold (fun state calculatedPart -> 
                        let (formulaPart,resolvedPart) = calculatedPart                    
                        state |> replaceStringOnlyFirstHit formulaPart (resolvedPart |> decimalToSymbol)
                    )
        
            match resolvedFormula with
            | ContainsBrackets -> resolvedFormula |> resolveBrackets
            | NotContainsBrackets -> resolvedFormula

First I use an active pattern to check, if the formula contains some brackets. And yeah if could done this in a simple if then, but it want to use active pattern and it makes the function at the end more understandable.

The function is recursively and runs as long brackets are there.
In the first step i extract all whats inside brackets with a Regex.
The Regex take at first the inner brackets, that's because the function must run recursively.
here you see how the regex works:

Now I take all the extracted formula parts, whats inside a bracket and map this into a tuple of the formula part itself as string with brackets sprintf "(%s)". That string do i need to replace it later the result of the calculation. The second part of the tuple contains the to add and subtract reducted partial formula. So I pipe the partial forumla to the "resolvePower" and the "resolveMultiply" functions.

Listing the calulatedParts function inside the resolveBrackets:

            let calculatedParts =
                insideBracketsParts
                |> Seq.map (fun formulaPart -> 
                    (formulaPart |> sprintf "(%s)" ,formulaPart |> resolvePower |> resolveMultiply))
                |> Seq.map (fun (part,multiresolved) -> 
                    (part,multiresolved |> splitFormula))
                |> Seq.map (fun (part,split) -> 
                    (part,split |> calculate))

Than I map this to the "splitFormula" function and than I map these to the "calculate" function.

The last mapping step is actually a folding step. So I replace the solved partial formulas with the result.

            let resolvedFormula =
                (formula,calculatedParts)
                ||> Seq.fold (fun state calculatedPart -> 
                        let (formulaPart,resolvedPart) = calculatedPart                    
                        state |> replaceStringOnlyFirstHit formulaPart (resolvedPart |> decimalToSymbol)
                    )
                    

I almost forget, there is a little helper function to replace a string only on the first hit. So i could avoid to replace parts multiple parts of the formula. Actually as I now think about it, maybe I cloud have used the normal replace function, because the resolved parts are the same. But now it is so as it is.

        let replaceStringOnlyFirstHit (search:string) replace (input:string) =
            let pos = input.IndexOf(search)
            if pos < 0 then input
            else
                input.Substring(0,pos) + replace + input.[pos+search.Length..]

The last is only a fancy way to check if there are brackets left in the formula, so the function can be called recursively.

        match resolvedFormula with
            | ContainsBrackets -> resolvedFormula |> resolveBrackets
            | NotContainsBrackets -> resolvedFormula

Power

The function has basically the same structure. It resolve the power operation.
Listing resolvePower function:

        type PowerFilter = Regex< @"(?<Power>[\+\-\*\/\^][0-9.]*[\^]{1}[\-]{0,1}[0-9.]*)" >

        let rec resolvePower formula =
            let formula = formula |> tryAddLeadingPlus

            let powerParts =
                formula            
                |> PowerFilter().TypedMatches
                |> Seq.map (fun x -> x.Power.Value)

            let calculatedParts =
                powerParts           
                |> Seq.map (fun formulaPart -> 
                    let leadingMathSymbol = formulaPart.[0]             
                    
                    (formulaPart, formulaPart.[1..] |> splitFormula, leadingMathSymbol ))
                |> Seq.map (fun (part,split,leadingMathSymbol) -> (part,split |> calculate,leadingMathSymbol))
        
            let resolvedFormula =
                (formula,calculatedParts)
                ||> Seq.fold (fun state calculatedPart -> 
                        let (formulaPart,resolvedPart,leadingMathSymbol) = calculatedPart
                        state |> replaceStringOnlyFirstHit formulaPart (resolvedPart |> decimalToSymbol |> sprintf "%c%s" leadingMathSymbol)                    
                    )
        
            if resolvedFormula.Contains("^") then resolvedFormula |> resolvePower
            else resolvedFormula

The little difference is, that i remember the leading math symbol in front of the power operation, so i can add the symbol afterward to the result. Also I did not run any of this towards another rolver function like in the "resolveBrackets".

As i mentioned a formula like "2^2^3" results here in 64, the real result should according to wolfram alpha 256. This is because as I mentioned in the brackets part, the regex resolves from left to right. It is possible to change that behavior, but in our case it's overkill, because in the real world, nobody uses that to calculate a price. But maybe someone of you has an idea.

The both functions for brackets and power uses following little helper function:

        let decimalToSymbol (dec:decimal) =
            dec.ToString(usCulture)

Multiply and Divide

The function has also the same structure as the both others. It resolve multiply and divide operations.

Listing of the resolveMultipy function:

        type MultiplyDivideFilter = Regex< @"(?<MultiplyDivide>[\+\-][0-9.]*[\*\/]{1}[\-]{0,1}[0-9.]*)" >

        let (|ContainsMultiplyDivideSymbol|NotContainsMultiplyDivideSymbol|) (str:string) =
            //let is = ["*";"/"] |> Seq.exists (fun symb -> symb |> str.Contains)
            let is = str.Contains("*") || str.Contains("/")
            match is with
            |true -> ContainsMultiplyDivideSymbol
            |false -> NotContainsMultiplyDivideSymbol

        let decimalToSymbolWithPrefix (dec:decimal) =
            let decStr = dec.ToString(usCulture)
            if dec < 0.0m then decStr 
            else decStr |> sprintf "+%s" 

        let rec resolveMultiply formula =
            let formula = formula |> tryAddLeadingPlus

            let multiplyDivideParts =
                formula            
                |> MultiplyDivideFilter().TypedMatches
                |> Seq.map (fun x -> x.MultiplyDivide.Value)

            let calculatedParts =
                multiplyDivideParts
                |> Seq.map (fun formulaPart -> (formulaPart, formulaPart |> splitFormula))
                |> Seq.map (fun (part,split) -> (part,split |> calculate))
        
            let resolvedFormula =
                (formula,calculatedParts)
                ||> Seq.fold (fun state calculatedPart -> 
                        let (formulaPart,resolvedPart) = calculatedPart
                        state |> replaceStringOnlyFirstHit formulaPart (resolvedPart |> decimalToSymbolWithPrefix)                    
                    )
        
            match resolvedFormula with
            | ContainsMultiplyDivideSymbol -> resolvedFormula |> resolveMultiply
            | NotContainsMultiplyDivideSymbol -> resolvedFormula

There is the little active pattern function to have an fancy way to check if there are multiply or divide symbols in the formula (and a commented fancy way to check this more functional ... overkill I know, but I am learning).

The other helper function converts a decimal to a string with maybe a leading + if the result is positive. This i need, because maybe in front of the part I resolve is another number. So look, why i do that:

1+2*3

// split +2*3
(+,2)
(*,3)

// calculate and replace

// without leading + the result would be 6
// so replace +2*3 with 6 i've got
16

// with leading + i got
1+6

I could have worked with the "leadingMathSymbol" from the power part, it also does the trick. But in that case the function to solve multiply and divide was written a little bit earlier than the resolve power function.
So that's because i have this little helper.

In this function there will be alway added a + in front of the formula when there is no other math symbol in front. that's because in most cases the formula will not start with a symbol, and the function must split the formula into pairs and that will fail, when the first number has no leading math symbol.

Now compose to the one and only calculation function

    let calculateFormula formula symbolToValueList =
        let valid = formula |> formulaValidator symbolToValueList
        if (not valid) then
            Result.Error "invalid formula"
        else                        
            formula 
            |> removeSpaces
            |> replaceSymbols symbolToValueList
            |> resolveBrackets
            |> resolvePower
            |> resolveMultiply                
            |> splitFormula    
            |> calculate
            |> Result.Ok

As you see here. I have a also a validation function and some helpers like "removeSpaces" to get the formula well formed into my functions.

So that's all. Maybe a few words to the regex i used.

MathPairRegex

(?<MathSymbol>[\+\-\*\/\^])(?<Number>[\-]*[0-9.]*)

There are 2 groups the allowed math symbols are +,-,*,/,^ and the number. Allowed are only 0-9 and . and maybe a - in front

BracketsFilter Regex

\((?<InsideBrackets>[0-9.\+\-\*\/\^]*)\)

The bracket filter is easy, give me all allowed characters inside a bracket.

PowerFilter Regex

(?<Power>[\+\-\*\/\^][0-9.]*[\^]{1}[\-]{0,1}[0-9.]*)

The power filter gives you every math symbol before the first number, than the first number, the power symbol, maybe a minus and the second number.

MultiplyDivideFilter Regex

(?<MultiplyDivide>[\+\-][0-9.]*[\*\/]{1}[\-]{0,1}[0-9.]*)

The MultiplyDivideFilter takes a always a number with a leading + or - than at least a * or / and maybe a - and a value

That's all.

I hope you read at least to the end. So this was my first journey to F# to solve a business rule.

I'll be please if you leave a comment or contact me for further discussions, help, ideas, critics or at least nice words.

oh. and the full listing you will find here, until i setup my github page.

Full Listing:

#r "..[here the path to the regex type provider dll].."

open System.Text.RegularExpressions
open System.Linq
open System
open System.Globalization
open FSharp.Text.RegexProvider
    

    //Simple Parser for the price formula to be independent of an heavy weight dependency   


    type MathPairRegex = Regex< @"(?<MathSymbol>[\+\-\*\/\^])(?<Number>[\-]*[0-9.]*)" >
    type AllowedFormulaSymbolsRegex = Regex< @"[0-9.\+\-\*\/\^ \(\)]" >
    type IsMathSymbolRegex = Regex< @"[\+\-\*\/\^\(\)]" >

    type BracketsFilter = Regex< @"\((?<InsideBrackets>[0-9.\+\-\*\/\^]*)\)" >
    type PowerFilter = Regex< @"(?<Power>[\+\-\*\/\^][0-9.]*[\^]{1}[\-]{0,1}[0-9.]*)" >
    type MultiplyDivideFilter = Regex< @"(?<MultiplyDivide>[\+\-][0-9.]*[\*\/]{1}[\-]{0,1}[0-9.]*)" >

    let isMathSymbol (input:char) =
            IsMathSymbolRegex().IsMatch(input.ToString())

    type SymbolToValue = SymbolToValue of string * decimal

    let usCulture = new CultureInfo("en-us")    
    
    let formulaValidator symbolToValueList formula = 
        let clearedFormula:string = 
            (formula,symbolToValueList) 
            ||> List.fold (fun (state:string) (item:SymbolToValue) ->
                let (SymbolToValue (symbol,_)) = item
                state.Replace(symbol,"")
                ) 
        let countMatches = 
            AllowedFormulaSymbolsRegex().Matches(clearedFormula).Count
        let onlyAllowedSymbols = (countMatches = clearedFormula.Length)
        if not onlyAllowedSymbols then false
        else
            // count the brackets
            let openBracketCount = clearedFormula.Count(fun x-> x = '(')
            let closedBracketsCount = clearedFormula.Count( fun x -> x = ')')
            openBracketCount = closedBracketsCount
        

    let replaceSymbols symbolToValueList formula =
        (formula,symbolToValueList) 
        ||> List.fold (fun (state:string) (item:SymbolToValue) ->
            let (SymbolToValue (symbol,value)) = item
            state.Replace(symbol,value.ToString(usCulture))
            ) 
    
    let removeSpaces (formula:string) = formula.Replace(" ","")

    let tryAddLeadingPlus (formula:string) =
            let isFirstCharMath = formula.[0] |> isMathSymbol            
            if isFirstCharMath then formula 
            else "+" + formula

    let splitFormula (formula:string) = 
        formula        
        |> tryAddLeadingPlus
        |> MathPairRegex().TypedMatches        
        |> Seq.map (fun i -> (i.MathSymbol.Value,i.Number.Value)) 

    let (|ParsedDecimal|) value =
        Decimal.Parse(value,usCulture)

    let calculate (symbolValues:(string * string) seq) =
        (0.0m,symbolValues)
        ||> Seq.fold (fun state item ->
            match item with
            |("+",(ParsedDecimal value)) ->                
                state + value
            |("-",(ParsedDecimal value)) ->
                state - value
            |("*",(ParsedDecimal value)) ->
                state * value
            |("/",(ParsedDecimal value)) ->
                state / value
            |("^",(ParsedDecimal value)) ->
                (decimal ((float state) ** (float value)))
            | _ -> state
            
            )
    
    let (|ContainsMultiplyDivideSymbol|NotContainsMultiplyDivideSymbol|) (str:string) =
        //let is = ["*";"/"] |> Seq.exists (fun symb -> symb |> str.Contains)
        let is = str.Contains("*") || str.Contains("/")
        match is with
        |true -> ContainsMultiplyDivideSymbol
        |false -> NotContainsMultiplyDivideSymbol

    let decimalToSymbolWithPrefix (dec:decimal) =
        let decStr = dec.ToString(usCulture)
        if dec < 0.0m then decStr 
        else decStr |> sprintf "+%s"   

    let decimalToSymbol (dec:decimal) =
        dec.ToString(usCulture)
    
    let replaceStringOnlyFirstHit (search:string) replace (input:string) =
        let pos = input.IndexOf(search)
        if pos < 0 then input
        else
            input.Substring(0,pos) + replace + input.[pos+search.Length..]



    // resolve Multiply
    let rec resolveMultiply formula =
        let formula = formula |> tryAddLeadingPlus

        let multiplyDivideParts =
            formula            
            |> MultiplyDivideFilter().TypedMatches
            |> Seq.map (fun x -> x.MultiplyDivide.Value)

        let calculatedParts =
            multiplyDivideParts
            |> Seq.map (fun formulaPart -> (formulaPart, formulaPart |> splitFormula))
            |> Seq.map (fun (part,split) -> (part,split |> calculate))
        
        let resolvedFormula =
            (formula,calculatedParts)
            ||> Seq.fold (fun state calculatedPart -> 
                    let (formulaPart,resolvedPart) = calculatedPart
                    state |> replaceStringOnlyFirstHit formulaPart (resolvedPart |> decimalToSymbolWithPrefix)                    
                )
        
        match resolvedFormula with
        | ContainsMultiplyDivideSymbol -> resolvedFormula |> resolveMultiply
        | NotContainsMultiplyDivideSymbol -> resolvedFormula


    // resolve power
    let rec resolvePower formula =
        let formula = formula |> tryAddLeadingPlus

        let powerParts =
            formula            
            |> PowerFilter().TypedMatches
            |> Seq.map (fun x -> x.Power.Value)

        let calculatedParts =
            powerParts           
            |> Seq.map (fun formulaPart -> 
                let leadingMathSymbol = formulaPart |> Seq.head                
                (formulaPart, formulaPart.[1..] |> splitFormula, leadingMathSymbol ))
            |> Seq.map (fun (part,split,leadingMathSymbol) -> (part,split |> calculate,leadingMathSymbol))
        
        let resolvedFormula =
            (formula,calculatedParts)
            ||> Seq.fold (fun state calculatedPart -> 
                    let (formulaPart,resolvedPart,leadingMathSymbol) = calculatedPart
                    state |> replaceStringOnlyFirstHit formulaPart (resolvedPart |> decimalToSymbol |> sprintf "%c%s" leadingMathSymbol)                    
                )
        
        if resolvedFormula.Contains("^") then resolvedFormula |> resolvePower
        else resolvedFormula
        
    let (|ContainsBrackets|NotContainsBrackets|) (str:string) =
        let is = str.Contains("(") || str.Contains(")")
        match is with
        |true -> ContainsBrackets
        |false -> NotContainsBrackets
            
    let rec resolveBrackets formula =
        let insideBracketsParts =
            formula            
            |> BracketsFilter().TypedMatches
            |> Seq.map (fun x -> x.InsideBrackets.Value)
        
        let calculatedParts =
            insideBracketsParts
            |> Seq.map (fun formulaPart -> (formulaPart |> sprintf "(%s)" ,formulaPart |> resolvePower |> resolveMultiply))
            |> Seq.map (fun (part,multiresolved) -> (part,multiresolved |> splitFormula))
            |> Seq.map (fun (part,split) -> (part,split |> calculate))

        let resolvedFormula =
            (formula,calculatedParts)
            ||> Seq.fold (fun state calculatedPart -> 
                    let (formulaPart,resolvedPart) = calculatedPart                    
                    state |> replaceStringOnlyFirstHit formulaPart (resolvedPart |> decimalToSymbol)
                )
        
        match resolvedFormula with
        | ContainsBrackets -> resolvedFormula |> resolveBrackets
        | NotContainsBrackets -> resolvedFormula
           
        
    let calculateFormula formula symbolToValueList =
        let valid = formula |> formulaValidator symbolToValueList
        if (not valid) then
            Result.Error "invalid formula"
        else                        
            formula 
            |> removeSpaces
            |> replaceSymbols symbolToValueList
            |> resolveBrackets
            |> resolvePower
            |> resolveMultiply                
            |> splitFormula    
            |> calculate
            |> Result.Ok

In the last 6 or 7 weeks I start to read and watch videos about the capabilities of F# and how it help me to write better code and better domain and business logics.

Thanks to Greg Young, the father of CQRS and developer of the EventStore, i want to know about functional languages. One sentence, actually two, he said was:

"When we talk about Event Sourcing, current state is a left-fold of previous behaviors. Nothing new to Functional Programmers"

so in F# he meant:

let currentState =
    (initialState,sequenceOfEvents) ||> Seq.fold applyEvent
    

So after that, I discovered talks of Scott Wlaschin and his site fsharpforfunandprofit.com and it is amazing what i can do with F# to model a domain and write code without heavy boilerplate like in C#.

Don't get me wrong, i love C#, but now i love F#, too.

So i start, likely for myself, to write, how i write code and modeling a business domain, here in my blog the next time.

Hi there.

I had thought about the first post on my blog for quiet some time. Beside I am currently very busy in business, because a dead line is coming, but finally i found a small topic, I want to write about.

"yak shaving". The thing is, I've never heard this term before. I've heard this term for the first, i think it was in a key note of the NDC-Conference with Scott Hanselman and he talked about, how someone shaves a yak.

You have to know, that I am a german citizen, so I am not familiar with the all the nice phrases you have. We have some of our own.

So here I want to say, that this term is awesome and it describes some of the tasks I am doing right now exactly as there are.

So nothing special on my first post, but this was some i want to talk about.

here is the current description of yak shaving:

yak shaving describes the task, that you have to do, to complete another task, the is needed to complete another task, that is finally related to complete the task, that you have actually want to complete. An if somehow your boss come and looks for you, how far you come to complete the wanted task, your are standing in the room and shaving a yak and doing some other things from the perspective of your boss than to complete the task he ask for. (And now, explain this to him ...)

Okay, maybe there are some other definitions out there. But i think that describes it well enough.