Practical generic programming for F#
F# C# Other
Clone or download
Fetching latest commit…
Cannot retrieve the latest commit at this time.
Permalink
Failed to load latest commit information.
.github
.paket
docs
lib
samples
src
tests
.gitattributes
.gitignore
.travis.yml
LICENSE.txt
README.md
RELEASE_NOTES.md
TypeShape.sln
appveyor.yml
build.cmd
build.fsx
build.sh
paket.dependencies
paket.lock

README.md

TypeShape

TypeShape is a small, extensible F# library for practical generic programming. Borrowing from ideas used in the FsPickler implementation, it uses a combination of reflection, active patterns and F# object expressions to minimize the amount of reflection required by the user in such applications.

TypeShape permits definition of programs that act on specific algebrae of types. The library uses reflection to derive the algebraic structure of a given System.Type instance and then applies a variant of the visitor pattern to provide relevant type information per shape.

See my slides for a more thorough introduction to the concept.

Installing

To incorporate TypeShape in your project place the following line in your paket.dependencies file:

github eiriktsarpalis/TypeShape:2.10 src/TypeShape/TypeShape.fs

and in paket.references:

File: TypeShape.fs TypeShape

TypeShape is also available on NuGet Status

Example: Implementing a value printer

open System
open TypeShape

let rec mkPrinter<'T> () : 'T -> string =
    let wrap(p : 'a -> string) = unbox<'T -> string> p
    match shapeof<'T> with
    | Shape.Unit -> wrap(fun () -> "()")
    | Shape.Bool -> wrap(sprintf "%b")
    | Shape.Byte -> wrap(fun (b:byte) -> sprintf "%duy" b)
    | Shape.Int32 -> wrap(sprintf "%d")
    | Shape.Int64 -> wrap(fun (b:int64) -> sprintf "%dL" b)
    | Shape.String -> wrap(sprintf "\"%s\"")
    | Shape.FSharpOption s ->
        s.Accept {
            new IFSharpOptionVisitor<'T -> string> with
                member __.Visit<'a> () =
                    let tp = mkPrinter<'a>()
                    wrap(function None -> "None" | Some t -> sprintf "Some (%s)" (tp t))
        }

    | Shape.Tuple2 s ->
        s.Accept {
            new ITuple2Visitor<'T -> string> with
                member __.Visit<'t1, 't2> () =
                    let tp = mkPrinter<'t1>()
                    let sp = mkPrinter<'t2>()
                    wrap(fun (t : 't1, s : 't2) -> sprintf "(%s, %s)" (tp t) (sp s))
        }

    | Shape.FSharpList s ->
        s.Accept {
            new IFSharpListVisitor<'T -> string> with
                member __.Visit<'a> () =
                    let tp = mkPrinter<'a>()
                    wrap(fun ts -> ts |> List.map tp |> String.concat "; " |> sprintf "[%s]")
        }

    | Shape.Array s when s.Rank = 1 ->
        s.Accept {
            new IArrayVisitor<'T -> string> with
                member __.Visit<'a> _ =
                    let tp = mkPrinter<'a> ()
                    wrap(fun ts -> ts |> Array.map tp |> String.concat "; " |> sprintf "[|%s|]")
        }

    | Shape.FSharpSet s ->
        s.Accept {
            new IFSharpSetVisitor<'T -> string> with
                member __.Visit<'a when 'a : comparison> () =
                    let tp = mkPrinter<'a>()
                    wrap(fun (s:Set<'a>) -> s |> Seq.map tp |> String.concat "; " |> sprintf "set [%s]")
        }

    | _ -> failwithf "unsupported type '%O'" typeof<'T>

let p = mkPrinter<(int list * string option) * (bool * unit)> ()
p (([1 .. 5], None), (false, ())) // "(([1; 2; 3; 4; 5], None), (false, ()))"

Let's see how the value printer compares to sprintf:

#time "on"

type TestType = (int list * string option * string) * (bool * unit)
let value : TestType = (([1 .. 5], None, "42"), (false, ()))

let p1 = sprintf "%A" : TestType -> string
let p2 = mkPrinter<TestType>()

// Real: 00:00:00.442, CPU: 00:00:00.437, GC gen0: 31, gen1: 0, gen2: 0
for i = 1 to 1000 do ignore <| p1 value
// Real: 00:00:00.006, CPU: 00:00:00.000, GC gen0: 2, gen1: 1, gen2: 0
for i = 1 to 1000 do ignore <| p2 value

Records, Unions and POCOs

TypeShape can be used to define generic programs that target arbitrary types: F# records, unions or POCOs. This is achieved using the IShapeMember abstraction:

type IShapeMember<'DeclaringType, 'Field> =
    inherit IShapeMember<'DeclaringType>
    abstract Project : 'DeclaringType -> 'Field
    abstract Inject : 'DeclaringType -> 'Field -> 'DeclaringType

An F# record then is just a list of member shapes, a union is a list of lists of member shapes. Member shapes can optionally be configured to generate code at runtime for more performant Project and Inject operations. Member shapes come with quoted versions of the API for staged generic programming applications.

To make our pretty printer support these types, we first provide a pretty printer for members:

let mkMemberPrinter (shape : IShapeMember<'DeclaringType>) =
   shape.Accept { new IShapeMemberVisitor<'DeclaringType, 'DeclaringType -> string> with
       member __.Visit (shape : ShapeMember<'DeclaringType, 'Field>) =
           let fieldPrinter = mkPrinter<'Field>()
           fieldPrinter << shape.Project }

Then for F# records:

    match shapeof<'T> with
    | Shape.FSharpRecord (:? ShapeFSharpRecord<'T> as shape) ->
        let fieldPrinters : (string * ('T -> string)) [] = 
            s.Fields |> Array.map (fun f -> f.Label, mkMemberPrinter f)

        fun (r:'T) ->
            fieldPrinters
            |> Seq.map (fun (label, fp) -> sprintf "%s = %s" label (fp r))
            |> String.concat "; "
            |> sprintf "{ %s }"

Similarly, we could also add support for arbitrary F# unions:

    match shapeof<'T> with
    | Shape.FSharpUnion (:? ShapeFSharpUnion<'T> as shape) ->
        let cases : ShapeFSharpUnionCase<'T> [] = s.UnionCases // all union cases
        let mkUnionCasePrinter (case : ShapeFSharpUnionCase<'T>) =
            let fieldPrinters = case.Fields |> Array.map mkMemberPrinter
            fun (u:'T) -> 
                fieldPrinters 
                |> Seq.map (fun fp -> fp u) 
                |> String.concat ", "
                |> sprintf "%s(%s)" case.CaseInfo.Name

        let casePrinters = cases |> Array.map mkUnionCasePrinter // generate printers for all union cases
        fun (u:'T) ->
            let tag : int = s.GetTag u // get the underlying tag for the union case
            casePrinters.[tag] u

Similar active patterns exist for classes with settable properties and general POCOs.

Extensibility

TypeShape can be extended to incorporate new active patterns supporting arbitrary shapes. Here's an example illustrating how TypeShape can be extended to support ISerializable shapes.

Additional examples

See the project samples folder for more implementations using TypeShape:

Projects using TypeShape

Related Work

Build Status

Head (branch master), Build & Unit tests

  • Windows Build status
  • Linux Build Status