Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Adding F# source code formatting based on F# compiler language servic…

…e (based on www.fssnip.net).
  • Loading branch information...
commit 6c9a379fb3f32709a75b3e5fecff6c85dd136acf 1 parent a951e67
@tpetricek authored
View
5 .gitignore
@@ -0,0 +1,5 @@
+src/FSharp.CodeFormat/bin
+src/FSharp.CodeFormat/obj
+src/FSharp.Markdown/bin
+src/FSharp.Markdown/obj
+*.suo
View
27 src/FSharp.CodeFormat.Tests/Script.fsx
@@ -0,0 +1,27 @@
+// --------------------------------------------------------------------------------------
+// TODO: Some actual unit tests would be nice
+// --------------------------------------------------------------------------------------
+
+#r @"..\FSharp.CodeFormat\bin\Debug\FSharp.CodeFormat.dll"
+open FSharp.CodeFormat
+open System.Reflection
+
+// Load custom-built F# compiler with joinads
+let asm = Assembly.LoadFile(@"C:\tomas\Binary\FSharp.Extensions\Debug\cli\4.0\bin\FSharp.Compiler.dll")
+
+let agent = CodeFormat.CreateAgent(asm)
+
+let source = @"
+ let foo = 10
+ foo
+"
+
+let snips =
+ agent.AsyncParseSource("C:\\test.fsx", source.Trim())
+ |> Async.RunSynchronously
+
+let res = CodeFormat.FormatHtml(snips, "fstips")
+res.SnippetsHtml.[0].Html
+
+// Assembly.Load("FSharp.Compiler, Version=2.0.0.0, Culture=neutral, PublicKeyToken=a19089b1c74d0809")
+// Assembly.LoadFile(@"C:\Program Files (x86)\Microsoft SDKs\F#\3.0\Framework\v4.0\FSharp.Compiler.dll")
View
276 src/FSharp.CodeFormat/CodeFormatAgent.fs
@@ -0,0 +1,276 @@
+// --------------------------------------------------------------------------------------
+// F# CodeFormat (CodeFormatAgent.fs)
+// (c) Tomas Petricek, 2012, Available under Apache 2.0 license.
+// --------------------------------------------------------------------------------------
+namespace FSharp.CodeFormat
+
+open System
+open System.IO
+open System.Web
+open System.Text
+open System.Collections.Generic
+
+open FSharp.CodeFormat
+open FSharp.CodeFormat.CommentFilter
+
+open Microsoft.FSharp.Compiler
+open Microsoft.FSharp.Compiler.Reflection
+open Microsoft.FSharp.Compiler.SourceCodeServices
+
+// --------------------------------------------------------------------------------------
+// ?
+// --------------------------------------------------------------------------------------
+
+module private Helpers =
+
+ /// Mapping table that translates F# compiler representation to our union
+ let private colorMap =
+ [ TokenColorKind.Comment, TokenKind.Comment
+ TokenColorKind.Identifier, TokenKind.Identifier
+ TokenColorKind.InactiveCode, TokenKind.Inactive
+ TokenColorKind.Keyword, TokenKind.Keyword
+ TokenColorKind.Number, TokenKind.Number
+ TokenColorKind.Operator, TokenKind.Operator
+ TokenColorKind.PreprocessorKeyword, TokenKind.Preprocessor
+ TokenColorKind.String, TokenKind.String
+ TokenColorKind.UpperIdentifier, TokenKind.Identifier ] |> Map.ofSeq
+
+ /// Return the TokenKind corresponding to the specified F# compiler token
+ let getTokenKind key =
+ defaultArg (Map.tryFind key colorMap) TokenKind.Default
+
+ // Parse command line options - split string by space, but if there is something
+ // enclosed in double quotes "..." then ignore spaces in the quoted text
+ let parseOptions (str:string) =
+ let rec loop i opts current =
+ let opts =
+ if i < str.Length && str.[i] <> ' ' then opts
+ else (System.String(current |> List.rev |> Array.ofSeq))::opts
+ if i = str.Length then opts
+ elif str.[i] = ' ' then loop (i+1) opts []
+ elif str.[i] = '"' then
+ let endp = str.IndexOf('"', i+1)
+ let chars = str.Substring(i+1, endp - i - 1) |> List.ofSeq |> List.rev
+ loop (endp + 1) opts (chars @ current)
+ else loop (i + 1) opts (str.[i] :: current)
+
+ loop 0 [] [] |> Array.ofSeq
+
+
+ /// Use the F# compiler's SourceTokenizer to split a snippet (array of strings)
+ /// into a snippet with token information and line numbers.
+ let getTokens file defines (lines:string[]) : Snippet =
+
+ // Get defined directives
+ let defines = defines |> Option.map (fun (s:string) ->
+ s.Split([| ' '; ';'; ',' |], StringSplitOptions.RemoveEmptyEntries) |> List.ofSeq)
+ // Create source tokenizer
+ let sourceTok = SourceTokenizer(defaultArg defines [], file)
+
+ // Parse lines using the tokenizer
+ [ let state = ref 0L
+ for n, line in lines |> Seq.zip [ 0 .. lines.Length ] do
+ let tokenizer = sourceTok.CreateLineTokenizer(line)
+ tokenizer.StartNewLine()
+ let rec parseLine() = seq {
+ match tokenizer.ScanToken(!state) with
+ | Some(tok), nstate ->
+ let str = line.Substring(tok.LeftColumn, tok.RightColumn - tok.LeftColumn + 1)
+ yield str, tok
+ state := nstate
+ yield! parseLine()
+ | None, nstate -> state := nstate }
+ yield n, parseLine() |> List.ofSeq ]
+
+ // Count the minimal number of spaces at the beginning of lines
+ // (so that we can remove spaces for indented text)
+ let countStartingSpaces (lines:Snippet) =
+ [ for l, (toks:_ list) in lines do
+ match toks with
+ | ((text:string), info)::_ when info.TokenName = "WHITESPACE" ->
+ yield text.Length - text.TrimStart([| ' ' |]).Length
+ | [] -> ()
+ | _ -> yield 0 ] |> Seq.min
+
+// --------------------------------------------------------------------------------------
+// Main type that implements parsing and uses F# services
+// --------------------------------------------------------------------------------------
+
+/// Uses agent to handle formatting requests
+type CodeFormatAgent(assembly) =
+
+ do FSharpCompiler.BindToAssembly(assembly)
+
+ // Get the number of "IDENT" token in the F# compiler
+ // (This is needed when calling compiler, and it varies depending
+ // on the version i.e. when new keywords are added). Use reflection hack!
+ let identToken : int = FSharpCompiler.``Parser.token.Tags``?IDENT
+
+ // Processes a single line of the snippet
+ let processSnippetLine (checkInfo:TypeCheckInfo) (lines:string[]) (line, lineTokens) =
+
+ // Recursive processing of tokens on the line
+ // (keeps a long identifier 'island')
+ let rec loop island (tokens:SnippetLine) = seq {
+ match tokens with
+ | [] -> ()
+ | (body, tokenInfo)::rest ->
+ // Update the current identifier island
+ // (long identifier e.g. Collections.List.map)
+ let island =
+ match tokenInfo.TokenName with
+ | "DOT" -> island // keep what we have found so far
+ | "IDENT" -> body::island // add current identifier
+ | _ -> [] // drop everything - not in island
+
+ // Find tootltip using F# compiler service & the identifier island
+ let tip =
+ // If we're processing an identfier, see if it has any tool tip
+ if (tokenInfo.TokenName = "IDENT") then
+ let island = island |> List.rev
+ let pos = (line, tokenInfo.LeftColumn + 1)
+ let tip = checkInfo.GetDataTipText(pos, lines.[line], island, identToken)
+ match ToolTipReader.tryFormatTip tip with
+ | Some(_) as res -> res
+ | _ when island.Length > 1 ->
+ // Try to find some information about the last part of the identifier
+ let pos = (line, tokenInfo.LeftColumn + 2)
+ let tip = checkInfo.GetDataTipText(pos, lines.[line], [ body ], identToken)
+ ToolTipReader.tryFormatTip tip
+ | _ -> None
+ else None
+
+ if tokenInfo.TokenName.StartsWith("OMIT") then
+ // Special OMIT tag - add tool tip stored in token name
+ // (The text immediately follows the keyword "OMIT")
+ yield Omitted(body, tokenInfo.TokenName.Substring(4))
+ elif tokenInfo.TokenName = "FSI" then
+ // F# Interactive output - return as Output token
+ yield Output(body)
+ else
+ // Lookup token kind & return information about token
+ yield Token(Helpers.getTokenKind tokenInfo.ColorClass, body, tip)
+
+ // Process the rest of the line
+ yield! loop island rest }
+
+ // Process the current line & return info about it
+ Line (loop [] (List.ofSeq lineTokens) |> List.ofSeq)
+
+
+ /// Process snippet
+ let processSnippet checkInfo lines (source:Snippet) =
+ source |> List.map (processSnippetLine checkInfo lines)
+
+// --------------------------------------------------------------------------------------
+
+ // Create an instance of an InteractiveChecker (which does background analysis
+ // in a typical IntelliSense editor integration for F#)
+ let checker = InteractiveChecker.Create(ignore)
+
+ /// Type-checking takes some time and doesn't return information on the
+ /// first call, so this function creates workflow that tries repeatedly
+ let rec getTypeCheckInfo(untypedInfo, file, source, opts) = async {
+ let obs = IsResultObsolete(fun () -> false)
+ let info = checker.TypeCheckSource(untypedInfo, file, 0, source, opts, obs)
+ match info with
+ | TypeCheckSucceeded(res) when res.TypeCheckInfo.IsSome ->
+ // Succeeded & got results back
+ return res.TypeCheckInfo.Value, res.Errors
+ | _ ->
+ do! Async.Sleep(500)
+ return! getTypeCheckInfo(untypedInfo, file, source, opts) }
+
+
+ // ------------------------------------------------------------------------------------
+
+ let processSourceCode (file, source, options, defines) = async {
+
+ // Read the source code into an array of lines
+ use reader = new StringReader(source)
+ let sourceLines =
+ [| let line = ref ""
+ while (line := reader.ReadLine(); line.Value <> null) do
+ yield line.Value |]
+
+ // Get options for a standalone script file (this adds some
+ // default references and doesn't require full project information)
+ let opts = checker.GetCheckOptionsFromScriptRoot(file, source)
+
+ // Override default options if the user specified something
+ let opts =
+ match options with
+ | Some(str:string) when not(String.IsNullOrEmpty(str)) ->
+ opts.WithProjectOptions(Helpers.parseOptions str)
+ | _ -> opts
+
+ // Run the first phase - parse source into AST without type information
+ let untypedInfo = checker.UntypedParse(file, source, opts)
+ // Run the second phase - perform type checking
+ let! checkInfo, errors = getTypeCheckInfo(untypedInfo, file, source, opts)
+
+ /// Parse source file into a list of lines consisting of tokens
+ let tokens = Helpers.getTokens file defines sourceLines
+
+ // --------------------------------------------------------------------------------
+ // When type-checking completes and we have a parsed file (as tokens), we can
+ // put the information together - this processes tokens and adds information such
+ // as color and tool tips (for identifiers)
+
+ // Process "omit" meta-comments in the source
+ let source = shrinkOmittedParts tokens |> List.ofSeq
+
+ // Split source into snippets if it contains meta-comments
+ let snippets : NamedSnippet list =
+ match getSnippets None [] source sourceLines with
+ | [] -> ["Untitled", source]
+ | snippets -> snippets |> List.rev
+
+ // Generate a list of snippets
+ let parsedSnippets =
+ snippets |> List.map (fun (title, lines) ->
+ // Process the current snippet
+ let parsed = processSnippet checkInfo sourceLines source
+
+ // Remove additional whitespace from start of lines
+ let spaces = Helpers.countStartingSpaces lines
+ let parsed = parsed |> List.map (function
+ | Line ((Token(kind, body, tip))::rest) ->
+ let body = body.Substring(spaces)
+ Line ((Token(kind, body, tip))::rest)
+ | line -> line)
+
+ // Return parsed snippet as 'Snippet' value
+ Snippet(title, parsed))
+
+ return parsedSnippets }
+
+ // ------------------------------------------------------------------------------------
+ // Agent that implements the parsing & formatting
+
+ let agent = MailboxProcessor.Start(fun agent -> async {
+ while true do
+ // Receive parameters for the next parsing request
+ let! request, (chnl:AsyncReplyChannel<_>) = agent.Receive()
+ let! res = processSourceCode request
+ chnl.Reply(res |> Array.ofList)
+ })
+
+ /// Parse the source code specified by 'source', assuming that it
+ /// is located in a specified 'file'. Optional arguments can be used
+ /// to give compiler command line options and preprocessor definitions
+ member x.AsyncParseSource(file, source, ?options, ?defines) =
+ agent.PostAndAsyncReply(fun chnl -> (file, source, options, defines), chnl)
+
+ /// Parse the source code specified by 'source', assuming that it
+ /// is located in a specified 'file'. Optional arguments can be used
+ /// to give compiler command line options and preprocessor definitions
+ member x.ParseSourceAsync(file, source, options, defines) =
+ x.AsyncParseSource(file, source, options, defines)
+ |> Async.StartAsTask
+
+ /// Parse the source code specified by 'source', assuming that it
+ /// is located in a specified 'file'. Optional arguments can be used
+ /// to give compiler command line options and preprocessor definitions
+ member x.ParseSource(file, source, ?options, ?defines) =
+ agent.PostAndReply(fun chnl -> (file, source, options, defines), chnl)
View
130 src/FSharp.CodeFormat/CommentFilter.fs
@@ -0,0 +1,130 @@
+// --------------------------------------------------------------------------------------
+// F# CodeFormat (CommentProcessing.fs)
+// (c) Tomas Petricek, 2012, Available under Apache 2.0 license.
+// --------------------------------------------------------------------------------------
+module private FSharp.CodeFormat.CommentFilter
+
+open System
+open System.IO
+open System.Text
+open System.Web
+
+open FSharp.Patterns
+open FSharp.Collections
+
+open Microsoft.FSharp.Compiler
+open Microsoft.FSharp.Compiler.SourceCodeServices
+
+// --------------------------------------------------------------------------------------
+// Handle special comments that can appear in F# snipptes. This includes:
+// Marking of a snippet that should be formatted:
+//
+// // [snippet:Some name]
+// // [/snippet]
+//
+// Omitting of a block of code in a visible snippet:
+//
+// (*[omit:<replacement>]*)...(*[/omit]*)
+//
+// Displaying of F# interactive output:
+//
+// // [fsi:<here is some fsi output>]
+//
+// --------------------------------------------------------------------------------------
+
+type Token = string * TokenInformation
+type SnippetLine = Token list
+type IndexedSnippetLine = int * SnippetLine
+type Snippet = IndexedSnippetLine list
+type NamedSnippet = string * Snippet
+
+/// Finds special commands (comments) in the source code. If there are commands, then
+/// we only generate HTML for parts of source (snippets). This function returns a list
+/// of snippets. The commands should be:
+/// // [snippet:Some title]
+/// ... some F# code ...
+/// // [/snippet]
+let rec getSnippets (state:NamedSnippet option) (snippets:NamedSnippet list)
+ (source:IndexedSnippetLine list) (lines:string[]) =
+ match source with
+ | [] -> snippets
+ | (line, tokens)::rest ->
+ let text = lines.[line].Trim()
+ match state, text with
+
+ // We're not inside a snippet and we found a beginning of one
+ | None, String.StartsWithTrim "//" (String.StartsWithTrim "[snippet:" title) ->
+ let title = title.Substring(0, title.IndexOf(']'))
+ getSnippets (Some(title, [])) snippets rest lines
+ // Not inside a snippet and there is a usual line
+ | None, _ ->
+ getSnippets state snippets rest lines
+
+ // We're inside a snippet and it ends
+ | Some(title, acc), String.StartsWithTrim "//" (String.StartsWithTrim "[/snippet]" _) ->
+ getSnippets None ((title, acc |> List.rev)::snippets) rest lines
+ // We're inside snippet - add current line to it
+ | Some(title, acc), _ ->
+ getSnippets (Some(title, (line, tokens)::acc)) snippets rest lines
+
+
+/// Preprocesses a line and merges all subsequent comments on a line
+/// into a single long comment (so that we can parse it as snippet command)
+let rec mergeComments (line:SnippetLine) (cmt:Token option) (acc:SnippetLine) =
+ match line, cmt with
+ | [], Some(cmt) -> cmt::acc |> List.rev
+ | [], None -> acc |> List.rev
+ | (str, tok)::line, None when tok.TokenName = "COMMENT" || tok.TokenName = "LINE_COMMENT" ->
+ mergeComments line (Some(str, tok)) acc
+ | (str, tok)::line, Some(scmt, cmt) when tok.TokenName = "COMMENT" || tok.TokenName = "LINE_COMMENT"->
+ let ncmt = cmt.WithRightColumn(tok.RightColumn)
+ mergeComments line (Some(scmt+str, ncmt)) acc
+ | (str, tok)::line, None ->
+ mergeComments line None ((str, tok)::acc)
+ | (str, tok)::line, Some(cmt) ->
+ mergeComments line None ((str, tok)::cmt::acc)
+
+
+/// Continue reading shrinked code until we reach the end (*[/omit]*) tag
+/// (see the function below for more information and beginning of shrinking)
+let rec shrinkOmittedCode (text:StringBuilder) line content (source:Snippet) =
+ match content, source with
+ // Take the next line, merge comments and continue looking for end
+ | [], (line, content)::source ->
+ shrinkOmittedCode (text.Append("\n")) line (mergeComments content None []) source
+ | (String.StartsAndEndsWithTrim ("(*", "*)") "[/omit]", tok)::rest, source
+ when tok.TokenName = "COMMENT" ->
+ line, rest, source, text
+ | (str, tok)::rest, _ ->
+ shrinkOmittedCode (text.Append(str)) line rest source
+ | [], [] -> line, [], [], text
+
+
+/// Find all code marked using the (*[omit:<...>]*) tags and replace it with
+/// a special token (named "OMIT...." where "...." is a replacement string)
+let rec shrinkLine line (content:SnippetLine) (source:Snippet) =
+ match content with
+ | [] -> [], source
+ | (String.StartsAndEndsWithTrim ("(*", "*)") (String.StartsAndEndsWithTrim ("[omit:", "]") body), (tok:TokenInformation))::rest
+ when tok.TokenName = "COMMENT" ->
+ let line, remcontent, source, text =
+ shrinkOmittedCode (StringBuilder()) line rest source
+ let line, source = shrinkLine line remcontent source
+ (body, tok.WithTokenName("OMIT" + (text.ToString()) ))::line, source
+ | (String.StartsWithTrim "//" (String.StartsAndEndsWith ("[fsi:", "]") fsi), (tok:TokenInformation))::rest ->
+ let line, source = shrinkLine line rest source
+ (fsi, tok.WithTokenName("FSI"))::line, source
+ | (str, tok)::rest ->
+ let line, source = shrinkLine line rest source
+ (str, tok)::line, source
+
+/// Process the whole source file and shrink all blocks marked using
+/// special 'omit' meta-comments (see the two functions above)
+let rec shrinkOmittedParts (source:Snippet) : Snippet =
+ [ match source with
+ | [] -> ()
+ | (line, content)::source ->
+ let content, source = shrinkLine line (mergeComments content None []) source
+ yield line, content
+ yield! shrinkOmittedParts source ]
+
View
71 src/FSharp.CodeFormat/FSharp.CodeFormat.fsproj
@@ -0,0 +1,71 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+ <Platform Condition=" '$(Platform)' == '' ">x86</Platform>
+ <ProductVersion>8.0.30703</ProductVersion>
+ <SchemaVersion>2.0</SchemaVersion>
+ <ProjectGuid>{341ebf32-d470-4c55-99e9-55f14f7ffbb1}</ProjectGuid>
+ <OutputType>Library</OutputType>
+ <RootNamespace>FSharp.CodeFormat</RootNamespace>
+ <AssemblyName>FSharp.CodeFormat</AssemblyName>
+ <TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
+ <TargetFrameworkProfile>
+ </TargetFrameworkProfile>
+ <Name>FSharp.CodeFormat</Name>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|x86' ">
+ <DebugSymbols>true</DebugSymbols>
+ <DebugType>full</DebugType>
+ <Optimize>false</Optimize>
+ <Tailcalls>false</Tailcalls>
+ <OutputPath>bin\Debug\</OutputPath>
+ <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <PlatformTarget>x86</PlatformTarget>
+ <DocumentationFile>
+ </DocumentationFile>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|x86' ">
+ <DebugType>pdbonly</DebugType>
+ <Optimize>true</Optimize>
+ <Tailcalls>true</Tailcalls>
+ <OutputPath>bin\Release\</OutputPath>
+ <DefineConstants>TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <PlatformTarget>x86</PlatformTarget>
+ <DocumentationFile>bin\Release\FSharp.CodeFormat.XML</DocumentationFile>
+ </PropertyGroup>
+ <ItemGroup>
+ <Reference Include="mscorlib" />
+ <Reference Include="FSharp.Core" />
+ <Reference Include="System" />
+ <Reference Include="System.Core" />
+ <Reference Include="System.Numerics" />
+ <Reference Include="System.Web" />
+ </ItemGroup>
+ <ItemGroup>
+ <Compile Include="..\FSharpX\Collections.fs">
+ <Link>Collections.fs</Link>
+ </Compile>
+ <Compile Include="..\FSharpX\StringParsing.fs">
+ <Link>StringParsing.fs</Link>
+ </Compile>
+ <Compile Include="FSharpCompiler.fs" />
+ <Compile Include="CommentFilter.fs" />
+ <Compile Include="SourceCode.fs" />
+ <Compile Include="ToolTipReader.fs" />
+ <Compile Include="CodeFormatAgent.fs" />
+ <Compile Include="HtmlFormatting.fs" />
+ <Compile Include="Main.fs" />
+ </ItemGroup>
+ <Import Project="$(MSBuildExtensionsPath32)\FSharp\1.0\Microsoft.FSharp.Targets" Condition="!Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
+ <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
+ <!-- To modify your build process, add your task inside one of the targets below and uncomment it.
+ Other similar extension points exist, see Microsoft.Common.targets.
+ <Target Name="BeforeBuild">
+ </Target>
+ <Target Name="AfterBuild">
+ </Target>
+ -->
+</Project>
View
460 src/FSharp.CodeFormat/FSharpCompiler.fs
@@ -0,0 +1,460 @@
+// --------------------------------------------------------------------------------------
+// F# CodeFormat (FSharpCompiler.fs)
+// (c) Tomas Petricek, 2012, Available under Apache 2.0 license.
+// --------------------------------------------------------------------------------------
+
+// Using 'Microsoft' namespace to make the API as similar to the actual one as possible
+namespace Microsoft.FSharp.Compiler
+
+// --------------------------------------------------------------------------------------
+// Wrapper for the APIs in 'FSharp.Compiler.dll' and 'FSharp.Compiler.Server.Shared.dll'
+// The API is currently internal, so we call it using the (?) operator and Reflection
+// --------------------------------------------------------------------------------------
+
+open System
+open System.Reflection
+open Microsoft.FSharp.Reflection
+open System.Globalization
+
+exception CompilerMissingException of string * string
+
+/// Implements the (?) operator that makes it possible to access internal methods
+/// and properties and contains definitions for F# assemblies
+module Reflection =
+ // Various flags configurations for Reflection
+ let staticFlags = BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Static
+ let instanceFlags = BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance
+ let ctorFlags = instanceFlags
+ let inline asMethodBase(a:#MethodBase) = a :> MethodBase
+
+ let (?) (o:obj) name : 'R =
+ // The return type is a function, which means that we want to invoke a method
+ if FSharpType.IsFunction(typeof<'R>) then
+ let argType, resType = FSharpType.GetFunctionElements(typeof<'R>)
+ FSharpValue.MakeFunction(typeof<'R>, fun args ->
+ // We treat elements of a tuple passed as argument as a list of arguments
+ // When the 'o' object is 'System.Type', we call static methods
+ let methods, instance, args =
+ let args =
+ if argType = typeof<unit> then [| |]
+ elif not(FSharpType.IsTuple(argType)) then [| args |]
+ else FSharpValue.GetTupleFields(args)
+ if (typeof<System.Type>).IsAssignableFrom(o.GetType()) then
+ let methods = (unbox<Type> o).GetMethods(staticFlags) |> Array.map asMethodBase
+ let ctors = (unbox<Type> o).GetConstructors(ctorFlags) |> Array.map asMethodBase
+ Array.concat [ methods; ctors ], null, args
+ else
+ o.GetType().GetMethods(instanceFlags) |> Array.map asMethodBase, o, args
+
+ // A simple overload resolution based on the name and number of parameters only
+ let methods =
+ [ for m in methods do
+ if m.Name = name && m.GetParameters().Length = args.Length then yield m ]
+ match methods with
+ | [] -> failwithf "No method '%s' with %d arguments found" name args.Length
+ | _::_::_ -> failwithf "Multiple methods '%s' with %d arguments found" name args.Length
+ | [:? ConstructorInfo as c] -> c.Invoke(args)
+ | [ m ] -> m.Invoke(instance, args) ) |> unbox<'R>
+ else
+ // When the 'o' object is 'System.Type', we access static properties
+ let typ, flags, instance =
+ if (typeof<System.Type>).IsAssignableFrom(o.GetType()) then unbox o, staticFlags, null
+ else o.GetType(), instanceFlags, o
+
+ // Find a property that we can call and get the value
+ let prop = typ.GetProperty(name, flags)
+ if prop = null then
+ let fld = typ.GetField(name, flags)
+ if fld = null then
+ failwithf "Field or property '%s' not found in '%s' using flags '%A'." name typ.Name flags
+ else
+ fld.GetValue(instance) |> unbox<'R>
+ else
+ let meth = prop.GetGetMethod(true)
+ if prop = null then failwithf "Property '%s' found, but doesn't have 'get' method." name
+ meth.Invoke(instance, [| |]) |> unbox<'R>
+
+
+ /// Wrapper type for the 'FSharp.Compiler.dll' assembly - expose types we use
+ type FSharpCompilerWrapper() =
+
+ let mutable assembly = None
+ /// Exposes the currently loaded FSharp.Compiler.dll
+ member x.CurrentAssembly : Assembly =
+ match assembly with
+ | None -> failwith "Assembly FSharp.Compiler is not configured!"
+ | Some asm -> asm
+ /// Configure the wrapper to use the specified FSharp.Compiler.dll
+ member x.BindToAssembly(asm) = assembly <- Some asm
+
+ member x.InteractiveChecker = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.InteractiveChecker")
+ member x.IsResultObsolete = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.IsResultObsolete")
+ member x.CheckOptions = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.CheckOptions")
+ member x.SourceTokenizer = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.SourceTokenizer")
+ member x.TokenInformation = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.TokenInformation")
+ member x.``Parser.token.Tags`` = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.Parser+token+Tags")
+
+ let FSharpCompiler = new FSharpCompilerWrapper()
+
+// Hide this part of code, because it is not needed in F# Snippets
+// (but it is nice to leave it here and keep file in sync with MonoDevelop)
+#if INTERACTIVE_SERVER
+ /// Wrapper type for the 'FSharp.Compiler.Server.Shared.dll' assembly - expose types we use
+ type FSharpCompilerServerShared private () =
+ static let asm =
+ lazy try Assembly.Load("FSharp.Compiler.Server.Shared, Version=2.0.0.0, Culture=neutral, PublicKeyToken=a19089b1c74d0809")
+ with e -> raise (CompilerMissingException("FSharp.Compiler.Server.Shared", e.ToString()))
+ static member InteractiveServer = asm.Value.GetType("Microsoft.FSharp.Compiler.Server.Shared.FSharpInteractiveServer")
+
+// --------------------------------------------------------------------------------------
+// Wrapper for 'Microsoft.Compiler.Server.Shared', which contains some API for
+// controlling F# Interactive using reflection (e.g. for interrupt)
+// --------------------------------------------------------------------------------------
+
+module Server =
+ module Shared =
+ open Reflection
+
+ type FSharpInteractiveServer(wrapped:obj) =
+ static member StartClient(channel:string) =
+ FSharpInteractiveServer
+ (FSharpCompilerServerShared.InteractiveServer?StartClient(channel))
+ member x.Interrupt() : unit = wrapped?Interrupt()
+#endif
+
+// --------------------------------------------------------------------------------------
+// Source code services (Part 1) - contains wrappers for tokenization etc.
+// --------------------------------------------------------------------------------------
+
+module SourceCodeServices =
+ open Reflection
+
+ type TokenColorKind =
+ | Comment = 2
+ | Default = 0
+ | Identifier = 3
+ | InactiveCode = 7
+ | Keyword = 1
+ | Number = 9
+ | Operator = 10
+ | PreprocessorKeyword = 8
+ | String = 4
+ | Text = 0
+ | UpperIdentifier = 5
+
+ type TokenCharKind =
+ | Comment = 10
+ | Default = 0
+ | Delimiter = 6
+ | Identifier = 2
+ | Keyword = 1
+ | LineComment = 9
+ | Literal = 4
+ | Operator = 5
+ | String = 3
+ | Text = 0
+ | WhiteSpace = 8
+
+ type TriggerClass(wrapped:obj) =
+ member x.Wrapped = wrapped
+
+ type TokenInformation(wrapped:obj) =
+ member x.LeftColumn : int = wrapped?LeftColumn
+ member x.RightColumn : int = wrapped?RightColumn
+ member x.Tag : int = wrapped?Tag
+ member x.TokenName : string = wrapped?TokenName
+ member x.ColorClass : TokenColorKind = enum<TokenColorKind>(unbox wrapped?ColorClass)
+ member x.CharClass : TokenCharKind = enum<TokenCharKind>(unbox wrapped?CharClass)
+ member x.TriggerClass : TriggerClass = TriggerClass(wrapped?TriggerClass)
+ member x.WithRightColumn(rightColumn:int) =
+ TokenInformation
+ ( FSharpCompiler.TokenInformation?``.ctor``
+ ( x.LeftColumn, rightColumn, int x.ColorClass, int x.CharClass,
+ x.TriggerClass.Wrapped, x.Tag, x.TokenName ) )
+ member x.WithTokenName(tokenName:string) =
+ TokenInformation
+ ( FSharpCompiler.TokenInformation?``.ctor``
+ ( x.LeftColumn, x.RightColumn, x.ColorClass, x.CharClass,
+ x.TriggerClass.Wrapped, x.Tag, tokenName ) )
+
+ type LineTokenizer(wrapped:obj) =
+ member x.StartNewLine() : unit = wrapped?StartNewLine()
+ member x.ScanToken(state:int64) =
+ let tup : obj = wrapped?ScanToken(state)
+ let optInfo, newstate = tup?Item1, tup?Item2
+ let optInfo =
+ if optInfo = null then None
+ else Some(new TokenInformation(optInfo?Value))
+ optInfo, newstate
+
+ type SourceTokenizer(defines:string list, source:string) =
+ let wrapped = FSharpCompiler.SourceTokenizer?``.ctor``(defines, source)
+ member x.CreateLineTokenizer(line:string) =
+ LineTokenizer(wrapped?CreateLineTokenizer(line))
+
+ // ------------------------------------------------------------------------------------
+
+ module Array =
+ let untypedMap f (a:System.Array) =
+ Array.init a.Length (fun i -> f (a.GetValue(i)))
+
+ module List =
+ let rec untypedMap f (l:obj) =
+ (l :?> System.Collections.IEnumerable) |> Seq.cast<obj> |> Seq.map f |> List.ofSeq
+
+ module PrettyNaming =
+ let IsIdentifierPartCharacter (c:char) =
+ let cat = System.Char.GetUnicodeCategory(c)
+ cat = UnicodeCategory.UppercaseLetter ||
+ cat = UnicodeCategory.LowercaseLetter ||
+ cat = UnicodeCategory.TitlecaseLetter ||
+ cat = UnicodeCategory.ModifierLetter ||
+ cat = UnicodeCategory.OtherLetter ||
+ cat = UnicodeCategory.LetterNumber ||
+ cat = UnicodeCategory.DecimalDigitNumber ||
+ cat = UnicodeCategory.ConnectorPunctuation ||
+ cat = UnicodeCategory.NonSpacingMark ||
+ cat = UnicodeCategory.SpacingCombiningMark || c = '\''
+
+ // ------------------------------------------------------------------------------------
+ // Source code services (Part 2) - contains wrappers for parsing & type checking.
+ // ------------------------------------------------------------------------------------
+
+ type Position = int * int
+
+ type Names = string list
+
+ type NamesWithResidue = Names * string
+
+ type XmlComment(wrapped:obj) =
+ member x.Wrapped = wrapped
+
+ let (|XmlCommentNone|XmlCommentText|XmlCommentSignature|) (xml:XmlComment) =
+ if xml.Wrapped?IsXmlCommentNone then XmlCommentNone()
+ elif xml.Wrapped?IsXmlCommentText then XmlCommentText(xml.Wrapped?Item : string)
+ elif xml.Wrapped?IsXmlCommentSignature then
+ let it1, it2 : string * string = xml.Wrapped?Item1, xml.Wrapped?Item2
+ XmlCommentSignature(it1, it2)
+ else failwith "Unexpected XmlComment value!"
+
+ type DataTipElement(wrapped:obj) =
+ member x.Wrapped = wrapped
+
+ let (|DataTipElementNone|DataTipElement|DataTipElementGroup|DataTipElementCompositionError|) (el:DataTipElement) =
+ if el.Wrapped?IsDataTipElementNone then
+ DataTipElementNone
+ elif el.Wrapped?IsDataTipElement then
+ let (s:string) = el.Wrapped?Item1
+ let xml = XmlComment(el.Wrapped?Item2)
+ DataTipElement(s, xml)
+ elif el.Wrapped?IsDataTipElementGroup then
+ let list = el.Wrapped?Item |> List.untypedMap (fun tup ->
+ let (s:string) = tup?Item1
+ let xml = XmlComment(tup?Item2)
+ s, xml )
+ DataTipElementGroup(list)
+ elif el.Wrapped?IsDataTipElementCompositionError then
+ DataTipElementCompositionError(el.Wrapped?Item : string)
+ else
+ failwith "Unexpected DataTipElement value!"
+
+ type DataTipText(wrapped:obj) =
+ member x.Wrapped = wrapped
+
+ let (|DataTipText|) (d:DataTipText) =
+ d.Wrapped?Item |> List.untypedMap (fun o ->
+ DataTipElement(o))
+
+ type FileTypeCheckStateIsDirty = string -> unit
+
+ /// Callback that indicates whether a requested result has become obsolete.
+ [<NoComparison;NoEquality>]
+ type IsResultObsolete =
+ | IsResultObsolete of (unit->bool)
+
+ type CheckOptions(wrapped:obj) =
+ member x.Wrapped = wrapped
+ member x.ProjectFileName : string = wrapped?ProjectFileName
+ member x.ProjectFileNames : string array = wrapped?ProjectFileNames
+ member x.ProjectOptions : string array = wrapped?ProjectOptions
+ member x.IsIncompleteTypeCheckEnvironment : bool = wrapped?IsIncompleteTypeCheckEnvironment
+ member x.UseScriptResolutionRules : bool = wrapped?UseScriptResolutionRules
+ member x.WithProjectOptions(options:string[]) =
+ CheckOptions.Create
+ ( x.ProjectFileName, x.ProjectFileNames, options,
+ x.IsIncompleteTypeCheckEnvironment, x.UseScriptResolutionRules)
+ static member Create(fileName:string, fileNames:string[], options:string[], incomplete:bool, scriptRes:bool) =
+ CheckOptions
+ (FSharpCompiler.CheckOptions?``.ctor``
+ (fileName, fileNames, options, incomplete, scriptRes))
+
+ type UntypedParseInfo(wrapped:obj) =
+ member x.Wrapped = wrapped
+ /// Name of the file for which this information were created
+ //abstract FileName : string
+ /// Get declaraed items and the selected item at the specified location
+ //abstract GetNavigationItems : unit -> NavigationItems
+ /// Return the inner-most range associated with a possible breakpoint location
+ //abstract ValidateBreakpointLocation : Position -> Range option
+ /// When these files change then the build is invalid
+ //abstract DependencyFiles : unit -> string list
+
+
+ type Severity = Warning | Error
+
+ type Declaration(wrapped:obj) =
+ member x.Name : string = wrapped?Name
+ member x.DescriptionText : DataTipText = DataTipText(wrapped?DescriptionText)
+ member x.Glyph : int = wrapped?Glyph
+
+ type DeclarationSet(wrapped:obj) =
+ member x.Items =
+ wrapped?Items |> Array.untypedMap (fun o -> Declaration(o))
+
+ type TypeCheckInfo(wrapped:obj) =
+ /// Resolve the names at the given location to a set of declarations
+ member x.GetDeclarations(pos:Position, line:string, names:NamesWithResidue, tokentag:int) =
+ DeclarationSet(wrapped?GetDeclarations(pos, line, names, tokentag))
+
+ /// Resolve the names at the given location to give a data tip
+ member x.GetDataTipText(pos:Position, line:string, names:Names, tokentag:int) : DataTipText =
+ DataTipText(wrapped?GetDataTipText(pos, line, names, tokentag))
+
+ /// Resolve the names at the given location to give F1 keyword
+ // member GetF1Keyword : Position * string * Names -> string option
+ // Resolve the names at the given location to a set of methods
+ // member GetMethods : Position * string * Names option * (*tokentag:*)int -> MethodOverloads
+ /// Resolve the names at the given location to the declaration location of the corresponding construct
+ // member GetDeclarationLocation : Position * string * Names * (*tokentag:*)int * bool -> FindDeclResult
+ /// A version of `GetDeclarationLocation` augmented with the option (via the `bool`) parameter to force .fsi generation (even if source exists); this is primarily for testing
+ // member GetDeclarationLocationInternal : bool -> Position * string * Names * (*tokentag:*)int * bool -> FindDeclResult
+
+
+ type ErrorInfo(wrapped:obj) =
+ member x.StartLine : int = wrapped?StartLine
+ member x.EndLine : int = wrapped?EndLine
+ member x.StartColumn : int = wrapped?StartColumn
+ member x.EndColumn : int = wrapped?EndColumn
+ member x.Severity : Severity =
+ if wrapped?Severity?IsError then Error else Warning
+ member x.Message : string = wrapped?Message
+ member x.Subcategory : string = wrapped?Subcategory
+
+ /// A handle to the results of TypeCheckSource
+ type TypeCheckResults(wrapped:obj) =
+ /// The errors returned by parsing a source file
+ member x.Errors : ErrorInfo array =
+ wrapped?Errors |> Array.untypedMap (fun e -> ErrorInfo(e))
+
+ /// A handle to type information gleaned from typechecking the file.
+ member x.TypeCheckInfo : TypeCheckInfo option =
+ if wrapped?TypeCheckInfo = null then None
+ else Some(TypeCheckInfo(wrapped?TypeCheckInfo?Value))
+
+ type TypeCheckAnswer(wrapped:obj) =
+ member x.Wrapped = wrapped
+
+ let (|NoAntecedant|Aborted|TypeCheckSucceeded|) (tc:TypeCheckAnswer) =
+ if tc.Wrapped?IsNoAntecedant then NoAntecedant()
+ elif tc.Wrapped?IsAborted then Aborted()
+ elif tc.Wrapped?IsTypeCheckSucceeded then
+ TypeCheckSucceeded(TypeCheckResults(tc.Wrapped?Item))
+ else failwith "Unexpected TypeCheckAnswer value"
+
+ type TypeCheckSucceededImpl(tyres:TypeCheckResults) =
+ member x.IsTypeCheckSucceeded = true
+ member x.IsAborted = false
+ member x.IsNoAntecedant = false
+ member x.Item = tyres
+
+ let TypeCheckSucceeded arg =
+ TypeCheckAnswer(TypeCheckSucceededImpl(arg))
+
+ type InteractiveChecker(wrapped:obj) =
+ /// Crate an instance of the wrapper
+ static member Create (dirty:FileTypeCheckStateIsDirty) =
+ InteractiveChecker(FSharpCompiler.InteractiveChecker?Create(dirty))
+
+ /// Parse a source code file, returning a handle that can be used for obtaining navigation bar information
+ /// To get the full information, call 'TypeCheckSource' method on the result
+ member x.UntypedParse(filename:string, source:string, options:CheckOptions) : UntypedParseInfo =
+ UntypedParseInfo(wrapped?UntypedParse(filename, source, options.Wrapped))
+
+ /// Typecheck a source code file, returning a handle to the results of the parse including
+ /// the reconstructed types in the file.
+ ///
+ /// Return None if the background builder is not yet done prepring the type check results for the antecedent to the
+ /// file.
+ member x.TypeCheckSource
+ ( parsed:UntypedParseInfo, filename:string, fileversion:int,
+ source:string, options:CheckOptions, (IsResultObsolete f)) =
+ TypeCheckAnswer
+ ( wrapped?TypeCheckSource
+ ( parsed.Wrapped, filename, fileversion, source, options.Wrapped,
+ FSharpCompiler.IsResultObsolete?NewIsResultObsolete(f) ) : obj)
+
+ /// For a given script file, get the CheckOptions implied by the #load closure
+ member x.GetCheckOptionsFromScriptRoot(filename:string, source:string) : CheckOptions =
+ CheckOptions(wrapped?GetCheckOptionsFromScriptRoot(filename, source))
+
+
+ /// Try to get recent type check results for a file. This may arbitrarily refuse to return any
+ /// results if the InteractiveChecker would like a chance to recheck the file, in which case
+ /// UntypedParse and TypeCheckSource should be called. If the source of the file
+ /// has changed the results returned by this function may be out of date, though may
+ /// still be usable for generating intellsense menus and information.
+ member x.TryGetRecentTypeCheckResultsForFile(filename:string, options:CheckOptions) =
+ let res = wrapped?TryGetRecentTypeCheckResultsForFile(filename, options.Wrapped) : obj
+ if res = null then None else
+ let tuple = res?Value
+ Some(UntypedParseInfo(tuple?Item1), TypeCheckResults(tuple?Item2), int tuple?Item3)
+
+ /// Begin background parsing the given project.
+ member x.StartBackgroundCompile(options:CheckOptions) =
+ wrapped?StartBackgroundCompile(options.Wrapped)
+
+ // Members that are not supported by the wrapper
+
+ /// Parse a source code file, returning information about brace matching in the file
+ /// Return an enumeration of the matching parethetical tokens in the file
+ // member MatchBraces : filename : string * source: string * options: CheckOptions -> (Range * Range) array
+
+ /// This function is called when the configuration is known to have changed for reasons not encoded in the CheckOptions.
+ /// For example, dependent references may have been deleted or created.
+ // member InvalidateConfiguration : options : CheckOptions -> unit
+
+ /// Stop the background compile.
+ // member StopBackgroundCompile : unit -> unit
+ /// Block until the background compile finishes.
+ // member WaitForBackgroundCompile : unit -> unit
+
+ /// Report a statistic for testability
+ // static member GlobalForegroundParseCountStatistic : int
+
+ /// Report a statistic for testability
+ // static member GlobalForegroundTypeCheckCountStatistic : int
+
+ // member GetSlotsCount : options : CheckOptions -> int
+ // member UntypedParseForSlot : slot:int * options : CheckOptions -> UntypedParseInfo
+
+module Utils =
+ open Reflection
+
+ /// Format an exception as a readable string with all information
+ /// (this also handles exceptions thrown by the F# language service)
+ let formatException e =
+ let sb = new Text.StringBuilder()
+ let rec printe s (e:exn) =
+ let name = e.GetType().FullName
+ Printf.bprintf sb "%s: %s (%s)\n\nStack trace: %s\n\n" s name e.Message e.StackTrace
+ if name = "Microsoft.FSharp.Compiler.ErrorLogger+Error" then
+ let (tup:obj) = e?Data0
+ Printf.bprintf sb "Compile error (%d): %s" tup?Item1 tup?Item2
+ elif name = "Microsoft.FSharp.Compiler.ErrorLogger+ReportedError" then
+ let (inner:obj) = e?Data0
+ if inner = null then Printf.bprintf sb "Reported error is null"
+ else printe "Reported error" (inner?Value)
+ elif e.InnerException <> null then
+ printe "Inner exception" e.InnerException
+ printe "Exception" e
+ sb.ToString()
View
181 src/FSharp.CodeFormat/HtmlFormatting.fs
@@ -0,0 +1,181 @@
+// --------------------------------------------------------------------------------------
+// F# CodeFormat (HtmlFormatting.fs)
+// (c) Tomas Petricek, 2012, Available under Apache 2.0 license.
+// --------------------------------------------------------------------------------------
+
+module FSharp.CodeFormat.Html
+
+open System
+open System.IO
+open System.Web
+open System.Text
+open System.Collections.Generic
+open FSharp.CodeFormat
+
+// --------------------------------------------------------------------------------------
+// Context used by the formatter
+// --------------------------------------------------------------------------------------
+
+/// Mutable type that formats tool tips and keeps the generated HTML
+type ToolTipFormatter(prefix) =
+ let tips = new Dictionary<ToolTipSpans, int * string>()
+ let mutable count = 0
+ let mutable uniqueId = 0
+
+ /// Formats tip and returns assignments for 'onmouseover' and 'onmouseout'
+ member x.FormatTip (tip:ToolTipSpans) overlapping formatFunction =
+ uniqueId <- uniqueId + 1
+ let stringIndex =
+ match tips.TryGetValue(tip) with
+ | true, (idx, _) -> idx
+ | _ ->
+ count <- count + 1
+ tips.Add(tip, (count, formatFunction tip))
+ count
+ // stringIndex is the index of the tool tip
+ // uniqueId is globally unique id of the occurrence
+ if overlapping then
+ // The <span> may contain other <span>, so we need to
+ // get the element and check where the mouse goes...
+ String.Format
+ ( "id=\"{0}t{1}\" onmouseout=\"hideTip(event, '{0}{1}', {2})\" " +
+ "onmouseover=\"showTip(event, '{0}{1}', {2}, document.getElementById('{0}t{1}'))\" ",
+ prefix, stringIndex, uniqueId )
+ else
+ String.Format
+ ( "onmouseout=\"hideTip(event, '{0}{1}', {2})\" " +
+ "onmouseover=\"showTip(event, '{0}{1}', {2})\" ",
+ prefix, stringIndex, uniqueId )
+
+ /// Returns all generated tool tip elements
+ member x.WriteTipElements (writer:TextWriter) =
+ for (KeyValue(_, (index, html))) in tips do
+ writer.Write(sprintf "<div class=\"tip\" id=\"%s%d\">%s</div>" prefix index html)
+
+/// Represents context used by the formatter
+type FormattingContext =
+ { AddLines : bool
+ GenerateErrors : bool
+ Writer : TextWriter
+ FormatTip : ToolTipSpans -> bool -> (ToolTipSpans -> string) -> string }
+
+// --------------------------------------------------------------------------------------
+// Formats various types from 'SourceCode.fs' as HTML
+// --------------------------------------------------------------------------------------
+
+/// Formats tool tip information and returns a string
+let formatToolTipSpans spans =
+ let sb = StringBuilder()
+ use wr = new StringWriter(sb)
+ // Inner recursive function that does the formatting
+ let rec format spans = spans |> List.iter (function
+ | Emphasis(spans) ->
+ wr.Write("<em>")
+ format spans
+ wr.Write("</em>")
+ | Literal(string) ->
+ let spaces = string.Length - string.TrimStart(' ').Length
+ wr.Write(String.replicate spaces "&160;")
+ wr.Write(string.Substring(spaces))
+ | HardLineBreak ->
+ wr.Write("<br />"))
+ format spans
+ sb.ToString()
+
+/// Format token spans such as tokens, omitted code etc.
+let rec formatTokenSpans (ctx:FormattingContext) = List.iter (function
+ | Error(kind, message, body) when ctx.GenerateErrors ->
+ let tipAttributes = ctx.FormatTip [Literal message] true formatToolTipSpans
+ ctx.Writer.Write("<span ")
+ ctx.Writer.Write(tipAttributes)
+ ctx.Writer.Write("class=\"cerr\">")
+ formatTokenSpans { ctx with FormatTip = fun _ _ _ -> "" } body
+ ctx.Writer.Write("</span>")
+
+ | Error(_, _, body) ->
+ formatTokenSpans ctx body
+
+ | Output(body) ->
+ ctx.Writer.Write("<span class=\"fsi\">")
+ ctx.Writer.Write(body)
+ ctx.Writer.Write("</span>")
+
+ | Omitted(body, hidden) ->
+ let tipAttributes = ctx.FormatTip [Literal body] false formatToolTipSpans
+ ctx.Writer.Write("<span ")
+ ctx.Writer.Write(tipAttributes)
+ ctx.Writer.Write("class=\"omitted\">")
+ ctx.Writer.Write(body)
+ ctx.Writer.Write("</span>")
+
+ | Token(kind, body, tip) ->
+ // Generate additional attributes for ToolTip
+ let tipAttributes =
+ match tip with
+ | Some(tip) -> ctx.FormatTip tip false formatToolTipSpans
+ | _ -> ""
+
+ // Get CSS class name of the token
+ let color =
+ match kind with
+ | TokenKind.Comment -> "c"
+ | TokenKind.Default -> ""
+ | TokenKind.Identifier -> "i"
+ | TokenKind.Inactive -> "inactive"
+ | TokenKind.Keyword -> "k"
+ | TokenKind.Number -> "n"
+ | TokenKind.Operator -> "o"
+ | TokenKind.Preprocessor -> "prep"
+ | TokenKind.String -> "s"
+
+ if kind <> TokenKind.Default then
+ // Colorize token & add tool tip
+ ctx.Writer.Write("<span ")
+ ctx.Writer.Write(tipAttributes)
+ ctx.Writer.Write("class=\"" + color + "\">")
+ ctx.Writer.Write(HttpUtility.HtmlEncode(body))
+ ctx.Writer.Write("</span>")
+ else
+ ctx.Writer.Write(HttpUtility.HtmlEncode(body)) )
+
+/// Generate HTML with the specified snippets
+let formatSnippets (ctx:FormattingContext) (snippets:Snippet[]) =
+ [| for (Snippet(title, lines)) in snippets do
+ // Generate snippet to a local StringBuilder
+ let mainStr = StringBuilder()
+ let ctx = { ctx with Writer = new StringWriter(mainStr) }
+
+ // Generate <pre> tag for the snippet
+ ctx.Writer.WriteLine("<pre class=\"fssnip\">")
+ let numberLength = lines.Length.ToString().Length
+ let linesLength = lines.Length
+ // Print all lines of the snippet
+ lines |> List.iteri (fun index (Line spans) ->
+ let isLast = index = linesLength - 1
+ // Add line number to the beginning
+ if ctx.AddLines then
+ let lineStr = (index + 1).ToString().PadLeft(numberLength)
+ ctx.Writer.Write("<span class=\"l\">{0}: </span>", lineStr)
+
+ // Write tokens & end of the line
+ formatTokenSpans ctx spans
+ if not isLast then ctx.Writer.WriteLine() )
+
+ // Close the <pre> tag for this snippet
+ ctx.Writer.WriteLine("</pre>")
+ ctx.Writer.Close()
+ yield title, mainStr.ToString() |]
+
+/// Format snippets and return HTML for <pre> tags together
+/// wtih HTML for ToolTips (to be added to the end of document)
+let format addLines addErrors prefix (snippets:Snippet[]) =
+ let tipf = ToolTipFormatter(prefix)
+ let ctx = { AddLines = addLines; GenerateErrors = addErrors
+ Writer = null; FormatTip = tipf.FormatTip }
+
+ // Generate main HTML for snippets
+ let snippets = formatSnippets ctx snippets
+ // Generate HTML with ToolTip tags
+ let tipStr = StringBuilder()
+ tipf.WriteTipElements(new StringWriter(tipStr))
+ snippets, tipStr.ToString()
View
44 src/FSharp.CodeFormat/Main.fs
@@ -0,0 +1,44 @@
+// --------------------------------------------------------------------------------------
+// F# CodeFormat (Main.fs)
+// (c) Tomas Petricek, 2012, Available under Apache 2.0 license.
+// --------------------------------------------------------------------------------------
+
+namespace FSharp.CodeFormat
+
+/// Represents an indivudal formatted snippet with title
+type FormattedSnippet(title:string, html:string) =
+ /// Returns the title of the snippet (or 'Unnamed') if not given
+ member x.Title = title
+ /// Returns the formatted HTML code for the snipet
+ member x.Html = html
+
+
+/// Represents formatted HTML snippets
+type FormattedHtml(snippets:FormattedSnippet[], tips:string) =
+ /// Returns the processed snippets as an array
+ member x.SnippetsHtml = snippets
+ /// Returns string with ToolTip elements for all the snippets
+ member x.ToolTipHtml = tips
+
+
+/// Exposes functionality of the F# code formatter with a nice interface
+type CodeFormat =
+ /// Returns a new instance of the agent that manages code formatting
+ /// using the F# compiler service. The agent requires a reference to
+ /// the 'FSharp.Compiler.dll' assembly. At the moment, the assembly
+ /// is shared by all the instances of formatting agent!
+ static member CreateAgent(assembly) =
+ CodeFormatAgent(assembly)
+
+ /// Formats the snippets parsed using the CodeFormatAgent as HTML
+ /// The parameters specify prefix for HTML tags, whether lines should
+ /// be added to outputs and whether errors should be printed.
+ static member FormatHtml(snippets, prefix, addLines, addErrors) =
+ let snip, tip = Html.format addLines addErrors prefix snippets
+ let snip = [| for t, h in snip -> FormattedSnippet(t, h) |]
+ FormattedHtml(snip, tip)
+
+ /// Formats the snippets parsed using the CodeFormatAgent as HTML
+ /// using the specified ID prefix and default settings.
+ static member FormatHtml(snippets, prefix) =
+ CodeFormat.FormatHtml(snippets, prefix, true, false)
View
45 src/FSharp.CodeFormat/SourceCode.fs
@@ -0,0 +1,45 @@
+// --------------------------------------------------------------------------------------
+// F# CodeFormat (SourceCode.fs)
+// (c) Tomas Petricek, 2012, Available under Apache 2.0 license.
+// --------------------------------------------------------------------------------------
+namespace FSharp.CodeFormat
+
+// --------------------------------------------------------------------------------------
+// Abstract Syntax representation of formatted source code
+// --------------------------------------------------------------------------------------
+
+type ToolTipSpans = list<ToolTipSpan>
+
+and ToolTipSpan =
+ | Emphasis of ToolTipSpans
+ | Literal of string
+ | HardLineBreak
+
+[<RequireQualifiedAccess>]
+type TokenKind =
+ | Keyword
+ | String
+ | Comment
+ | Identifier
+ | Inactive
+ | Number
+ | Operator
+ | Preprocessor
+ | Default
+
+[<RequireQualifiedAccess>]
+type ErrorKind =
+ | Error
+ | Warning
+
+type TokenSpan =
+ | Token of TokenKind * string * ToolTipSpans option
+ | Error of ErrorKind * string * TokenSpans
+ | Omitted of string * string
+ | Output of string
+
+and TokenSpans = TokenSpan list
+
+type Line = Line of TokenSpans
+
+type Snippet = Snippet of string * Line list
View
288 src/FSharp.CodeFormat/SourceParser.fs
@@ -0,0 +1,288 @@
+// --------------------------------------------------------------------------------------
+// (c) Tomas Petricek, http://tomasp.net/blog
+// This code released under the terms of the Microsoft Public License (MS-PL)
+// --------------------------------------------------------------------------------------
+namespace FSharp.IntelliSense
+
+open System
+open System.IO
+open System.Web
+open System.Text
+open System.Collections.Generic
+
+open FSharp.IntelliSense
+open FSharp.IntelliSense.TextProcessing
+open Microsoft.FSharp.Compiler
+open Microsoft.FSharp.Compiler.SourceCodeServices
+
+// --------------------------------------------------------------------------------------
+// Color map and various types returned from source code processing
+// --------------------------------------------------------------------------------------
+
+/// A mapping from kinds of tokens to CSS classes used by the formatter
+module Colors =
+ let colorMap =
+ [ TokenColorKind.Comment, "c"
+ TokenColorKind.Identifier, "i"
+ TokenColorKind.InactiveCode, "inactive"
+ TokenColorKind.Keyword, "k"
+ TokenColorKind.Number, "n"
+ TokenColorKind.Operator, "o"
+ TokenColorKind.PreprocessorKeyword, "prep"
+ TokenColorKind.String, "s"
+ TokenColorKind.UpperIdentifier, "i" ] |> Map.ofSeq
+
+
+/// Stores information about tool tip for an identifier
+type ToolTip private (str) =
+
+ /// Remove additional (unnecessary) spaces from beginning of all lines
+ static let rec removeSpaces (lines:seq<string>) =
+ let remove =
+ seq { for s in lines do
+ let ts = s.TrimStart [|' '|]
+ if ts <> "" then yield s.Length - ts.Length } |> Seq.min
+ if remove > 0 then
+ seq { for s in lines ->
+ if s.TrimStart [|' '|] = "" then s
+ else s.Substring(remove) }
+ else lines
+
+ /// Format lines as HTML - replace initial spaces with entities and use <br/>
+ static let formatLines (lines:seq<string>) =
+ [ for l in lines do
+ let trim = l.TrimStart(' ')
+ let dif = l.Length - trim.Length
+ yield (String.replicate dif "&#160;") + trim + "<br />" ]
+ |> String.concat ""
+
+ /// Returns tool tip text formatted as a HTML
+ member x.ToolTipHtml = str
+
+ /// Creates a tool tip - returns 'None' if it contains no data
+ static member FromString(str:string) =
+ let str = HttpUtility.HtmlEncode(str.Trim [| '\n'; '\r' |])
+ let lines = str.Split [| '\n' |] |> removeSpaces
+ ToolTip(formatLines lines)
+
+ /// Creates a tool tip - returns 'None' if it contains no data
+ static member TryCreate(tip:DataTipText) =
+ match tip with
+ | DataTipText(elems)
+ when elems |> List.forall (function
+ DataTipElementNone -> true | _ -> false) -> None
+ | _ ->
+ // Format the tool tip as a HTML
+ let lines = (TipFormatter.formatTip tip).Split([| '\n' |])
+ let str = formatLines lines
+ Some(ToolTip(str))
+
+
+/// Stores information about a single token (including tip & color)
+type TokenInfo =
+ { Token : TokenInformation
+ Text : string
+ Color : string option
+ Tip : ToolTip option }
+
+
+/// Stores information about line in the source code
+type LineInfo =
+ { Index : int
+ LineNumber : int
+ Tokens : TokenInfo list }
+
+/// Stores information about source code snippet
+type SnippetInfo =
+ { Lines : LineInfo list
+ Title : string }
+
+/// Represents information about error message
+type ErrorInfo =
+ { StartColumn : int
+ StartLine : int
+ EndColumn : int
+ EndLine : int
+ IsError : bool
+ Message : string }
+
+// --------------------------------------------------------------------------------------
+// Main type that implements parsing and uses F# services
+// --------------------------------------------------------------------------------------
+
+/// Parses the specified file using F# compiler (by calling 'TokenizeSource'),
+/// performs type checking (using 'RunTypeCheck') and then creates information
+/// for the formatter (using 'ProcessSourceTokens')
+// [snippet:Async]
+type SourceFile(file, source, lines:string[], ?options, ?defines) =
+ (*[omit:(construction of interactive checker and compiler options omitted)]*)
+
+ // Create an instance of an InteractiveChecker (which does background analysis
+ // in a typical IntelliSense editor integration for F#)
+ let checker = InteractiveChecker.Create(ignore)
+ // Get options for a standalone script file (this adds some
+ // default references and doesn't require full project information)
+ let opts = checker.GetCheckOptionsFromScriptRoot(file, source)
+
+ // Print additional information for debugging
+ let trace = false
+
+ // Parse command line options - split string by space, but if there is something
+ // enclosed in double quotes "..." then ignore spaces in the quoted text
+ let rec parseOptions (str:string) i opts current =
+ let opts =
+ if i < str.Length && str.[i] <> ' ' then opts
+ else (String(current |> List.rev |> Array.ofSeq))::opts
+ if i = str.Length then opts
+ elif str.[i] = ' ' then parseOptions str (i+1) opts []
+ elif str.[i] = '"' then
+ let endp = str.IndexOf('"', i+1)
+ let chars = str.Substring(i+1, endp - i - 1) |> List.ofSeq |> List.rev
+ parseOptions str (endp + 1) opts (chars @ current)
+ else parseOptions str (i + 1) opts (str.[i] :: current)
+
+ // Override default options if the user specified something
+ let opts =
+ match options with
+ | Some(str:string) when not(String.IsNullOrEmpty(str)) ->
+ opts.WithProjectOptions(parseOptions str 0 [] [] |> Array.ofSeq)
+ | _ -> opts
+
+ // Run first parsing phase - parse source into AST without type information
+ let untypedInfo = checker.UntypedParse(file, source, opts)
+
+ // Creates an empty "Identifier" token (we need it when getting ToolTip)
+ let identToken = 179 // 179 in 4.3, 176 in 4.0, 178 in joinads(*[/omit]*)
+
+ /// Type-checking takes some time and doesn't return information on the
+ /// first call, so this function creates workflow that tries repeatedly
+ let rec getTypeCheckInfo() = async {
+ let obs = IsResultObsolete(fun () -> false)
+ let info = checker.TypeCheckSource(untypedInfo, file, 0, source, opts, obs)
+ match info with
+ | TypeCheckSucceeded(res) when res.TypeCheckInfo.IsSome ->
+ let errs = (*[omit:(copying of errors omitted)]*)
+ seq { for e in res.Errors ->
+ { StartColumn = e.StartColumn; StartLine = e.StartLine
+ Message = e.Message; IsError = e.Severity = Error
+ EndColumn = e.EndColumn; EndLine = e.EndLine } }(*[/omit]*)
+ return res.TypeCheckInfo.Value, errs
+ | _ ->
+ do! Async.Sleep(500)
+ return! getTypeCheckInfo() }
+
+ /// Runs type checking and allows specifying a timeout
+ member x.RunTypeCheck(?timeout) =
+ Async.RunSynchronously(getTypeCheckInfo(), ?timeout = timeout)
+// [/snippet]
+
+ /// Parse source file into a list of lines consisting of tokens
+ member x.TokenizeSource() =
+ let defines = defines |> Option.map (fun (s:string) ->
+ s.Split([| ' '; ';'; ',' |], StringSplitOptions.RemoveEmptyEntries) |> List.ofSeq)
+ let sourceTok = SourceTokenizer(defaultArg defines [], file)
+ [ let state = ref 0L
+ for n, line in lines |> Seq.zip [ 0 .. lines.Length ] do
+ let tokenizer = sourceTok.CreateLineTokenizer(line)
+ tokenizer.StartNewLine()
+ let rec parseLine() = seq {
+ match tokenizer.ScanToken(!state) with
+ | Some(tok), nstate ->
+ let str = line.Substring(tok.LeftColumn, tok.RightColumn - tok.LeftColumn + 1)
+ yield str, tok
+ state := nstate
+ yield! parseLine()
+ | None, nstate -> state := nstate }
+ yield n, parseLine() |> List.ofSeq ]
+
+ /// When type-checking completes and we have a parsed file (as tokens), we can
+ /// put the information together - this processes tokens and adds information such
+ /// as color and tool tips (for identifiers)
+ member x.ProcessSourceTokens(checkInfo:TypeCheckInfo, source) =
+
+ // Process "omit" meta-comments in the source
+ let source = shrinkOmittedParts source |> List.ofSeq
+
+ // Split source into snippets if it contains meta-comments
+ let snippets =
+ match getSnippets None [] source lines with
+ | [] -> ["Untitled", source]
+ | snippets -> snippets |> List.rev
+
+ let processSnippet source = [
+ for i, (line, lineTokens) in source |> List.zip [ 1 .. source.Length ] do
+ // Recursive processing of tokens on the line (keeps a long identifier 'island')
+ // [snippet:line]
+ let rec processLine island tokens = seq {
+ match tokens with
+ | [] -> ()
+ | (str, (tok:TokenInformation))::rest ->
+ (*[omit:(updating of long identifier information omitted)]*)
+ // Update the current identifier island
+ // (long identifier e.g. Collections.List.map)
+ let island =
+ match tok.TokenName with
+ | "DOT" -> island // keep what we have found so far
+ | "IDENT" -> str::island // add current identifier
+ | _ -> [] // drop everything - not in island
+ (*[/omit]*)
+ let tip =
+ // If we're processing an identfier, see if it has any tool tip
+ if (tok.TokenName = "IDENT") then
+ let island = island |> List.rev
+ let pos = (line, tok.LeftColumn + 1)
+ let tip = checkInfo.GetDataTipText(pos, lines.[line], island, identToken)
+ match ToolTip.TryCreate(tip) with
+ | Some(_) as res -> res
+ | _ when island.Length > 1 -> (*[omit:(alternative attempt omitted)]*)
+ // Try to find some information about the last part of the identifier
+ let pos = (line, tok.LeftColumn + 2)
+ let tip = checkInfo.GetDataTipText(pos, lines.[line], [ str ], identToken)
+ ToolTip.TryCreate(tip)(*[/omit]*)
+ | _ -> None
+ elif tok.TokenName.StartsWith("OMIT") then (*[omit:(...)]*)
+ // Special omit tag - add tool tip stored in token name
+ Some(ToolTip.FromString(tok.TokenName.Substring(4)))(*[/omit]*)
+ else None
+
+ // Find color for the current token
+ let color =
+ if tok.TokenName = "FSI" then Some("fsi")
+ elif tok.TokenName.StartsWith("OMIT") then Some("omitted")
+ else Colors.colorMap.TryFind(tok.ColorClass)
+ // Return all information about token and continue
+ yield { Token = tok; Text = str; Color = color; Tip = tip }
+ yield! processLine island rest }
+ // [/snippet]
+
+ // Process the current line & return info about it
+ let lineInfos = processLine [] (List.ofSeq lineTokens) |> List.ofSeq
+ yield { Index = i; LineNumber = line; Tokens = lineInfos } ]
+
+ // Generate a list of snippets
+ [ for title, lines in snippets do
+ // Print debug information
+
+ if trace then printfn "\n\n\n%A" lines
+ // Count the minimal number of spaces at the beginning of lines
+ // (so that we can remove spaces for indented text)
+ let spaces =
+ [ for l, (toks:_ list) in lines do
+ match toks with
+ | ((text:string), info)::_ when info.TokenName = "WHITESPACE" ->
+ yield text.Length - text.TrimStart([| ' ' |]).Length
+ | [] -> ()
+ | _ -> yield 0 ] |> Seq.min
+
+ // Process the current snippet
+ let res = processSnippet lines
+
+ // Remove additional whitespace from start of lines
+ let res =
+ [ for line in res do
+ match line.Tokens with
+ | first::rest ->
+ let tokens = { first with Text = first.Text.Substring(spaces) }::rest
+ yield { line with Tokens = tokens }
+ | _ -> yield line ]
+ yield { Title = title; Lines = res } ]
View
90 src/FSharp.CodeFormat/ToolTipReader.fs
@@ -0,0 +1,90 @@
+// --------------------------------------------------------------------------------------
+// F# CodeFormat (ToolTipReader.fs)
+// (c) Tomas Petricek, 2012, Available under Apache 2.0 license.
+// --------------------------------------------------------------------------------------
+module private FSharp.CodeFormat.ToolTipReader
+
+open System
+open System.IO
+open System.Text
+open System.Web
+
+open FSharp.Collections
+
+open Microsoft.FSharp.Compiler
+open Microsoft.FSharp.Compiler.SourceCodeServices
+
+// --------------------------------------------------------------------------------------
+// Implements formatting of tool tips
+// --------------------------------------------------------------------------------------
+
+/// Turn string into a sequence of lines interleaved with line breaks
+let formatMultilineString (s:string) =
+ [ for line in s.Split('\n') do
+ yield HardLineBreak
+ yield Literal line ]
+ |> List.tail
+
+/// Format comment in the tool tip
+let private formatComment = function
+ | XmlCommentText(s) ->
+ [ Emphasis (formatMultilineString s)
+ HardLineBreak ]
+ | _ ->
+ // TODO: For 'XmlCommentSignature' we could get documentation
+ // from 'xml' files, but we don't know where to get them...
+ []
+
+/// Format the element of a tool tip (comment, overloads, etc.)
+let private formatElement = function
+ | DataTipElementNone -> []
+ | DataTipElement(it, comment) ->
+ [ yield! formatMultilineString it
+ yield HardLineBreak
+ yield! formatComment comment ]
+ | DataTipElementGroup(items) ->
+ // Trim the items to at most 10 displayed in a tool tip
+ let items, trimmed =
+ if items.Length <= 10 then items, false
+ else items |> Seq.take 10 |> List.ofSeq, true
+ [ for (it, comment) in items do
+ yield! formatMultilineString it
+ yield HardLineBreak
+ yield! formatComment comment
+
+ // Add note with the number of omitted overloads
+ if trimmed then
+ let msg = sprintf "(+%d other overloads)" (items.Length - 10)
+ yield Literal " "
+ yield Emphasis [Literal (msg) ]
+ yield HardLineBreak ]
+
+ | DataTipElementCompositionError(err) -> []
+
+/// Format entire tool tip as a value of type ToolTipSpans
+let private formatTip tip =
+ let spans =
+ match tip with
+ | DataTipText([single]) -> formatElement single
+ | DataTipText(items) ->
+ [ yield Literal "Multiple items"
+ yield HardLineBreak
+ for first, item in Seq.mapi (fun i it -> i = 0, it) items do
+ if not first then
+ yield HardLineBreak
+ yield Literal "--------------------"
+ yield HardLineBreak
+ yield! formatElement item ]
+
+ // Remove unnecessary line breaks
+ spans
+ |> List.skipWhile ((=) HardLineBreak) |> List.rev
+ |> List.skipWhile ((=) HardLineBreak) |> List.rev
+
+/// Format a tool tip, but first make sure that there is actually
+/// some text in the tip. Returns None if no information is available
+let tryFormatTip = function
+ | DataTipText(elems)
+ when elems |> List.forall (function
+ DataTipElementNone -> true | _ -> false) -> None
+ | tip -> Some(formatTip tip)
View
63 src/FSharp.CodeFormat/files/style.css
@@ -0,0 +1,63 @@
+pre.fssnip
+{
+ background:#f0f0f0;
+ font-family:consolas, monaco,'Lucida Console',monospace;
+ font-size:80%;
+ padding:10px;
+ margin:10px 5px 10px 5px;
+ position:relative;
+}
+
+/* identifier */
+span.i { color:#000000; }
+/* comment */
+span.c { color:#008000; }
+/* inactive code */
+span.inactive { color:#808080; }
+/* keywords */
+span.k { color:#000080; }
+/* numbers */
+span.n { color:#008000; }
+/* operators */
+span.o { color:#800080; }
+/* preprocessor */
+span.prep { color:#800080; }
+/* string */
+span.s { color:#808000; }
+/* line number */
+span.l { color:#80b0b0; }
+/* fsi output */
+span.fsi { font-style:italic; color:#606060; }
+/* omitted */
+span.omitted {
+ border:solid 1px #d8d8d8;
+ color:#808080;
+ padding:0px 0px 1px 0px;
+ background:#fafafa;
+}
+span.cerr {
+ background:url(tilde.png) repeat-x left bottom;
+}
+
+div.tip
+{
+ font:8pt calibri;
+ padding:3px;
+ border:1px solid #606060;
+ background:#ffffd0;
+ display:none;
+}
+
+h2
+{
+ font:bold 16pt 'calibri';
+}
+
+pre a.fssniplink
+{
+ font:bold 7.5pt calibry, arial, verdana;
+ position:absolute;
+ bottom:0.3em;
+ right:0.3em;
+ color:#a8a8a8;
+}
View
BIN  src/FSharp.CodeFormat/files/tilde.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
51 src/FSharp.CodeFormat/files/tips.js
@@ -0,0 +1,51 @@
+var currentTip = null;
+var currentTipElement = null;
+
+function hideTip(evt, name, unique)
+{
+ var el = document.getElementById(name);
+ el.style.display = "none";
+ currentTip = null;
+}
+
+function findPos(obj)
+{
+ // no idea why, but it behaves differently in webbrowser component
+ if (window.location.search == "?inapp")
+ return [obj.offsetLeft + 10, obj.offsetTop + 30];
+
+ var curleft = 0;
+ var curtop = obj.offsetHeight;
+ while (obj)
+ {
+ curleft += obj.offsetLeft;
+ curtop += obj.offsetTop;
+ obj = obj.offsetParent;
+ };
+ return [curleft, curtop];
+}
+
+function hideUsingEsc(e)
+{
+ if (!e) { e = event; }
+ hideTip(e, currentTipElement, currentTip);
+}
+
+function showTip(evt, name, unique, owner)
+{
+ document.onkeydown = hideUsingEsc;
+ if (currentTip == unique) return;
+ currentTip = unique;
+ currentTipElement = name;
+
+ var pos = findPos(owner ? owner : (evt.srcElement ? evt.srcElement : evt.target));
+ var posx = pos[0];
+ var posy = pos[1];
+
+ var el = document.getElementById(name);
+ var parent = (document.documentElement == null) ? document.body : document.documentElement;
+ el.style.position = "absolute";
+ el.style.left = posx + "px";
+ el.style.top = posy + "px";
+ el.style.display = "block";
+}
View
11 src/FSharp.Markdown.sln → src/FSharp.Formatting.sln
@@ -5,6 +5,13 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Markdown", "FSharp.M
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Markdown.Tests", "FSharp.Markdown.Tests\FSharp.Markdown.Tests.fsproj", "{07DE4905-050C-4378-A039-F1EF7E1F309D}"
EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.CodeFormat", "FSharp.CodeFormat\FSharp.CodeFormat.fsproj", "{341EBF32-D470-4C55-99E9-55F14F7FFBB1}"
+EndProject
+Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "FSharp.CodeFormat.Tests", "FSharp.CodeFormat.Tests", "{D8986C46-42E0-4087-9A07-131163119BC6}"
+ ProjectSection(SolutionItems) = preProject
+ FSharp.CodeFormat.Tests\Script.fsx = FSharp.CodeFormat.Tests\Script.fsx
+ EndProjectSection
+EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|x86 = Debug|x86
@@ -19,6 +26,10 @@ Global
{07DE4905-050C-4378-A039-F1EF7E1F309D}.Debug|x86.Build.0 = Debug|x86
{07DE4905-050C-4378-A039-F1EF7E1F309D}.Release|x86.ActiveCfg = Release|x86
{07DE4905-050C-4378-A039-F1EF7E1F309D}.Release|x86.Build.0 = Release|x86
+ {341EBF32-D470-4C55-99E9-55F14F7FFBB1}.Debug|x86.ActiveCfg = Debug|x86
+ {341EBF32-D470-4C55-99E9-55F14F7FFBB1}.Debug|x86.Build.0 = Debug|x86
+ {341EBF32-D470-4C55-99E9-55F14F7FFBB1}.Release|x86.ActiveCfg = Release|x86
+ {341EBF32-D470-4C55-99E9-55F14F7FFBB1}.Release|x86.Build.0 = Release|x86
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
View
7 src/FSharp.Markdown/FSharp.Markdown.fsproj
@@ -10,7 +10,8 @@
<RootNamespace>FSharp.Markdown</RootNamespace>
<AssemblyName>FSharp.Markdown</AssemblyName>
<TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
- <TargetFrameworkProfile>Client</TargetFrameworkProfile>
+ <TargetFrameworkProfile>
+ </TargetFrameworkProfile>
<Name>FSharp.Markdown</Name>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|x86' ">
@@ -42,8 +43,8 @@
<Reference Include="System.Numerics" />
</ItemGroup>
<ItemGroup>
- <Compile Include="Collections.fs" />
- <Compile Include="StringParsing.fs" />
+ <Compile Include="..\FSharpX\Collections.fs" />
+ <Compile Include="..\FSharpX\StringParsing.fs" />
<Compile Include="Markdown.fs" />
<Compile Include="MarkdownParser.fs" />
<Compile Include="HtmlFormatting.fs" />
View
1  src/FSharp.Markdown/HtmlFormatting.fs
@@ -144,7 +144,6 @@ let rec formatParagraph (ctx:FormattingContext) paragraph =
formatSpans ctx spans
| HtmlBlock(code) ->
ctx.Writer.Write(code)
- | Unknown -> ()
ctx.LineBreak()
/// Write a list of MarkdownParagrpah values to a TextWriter
View
24 src/FSharp.Markdown/Main.fs
@@ -84,4 +84,26 @@ type Markdown =
/// The result will be returned as a string.
static member TransformHtml(text) =
Markdown.TransformHtml(text, Environment.NewLine)
-
+
+ /// Transform the provided MakrdownDocument into HTML
+ /// format and write the result to a given writer.
+ static member WriteHtml(doc:MarkdownDocument, writer, newline) =
+ formatMarkdown writer newline doc.DefinedLinks doc.Paragraphs
+
+ /// Transform the provided MakrdownDocument into HTML
+ /// format and return the result as a string.
+ static member WriteHtml(doc:MarkdownDocument, newline) =
+ let sb = new System.Text.StringBuilder()
+ use wr = new StringWriter(sb)
+ Markdown.WriteHtml(doc, wr, newline)
+ sb.ToString()
+
+ /// Transform the provided MakrdownDocument into HTML
+ /// format and return the result as a string.
+ static member WriteHtml(doc:MarkdownDocument) =
+ Markdown.WriteHtml(doc, Environment.NewLine)
+
+ /// Transform the provided MakrdownDocument into HTML
+ /// format and write the result to a given writer.
+ static member WriteHtml(doc:MarkdownDocument, writer) =
+ Markdown.WriteHtml(doc, writer, Environment.NewLine)
View
68 src/FSharp.Markdown/Markdown.fs
@@ -39,6 +39,70 @@ type MarkdownParagrph =
| QuotedBlock of MarkdownParagrphs
| Span of MarkdownSpans
| HorizontalRule
- | Unknown
-and MarkdownParagrphs = list<MarkdownParagrph>
+and MarkdownParagrphs = list<MarkdownParagrph>
+
+// --------------------------------------------------------------------------------------
+// Patterns that make recursive Markdown processing easier
+// --------------------------------------------------------------------------------------
+
+module Matching =
+ type SpanLeafInfo = private SL of MarkdownSpan
+ type SpanNodeInfo = private SN of MarkdownSpan
+
+ let (|SpanLeaf|SpanNode|) span =
+ match span with
+ | Literal _
+ | InlineCode _
+ | DirectImage _
+ | IndirectImage _
+ | HardLineBreak ->
+ SpanLeaf(SL span)
+ | Strong spans
+ | Emphasis spans
+ | DirectLink(spans, _)
+ | IndirectLink(spans, _, _) ->
+ SpanNode(SN span, spans)
+
+ let SpanLeaf (SL(span)) = span
+ let SpanNode (SN(span), spans) =
+ match span with
+ | Strong _ -> Strong spans
+ | Emphasis _ -> Emphasis spans
+ | DirectLink(_, a) -> DirectLink(spans, a)
+ | IndirectLink(_, a, b) -> IndirectLink(spans, a, b)
+ | _ -> invalidArg "" "Incorrect SpanNodeInfo"
+
+ type ParagraphSpansInfo = private PS of MarkdownParagrph
+ type ParagraphLeafInfo = private PL of MarkdownParagrph
+ type ParagraphNestedInfo = private PN of MarkdownParagrph
+
+ let (|ParagraphLeaf|ParagraphNested|ParagraphSpans|) par =
+ match par with
+ | Heading(_, spans)
+ | Paragraph(spans)
+ | Span(spans) ->
+ ParagraphSpans(PS par, spans)
+ | CodeBlock _
+ | HtmlBlock _
+ | HorizontalRule ->
+ ParagraphLeaf(PL par)
+ | ListBlock(_, pars) ->
+ ParagraphNested(PN par, pars)
+ | QuotedBlock(nested) ->
+ ParagraphNested(PN par, [nested])
+
+ let ParagraphSpans (PS(par), spans) =
+ match par with
+ | Heading(a, _) -> Heading(a, spans)
+ | Paragraph(_) -> Paragraph(spans)
+ | Span(_) -> Span(spans)
+ | _ -> invalidArg "" "Incorrect ParagraphSpansInfo."
+
+ let ParagraphLeaf (PL(par)) = par
+
+ let ParagraphNested (PN(par), pars) =
+ match par with
+ | ListBlock(a, _) -> ListBlock(a, pars)
+ | QuotedBlock(_) -> QuotedBlock(List.concat pars)
+ | _ -> invalidArg "" "Incorrect ParagraphNestedInfo."
View
0  src/FSharp.Markdown/Collections.fs → src/FSharpX/Collections.fs
File renamed without changes
View
20 src/FSharp.Markdown/StringParsing.fs → src/FSharpX/StringParsing.fs
@@ -42,7 +42,25 @@ module String =
if starts |> Seq.exists (text.StartsWith) then Some() else None
/// Matches when a string starts with the specified sub-string
let (|StartsWith|_|) (start:string) (text:string) =
- if text.StartsWith(start) then Some() else None
+ if text.StartsWith(start) then Some(text.Substring(start.Length)) else None
+ /// Matches when a string starts with the specified sub-string
+ /// The matched string is trimmed from all whitespace.
+ let (|StartsWithTrim|_|) (start:string) (text:string) =
+ if text.StartsWith(start) then Some(text.Substring(start.Length).Trim()) else None
+
+ /// Matches when a string starts with the given value and ends
+ /// with a given value (and returns the rest of it)
+ let (|StartsAndEndsWith|_|) (starts, ends) (s:string) =
+ if s.StartsWith(starts) && s.EndsWith(ends) &&
+ s.Length >= starts.Length + ends.Length then
+ Some(s.Substring(starts.Length, s.Length - starts.Length - ends.Length))
+ else None
+
+ /// Matches when a string starts with the given value and ends
+ /// with a given value (and returns trimmed body)
+ let (|StartsAndEndsWithTrim|_|) args = function
+ | StartsAndEndsWith args (TrimBoth res) -> Some res
+ | _ -> None
/// Matches when a string starts with a non-zero number of complete
/// repetitions of the specified parameter (and returns the number
Please sign in to comment.
Something went wrong with that request. Please try again.