AutoMapper DSL (Computation Expression) for F#

Question

I have created a DSL for AutoMapper using an F# Computation Expression Builder. The Computation Builder itself is fairly simple, and effectively defines 5 basic operations: map to map from a field in the source to a field in the destination, value to use a specific value for a field in the destination, ignore to ignore a field in the destination, resolve to use an IValueResolver to populate a field in the destination, and convert to use an ITypeConverter. There are also define and endMap keywords to signify the beginning and end of the map respectively, and a special ignoreRest custom operation to ignore all un-mapped fields in the destination.

The source code for the Computation Builder is as follows:

namespace AutoMapper.FSharp

open AutoMapper
open FSharp.Quotations
open FSharp.Linq.RuntimeHelpers
open System
open System.Linq.Expressions

type MappingProfile () =
    inherit Profile()

type MappingProfileBuilder () =
    let mutable profile = Unchecked.defaultof<MappingProfile>
    let toLinq (expr : Expr<'a -> 'b>) =
        let linq = expr |> LeafExpressionConverter.QuotationToExpression
        let call = linq |> unbox<MethodCallExpression>
        let lambda = call.Arguments.[0] |> unbox<LambdaExpression>
        Expression.Lambda<Func<'a, 'b>>(lambda.Body, lambda.Parameters) 
    member __.Yield x = 
        profile <- new MappingProfile()
        profile
    [<CustomOperation("define")>]
    member this.Define<'source, 'destination> (profile: MappingProfile) =        
        profile.CreateMap<'source, 'destination>()
    [<CustomOperation("map")>]
    member this.Map (map: IMappingExpression<'source, 'destination>, [<ReflectedDefinition>] s: Expr<'source -> 'sourceMember>, [<ReflectedDefinition>] d: Expr<'destination -> 'destinationMember>) =
        let mapTo = d |> toLinq
        let mapFrom = Action<IMemberConfigurationExpression<'source, 'destination, 'destinationMember>> (fun (opts: IMemberConfigurationExpression<'source, 'destination, 'destinationMember>) -> opts.MapFrom(s |> toLinq))
        map.ForMember(mapTo, mapFrom)
    [<CustomOperation("ignore")>]
    member this.Ignore (map: IMappingExpression<'source, 'destination>, [<ReflectedDefinition>] x: Expr<'destination -> 'destintaionMember>) = 
        let mapTo = x |> toLinq
        let mapFrom = Action<IMemberConfigurationExpression<'source, 'destination, 'destintaionMember>> (fun (opts: IMemberConfigurationExpression<'source, 'destination, 'destintaionMember>) -> opts.Ignore())
        map.ForMember(mapTo, mapFrom)
    [<CustomOperation("value")>]
    member this.Value (map: IMappingExpression<'source, 'destination>, [<ReflectedDefinition>] x: Expr<'destination -> 'destintaionMember>, v: 'destinationMember) =
        let mapTo = x |> toLinq
        let mapFrom = Action<IMemberConfigurationExpression<'source, 'destination, 'destinationMember>> (fun (opts: IMemberConfigurationExpression<'source, 'destination, 'destinationMember>) -> opts.UseValue(v))
        map.ForMember(mapTo, mapFrom)
    [<CustomOperation("resolve")>]
    member this.Resolve (map: IMappingExpression<'source, 'destination>, [<ReflectedDefinition>] x: Expr<'destination -> 'destintaionMember>, r: IValueResolver<'source, 'destination, 'destinationMember>) =
        let mapTo = x |> toLinq
        let mapFrom = Action<IMemberConfigurationExpression<'source, 'destination, 'destinationMember>> (fun (opts: IMemberConfigurationExpression<'source, 'destination, 'destinationMember>) -> opts.ResolveUsing(r))
        map.ForMember(mapTo, mapFrom)
    [<CustomOperation("convert")>]
    member this.Convert (map: IMappingExpression<'source, 'destination>, c: ITypeConverter<'source, 'destination>) =
        map.ConvertUsing(c)
        map
    [<CustomOperation("ignoreRest")>]
    member this.IgnoreRest (map: IMappingExpression<'source, 'destination>) =
        map.ForAllOtherMembers(Action<IMemberConfigurationExpression<'source, 'destination, obj>> (fun (opts: IMemberConfigurationExpression<'source, 'destination, obj>) -> opts.Ignore()))
        map
    [<CustomOperation("endMap")>]
    member this.EndMap (map: IMappingExpression<'source, 'destination>) =
        profile :> Profile

[<AutoOpen>]
module MapBuilder =
    let automapper = MappingProfileBuilder()

Before using the computation builder, we'll need a test model to use in a map:

namespace AutoMapper.FSharp.TestModel

open System

[<CLIMutable>]
type InputObject =
    {
        Name: string
        Value: int
        Date: DateTime
        Coordinates: (int*int) list
    }

[<CLIMutable>]
type Coordinate = 
    {X: int; Y: int}

[<CLIMutable>]
type OutputObject =
    {
        Id: Guid
        Description: string
        CoreValue: int
        Time: DateTime
        Coordinates: Coordinate list
        IsComplete: bool
    }

Now, using the automapper Computation Expression, we can define a map from InputObject to OutputObject as follows:

namespace AutoMapper.FSharp

open AutoMapper
open AutoMapper.FSharp.TestModel
open System

module Maps =
    let coordinateResolver =
        {new IValueResolver<InputObject, OutputObject, Coordinate list> with
            member __.Resolve(source, destination, destinationMember, context) =
                source.Coordinates |> List.map (fun (x,y) -> {X = x; Y = y})
        }

    let inputObjectToOutputObject = 
        automapper {
            define
            value   (fun (d: OutputObject) -> d.Id)  (Guid.NewGuid())
            map     (fun (s: InputObject) -> s.Name) (fun d -> d.Description)
            map     (fun s -> s.Value)               (fun d -> d.CoreValue)
            map     (fun s -> s.Date)                (fun d -> d.Time)
            resolve (fun d -> d.Coordinates)         coordinateResolver
            ignoreRest
            endMap
        }

And for good measure, here's a Test program that brings everything together and executes the example map:

open AutoMapper
open AutoMapper.FSharp
open AutoMapper.FSharp.TestModel
open System

module Test =
    [<EntryPoint>]
    let main argv = 
        let config = AutoMapper.Configuration.MapperConfigurationExpression()
        config.AddProfile(Maps.inputObjectToOutputObject)
        Mapper.Initialize(config)
        printf "Name: "
        let name = Console.ReadLine()
        printf "Value: "
        let value = Console.ReadLine() |> Int32.Parse
        printf "X = "
        let x = Console.ReadLine() |> Int32.Parse
        printf "Y = "
        let y = Console.ReadLine() |> Int32.Parse
        let inputObject =
            {
                Name = name;
                Value = value;
                Date = DateTime.Now;
                Coordinates = [0,0; x,y]
            }
        printfn "Input Object: %A" inputObject
        let outputObject = Mapper.Map<InputObject, OutputObject>(inputObject)
        printfn "Output Object: %A" outputObject
        printfn"\r\nPress any key to exit..."
        Console.ReadKey() |> ignore
        0 // return an integer exit code

I'd welcome feedback on the Computation Builder implementation, and the design of the DSL itself. I'm still on the fence about the source/destination left/right column alignment. I went with what seemed intuitive to me, but I'm not quite happy with it yet, especially as sometimes the destination field expressions are on the left (such as when using resolve or value). Let me know what you would do differently.

Answer 1

This is a really cool idea. As far as limiting the cognitive overhead of the lambdas, you could do a combination of what Gjallarhorn and Argu do:

The idea from Gjallarhorn is to have the user create a dummy value of the type you want to make a lambda of, and then instead of a lambda have the user just access a property on that type:

let dummyInput: InputObject = // your dummy code goes here

let dummyOutput: OutputObject = // ditto
... some time passes ... 


let inputObjectToOutputObject = 
        automapper {
            map     dummyInput.Name         dummyOutput.Description
            map     dummyInput.Value        dummyOutput.CoreValue
            map     dummyInput.Date         dummyOutput.Time
            resolve dummyOutput.Coordinates coordinateResolver
            ignoreRest
            endMap
        }

etc, etc

Now, the part you could take from Argu is to decorate your builder methods that take IMappingExpression to instead take Expr<something> and use ReflectedDefinition(true) attribute to turn those property accesses into Expressions automatically. What you get from that looks something like this:

type Foo = { Bar: string}
let thing = { Bar = "lol" }
<@ thing.Bar @>

> type Foo =
  {Bar: string;}
val thing : Foo = {Bar = "lol";}
val it : Quotations.Expr<string> =
  PropertyGet (Some (PropertyGet (None, thing, [])), Bar, [])

And then you could translate simple propertyGets like that into the IMappingExpression for the user.

Just an idea. Otherwise I really like the idea!