Created
February 6, 2015 11:02
-
-
Save aaronpowell/74c4bc0315c2e1b42b48 to your computer and use it in GitHub Desktop.
A basic Type Provider for taking a string and making something silly.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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