Creates a abstract generator class which provides all methods for visiting the specified glTF specification

FsharpGeneratorUsingglTFSpecificationFiles.fs

open System.IO

// Weitere Informationen zu F# unter "http://fsharp.org".
// Weitere Hilfe finden Sie im Projekt "F#-Tutorial".

module Generator = 
    open System.IO
    open System
    open System.Text.RegularExpressions
    open System.CodeDom.Compiler

    open Microsoft.FSharp.Compiler
    open Microsoft.FSharp.Compiler.SourceCodeServices
    
    
    type Decl = string * string option

    type MemberKind = 
        | AbstractFunction of decl:Decl
        | Function of selfIdentifier:string * decl:Decl * params:Decl[] * content:string[]
        | Property of decl:Decl * get:string * set:string

    type AST = 
        | AbstractClass of name:string * parameters:Decl[] * members:MemberKind[]
        | Class of name:string * parameters:Decl[] * members:MemberKind[]
        | Interface of name:string * members:Decl[]
        | Module of name:string * childs:AST
        | Binding of decl:Decl * expression : string
        | Alias of decl:Decl
        | Expression of content:AST
    
    let pathNamePrefix = "pathTo"
    
    let formatDeclWithBrackets (decl:Decl) =
        let name, signatureOption = decl
        match signatureOption with
        | Some s -> sprintf "(%s:%s)" name s
        | None -> sprintf "%s" name
    
    let formatDecl (decl:Decl) =
        let name, signatureOption = decl
        match signatureOption with
        | Some s -> sprintf "%s:%s" name s
        | None -> sprintf "%s" name
            
    let formatTupleParams parameters =
        let formattedParams = 
            parameters  
            |> Array.map (fun decl -> formatDecl decl)
        sprintf "(%s%s)" 
            (formattedParams 
            |> Array.take (Array.length formattedParams - 1)
            |> String.concat ", ")
            (formattedParams |> Seq.last)

    let formatParams parameters =
        let formattedParams = 
            parameters  
            |> Array.map (fun decl -> formatDeclWithBrackets decl)
        sprintf "%s%s" 
            (formattedParams 
            |> Array.take (Array.length formattedParams - 1)
            |> String.concat " ")
            (formattedParams |> Seq.last)

    let formatDefinition decl value = 
        let formattedDecl = formatDecl decl
        sprintf """let %s = %s""" formattedDecl value

    let formatPathDefinition name value = 
        let pathName = sprintf "%s%s" pathNamePrefix name
        let wrappedValue = sprintf """@"%s" """ value
        formatDefinition (pathName, None) wrappedValue

    let formatMethodCall name fParams = sprintf "%s %s" name fParams

    let formatTypeAlias decl =
        let name, typeNameOption = decl
        match typeNameOption with
        | Some typeName -> 
            sprintf "type %s = %s" name typeName
        | None -> 
            printfn "WARNING: Incomplete type alias %A" decl
            ""
    
    let writeAST moduleName ast dependencies =
        use writer = new StringWriter()
        use formattedWriter = new IndentedTextWriter(writer)

        let indent () = formattedWriter.Indent <- formattedWriter.Indent + 1
        let unindent () = formattedWriter.Indent <- formattedWriter.Indent - 1

        let writeAttributes names =
            formattedWriter.Write "[<"
            for name in names do sprintf "%s; " name |> formattedWriter.Write
            formattedWriter.Write ">]"
        
        let beginModule name = 
            indent()
            sprintf "module %s = " name |> formattedWriter.WriteLine

        let beginSingleModule name = 
            sprintf "module %s" name |> formattedWriter.WriteLine

        let endModule () = unindent()

        let writeOpenModuleOrNamespace name = 
            sprintf "open %s" name |> formattedWriter.WriteLine

        let writeAttribute fullName =
            sprintf "[<%s>]" fullName |> formattedWriter.WriteLine

        let writeDefinition decl value = formatDefinition decl value |> formattedWriter.WriteLine 

        let writePathDefinition name value = formatPathDefinition name value |> formattedWriter.WriteLine

        let writeTypeDefinition name paramsOption =
            let formattedParameters = 
                match paramsOption with
                | Some parameters -> formatTupleParams parameters
                | None -> ""
            sprintf "type %s %s =" name formattedParameters |> formattedWriter.WriteLine

        let writeArrayDefinition name contents =
            formattedWriter.WriteLine(sprintf "let %s = " name)
            indent()
            formattedWriter.WriteLine("[|")
            indent()
            contents |> Seq.iter(fun name -> formattedWriter.WriteLine(sprintf """ "%s" """ name))
            unindent()
            formattedWriter.WriteLine("|]")
            unindent()

        let writeAbstractFunction decl =
            let formattedDecl = formatDecl decl
            sprintf "abstract member %s" formattedDecl |> formattedWriter.WriteLine
        
        let writeAbstractMembers abstractMembers =
            for memberDef in abstractMembers do
                writeAbstractFunction memberDef
                formattedWriter.WriteLine()

        let writeMemberFunction selfIdentifier decl fParams (contents:string[]) =
            let formattedDecl = formatDecl decl
            sprintf "member %s.%s %s =" selfIdentifier formattedDecl (fParams |> formatParams)|> formattedWriter.WriteLine
            indent()
            contents |> Array.iter formattedWriter.WriteLine
            unindent()
        
        let writeAbstractClass name (constructorParams:Decl[]) members =
            writeAttribute "AbstractClass"
            writeTypeDefinition name (Some constructorParams)
            indent()
            for memberDef in members do
                formattedWriter.WriteLine()
                match memberDef with
                | AbstractFunction decl as m -> 
                    writeAbstractFunction decl
                | Function (selfIdentifier, name, fParams, contents) as def -> 
                    writeMemberFunction selfIdentifier name fParams contents
            unindent()

        let writeInterface name (members:Decl[]) =
            writeAttribute "Interface"
            writeTypeDefinition name None
            indent()
            writeAbstractMembers members
            unindent()
        
        let writeTypeAlias decl =
            formatTypeAlias decl |> formattedWriter.WriteLine
        
        //let writeDefinitionPair i name =
        //    let location = fullPaths.[i]
        //    sprintf """/// <summary> Path to the '%s' file. </summary>""" (fullNames.[i]) |> formattedWriter.WriteLine
        //    writePathDefinition name location
        //    FullJsonTypeDeclaration name location |> formattedWriter.WriteLine
        //    formattedWriter.WriteLine()
        
        beginSingleModule moduleName
        for dependency in dependencies do writeOpenModuleOrNamespace dependency

        for i in 0..1 do formattedWriter.WriteLine()

        let rec visitAST remainingAST =
            match remainingAST with
            | h :: t ->
                match h with
                | AST.AbstractClass(name, parameters, members) -> writeAbstractClass name parameters members
                | AST.Interface(name, members) -> writeInterface name members
                | AST.Binding(decl, expression) -> writeDefinition decl expression
                | AST.Alias decl -> writeTypeAlias decl
                | _ as unhandeledType -> printfn "Unhandeled AST type %A" unhandeledType
                formattedWriter.WriteLine()
                visitAST t
            | _ ->
                ()

        visitAST ast
        
        formattedWriter.Flush()
        writer.ToString()



    let generateSupportFileContent specificationPath =
        let files = 
            Directory.EnumerateFiles specificationPath
            |> Seq.map Path.GetFullPath 
            |> Seq.filter(fun f -> Path.GetExtension f = ".json")
            |> Seq.toArray

        let fullPaths = files |> Seq.map Path.GetFullPath |> Seq.filter(fun f -> Path.GetExtension f = ".json") |> Seq.toArray
        let fullNames = fullPaths |> Seq.map Path.GetFileName |> Seq.toArray
        let typeNames =
            fullPaths
            |> Array.map Path.GetFileNameWithoutExtension
            |> Array.map (fun f -> Regex.Replace(f, """\b\.?(?<a>[a-z])""", (fun m -> m.Groups.["a"].Value.ToUpper())))
        
        let formatJsonType location = sprintf """JsonProvider< @"%s">""" location
    
        let abstractMembers = (typeNames |> Array.map(fun n -> AbstractFunction("Visit"+ n, n + ".Root" + " -> unit" |> Some)))
        let nonAbstractMember =
            let selfIdentifer = "self"
            let name = "VisitSchemaDir"
            let ``params`` = [| "pathToSchemaDir", Some "string" |]
            let content =
                let schemaVarsDefinitions =
                    typeNames
                    |> Array.mapi
                        (fun i t -> t.ToLower(), sprintf "Path.Combine(pathToSchemaDir, %s) |> %s.Load" (sprintf """@"%s" """ fullNames.[i]) t)
                    |> Array.map(fun (name, content) -> formatDefinition (name,None) content)

                let calls =
                    typeNames
                    |> Array.map(fun t -> selfIdentifer + ".Visit" + t, t.ToLower())
                    |> Array.map(fun (name, param) -> formatMethodCall name param)
                    
                calls |> Array.append schemaVarsDefinitions
                
            Function(selfIdentifer, (name, None), ``params``, content)
        
        let abstractClass = AST.AbstractClass("Generator", [| "", None |], ([| nonAbstractMember |] |> Array.append abstractMembers))
        
        let dependencies =
            [|  "FSharp.Data"
                "System.IO" |]
        let moduleName = "GeneratedSchemaDefinitions"

        let typeAlias =
            typeNames 
            |> Array.mapi (fun i t -> t, formatJsonType fullPaths.[i] |> Some)
            |> Array.map AST.Alias
        
        let ast = [| abstractClass |] |> Array.append typeAlias |> Array.toList

        writeAST moduleName ast dependencies


[<EntryPoint>]
let main argv = 
    printfn "%A" argv
    let res = Generator.generateSupportFileContent @"E:\Development\glTF\specification\2.0\schema\"
    File.WriteAllText("./test.fs", res)
    0 // Integer-Exitcode zurückgeben