Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
A basic Type Provider for taking a string and making something silly.
namespace Samples.FSharp.StringTypeProvider
open System
open System.Reflection
open Samples.FSharp.ProvidedTypes
open Microsoft.FSharp.Core.CompilerServices
open Microsoft.FSharp.Quotations
[<TypeProvider>]
type StringTypeProvider(config: TypeProviderConfig) as this =
inherit TypeProviderForNamespaces()
let namespaceName = "Samples.StringTypeProvider"
let thisAssembly = Assembly.GetExecutingAssembly()
let staticParams = [ProvidedStaticParameter("value", typeof<string>)]
let t = ProvidedTypeDefinition(thisAssembly, namespaceName, "StringTyped", Some typeof<obj>, HideObjectMethods = true)
do t.DefineStaticParameters(
parameters = staticParams,
instantiationFunction = (fun typeName paramValues ->
match paramValues with
| [| :? string as value |] ->
let ty = ProvidedTypeDefinition(
thisAssembly,
namespaceName,
typeName,
Some typeof<obj>
)
let lengthProp = ProvidedProperty(
"Length",
typeof<int>,
GetterCode = fun args -> <@@ value.Length @@>
)
ty.AddMember lengthProp
let charProps = value
|> Seq.map(fun c ->
let p = ProvidedProperty(
c.ToString(),
typeof<char>,
GetterCode = fun args -> <@@ c @@>
)
let doc = sprintf "The char %s" (c.ToString())
p.AddXmlDoc doc
p
)
|> Seq.toList
ty.AddMembersDelayed (fun () -> charProps)
let sanitized = value.Replace(" ","")
let valueProp = ProvidedProperty(
sanitized,
typeof<string>,
GetterCode = fun args -> <@@ value @@>
)
valueProp.AddXmlDoc "This is the value that you gave me to start with"
ty.AddMember valueProp
let ctor = ProvidedConstructor(
parameters = [],
InvokeCode = fun args -> <@@ value :> obj @@>
)
ctor.AddXmlDoc "Initializes a the awesomes"
ty.AddMember ctor
let reverser = ProvidedMethod(
methodName = "Reverse",
parameters = [],
returnType = typeof<string>,
InvokeCode = (fun args ->
<@@
value
|> Seq.map (fun x -> x.ToString())
|> Seq.toList
|> List.rev
|> List.reduce (fun acc el -> acc + el)
@@>))
ty.AddMember reverser
ty
| _ -> failwith "No idea what you're doing"
)
)
do this.AddNamespace(namespaceName, [t])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.