Skip to content

Instantly share code, notes, and snippets.

@zecl
Last active August 29, 2015 14:03
Show Gist options
  • Save zecl/ae41d618d8dc0ef98673 to your computer and use it in GitHub Desktop.
Save zecl/ae41d618d8dc0ef98673 to your computer and use it in GitHub Desktop.
F# Compiler Serviceでソースコードからすべての型のFullNameを取得
// F# Compiler Service
#r @"..\packages\FSharp.Compiler.Service.0.0.57\lib\net45\FSharp.Compiler.Service.dll"
open System
open Microsoft.FSharp.Compiler.SourceCodeServices
open Microsoft.FSharp.Compiler.Ast
let checker = InteractiveChecker.Create()
let getUntypedTree (file, input) =
let checkOptions = checker.GetProjectOptionsFromScript(file, input, otherFlags = [| "--define:DEBUG" |]) |> Async.RunSynchronously
let untypedRes = checker.ParseFileInProject(file, input, checkOptions) |> Async.RunSynchronously
match untypedRes.ParseTree with
| Some tree -> tree
| None -> failwith "failed to parse"
let rec getAllFullNameOfType modulesOrNss =
modulesOrNss |> Seq.map(fun moduleOrNs ->
let (SynModuleOrNamespace(lid, isModule, moduleDecls, xmlDoc, attribs, synAccess, m)) = moduleOrNs
let topNamespaceOrModule = String.Join(".",(lid.Head::lid.Tail))
//inner modules
let modules = moduleDecls.Head::moduleDecls.Tail
getDeclarations modules |> Seq.map (fun x -> String.Join(".", [topNamespaceOrModule;x]))
) |> Seq.collect id
and getDeclarations moduleDecls =
Seq.fold (fun acc declaration ->
match declaration with
| SynModuleDecl.NestedModule(componentInfo, modules, _isContinuing, _range) ->
match componentInfo with
| SynComponentInfo.ComponentInfo(_,_,_,lid,_,_,_,_) ->
let moduleName = String.Join(".",(lid.Head::lid.Tail))
let children = getDeclarations modules
seq {
yield! acc
yield! children |> Seq.map(fun child -> moduleName + "+" + child) }
| SynModuleDecl.Types(typeDefs, _range) ->
let types =
typeDefs |> Seq.map(fun typeDef ->
match typeDef with
| SynTypeDefn.TypeDefn(componentInfo,_,_,_) ->
match componentInfo with
| SynComponentInfo.ComponentInfo(_,typarDecls,_,lid,_,_,_,_) ->
let typarString = typarDecls |> function | [] -> "" | x -> "`" + string x.Length
let typeName = String.Join(".",(lid.Head::lid.Tail))
typeName + typarString)
seq {
yield! acc
yield! types }
| _ -> acc
) Seq.empty moduleDecls
let input = """
// Sets the hello wrold variable
namespace Test.Namespace1
open System
open PiyoPiyo
type TestClass1<'T1, 'T2> = class end
type DU1 =
| Item1 of int
| Item2 of string
type DU2<'a> =
| Item1 of 'a
| Item2 of string
#if DEBUG
module Hoge =
type TestClass2 () =
inherit TestClass1 ()
let hello = "Hello world"
#endif
module Fuga =
type TestClass3 = class end
let add x y = x + y
type TestClass4 = class end
module Piyo =
type TestClass5<'a,'b,'c> = class end
"""
let tree = getUntypedTree("/dummy.fsx", input)
match tree with
| ParsedInput.ImplFile(ParsedImplFileInput(file, isScript, qualName, pragmas, hashDirectives, modules, b)) ->
getAllFullNameOfType modules |> Seq.iter(fun x -> printfn "%s" x)
(*
Test.Namespace1.TestClass1`2
Test.Namespace1.DU1
Test.Namespace1.DU2`1
Test.Namespace1.Hoge+TestClass2
Test.Namespace1.Fuga+TestClass3
Test.Namespace1.Fuga+TestClass4
Test.Namespace1.Fuga+Piyo+TestClass5`3
*)
| _ -> failwith "(*.fsi) not supported."
System.Console.ReadKey () |> ignore
@yukitos
Copy link

yukitos commented Jul 1, 2014

let checkOptions = checker.GetProjectOptionsFromScript(file, input, otherFlags = [| "--define:DEBUG" |]) |> Async.RunSynchronously

でどうでしょう?

@zecl
Copy link
Author

zecl commented Jul 1, 2014

できました! ありがとうございます!

@yukitos
Copy link

yukitos commented Jul 1, 2014

👍

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment