Workspace peek

paket.dependencies

@@ -5,6 +5,7 @@ nuget Argu 3.7
 nuget FSharp.Compiler.Service 11.0.9 framework: >= net45
 nuget FSharp.Compiler.Service.ProjectCracker 11.0.9
 nuget Dotnet.ProjInfo 0.7.4
+nuget Sln 0.2.0
 nuget Mono.Cecil
 nuget NDesk.Options
 nuget Newtonsoft.Json

paket.lock

@@ -41,6 +41,7 @@ NUGET
       NUnit.Extension.TeamCityEventListener (>= 1.0.2)
       NUnit.Extension.VSProjectLoader (>= 3.5)
     Octokit (0.24)
+    Sln (0.2)
     Suave (1.1.3)
       FSharp.Core (>= 3.1.2.5)
     System.Collections.Concurrent (4.3)

src/FsAutoComplete.Core/CommandResponse.fs

@@ -295,6 +295,42 @@ module CommandResponse =
     Parameters : Parameter list list
   }
 
+  type WorkspacePeekResponse = {
+    Found: WorkspacePeekFound list
+  }
+  and WorkspacePeekFound =
+    | Directory of WorkspacePeekFoundDirectory
+    | Solution of WorkspacePeekFoundSolution
+  and WorkspacePeekFoundDirectory = {
+    Directory: string
+    Fsprojs: string list
+  }
+  and WorkspacePeekFoundSolution = {
+    Path: string
+    Items: WorkspacePeekFoundSolutionItem list
+    Configurations: WorkspacePeekFoundSolutionConfiguration list
+  }
+  and [<RequireQualifiedAccess>] WorkspacePeekFoundSolutionItem = {
+    Guid: Guid
+    Name: string
+    Kind: WorkspacePeekFoundSolutionItemKind
+  }
+  and WorkspacePeekFoundSolutionItemKind =
+    | MsbuildFormat of WorkspacePeekFoundSolutionItemKindMsbuildFormat
+    | Folder of WorkspacePeekFoundSolutionItemKindFolder
+  and [<RequireQualifiedAccess>] WorkspacePeekFoundSolutionItemKindMsbuildFormat = {
+    Configurations: WorkspacePeekFoundSolutionConfiguration list
+  }
+  and [<RequireQualifiedAccess>] WorkspacePeekFoundSolutionItemKindFolder = {
+    Items: WorkspacePeekFoundSolutionItem list
+    Files: FilePath list
+  }
+  and [<RequireQualifiedAccess>] WorkspacePeekFoundSolutionConfiguration = {
+    Id: string
+    ConfigurationName: string
+    PlatformName: string
+  }
+
   let info (serialize : Serializer) (s: string) = serialize { Kind = "info"; Data = s }
 
   let errorG (serialize : Serializer) (errorData: ErrorData) message =
@@ -350,6 +386,36 @@ module CommandResponse =
     | GenericError errorMessage -> error serialize errorMessage //compatibility with old api
     | ProjectNotRestored project -> errorG serialize (ErrorData.ProjectNotRestored { Project = project }) "Project not restored"
 
+  let workspacePeek (serialize : Serializer) (found: FsAutoComplete.WorkspacePeek.Interesting list) =
+    let mapInt i =
+        match i with
+        | FsAutoComplete.WorkspacePeek.Interesting.Directory (p, fsprojs) ->
+            WorkspacePeekFound.Directory { WorkspacePeekFoundDirectory.Directory = p; Fsprojs = fsprojs }
+        | FsAutoComplete.WorkspacePeek.Interesting.Solution (p, sd) ->
+            let rec item (x: FsAutoComplete.WorkspacePeek.SolutionItem) =
+                let kind =
+                    match x.Kind with
+                    | FsAutoComplete.WorkspacePeek.SolutionItemKind.Unknown
+                    | FsAutoComplete.WorkspacePeek.SolutionItemKind.Unsupported ->
+                        None
+                    | FsAutoComplete.WorkspacePeek.SolutionItemKind.MsbuildFormat msbuildProj ->
+                        Some (WorkspacePeekFoundSolutionItemKind.MsbuildFormat { 
+                            WorkspacePeekFoundSolutionItemKindMsbuildFormat.Configurations = [] 
+                        })
+                    | FsAutoComplete.WorkspacePeek.SolutionItemKind.Folder(children, files) ->
+                        let c = children |> List.choose item
+                        Some (WorkspacePeekFoundSolutionItemKind.Folder { 
+                            WorkspacePeekFoundSolutionItemKindFolder.Items = c
+                            Files = files
+                        })
+                kind
+                |> Option.map (fun k -> { WorkspacePeekFoundSolutionItem.Guid = x.Guid; Name = x.Name; Kind = k })
+            let items = sd.Items |> List.choose item
+            WorkspacePeekFound.Solution { WorkspacePeekFoundSolution.Path = p; Items = items; Configurations = [] }
+
+    let data = { WorkspacePeekResponse.Found = found |> List.map mapInt }
+    serialize { Kind = "workspacePeek"; Data = data }
+
   let completion (serialize : Serializer) (decls: FSharpDeclarationListItem[]) includeKeywords =
       serialize {  Kind = "completion"
                    Data = [ for d in decls do

src/FsAutoComplete.Core/Commands.fs

@@ -396,3 +396,9 @@ type Commands (serialize : Serializer) =
         else
             return [Response.info serialize "Union at position not found"]
     }
+
+    member __.WorkspacePeek (dir: string) (deep: int) (excludedDirs: string list) = async {
+        let d = WorkspacePeek.peek dir deep excludedDirs
+
+        return [Response.workspacePeek serialize d]
+    }

src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj

@@ -56,6 +56,7 @@
     <Compile Include="AssemblyContentProvider.fs" />
     <Compile Include="UnopenedNamespacesResolver.fs" />
     <Compile Include="CompilerServiceInterface.fs" />
+    <Compile Include="Workspace.fs" />
     <Compile Include="CommandResponse.fs" />
     <Compile Include="Project.fs" />
     <Compile Include="State.fs" />
@@ -174,6 +175,17 @@
       </ItemGroup>
     </When>
   </Choose>
+  <Choose>
+    <When Condition="$(TargetFrameworkIdentifier) == '.NETFramework' And $(TargetFrameworkVersion) == 'v4.5'">
+      <ItemGroup>
+        <Reference Include="Sln">
+          <HintPath>..\..\packages\Sln\lib\net45\Sln.dll</HintPath>
+          <Private>True</Private>
+          <Paket>True</Paket>
+        </Reference>
+      </ItemGroup>
+    </When>
+  </Choose>
   <Choose>
     <When Condition="$(TargetFrameworkIdentifier) == '.NETFramework' And $(TargetFrameworkVersion) == 'v4.5'">
       <ItemGroup>

src/FsAutoComplete.Core/Workspace.fs

@@ -0,0 +1,166 @@
+module FsAutoComplete.WorkspacePeek
+
+open System
+open System.IO
+
+type SolutionData = {
+    Items: SolutionItem list
+    Configurations: SolutionConfiguration list
+    }
+and SolutionConfiguration = {
+    Id: string
+    ConfigurationName: string
+    PlatformName: string
+    IncludeInBuild: bool
+    }
+and SolutionItem = {
+    Guid: Guid
+    Name: string
+    Kind: SolutionItemKind
+    }
+and SolutionItemKind =
+    | MsbuildFormat of SolutionItemMsbuildConfiguration list
+    | Folder of (SolutionItem list) * (string list)
+    | Unsupported
+    | Unknown
+and SolutionItemMsbuildConfiguration = {
+    Id: string
+    ConfigurationName: string
+    PlatformName: string
+    }
+
+[<RequireQualifiedAccess>]
+type Interesting =
+| Solution of string * SolutionData
+| Directory of string * string list
+
+let tryParseSln slnFilePath = 
+    let parseSln (sln: Microsoft.Build.Construction.SolutionFile) =
+        let slnDir = Path.GetDirectoryName slnFilePath
+        let makeAbsoluteFromSlnDir =
+            let makeAbs path =
+                if Path.IsPathRooted path then
+                    path
+                else
+                    Path.Combine(slnDir, path)
+                    |> Path.GetFullPath
+            Utils.normalizeDirSeparators >> makeAbs
+        let rec parseItem (item: Microsoft.Build.Construction.ProjectInSolution) =
+            let parseKind (item: Microsoft.Build.Construction.ProjectInSolution) =
+                match item.ProjectType with
+                | Microsoft.Build.Construction.SolutionProjectType.KnownToBeMSBuildFormat ->
+                    (item.RelativePath |> makeAbsoluteFromSlnDir), SolutionItemKind.MsbuildFormat []
+                | Microsoft.Build.Construction.SolutionProjectType.SolutionFolder ->
+                    let children =
+                        sln.ProjectsInOrder
+                        |> Seq.filter (fun x -> x.ParentProjectGuid = item.ProjectGuid)
+                        |> Seq.map parseItem
+                        |> List.ofSeq
+                    let files =
+                        item.FolderFiles
+                        |> Seq.map makeAbsoluteFromSlnDir
+                        |> List.ofSeq
+                    item.ProjectName, SolutionItemKind.Folder (children, files)
+                | Microsoft.Build.Construction.SolutionProjectType.EtpSubProject
+                | Microsoft.Build.Construction.SolutionProjectType.WebDeploymentProject
+                | Microsoft.Build.Construction.SolutionProjectType.WebProject ->
+                    (item.ProjectName |> makeAbsoluteFromSlnDir), SolutionItemKind.Unsupported
+                | Microsoft.Build.Construction.SolutionProjectType.Unknown
+                | _ ->
+                    (item.ProjectName |> makeAbsoluteFromSlnDir), SolutionItemKind.Unknown
+
+            let name, itemKind = parseKind item 
+            { Guid = item.ProjectGuid |> Guid.Parse
+              Name = name
+              Kind = itemKind }
+
+        let items =
+            sln.ProjectsInOrder
+            |> Seq.filter (fun x -> isNull x.ParentProjectGuid)
+            |> Seq.map parseItem
+        let data = {
+            Items = items |> List.ofSeq
+            Configurations = []
+        }
+        (slnFilePath, data)
+
+    let slnFile =
+        try
+            Microsoft.Build.Construction.SolutionFile.Parse(slnFilePath)
+            |> Some
+        with _ ->
+            None
+
+    slnFile
+    |> Option.map parseSln
+
+open System.IO
+
+type private UsefulFile =
+    | FsProj
+    | Sln
+    | Fsx
+
+let private partitionByChoice3 =
+    let foldBy (a, b, c) t =
+        match t with
+        | Choice1Of3 x -> (x :: a, b, c)
+        | Choice2Of3 x -> (a, x :: b, c)
+        | Choice3Of3 x -> (a, b, x :: c)
+    Array.fold foldBy ([],[],[])
+
+let peek (rootDir: string) deep (excludedDirs: string list) =
+    let dirInfo = DirectoryInfo(rootDir)
+
+    //TODO accept glob list to ignore
+    let ignored =
+        let normalizedDirs = excludedDirs |> List.map (fun s -> s.ToUpperInvariant()) |> Array.ofList
+        (fun (s: string) -> normalizedDirs |> Array.contains (s.ToUpperInvariant()))
+
+    let scanDir (dirInfo: DirectoryInfo) =
+        let hasExt ext (s: FileInfo) = s.FullName.EndsWith(ext)
+        dirInfo.EnumerateFiles("*.*", SearchOption.TopDirectoryOnly)
+        |> Seq.choose (fun s ->
+            match s with
+            | x when x |> hasExt ".sln" -> Some (UsefulFile.Sln, x)
+            | x when x |> hasExt ".fsx" -> Some (UsefulFile.Fsx, x)
+            | x when x |> hasExt ".fsproj" -> Some (UsefulFile.FsProj, x)
+            | _ -> None)
+        |> Seq.toArray
+
+    let dirs =
+        let rec scanDirs (dirInfo: DirectoryInfo) lvl =
+            seq {
+                if lvl <= deep then
+                    yield dirInfo
+                    for s in dirInfo.GetDirectories() do
+                        if not(ignored s.Name) then
+                            yield! scanDirs s (lvl + 1)
+            }
+
+        scanDirs dirInfo 0
+        |> Array.ofSeq
+
+    let getInfo (t, (f: FileInfo)) =
+        match t with
+        | UsefulFile.Sln ->
+            tryParseSln f.FullName
+            |> Option.map Choice1Of3
+        | UsefulFile.Fsx ->
+            Some (Choice2Of3 (f.FullName))
+        | UsefulFile.FsProj ->
+            Some (Choice3Of3 (f.FullName))
+
+    let found =
+        dirs
+        |> Array.Parallel.collect scanDir
+        |> Array.Parallel.choose getInfo
+
+    let slns, _fsxs, fsprojs =
+        found |> partitionByChoice3
+
+    //TODO weight order of fsprojs from sln
+    let dir = rootDir, (fsprojs |> List.sort)
+
+    [ yield! slns |> List.map Interesting.Solution
+      yield dir |> Interesting.Directory ]

src/FsAutoComplete.Core/paket.references

@@ -1,5 +1,6 @@
 FSharp.Compiler.Service.ProjectCracker
 FSharp.Compiler.Service
 FSharpLint.Core
+Sln
 Dotnet.ProjInfo
-Newtonsoft.Json
+Newtonsoft.Json

src/FsAutoComplete.Suave/FsAutoComplete.Suave.fs

@@ -24,6 +24,7 @@ module Contract =
     type CompletionRequest = {FileName : string; SourceLine : string; Line : int; Column : int; Filter : string; IncludeKeywords : bool;}
     type PositionRequest = {FileName : string; Line : int; Column : int; Filter : string}
     type LintRequest = {FileName : string}
+    type WorkspacePeekRequest = {Directory : string; Deep: int; ExcludedDirs: string array}
 
 [<AutoOpen>]
 module internal Utils =
@@ -183,6 +184,7 @@ let main argv =
             path "/lint" >=> handler (fun (data: LintRequest) -> commands.Lint data.FileName)
             path "/namespaces" >=> positionHandler (fun data tyRes lineStr _   -> commands.GetNamespaceSuggestions tyRes { Line = data.Line; Col = data.Column } lineStr)
             path "/unionCaseGenerator" >=> positionHandler (fun data tyRes lineStr lines   -> commands.GetUnionPatternMatchCases tyRes { Line = data.Line; Col = data.Column } lines lineStr)
+            path "/workspacePeek" >=> handler (fun (data : WorkspacePeekRequest) -> commands.WorkspacePeek data.Directory data.Deep (data.ExcludedDirs |> List.ofArray))
         ]
 
     let main (args: ParseResults<CLIArguments>) =

src/FsAutoComplete/CommandInput.fs

@@ -29,6 +29,7 @@ type Command =
   | Project of string * bool
   | Colorization of bool
   | CompilerLocation
+  | WorkspacePeek of string * int * string[]
   | Started
   | Quit
 
@@ -100,6 +101,18 @@ module CommandInput =
     return '"'
   }
 
+  // Parse 'parse "<filename>" [sync]' command
+  let workspacePeek =
+    parser {
+      let! _ = string "workspacepeek "
+      let! _ = char '"'
+      let! dir = some (sat ((<>) '"')) |> Parser.map String.OfSeq
+      let! _ = char '"'
+      let! _ = many (string " ")
+      let! deep = some digit |> Parser.map (String.OfSeq >> int)
+      let excludeDir = [| |]
+      return WorkspacePeek (dir, deep, excludeDir) }
+
   // Parse 'completion "<filename>" "<linestr>" <line> <col> [timeout]' command
   let completionTipOrDecl = parser {
     let! f = (string "completion " |> Parser.map (fun _ -> Completion)) <|>
@@ -156,7 +169,7 @@ module CommandInput =
     | null -> Quit
     | input ->
       let reader = Parsing.createForwardStringReader input 0
-      let cmds = compilerlocation <|> helptext <|> declarations <|> lint <|> parse <|> project <|> completionTipOrDecl <|> quit <|> colorizations <|> error
+      let cmds = compilerlocation <|> helptext <|> declarations <|> lint <|> parse <|> project <|> completionTipOrDecl <|> quit <|> colorizations <|> workspacePeek <|> error
       let cmd = reader |> Parsing.getFirst cmds
       match cmd with
       | Parse (filename,kind,_) ->