4 people like it.

Multi-currency report

Multi-currency report (generated as HTML) based on example given at the start of chapter one of Kent Beck's Test-Driven Development by Example book.

Multi-currency domain

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
type Money = private { Amount:decimal; Currency:Currency } 
   with   
   static member ( * ) (lhs:Money,rhs:decimal) = 
      { lhs with Amount=lhs.Amount * rhs }
   static member ( + ) (lhs:Money,rhs:Money) =
      if lhs.Currency <> rhs.Currency then invalidOp "Currency mismatch"
      { lhs with Amount=lhs.Amount + rhs.Amount}
   override money.ToString() = sprintf "%M%s" money.Amount money.Currency
and  Currency = string

type RateTable = { To:Currency; From:Map<Currency,decimal> }

let exchangeRate (rates:RateTable) cy =   
   if rates.To = cy then 1.0M else rates.From.[cy]

let convertCurrency (rates:RateTable) money =
   let rate = exchangeRate rates money.Currency
   { Amount=money.Amount / rate; Currency=rates.To }

Multi-currency report model

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
type Report = { Rows:Row list; Total:Money }
and  Row = { Position:Position; Total:Money }
and  Position = { Instrument:string; Shares:int; Price:Money }

let generateReport rates positions =
   let rows =
      [for position in positions ->        
         let total = position.Price * decimal position.Shares
         { Position=position; Total=total } ]
   let total =
      rows
      |> Seq.map (fun row -> convertCurrency rates row.Total)   
      |> Seq.reduce (+)
   { Rows=rows; Total=total }

Multi-currency report view

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
let toHtml (report:Report) =
   html [
      head [ title %"Multi-currency report" ]      
      body [
         table [
            "border"%="1"
            "style"%="border-collapse:collapse;"
            "cellpadding"%="8"
            thead [
               tr [th %"Instrument"; th %"Shares"; th %"Price"; th %"Total"] 
            ]
            tbody [
               for row in report.Rows ->
                  let p = row.Position
                  tr [td %p.Instrument; td %p.Shares; td %p.Price; td %row.Total]
            ]
            tfoot [
               tr [td ("colspan"%="3"::"align"%="right"::[strong %"Total"])
                   td %report.Total]
            ]
         ]
      ]
   ]

Example

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
let USD amount = { Amount=amount; Currency="USD" }
let CHF amount = { Amount=amount; Currency="CHF" }

let positions =
   [{Instrument="IBM";      Shares=1000; Price=USD( 25M)}
    {Instrument="Novartis"; Shares= 400; Price=CHF(150M)}]

let inUSD = { To="USD"; From=Map.ofList ["CHF",1.5M] }

let positionsInUSD = generateReport inUSD positions

let report = positionsInUSD |> toHtml |> Html.toString

Show report embedded

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
#r "System.Windows.Forms.dll"
open System.Windows.Forms
let form = new Form(Text="Multi-currency report")
let web = new WebBrowser(Dock=DockStyle.Fill)
form.Controls.Add(web)
web.Navigate("about:blank")
web.Document.Write(report)
form.Show()

Write report & launch in browser

1: 
2: 
3: 
4: 
5: 
6: 
7: 
open System.IO
let name = System.Guid.NewGuid().ToString()
let path = System.IO.Path.GetTempPath() + name + ".html"
let writer = File.CreateText(path)
writer.Write(report)
writer.Close()
System.Diagnostics.Process.Start(path)
type Money =
  private {Amount: decimal;
           Currency: Currency;}
  override ToString : unit -> string
  static member ( + ) : lhs:Money * rhs:Money -> Money
  static member ( * ) : lhs:Money * rhs:decimal -> Money

Full name: Script.Money
Money.Amount: decimal
Multiple items
val decimal : value:'T -> decimal (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.decimal

--------------------
type decimal = System.Decimal

Full name: Microsoft.FSharp.Core.decimal

--------------------
type decimal<'Measure> = decimal

Full name: Microsoft.FSharp.Core.decimal<_>
Multiple items
Money.Currency: Currency

--------------------
type Currency = string

Full name: Script.Currency
val lhs : Money
val rhs : decimal
val rhs : Money
Money.Currency: Currency
val invalidOp : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.invalidOp
val money : Money
override Money.ToString : unit -> string

Full name: Script.Money.ToString
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
type Currency = string

Full name: Script.Currency
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
type RateTable =
  {To: Currency;
   From: Map<Currency,decimal>;}

Full name: Script.RateTable
RateTable.To: Currency
RateTable.From: Map<Currency,decimal>
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val exchangeRate : rates:RateTable -> cy:Currency -> decimal

Full name: Script.exchangeRate
val rates : RateTable
val cy : Currency
val convertCurrency : rates:RateTable -> money:Money -> Money

Full name: Script.convertCurrency
val rate : decimal
type Report =
  {Rows: Row list;
   Total: Money;}

Full name: Script.Report
Report.Rows: Row list
type Row =
  {Position: Position;
   Total: Money;}

Full name: Script.Row
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
Report.Total: Money
Multiple items
Row.Position: Position

--------------------
type Position =
  {Instrument: string;
   Shares: int;
   Price: Money;}

Full name: Script.Position
Row.Total: Money
type Position =
  {Instrument: string;
   Shares: int;
   Price: Money;}

Full name: Script.Position
Position.Instrument: string
Position.Shares: int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
Position.Price: Money
val generateReport : rates:RateTable -> positions:seq<Position> -> Report

Full name: Script.generateReport
val positions : seq<Position>
val rows : Row list
val position : Position
val total : Money
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
val row : Row
val reduce : reduction:('T -> 'T -> 'T) -> source:seq<'T> -> 'T

Full name: Microsoft.FSharp.Collections.Seq.reduce
val toHtml : report:Report -> Html

Full name: Script.toHtml
val report : Report
val html : (Html list -> Html)

Full name: Script.html
val head : (Html list -> Html)

Full name: Script.head
val title : (Html list -> Html)

Full name: Script.title
val body : (Html list -> Html)

Full name: Script.body
val table : (Html list -> Html)

Full name: Script.table
val thead : (Html list -> Html)

Full name: Script.thead
val tr : (Html list -> Html)

Full name: Script.tr
val th : (Html list -> Html)

Full name: Script.th
val tbody : (Html list -> Html)

Full name: Script.tbody
val p : Position
Row.Position: Position
val td : (Html list -> Html)

Full name: Script.td
val tfoot : (Html list -> Html)

Full name: Script.tfoot
val strong : (Html list -> Html)

Full name: Script.strong
val USD : amount:decimal -> Money

Full name: Script.USD
val amount : decimal
val CHF : amount:decimal -> Money

Full name: Script.CHF
val positions : Position list

Full name: Script.positions
val inUSD : RateTable

Full name: Script.inUSD
val ofList : elements:('Key * 'T) list -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.ofList
val positionsInUSD : Report

Full name: Script.positionsInUSD
val report : string

Full name: Script.report
type Html =
  | Elem of string * Html list
  | Attr of string * string
  | Text of string
  override ToString : unit -> string
  static member toString : elem:Html -> string

Full name: Script.Html
static member Html.toString : elem:Html -> string
namespace System
namespace System.Windows
namespace System.Windows.Forms
val form : Form

Full name: Script.form
Multiple items
type Form =
  inherit ContainerControl
  new : unit -> Form
  member AcceptButton : IButtonControl with get, set
  member Activate : unit -> unit
  member ActiveMdiChild : Form
  member AddOwnedForm : ownedForm:Form -> unit
  member AllowTransparency : bool with get, set
  member AutoScale : bool with get, set
  member AutoScaleBaseSize : Size with get, set
  member AutoScroll : bool with get, set
  member AutoSize : bool with get, set
  ...
  nested type ControlCollection

Full name: System.Windows.Forms.Form

--------------------
Form() : unit
union case Html.Text: string -> Html
val web : WebBrowser

Full name: Script.web
Multiple items
type WebBrowser =
  inherit WebBrowserBase
  new : unit -> WebBrowser
  member AllowNavigation : bool with get, set
  member AllowWebBrowserDrop : bool with get, set
  member CanGoBack : bool
  member CanGoForward : bool
  member Document : HtmlDocument
  member DocumentStream : Stream with get, set
  member DocumentText : string with get, set
  member DocumentTitle : string
  member DocumentType : string
  ...

Full name: System.Windows.Forms.WebBrowser

--------------------
WebBrowser() : unit
type DockStyle =
  | None = 0
  | Top = 1
  | Bottom = 2
  | Left = 3
  | Right = 4
  | Fill = 5

Full name: System.Windows.Forms.DockStyle
field DockStyle.Fill = 5
property Control.Controls: Control.ControlCollection
Control.ControlCollection.Add(value: Control) : unit
WebBrowser.Navigate(urlString: string) : unit
WebBrowser.Navigate(url: System.Uri) : unit
WebBrowser.Navigate(urlString: string, newWindow: bool) : unit
WebBrowser.Navigate(url: System.Uri, newWindow: bool) : unit
WebBrowser.Navigate(urlString: string, targetFrameName: string) : unit
WebBrowser.Navigate(url: System.Uri, targetFrameName: string) : unit
WebBrowser.Navigate(urlString: string, targetFrameName: string, postData: byte [], additionalHeaders: string) : unit
WebBrowser.Navigate(url: System.Uri, targetFrameName: string, postData: byte [], additionalHeaders: string) : unit
property WebBrowser.Document: HtmlDocument
HtmlDocument.Write(text: string) : unit
Control.Show() : unit
Form.Show(owner: IWin32Window) : unit
namespace System.IO
val name : string

Full name: Script.name
Multiple items
type Guid =
  struct
    new : b:byte[] -> Guid + 4 overloads
    member CompareTo : value:obj -> int + 1 overload
    member Equals : o:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member ToByteArray : unit -> byte[]
    member ToString : unit -> string + 2 overloads
    static val Empty : Guid
    static member NewGuid : unit -> Guid
    static member Parse : input:string -> Guid
    static member ParseExact : input:string * format:string -> Guid
    ...
  end

Full name: System.Guid

--------------------
System.Guid()
System.Guid(b: byte []) : unit
System.Guid(g: string) : unit
System.Guid(a: int, b: int16, c: int16, d: byte []) : unit
System.Guid(a: uint32, b: uint16, c: uint16, d: byte, e: byte, f: byte, g: byte, h: byte, i: byte, j: byte, k: byte) : unit
System.Guid(a: int, b: int16, c: int16, d: byte, e: byte, f: byte, g: byte, h: byte, i: byte, j: byte, k: byte) : unit
System.Guid.NewGuid() : System.Guid
val path : string

Full name: Script.path
type Path =
  static val DirectorySeparatorChar : char
  static val AltDirectorySeparatorChar : char
  static val VolumeSeparatorChar : char
  static val InvalidPathChars : char[]
  static val PathSeparator : char
  static member ChangeExtension : path:string * extension:string -> string
  static member Combine : [<ParamArray>] paths:string[] -> string + 3 overloads
  static member GetDirectoryName : path:string -> string
  static member GetExtension : path:string -> string
  static member GetFileName : path:string -> string
  ...

Full name: System.IO.Path
Path.GetTempPath() : string
val writer : StreamWriter

Full name: Script.writer
type File =
  static member AppendAllLines : path:string * contents:IEnumerable<string> -> unit + 1 overload
  static member AppendAllText : path:string * contents:string -> unit + 1 overload
  static member AppendText : path:string -> StreamWriter
  static member Copy : sourceFileName:string * destFileName:string -> unit + 1 overload
  static member Create : path:string -> FileStream + 3 overloads
  static member CreateText : path:string -> StreamWriter
  static member Decrypt : path:string -> unit
  static member Delete : path:string -> unit
  static member Encrypt : path:string -> unit
  static member Exists : path:string -> bool
  ...

Full name: System.IO.File
File.CreateText(path: string) : StreamWriter
TextWriter.Write(value: obj) : unit
   (+0 other overloads)
TextWriter.Write(value: decimal) : unit
   (+0 other overloads)
TextWriter.Write(value: float) : unit
   (+0 other overloads)
TextWriter.Write(value: float32) : unit
   (+0 other overloads)
TextWriter.Write(value: uint64) : unit
   (+0 other overloads)
TextWriter.Write(value: int64) : unit
   (+0 other overloads)
TextWriter.Write(value: uint32) : unit
   (+0 other overloads)
TextWriter.Write(value: int) : unit
   (+0 other overloads)
TextWriter.Write(value: bool) : unit
   (+0 other overloads)
StreamWriter.Write(value: string) : unit
   (+0 other overloads)
StreamWriter.Close() : unit
namespace System.Diagnostics
Multiple items
type Process =
  inherit Component
  new : unit -> Process
  member BasePriority : int
  member BeginErrorReadLine : unit -> unit
  member BeginOutputReadLine : unit -> unit
  member CancelErrorRead : unit -> unit
  member CancelOutputRead : unit -> unit
  member Close : unit -> unit
  member CloseMainWindow : unit -> bool
  member EnableRaisingEvents : bool with get, set
  member ExitCode : int
  ...

Full name: System.Diagnostics.Process

--------------------
System.Diagnostics.Process() : unit
System.Diagnostics.Process.Start(startInfo: System.Diagnostics.ProcessStartInfo) : System.Diagnostics.Process
System.Diagnostics.Process.Start(fileName: string) : System.Diagnostics.Process
System.Diagnostics.Process.Start(fileName: string, arguments: string) : System.Diagnostics.Process
System.Diagnostics.Process.Start(fileName: string, userName: string, password: System.Security.SecureString, domain: string) : System.Diagnostics.Process
System.Diagnostics.Process.Start(fileName: string, arguments: string, userName: string, password: System.Security.SecureString, domain: string) : System.Diagnostics.Process

More information

Link:http://fssnip.net/r5
Posted:8 years ago
Author:Phillip Trelford
Tags: html , dsl , money