open TypeShape

​

open System

open System.Collections.Concurrent

open TypeShape.Core

let rec mkPrinter<'T> () : 'T -> string =

    // todo probably a good idea to cache the printers

    let wrap(p : 'a -> string) = unbox<'T -> string> p

    let mkMemberPrinter (shape : IShapeMember<'DeclaringType>) =

       shape.Accept { new IMemberVisitor<'DeclaringType, 'DeclaringType -> string> with

           member __.Visit (shape : ShapeMember<'DeclaringType, 'Field>) =

               let fieldPrinter = mkPrinter<'Field>()

               fieldPrinter << shape.Get }

    let mkFieldPrinter (shape : IShapeReadOnlyMember<'DeclaringType>) =

       shape.Accept { new IReadOnlyMemberVisitor<'DeclaringType, list<string * ('DeclaringType -> string)>> with

           member __.Visit (shape : ReadOnlyMember<'DeclaringType, 'Field2>) =

                let fieldPrinter = mkPrinter<'Field2>()

                if shape.IsPublic then 

                    [ shape.MemberInfo.Name, fieldPrinter << shape.Get ]

                else 

                    []}

    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.Double -> wrap(sprintf "%f")

    | Shape.FSharpOption s ->

        s.Element.Accept {

            new ITypeVisitor<'T -> string> with

                member __.Visit<'a> () =

                    let tp = mkPrinter<'a>()

                    wrap(function None -> "None" | Some t -> sprintf "Some (%s)" (tp t))

        }

​

    | Shape.FSharpList s ->

        s.Element.Accept {

            new ITypeVisitor<'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.Element.Accept {

            new ITypeVisitor<'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]")

        }

    | Shape.FSharpUnion (:? ShapeFSharpUnion<'T> as shape) ->

        let cases : ShapeFSharpUnionCase<'T> [] = shape.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 = shape.GetTag u // get the underlying tag for the union case

            casePrinters.[tag] u

    | Shape.Poco (:? ShapePoco<'T> as shape) ->

        let propPrinters = shape.Properties |> Array.map mkFieldPrinter

        fun (r:'T) ->

            propPrinters

            |> Seq.collect id

            |> Seq.map (fun (label, ep) -> let value = ep r in sprintf "%s = %s" label value)

            |> String.concat "; "

            |> sprintf "{ %s }" 

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

​

[<StructuredFormatDisplay("{AsString}")>]

type Account() =

    let mutable balance = 0.0

    let mutable number = 0

    let mutable firstName = ""

    let mutable lastName = ""

    member this.AccountNumber

      with get() = number

      and set(value) = number <- value

    member this.FirstName

      with get() = firstName

      and set(value) = firstName <- value

    member this.LastName

      with get() = lastName

      and set(value) = lastName <- value

    member this.Balance

      with get() = balance

      and set(value) = balance <- value

    member this.Deposit(amount: float) = this.Balance <- this.Balance + amount

    member this.Withdraw(amount: float) = this.Balance <- this.Balance - amount

    with 

        override this.ToString() = this |> mkPrinter()

        member private this.AsString = this |> mkPrinter()

​

[<StructuredFormatDisplay("{AsString}")>]

type MaskedSimpleDU1 =     

    | OneOption 

with member private this.AsString = this |> mkPrinter()

Account() |> printfn "%A"

OneOption |> printfn "%A"