Dzoukr / Dapper.FSharp

Lightweight F# extension for StackOverflow Dapper with support for MSSQL, MySQL, PostgreSQL, and SQLite
MIT License
365 stars 35 forks source link

Add TypeHandler for fieldless and single case DUs #100

Open lucasteles opened 7 months ago

lucasteles commented 7 months ago

Using single-case DU to strongly type values is very common and also just fieldless enum-like DUs:

type Email = Email of string
type PersonId = PersonId of Guid
type Light = On | Off

So it would be great to have TypeHandler support for those cases

I've been using an implementation that looks like this:

module TypeHandlers =
    type SingleCaseUnionTypeHandler<'t>() =
        inherit SqlMapper.TypeHandler<'t>()

        let caseInfo =
            FSharpType.GetUnionCases(typedefof<'t>)
            |> Array.tryExactlyOne
            |> Option.filter (fun c -> c.GetFields().Length = 1)

        override _.Parse(value) =
            match caseInfo with
            | None -> failwith $"Unable to map type #{typedefof<'t>.Name}"
            | Some case -> FSharpValue.MakeUnion(case, [| value |]) :?> 't

        override this.SetValue(parameter, value) =
            match caseInfo with
            | None -> failwith $"Unable to map type #{typedefof<'t>.Name}"
            | Some case -> parameter.Value <- FSharpValue.GetUnionFields(value, case.DeclaringType) |> snd |> Seq.head

    type SimpleUnionTypeHandler<'t when 't: equality>() =
        inherit SqlMapper.TypeHandler<'t>()

        let cases =
            FSharpType.GetUnionCases(typeof<'t>)
            |> Array.filter (fun c -> c.GetFields() |> Array.isEmpty)

        override _.Parse(value) =
            cases
            |> Array.tryFind (fun c -> c.Name = string value)
            |> Option.map (fun c -> FSharpValue.MakeUnion(c, [||]))
            |> function
                | None -> failwith $"Unable to map type #{typedefof<'t>.Name}"
                | Some case -> case :?> 't

        override this.SetValue(parameter, value) =
            parameter.Value <-
                cases
                |> Array.tryFind value.Equals
                |> Option.map (fun c -> box c.Name)
                |> Option.toObj

    let registerUnion<'t when 't: equality> =
        let cases = typedefof<'t> |> FSharpType.GetUnionCases

        if cases |> Array.forall (fun c -> c.GetFields().Length = 0) then
            SqlMapper.AddTypeHandler(SimpleUnionTypeHandler<'t>())

        if cases.Length = 1 then
            SqlMapper.AddTypeHandler(SingleCaseUnionTypeHandler<'t>())