Skip to content

Commit

Permalink
Merge branch 'master' of github.com:fsharp/fsharpx
Browse files Browse the repository at this point in the history
  • Loading branch information
@forki
forki committed May 9, 2013
2 parents d3d7e6c + e9912d9 commit 0947db5
Show file tree
Hide file tree
Showing 6 changed files with 111 additions and 84 deletions.
123 changes: 57 additions & 66 deletions src/FSharpx.TypeProviders.Excel/ExcelProvider.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,37 +10,36 @@ open System.Collections.Generic

let ApplyMoveToRange (rg:Excel.Range) (move:Excel.XlDirection) = rg.Worksheet.Range(rg, rg.End(move))

let internal getRange (xlWorkBookInput : Excel.Workbook) sheetorrangename (headerRow : int) =
let mysheets = seq { for sheet in xlWorkBookInput.Worksheets do yield sheet :?> Excel.Worksheet }
let names = seq { for name in xlWorkBookInput.Names do yield name :?> Excel.Name}
let hasWs = Seq.exists (fun (ws:Excel.Worksheet) -> (ws.Name = sheetorrangename)) mysheets
if hasWs then
let sheet = Seq.find (fun (ws:Excel.Worksheet) -> (ws.Name = sheetorrangename)) mysheets
let firstcell = sheet.Cells.Item(box headerRow, 1) :?> Excel.Range
ApplyMoveToRange (ApplyMoveToRange firstcell Excel.XlDirection.xlToRight) Excel.XlDirection.xlDown
else
let hasName = Seq.exists (fun (ws:Excel.Name) -> (ws.Name = sheetorrangename)) names
if hasName then
(Seq.find (fun (ws:Excel.Name) -> (ws.Name = sheetorrangename)) names ).RefersToRange
else
failwith (sprintf "Sheet or range %A was not found" sheetorrangename)

// Simple type wrapping Excel data
type ExcelFileInternal(filename, sheetorrangename) =
type ExcelFileInternal(filename, sheetorrangename, headerRow : int) =
let data =
let xlApp = new Excel.ApplicationClass()
xlApp.Visible <- false
xlApp.ScreenUpdating <- false
xlApp.DisplayAlerts <- false;
let xlWorkBookInput = xlApp.Workbooks.Open(filename)



let mysheets = seq { for sheet in xlWorkBookInput.Worksheets do yield sheet :?> Excel.Worksheet }
let names = seq { for name in xlWorkBookInput.Names do yield name :?> Excel.Name}

let hasWs = Seq.exists (fun (ws:Excel.Worksheet) -> (ws.Name = sheetorrangename)) mysheets
let xlRangeInput = if hasWs then
let sheet = Seq.find (fun (ws:Excel.Worksheet) -> (ws.Name = sheetorrangename)) mysheets
let firstcell = sheet.Cells.Item(1,1) :?> Excel.Range
ApplyMoveToRange (ApplyMoveToRange firstcell Excel.XlDirection.xlToRight) Excel.XlDirection.xlDown
else
let hasName = Seq.exists (fun (ws:Excel.Name) -> (ws.Name = sheetorrangename)) names
if hasName then
(Seq.find (fun (ws:Excel.Name) -> (ws.Name = sheetorrangename)) names ).RefersToRange
else
failwith (sprintf "Sheet or range %A was not found" sheetorrangename)

let xlRangeInput = getRange xlWorkBookInput sheetorrangename headerRow

let objRangeInput = xlRangeInput.Value2 :?> obj[,]
let res = seq { for irow in 2 .. objRangeInput.GetLength(0) do
yield seq { for jcol in 1 .. objRangeInput.GetLength(1) do
yield objRangeInput.[irow,jcol] }
yield objRangeInput.[irow,jcol] }
|> Seq.toArray }
|> Seq.toArray

Expand Down Expand Up @@ -76,80 +75,72 @@ let internal typExcel(cfg:TypeProviderConfig) =
// Create the main provided type
let excTy = ProvidedTypeDefinition(System.Reflection.Assembly.GetExecutingAssembly(), rootNamespace, "ExcelFile", Some(typeof<obj>))

let defaultHeaderRow = 1

// Parameterize the type by the file to use as a template
let filename = ProvidedStaticParameter("filename", typeof<string>)
let sheetorrangename = ProvidedStaticParameter("sheetname", typeof<string>, "Sheet1")
let forcestring = ProvidedStaticParameter("forcestring", typeof<bool>, false)
let headerRow = ProvidedStaticParameter("headerrow", typedefof<int>, defaultHeaderRow)

let staticParams = [ filename
sheetorrangename
forcestring]
forcestring
headerRow ]

do excTy.DefineStaticParameters(staticParams, fun tyName paramValues ->
let (filename, sheetorrangename , forcestring) =
match paramValues with
| [| :? string as filename; :? string as sheetorrangename ; :? bool as forcestring |] -> (filename, sheetorrangename , forcestring)
| [| :? string as filename; :? bool as forcestring |] -> (filename, "Sheet1",forcestring)
| [| :? string as filename|] -> (filename, "Sheet1", false)
| _ -> ("no file specified to type provider", "", true)
let (filename, sheetorrangename, forcestring, headerRow) =
match paramValues with
| [| :? string as filename; :? string as sheetorrangename; :? bool as forcestring; :? int as headerRow|] -> (filename, sheetorrangename, forcestring, headerRow)
| [| :? string as filename; :? string as sheetorrangename; :? bool as forcestring |] -> (filename, sheetorrangename, forcestring, defaultHeaderRow)
| [| :? string as filename; :? bool as forcestring |] -> (filename, "Sheet1", forcestring, defaultHeaderRow)
| [| :? string as filename|] -> (filename, "Sheet1", false, defaultHeaderRow)
| _ -> ("no file specified to type provider", "", true, defaultHeaderRow)

// [| :? string as filename , :? bool as forcestring |]
// resolve the filename relative to the resolution folder
let resolvedFilename = Path.Combine(cfg.ResolutionFolder, filename)

let ProvidedTypeDefinitionExcelCall (filename, sheetorrangename , forcestring) =
let ProvidedTypeDefinitionExcelCall (filename, sheetorrangename, forcestring, headerRow) =
let xlApp = new Excel.ApplicationClass()
let xlWorkBookInput = xlApp.Workbooks.Open(resolvedFilename)
let mysheets = seq { for sheet in xlWorkBookInput.Worksheets do yield sheet :?> Excel.Worksheet }
let names = seq { for name in xlWorkBookInput.Names do yield name :?> Excel.Name}


let hasWs = Seq.exists (fun (ws:Excel.Worksheet) -> (ws.Name = sheetorrangename)) mysheets
let xlRangeInput = if hasWs then
let sheet = Seq.find (fun (ws:Excel.Worksheet) -> (ws.Name = sheetorrangename)) mysheets
let firstcell = sheet.Cells.Item(1,1) :?> Excel.Range
ApplyMoveToRange (ApplyMoveToRange firstcell Excel.XlDirection.xlToRight) Excel.XlDirection.xlDown
else
let hasName = Seq.exists (fun (ws:Excel.Name) -> (ws.Name = sheetorrangename)) names
if hasName then
(Seq.find (fun (ws:Excel.Name) -> (ws.Name = sheetorrangename)) names ).RefersToRange
else
failwith (sprintf "Sheet or range %A was not found" sheetorrangename)

let xlRangeInput = getRange xlWorkBookInput sheetorrangename headerRow

let lines = (seq { for row in xlRangeInput.Rows do yield row } |> Seq.cache)
let headerLine = (Seq.head lines):?> Excel.Range
// define a provided type for each row, erasing to a float[]
let rowTy = ProvidedTypeDefinition("Row", Some(typeof<obj[]>))


let oFirstdataLine =
match (Seq.length lines) with
| 1 -> None
| _ -> Some( lines |> Seq.skip 1 |> Seq.head :?> Excel.Range)

| _ -> Some( lines |> Seq.skip 1 |> Seq.head :?> Excel.Range)

// add one property per Excel field
for i in 0 .. (headerLine.Columns.Count - 1 ) do
let headerText = ((headerLine.Cells.Item(1,i+1) :?> Excel.Range).Value2).ToString()

let header = (headerLine.Cells.Item(1,i+1) :?> Excel.Range).Value2
if header <> null then do
let headerText = header.ToString()

let valueType, gettercode =
if forcestring || oFirstdataLine = None then
typeof<string>, (fun [row] -> <@@ ((%%row:obj[]).[i]):?> string @@>)
else
let firstdataLine = oFirstdataLine.Value
if xlApp.WorksheetFunction.IsText(firstdataLine.Cells.Item(1,i+1)) then
typeof<string>, (fun [row] -> <@@ ((%%row:obj[]).[i]):?> string @@>)
elif xlApp.WorksheetFunction.IsNumber(firstdataLine.Cells.Item(1,i+1)) then
typeof<float> , (fun [row] -> <@@ ((%%row:obj[]).[i]):?> float @@>)
else
typeof<string>, (fun [row] -> <@@ ((%%row:obj[]).[i]):?> string @@>)

//TODO : test w different types
let prop = ProvidedProperty(headerText, valueType, GetterCode = gettercode)
// Add metadata defining the property's location in the referenced file
prop.AddDefinitionLocation(1, i, filename)
rowTy.AddMember(prop)
let valueType, gettercode =
if forcestring || oFirstdataLine = None then
typeof<string>, (fun [row] -> <@@ ((%%row:obj[]).[i]) |> string @@>)
else
let firstdataLine = oFirstdataLine.Value
if xlApp.WorksheetFunction.IsText(firstdataLine.Cells.Item(1,i+1)) then
typeof<string>, (fun [row] -> <@@ ((%%row:obj[]).[i]) |> string @@>)
elif xlApp.WorksheetFunction.IsNumber(firstdataLine.Cells.Item(1,i+1)) then
typeof<float> , (fun [row] -> <@@ ((%%row:obj[]).[i]) :?> float @@>)
else
typeof<string>, (fun [row] -> <@@ ((%%row:obj[]).[i]) |> string @@>)

//TODO : test w different types
let prop = ProvidedProperty(headerText, valueType, GetterCode = gettercode)
// Add metadata defining the property's location in the referenced file
prop.AddDefinitionLocation(1, i, filename)
rowTy.AddMember(prop)

xlWorkBookInput.Close()
xlApp.Quit()
Expand All @@ -158,16 +149,16 @@ let internal typExcel(cfg:TypeProviderConfig) =
let ty = ProvidedTypeDefinition(System.Reflection.Assembly.GetExecutingAssembly(), rootNamespace, tyName, Some(typeof<ExcelFileInternal>))

// add a parameterless constructor which loads the file that was used to define the schema
ty.AddMember(ProvidedConstructor([], InvokeCode = fun [] -> <@@ ExcelFileInternal(resolvedFilename, sheetorrangename) @@>))
ty.AddMember(ProvidedConstructor([], InvokeCode = fun [] -> <@@ ExcelFileInternal(resolvedFilename, sheetorrangename, headerRow) @@>))
// add a constructor taking the filename to load
ty.AddMember(ProvidedConstructor([ProvidedParameter("filename", typeof<string>)], InvokeCode = fun [filename] -> <@@ ExcelFileInternal(%%filename) @@>))
ty.AddMember(ProvidedConstructor([ProvidedParameter("filename", typeof<string>)], InvokeCode = fun [filename] -> <@@ ExcelFileInternal(%%filename, sheetorrangename, headerRow) @@>))
// add a new, more strongly typed Data property (which uses the existing property at runtime)
ty.AddMember(ProvidedProperty("Data", typedefof<seq<_>>.MakeGenericType(rowTy), GetterCode = fun [excFile] -> <@@ (%%excFile:ExcelFileInternal).Data @@>))
// add the row type as a nested type
ty.AddMember(rowTy)
ty

(memoize ProvidedTypeDefinitionExcelCall)(filename, sheetorrangename , forcestring)
(memoize ProvidedTypeDefinitionExcelCall)(filename, sheetorrangename, forcestring, headerRow)
)

// add the type to the namespace
Expand Down
4 changes: 2 additions & 2 deletions src/FSharpx.TypeProviders.Excel/TestExcelProvider.fsx
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,6 @@ open FSharpx.TypeProviders.ExcelProvider
let (++) a b = Path.Combine(a, b)
let resolutionFolder = __SOURCE_DIRECTORY__ ++ ".." ++ ".." ++ "tests" ++ "FSharpx.TypeProviders.Excel.Tests"

generate (fun _ cfg -> typExcel cfg) resolutionFolder [| box "BookTest.xls"; box "Sheet1"; box true |]
generate (fun _ cfg -> typExcel cfg) resolutionFolder [| box "BookTest.xls"; box "Sheet1"; box true; box 1 |]
|> prettyPrint
|> Console.WriteLine
|> Console.WriteLine
Binary file added tests/FSharpx.TypeProviders.Excel.Tests/BookTestDifferentData.xls
View file
Binary file not shown.
Binary file added tests/FSharpx.TypeProviders.Excel.Tests/BookTestWithHeader.xls
View file
Binary file not shown.
36 changes: 33 additions & 3 deletions tests/FSharpx.TypeProviders.Excel.Tests/Excel.Tests.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,12 +4,42 @@ open NUnit.Framework
open FSharpx
open FsUnit

open System
open System.IO

type BookTest = ExcelFile<"BookTest.xls", "Sheet1", true>

type HeaderTest = ExcelFile<"BookTestWithHeader", "Sheet1", true, 2>

let file = BookTest()
let row1 = file.Data |> Seq.head

[<Test>]
let ``Can access first row in typed excel data``() =
[<Test>]
let ``Can access first row in typed excel data``() =
row1.SEC |> should equal "ASI"
row1.BROKER |> should equal "TFS Derivatives HK"
row1.BROKER |> should equal "TFS Derivatives HK"

[<Test>]
let ``Can pick an arbitrary header row``() =
let file = HeaderTest()
let row = file.Data |> Seq.head

row.SEC |> should equal "ASI"
row.BROKER |> should equal "TFS Derivatives HK"

[<Test>]
let ``Can load data from spreadsheet``() =
let file = Path.Combine(Environment.CurrentDirectory, "BookTestDifferentData.xls")

printfn "%s" file


let otherBook = BookTest(file)
let row = otherBook.Data |> Seq.head

row.SEC |> should equal "TASI"
row.STYLE |> should equal "B"
row.``STRIKE 1`` |> should equal "3"
row.``STRIKE 2`` |> should equal "4"
row.``STRIKE 3`` |> should equal "5"
row.VOL |> should equal "322"
32 changes: 19 additions & 13 deletions tests/FSharpx.TypeProviders.Excel.Tests/FSharpx.TypeProviders.Excel.Tests.fsproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,25 @@
<WarningLevel>3</WarningLevel>
<DocumentationFile>bin\Release\FSharpx.TypeProviders.Excel.Tests.XML</DocumentationFile>
</PropertyGroup>
<PropertyGroup>
<MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
</PropertyGroup>
<Import Project="$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')" />
<ItemGroup>
<Compile Include="..\FSharpx.Tests\FsUnit.fs">
<Link>FsUnit.fs</Link>
</Compile>
<Compile Include="Excel.Tests.fs" />
<Content Include="BookTest.xls">
<CopyToOutputDirectory>Always</CopyToOutputDirectory>
</Content>
<None Include="BookTestDifferentData.xls">
<CopyToOutputDirectory>Always</CopyToOutputDirectory>
</None>
<None Include="BookTestWithHeader.xls">
<CopyToOutputDirectory>Always</CopyToOutputDirectory>
</None>
</ItemGroup>
<ItemGroup>
<Reference Include="FSharpx.TypeProviders.Excel">
<HintPath>..\..\src\FSharpx.TypeProviders.Excel\bin\Debug\FSharpx.TypeProviders.Excel.dll</HintPath>
Expand All @@ -49,19 +68,6 @@
<Reference Include="System.Core" />
<Reference Include="System.Numerics" />
</ItemGroup>
<ItemGroup>
<Compile Include="..\FSharpx.Tests\FsUnit.fs">
<Link>FsUnit.fs</Link>
</Compile>
<Compile Include="Excel.Tests.fs" />
<Content Include="BookTest.xls">
<CopyToOutputDirectory>Always</CopyToOutputDirectory>
</Content>
</ItemGroup>
<PropertyGroup>
<MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
</PropertyGroup>
<Import Project="$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')" />
<!-- 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">
Expand Down

0 comments on commit 0947db5

Please sign in to comment.