├── Chapter11 ├── Secret.txt ├── Ch11_1.sql ├── Ch11_2.fsx ├── Ch11_1.fsx ├── KeyTypeProvider.fs ├── Ch11_3.fsx └── Ch11_4.fsx ├── Chapter03 ├── Ch3_2.fsx ├── Ch3_6.fsx ├── Ch3_4.fsx ├── Ch3_5.fsx ├── Ch3_8.fsx ├── Ch3_1.fsx ├── Ch3_7.fsx └── Ch3_3.fsx ├── Chapter06 ├── Ch6_1.fsx ├── Ch6_2.fsx ├── Ch6_5.fsx ├── Ch6_3.fsx └── Ch6_4.fsx ├── Chapter09 ├── LaserShip20160701.xlsx ├── Lasership Invoice Format.xlsx ├── Ch9_1_1.fsx ├── Ch9_1_2.fsx ├── Ch9_1_3.fsx ├── Ch9_1_6.fsx ├── Ch9_1_5.fsx ├── Ch9_1_4.fsx ├── SCHEMA_LaserShip.sql ├── Ch9_3.fsx ├── Ch9_2.fsx └── Ch9_4.fsx ├── Chapter04 ├── Ch4_2.fsx ├── Ch4_3.fsx ├── Ch4_4.fsx ├── Ch4_5.fsx ├── Ch4_6.fsx └── Ch4_1.fsx ├── Chapter01 ├── Ch1_3.fsx ├── Ch1_1.fsx ├── Ch1_2.fsx └── HugeNumber.fs ├── Chapter07 ├── Ch7_5.fsx ├── Ch7_6.fsx ├── Ch7_9.fsx ├── Ch7_1.fsx ├── Ch7_7.fsx ├── Ch7_3.fsx ├── Ch7_2.fsx ├── Ch7_8.fsx └── Ch7_4.fsx ├── Chapter02 ├── Ch2_1.fsx ├── Ch2_3.fsx └── Ch2_2.fsx ├── Chapter08 ├── Ch8_1.fsx ├── Ch8_7.fsx ├── Ch8_3.fsx ├── Ch8_6.fsx ├── Ch8_8.fsx ├── Ch8_4.fsx ├── Ch8_5.fsx └── Ch8_2.fsx ├── Chapter12 ├── Ch12_1.fsx ├── Ch12_2_Command.fsx ├── Ch12_4_Strategy.fsx └── Ch12_3_Template.fsx ├── Chapter13 ├── Ch13_1.fsx ├── Ch13_3.fsx ├── Ch13_2.fsx └── Ch13_4.fsx ├── .gitattributes ├── Chapter05 ├── Ch5_2.fsx ├── Ch5_5.fsx ├── Ch5_1.fsx ├── Ch5_4.fsx └── Ch5_3.fsx ├── .gitignore ├── License ├── Chapter10 ├── Ch10_3.fsx ├── Ch10_1.fsx ├── Ch10_4.fsx └── Ch10_2.fsx └── README.md /Chapter11/Secret.txt: -------------------------------------------------------------------------------- 1 | ABigSecret -------------------------------------------------------------------------------- /Chapter03/Ch3_2.fsx: -------------------------------------------------------------------------------- 1 | let m: int [,] = Array2D.init 10 10 (fun x y -> if x = y then 1 else 0) 2 | 3 | -------------------------------------------------------------------------------- /Chapter06/Ch6_1.fsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PacktPublishing/Fsharp-4.0-Design-Patterns/HEAD/Chapter06/Ch6_1.fsx -------------------------------------------------------------------------------- /Chapter09/LaserShip20160701.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PacktPublishing/Fsharp-4.0-Design-Patterns/HEAD/Chapter09/LaserShip20160701.xlsx -------------------------------------------------------------------------------- /Chapter04/Ch4_2.fsx: -------------------------------------------------------------------------------- 1 | let transformA' v = 2 | match v with 3 | | 1 -> "1" 4 | | 2 -> "2" 5 | | THREE -> "3" 6 | 7 | transformA' 50 8 | -------------------------------------------------------------------------------- /Chapter09/Lasership Invoice Format.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PacktPublishing/Fsharp-4.0-Design-Patterns/HEAD/Chapter09/Lasership Invoice Format.xlsx -------------------------------------------------------------------------------- /Chapter01/Ch1_3.fsx: -------------------------------------------------------------------------------- 1 | #load "HugeNumber.fs" 2 | hugeNumber |> (Seq.map (string >> int) >> Seq.windowed 5 3 | >> Seq.map (Seq.reduce (*)) >> Seq.max 4 | >> printfn "%s %d" "Functional solution:") 5 | -------------------------------------------------------------------------------- /Chapter03/Ch3_6.fsx: -------------------------------------------------------------------------------- 1 | let mutable x = "I'm x" 2 | let mutable y = x 3 | y <- "I'm y" 4 | sprintf "%s|%s" x y 5 | 6 | let rx = ref "I'm rx" 7 | let ry = rx 8 | ry := "I'm ry" 9 | sprintf "%s|%s" !rx !ry -------------------------------------------------------------------------------- /Chapter07/Ch7_5.fsx: -------------------------------------------------------------------------------- 1 | // Lazy Evaluation 2 | let twoByTwo = lazy (let r = 2*2 in 3 | printfn "Everybody knows that 2*2=%d" r; r) 4 | twoByTwo.Force() 5 | twoByTwo.Force() 6 | 7 | -------------------------------------------------------------------------------- /Chapter02/Ch2_1.fsx: -------------------------------------------------------------------------------- 1 | [] type m // meters 2 | [] type s // seconds 3 | 4 | let fallSpeed (height: float) = 2.0 * height * 9.81 |> sqrt 5 | let empireStateBuilding = 381.0 6 | fallSpeed empireStateBuilding -------------------------------------------------------------------------------- /Chapter08/Ch8_1.fsx: -------------------------------------------------------------------------------- 1 | // QuickSort 2 | let rec qsort : int list -> _ = function 3 | | [] -> [] 4 | | x::xs -> 5 | let less, greater = List.partition ((>) x) xs 6 | qsort less @ x :: qsort greater 7 | 8 | qsort [1;7;2;-5;-3;0;42] -------------------------------------------------------------------------------- /Chapter07/Ch7_6.fsx: -------------------------------------------------------------------------------- 1 | // CPS 2 | let rec ``factorial (cps)`` cont = function 3 | | z when z = 0I -> cont 1I 4 | | n -> ``factorial (cps)`` (fun x -> cont(n * x)) (n - 1I) 5 | 6 | let howLong = (string >> String.length) 7 | 8 | howLong <| ``factorial (cps)`` id 10000I 9 | -------------------------------------------------------------------------------- /Chapter12/Ch12_1.fsx: -------------------------------------------------------------------------------- 1 | // This is a placeholder 2 | 3 | // function argument contravariance 4 | type T = interface end // base 5 | type S() = interface T // an implementation 6 | let f (x: T) = () // a function upon base 7 | f(S()) // application to implementation does not need coercion! 8 | -------------------------------------------------------------------------------- /Chapter11/Ch11_1.sql: -------------------------------------------------------------------------------- 1 | CREATE DATABASE demo 2 | GO 3 | 4 | Use demo 5 | GO 6 | 7 | SET ANSI_NULLS ON 8 | GO 9 | 10 | SET QUOTED_IDENTIFIER ON 11 | GO 12 | 13 | CREATE PROCEDURE dbo.MockQuery 14 | AS 15 | BEGIN 16 | SET NOCOUNT ON; 17 | WAITFOR DELAY '00:00:01' 18 | SELECT 1 19 | END 20 | GO 21 | -------------------------------------------------------------------------------- /Chapter04/Ch4_3.fsx: -------------------------------------------------------------------------------- 1 | let verifyGuid g = 2 | match System.Guid.TryParse g with 3 | | (true,_ as r) -> sprintf "%s is a genuine GUID %A" g (snd r) 4 | | (_,_ as r) -> sprintf "%s is a garbage GUID, defaults to %A" 5 | g (snd r) 6 | 7 | verifyGuid "7dbb5967e90142c59690275bd10331f3" 8 | verifyGuid "xyzzy" 9 | -------------------------------------------------------------------------------- /Chapter09/Ch9_1_1.fsx: -------------------------------------------------------------------------------- 1 | let isVowel = function 2 | | 'A' | 'a' | 'E' | 'e' | 'I' | 'i' 3 | | 'O' | 'o' | 'U' | 'u' -> true 4 | | _ -> false 5 | 6 | let alphabet = seq { 'A' .. 'Z' } 7 | 8 | alphabet |> Seq.filter isVowel |> Seq.sortDescending |> Seq.head 9 | // val it : char = 'U' 10 | 11 | -------------------------------------------------------------------------------- /Chapter02/Ch2_3.fsx: -------------------------------------------------------------------------------- 1 | // Define interface 2 | type IMyInterface = 3 | abstract member DoIt: unit -> unit 4 | 5 | // Implement interface... 6 | let makeMyInterface() = 7 | { 8 | new IMyInterface with 9 | member __.DoIt() = printfn "Did it!" 10 | } 11 | 12 | //... and use it 13 | makeMyInterface().DoIt() 14 | 15 | -------------------------------------------------------------------------------- /Chapter09/Ch9_1_2.fsx: -------------------------------------------------------------------------------- 1 | open System.Linq 2 | 3 | let isVowel = function 4 | | 'A' | 'a' | 'E' | 'e' | 'I' | 'i' 5 | | 'O' | 'o' | 'U' | 'u' -> true 6 | | _ -> false 7 | 8 | let alphabet = seq { 'A' .. 'Z' } 9 | 10 | alphabet.Where(isVowel).OrderByDescending(fun x -> x).First() 11 | // val it : char = 'U' 12 | -------------------------------------------------------------------------------- /Chapter11/Ch11_2.fsx: -------------------------------------------------------------------------------- 1 | #r @"C:\code\packtbook\KeyTypeProvider\bin\Debug\KeyTypeProvider.dll" 2 | open FSharp.IO 3 | open System 4 | 5 | type Vault = SecretKey< @".\Secret.txt"> 6 | 7 | let unlock = function 8 | | Vault.Key -> true 9 | | _ -> false 10 | 11 | while Console.ReadLine() |> unlock |> not do 12 | printfn "Go away, Hacker!" 13 | 14 | printfn "Please proceed, Master!" 15 | -------------------------------------------------------------------------------- /Chapter07/Ch7_9.fsx: -------------------------------------------------------------------------------- 1 | open System 2 | 3 | let (|Recent|Due|) (dt: DateTimeOffset) = 4 | if DateTimeOffset.Now.AddDays(-3.0) <= dt then Recent 5 | else Due 6 | 7 | 8 | let isDue = function 9 | | Recent -> printfn "don't do anything" 10 | | Due -> printfn "time to pay this one" 11 | 12 | isDue <| DateTimeOffset.Now.AddDays(-2.0) 13 | isDue <| DateTimeOffset.Now.AddDays(-4.0) 14 | 15 | -------------------------------------------------------------------------------- /Chapter13/Ch13_1.fsx: -------------------------------------------------------------------------------- 1 | // if-then as an expression 2 | let f a b = // a and b inferred of type 'a(requires comparison) 3 | if a < b then 4 | a 5 | else 6 | b 7 | 8 | let f' a b = 9 | if a < b then 10 | a 11 | 12 | let f'' (a:'a) b = 13 | if a < b then 14 | a // warning 15 | 16 | let f''' (a:int) b = 17 | if a < b then 18 | a // error 19 | -------------------------------------------------------------------------------- /Chapter13/Ch13_3.fsx: -------------------------------------------------------------------------------- 1 | let positive = function 2 | | x when x > 0 -> true 3 | | x when x <= 0 -> false 4 | 5 | let positive' = function 6 | | x when x > 0 -> true 7 | | _ -> false 8 | 9 | type TickTack = Tick | Tack 10 | 11 | let ticker x = 12 | match x with 13 | | Tick -> printfn "Tick" 14 | | Tock -> printfn "Tock" 15 | | Tack -> printfn "Tack" 16 | 17 | ticker Tick 18 | ticker Tack -------------------------------------------------------------------------------- /Chapter02/Ch2_2.fsx: -------------------------------------------------------------------------------- 1 | type IMyInterface = 2 | abstract member DoIt: unit -> unit 3 | 4 | type MyImpl() = 5 | interface IMyInterface with 6 | member __.DoIt() = printfn "Did it!" 7 | 8 | MyImpl().DoIt() // Error: member 'DoIt' is not defined 9 | 10 | (MyImpl() :> IMyInterface).DoIt() 11 | 12 | // ... but 13 | let doit (doer: IMyInterface) = 14 | doer.DoIt() 15 | 16 | doit (MyImpl()) 17 | 18 | -------------------------------------------------------------------------------- /Chapter03/Ch3_4.fsx: -------------------------------------------------------------------------------- 1 | let apply case arg = 2 | if case = 0 then 3 | sin arg 4 | elif case = 1 then 5 | cos arg 6 | elif case = 2 then 7 | asin arg 8 | elif case = 3 then 9 | acos arg 10 | else 11 | arg 12 | 13 | let apply' case arg = 14 | try 15 | [|sin; cos; asin; acos|].[case] arg 16 | with 17 | | :?System.IndexOutOfRangeException -> arg 18 | 19 | -------------------------------------------------------------------------------- /Chapter09/Ch9_1_3.fsx: -------------------------------------------------------------------------------- 1 | let isVowel = function 2 | | 'A' | 'a' | 'E' | 'e' | 'I' | 'i' 3 | | 'O' | 'o' | 'U' | 'u' -> true 4 | | _ -> false 5 | 6 | let alphabet = seq { 'A' .. 'Z' } 7 | 8 | query { 9 | for letter in alphabet do 10 | where (isVowel letter) 11 | sortByDescending letter 12 | select letter // may be omitted 13 | head 14 | } 15 | // val it : char = 'U' 16 | 17 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /Chapter04/Ch4_4.fsx: -------------------------------------------------------------------------------- 1 | open System 2 | 3 | let validate keyA keyB = 4 | match (keyA,keyB) with 5 | | ("","") -> "both keys are empty" 6 | | (x,y) & (("",_) | (_,"")) -> 7 | sprintf "one key is empty: keyA = %s; keyB = %s" x y 8 | | _ & (x,y) -> 9 | sprintf "both keys are not empty: keyA = %s; keyB = %s" x y 10 | 11 | validate "" "" 12 | validate "abc" "" 13 | validate "" "abc" 14 | validate "42" "42" 15 | validate "xyzzy" "kensentme" -------------------------------------------------------------------------------- /Chapter03/Ch3_5.fsx: -------------------------------------------------------------------------------- 1 | let simpleClosure = 2 | let scope = "old lexical scope" 3 | let enclose() = 4 | sprintf "%s" scope 5 | let scope = "new lexical scope" 6 | sprintf "[%s][%s]" scope (enclose()) 7 | 8 | let trackState seed = 9 | let state = ref seed in 10 | fun () -> incr state; (!state, seed) 11 | 12 | let counter1 = trackState 5 13 | counter1() 14 | counter1() 15 | 16 | let counter2 = trackState 100 17 | counter2() 18 | counter2() 19 | -------------------------------------------------------------------------------- /Chapter01/Ch1_1.fsx: -------------------------------------------------------------------------------- 1 | // Imperative monolithic solution a-la C/C++ 2 | #load "HugeNumber.fs" 3 | let number = hugeNumber.ToCharArray() 4 | 5 | let mutable maxProduct = 0 6 | let charZero = int('0') 7 | 8 | for i in 0..995 do 9 | let mutable currentProduct = 1 10 | for j in 0..4 do 11 | currentProduct <- currentProduct * (int(number.[i + j]) - charZero) 12 | if maxProduct < currentProduct then 13 | maxProduct <- currentProduct 14 | 15 | printfn "%s %d" "Imperative solution:" maxProduct -------------------------------------------------------------------------------- /Chapter04/Ch4_5.fsx: -------------------------------------------------------------------------------- 1 | open System 2 | 3 | let validate keyA keyB = 4 | match (keyA,keyB) with 5 | | ("","") -> "both keys are empty" 6 | | (x,y) & (("",_) | (_,"")) -> sprintf "one key is empty: keyA = %s; keyB = %s" x y 7 | | (x,y) when x = y -> sprintf "both keys are not empty: keyA = keyB = %s" x 8 | | (x,y) -> sprintf "both keys are not empty: keyA = %s; keyB = %s" x y 9 | 10 | validate "" "" 11 | validate "abc" "" 12 | validate "" "abc" 13 | validate "42" "42" 14 | validate "xyzzy" "kensentme" -------------------------------------------------------------------------------- /Chapter05/Ch5_2.fsx: -------------------------------------------------------------------------------- 1 | type transport = { code: int; name: string } 2 | 3 | let a = { code = 1; name = "car" } 4 | let b = { name = "jet"; code = 2 } 5 | 6 | let c = { b with transport.name = "plane" } 7 | 8 | c = b 9 | 10 | [] 11 | type Transport = { code: int; name: string } 12 | let x = {Transport.code=5; name="boat" } 13 | let y = { x with name = "boat"} 14 | let noteq = x = y 15 | let eq = x = x 16 | 17 | let { transport.code = _; name = aName } = a 18 | let { transport.name = aname} = a 19 | let aName' = a.name -------------------------------------------------------------------------------- /Chapter04/Ch4_6.fsx: -------------------------------------------------------------------------------- 1 | open System 2 | 3 | let validate key1 key2 = (key1,key2) |> function 4 | | ("","") -> "both keys are empty" 5 | | (x,y) & (("",_) | (_,"")) -> 6 | sprintf "one key is empty: keyA = %s; keyB = %s" x y 7 | | (x,y) when x = y -> 8 | sprintf "both keys are not empty: keyA = keyB = %s" x 9 | | (x,y) -> 10 | sprintf "both keys are not empty: keyA = %s; keyB = %s" x y 11 | 12 | validate "" "" 13 | validate "abc" "" 14 | validate "" "abc" 15 | validate "42" "42" 16 | validate "xyzzy" "kensentme" 17 | -------------------------------------------------------------------------------- /Chapter05/Ch5_5.fsx: -------------------------------------------------------------------------------- 1 | type PaymentInstrumentDiscount = 2 | | CreditCard of decimal 3 | | DebitCard of decimal 4 | | ACH of decimal 5 | 6 | member x.ApplyDiscount payment = 7 | match x with 8 | | CreditCard d -> payment - d 9 | | DebitCard d -> payment - d 10 | | ACH d -> payment - d 11 | 12 | printfn "Payment amount: credit card $%.2f; debit card $%.2f; ACH $%.2f" 13 | ((CreditCard 0.0M).ApplyDiscount 20.23M) 14 | ((DebitCard 0.35M).ApplyDiscount 20.23M) 15 | ((ACH 0.75M).ApplyDiscount 20.23M) -------------------------------------------------------------------------------- /Chapter05/Ch5_1.fsx: -------------------------------------------------------------------------------- 1 | // Tuples 2 | let tuple = (1,"2",fun() -> 3) 3 | 4 | tuple = (1,"2",fun() -> 3) // does not compile because equivalence is not defined for functions 5 | 6 | let a = 1,"car" 7 | a = (1,"car") // true 8 | a = (2,"jet") // false 9 | a < (2,"jet") // true 10 | 11 | let (elem1, elem2) = a 12 | printfn "(%i,%s)" elem1 elem2 13 | 14 | let (_,_,f) = tuple in 15 | f() 16 | 17 | type System.Tuple<'T1,'T2> with 18 | member t.AsString() = 19 | sprintf "[[%A]:[%A]]" t.Item1 t.Item2 20 | 21 | (a |> box :?> System.Tuple).AsString() 22 | -------------------------------------------------------------------------------- /Chapter13/Ch13_2.fsx: -------------------------------------------------------------------------------- 1 | let gr = ref [] // error: value restriction 2 | let gr<'a> : 'a list ref = ref [] 3 | gr := ["a"] 4 | let x = !gr // error: value restriction 5 | let x: string list = !gr 6 | printfn "%A" x 7 | let cr = gr 8 | cr := ["a"] 9 | let y = !cr 10 | printfn "%A" y 11 | //////////////////////////////////////////////////// 12 | let allEmpty = List.forall ((=) []) // error: value restriction 13 | 14 | let allEmpty xs = List.forall ((=) []) xs // remedy 1 15 | let allEmpty : int list list -> bool = List.forall ((=) []) // remedy 2 16 | let allEmpty = fun x -> List.forall ((=) []) x // remedy 3 -------------------------------------------------------------------------------- /Chapter03/Ch3_8.fsx: -------------------------------------------------------------------------------- 1 | let cutter s = 2 | let cut s = 3 | printfn "imitator cut: %s" s 4 | let cut (s: string) = 5 | if s.Length > 0 then 6 | printfn "real cut: %s" s 7 | cut s.[1..] 8 | else 9 | printfn "finished cutting" 10 | cut s 11 | 12 | let cutter s = 13 | let cut s = 14 | printfn "imitator cut: %s" s 15 | let rec cut (s: string) = 16 | if s.Length > 0 then 17 | printfn "real cut: %s" s 18 | cut s.[1..] 19 | else 20 | printfn "finished cutting" 21 | cut s 22 | cutter "wow!" 23 | -------------------------------------------------------------------------------- /Chapter05/Ch5_4.fsx: -------------------------------------------------------------------------------- 1 | type ChargeAttempt = 2 | | Original 3 | | Retry of int 4 | 5 | let cco = Original 6 | // equivalent let cco = ChargeAttempt.Original 7 | 8 | let ccr = Retry 4 9 | // equivalent let ccr = ChargeAttempt.Retry(4) 10 | 11 | type Brightness = Brightness of int 12 | type Voltage = Voltage of int 13 | type Bulb = { voltage: Voltage; brightness: Brightness } 14 | 15 | let myBulb = { voltage = Voltage(110); brightness= Brightness(2500)} 16 | 17 | let lamp1br = Brightness(2500) 18 | lamp1br = Brightness(2500) // true 19 | lamp1br < Brightness(2100) // false 20 | 21 | match myBulb.brightness with 22 | | Brightness(v) -> v 23 | -------------------------------------------------------------------------------- /Chapter07/Ch7_1.fsx: -------------------------------------------------------------------------------- 1 | // Naive implementation of factorial function 2 | let rec ``naive factorial`` = function 3 | | n when n = 0I -> 1I 4 | | _ as n -> n * ``naive factorial`` (n - 1I) 5 | 6 | ``naive factorial`` 1000I 7 | ``naive factorial`` 10000I 8 | 9 | // Shrewd implementation of factorial function 10 | let ``wise factorial`` n = 11 | let rec factorial_tail_call acc = function 12 | | n when n = 0I -> acc 13 | | _ as n -> factorial_tail_call (acc * n) (n - 1I) 14 | factorial_tail_call 1I n 15 | 16 | let howLong = (string >> String.length) 17 | 18 | howLong <| ``wise factorial`` 1000I //2568 19 | howLong <| ``wise factorial`` 10000I //35660 20 | howLong <| ``wise factorial`` 100000I // 456674 21 | -------------------------------------------------------------------------------- /Chapter03/Ch3_1.fsx: -------------------------------------------------------------------------------- 1 | let circleArea radius = 2 | System.Math.PI * radius * radius 3 | 4 | circleArea 10. 5 | 6 | //--------------------------------------------------------------------------- 7 | let opaque arg = 8 | System.DateTime.Now.Second * (if arg % 2 = 0 then 2 else 1) 9 | 10 | 11 | //--------------------------------------------------------------------------- 12 | // int64 value 13 | let getNextRandom = (%) System.DateTime.Now.Ticks 1000L 14 | 15 | getNextRandom 16 | 17 | // unit->x64 function 18 | let getNextRandomA() = (%) System.DateTime.Now.Ticks 1000L 19 | 20 | getNextRandomA() 21 | getNextRandomA() 22 | 23 | // unit->unit function 24 | let getNextRandomB () = printfn "%d" ((%) System.DateTime.Now.Ticks 1000L) 25 | 26 | getNextRandomB() 27 | -------------------------------------------------------------------------------- /Chapter05/Ch5_3.fsx: -------------------------------------------------------------------------------- 1 | 2 | type Configuration = { 3 | Database: string 4 | RetryCount: int 5 | } 6 | 7 | [] 8 | [] 9 | module Configuration = 10 | let private singleton = ref { Database = "(local)"; RetryCount = 3 } 11 | let private guard = obj() 12 | 13 | type Configuration with 14 | static member Current 15 | with get() = lock guard <| fun() -> !singleton 16 | and set value = lock guard <| fun() -> singleton := value 17 | 18 | 19 | printfn "Default start-up config: %A" Configuration.Current 20 | 21 | Configuration.Current <- { Configuration.Current with Database = ".\SQLExpress" } 22 | 23 | printfn "Updated config: %A" Configuration.Current -------------------------------------------------------------------------------- /Chapter08/Ch8_7.fsx: -------------------------------------------------------------------------------- 1 | /// R E O R D E R I N G /// 2 | List.sort [1;8;3;6;4;-2] 3 | // val it : int list = [-2; 1; 3; 4; 6; 8] 4 | List.sortDescending [1;8;3;6;4;-2] 5 | // val it : int list = [8; 6; 4; 3; 1; -2] 6 | List.sortBy (fun x -> x.GetHashCode()) ["Fourteen";"Zero";"Forty Two"] 7 | // val it : string list = ["Zero"; "Forty Two"; "Fourteen"] 8 | 9 | /// M A P P I N G /// 10 | "Je ne regrette rien".Split([|' '|]) 11 | |> Seq.collect (fun x -> x.ToCharArray()) 12 | |> Seq.toList 13 | // val it : char list = 14 | // ['J'; 'e'; 'n'; 'e'; 'r'; 'e'; 'g'; 15 | // 'r'; 'e'; 't'; 't'; 'e'; 'r'; 'i'; 'e'; 'n'] 16 | 17 | "Je ne regrette rien".Split([|' '|]) 18 | |> Seq.indexed 19 | // val it : seq = 20 | // seq [(0, "Je"); (1, "ne"); (2, "regrette"); (3, "rien")] 21 | 22 | -------------------------------------------------------------------------------- /Chapter04/Ch4_1.fsx: -------------------------------------------------------------------------------- 1 | [] 2 | let THREE = 3 3 | 4 | let transformA v = 5 | match v with 6 | | 1 -> "1" 7 | | 2 -> "2" 8 | | THREE -> "3" 9 | 10 | transformA <| (1 + 2) 11 | 12 | type Multiples = 13 | | Zero = 0 14 | | Five = 5 15 | 16 | let transformB ``compare me`` = 17 | match ``compare me`` with 18 | | Multiples.Zero -> "0" 19 | | Multiples.Five -> "5" 20 | 21 | Multiples.Five |> transformB 22 | 23 | enum(1) |> transformB 24 | 25 | let transformB' m = 26 | match m with 27 | | Multiples.Zero -> Some "0" 28 | | Multiples.Five -> Some "5" 29 | | _ -> None 30 | 31 | let transformB'' m = 32 | match m with 33 | | _ -> None 34 | | Multiples.Zero -> Some "0" 35 | | Multiples.Five -> Some "5" 36 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Windows image file caches 2 | Thumbs.db 3 | ehthumbs.db 4 | 5 | # Folder config file 6 | Desktop.ini 7 | 8 | # Recycle Bin used on file shares 9 | $RECYCLE.BIN/ 10 | 11 | # Windows Installer files 12 | *.cab 13 | *.msi 14 | *.msm 15 | *.msp 16 | 17 | # Windows shortcuts 18 | *.lnk 19 | 20 | # ========================= 21 | # Operating System Files 22 | # ========================= 23 | 24 | # OSX 25 | # ========================= 26 | 27 | .DS_Store 28 | .AppleDouble 29 | .LSOverride 30 | 31 | # Thumbnails 32 | ._* 33 | 34 | # Files that might appear in the root of a volume 35 | .DocumentRevisions-V100 36 | .fseventsd 37 | .Spotlight-V100 38 | .TemporaryItems 39 | .Trashes 40 | .VolumeIcon.icns 41 | 42 | # Directories potentially created on remote AFP share 43 | .AppleDB 44 | .AppleDesktop 45 | Network Trash Folder 46 | Temporary Items 47 | .apdisk 48 | -------------------------------------------------------------------------------- /Chapter08/Ch8_3.fsx: -------------------------------------------------------------------------------- 1 | /// A G G R E G A T O R S /// 2 | // associative operation min 3 | List.reduce min [1;2;3;4;5] 4 | // val it : int = 1 5 | List.reduceBack min [1;2;3;4;5] 6 | // val it : int = 1 7 | 8 | // non-associative operation (-) 9 | List.reduce (-) [1;2;3;4;5] 10 | // val it : int = -13 11 | List.reduceBack (-) [1;2;3;4;5] 12 | // val it : int = 3 13 | 14 | List.sumBy (fun x -> -x) [1;2;3] 15 | // val it : int = -6 16 | List.minBy (fun x -> -x) [1;2;3] 17 | // val it : int = 3 18 | 19 | let randoms lo hi len = 20 | let r = System.Random() 21 | let max = hi + 1 22 | let rec generate n = seq { 23 | if n < len then 24 | yield r.Next(lo,max) 25 | yield! generate (n + 1) 26 | } 27 | generate 0 28 | 29 | randoms 1 6 10000000 30 | |> Seq.countBy id 31 | |> Seq.toList 32 | |> printfn "%A" -------------------------------------------------------------------------------- /Chapter12/Ch12_2_Command.fsx: -------------------------------------------------------------------------------- 1 | // Command design pattern 2 | type OrderType = Sale | Refund 3 | type Transaction = Transaction of OrderType * decimal 4 | 5 | let sale total cost = total + cost 6 | let refund total cost = total - cost 7 | 8 | let Order total = function 9 | | Transaction(OrderType.Sale, cost) -> sale total cost 10 | | Transaction(OrderType.Refund, cost) -> refund total cost 11 | 12 | let Cancellation total = function 13 | | Transaction(OrderType.Sale, cost) -> refund total cost 14 | | Transaction(OrderType.Refund, cost) -> sale total cost 15 | 16 | let orderFlow = [Transaction(OrderType.Sale, 25.98M); Transaction(OrderType.Sale, 15.03M); 17 | Transaction(OrderType.Refund, 19.49M); Transaction(OrderType.Sale, 250.34M)] 18 | 19 | let totalForward = orderFlow |> Seq.fold Order 0.0M 20 | let totalBackward = orderFlow |> Seq.fold Cancellation totalForward -------------------------------------------------------------------------------- /Chapter07/Ch7_7.fsx: -------------------------------------------------------------------------------- 1 | // Active Patterns 2 | open System 3 | 4 | let (|Echo|) x = x 5 | 6 | let checkEcho p = 7 | match p with 8 | | Echo 42 -> "42!" 9 | | Echo x -> sprintf "%O is not good" x 10 | 11 | checkEcho 0 12 | checkEcho 42 13 | checkEcho "echo" // Does not compile! 14 | 15 | let (|``I'm active pattern``|) x = x + 2 16 | 17 | let x = match 40 with ``I'm active pattern`` x -> x 18 | 19 | let (``I'm active pattern`` x) = 40 20 | 21 | let hexCharSet = ['0'..'9'] @ ['a'..'f'] |> set in 22 | let (|IsValidGuidCode|) (guidstr: string) = 23 | let (|HasRightSize|) _ = guidstr.Length = 32 24 | let (|IsHex|) _ = (guidstr.ToLower() |> set) = hexCharSet 25 | match () with (HasRightSize rightsize & IsHex hex)-> rightsize && hex 26 | 27 | let (IsValidGuidCode valid) = "abc" 28 | let (IsValidGuidCode valid) = "0123456789AbCdEfFFEEDDCCbbAA9988" 29 | 30 | 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /Chapter07/Ch7_3.fsx: -------------------------------------------------------------------------------- 1 | let ``folding factorial (seq)`` n = 2 | let factors = Seq.init (n + 1) bigint.op_Implicit |> Seq.skip 1 3 | use er = factors.GetEnumerator() 4 | let mutable acc = 1I 5 | while er.MoveNext() do 6 | acc <- acc * er.Current 7 | acc 8 | 9 | let ``folding factorial (lib)`` n = 10 | Seq.init (n + 1) bigint.op_Implicit 11 | |> Seq.skip 1 12 | |> Seq.fold (*) 1I 13 | 14 | let howLong = (string >> String.length) 15 | 16 | howLong <| ``folding factorial (seq)`` 10000 17 | howLong <| ``folding factorial (lib)`` 10000 18 | 19 | // Excerpt from seq.fs of FSharp.Core.Collections: 20 | [] 21 | let fold<'T,'State> f (x:'State) (source : seq<'T>) = 22 | checkNonNull "source" source 23 | use e = source.GetEnumerator() 24 | let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) 25 | let mutable state = x 26 | while e.MoveNext() do 27 | state <- f.Invoke(state, e.Current) 28 | state -------------------------------------------------------------------------------- /Chapter03/Ch3_7.fsx: -------------------------------------------------------------------------------- 1 | let s = "I'm a string" 2 | 3 | let dict = 4 | System.Collections.Generic.Dictionary() 5 | 6 | let gameOutcome isWin = 7 | "You " + if isWin then "win" else "loose" 8 | 9 | // erroneous function definition - signature cannot be inferred 10 | let truncator limit s = 11 | if s.Length > limit then 12 | s.Substring(0, limit) 13 | else 14 | s 15 | // explicit parameter definition 16 | let truncator limit (s: string) = 17 | if s.Length > limit then 18 | s.Substring(0, limit) 19 | else 20 | s 21 | 22 | let truncator' limit s = 23 | if not (System.String.IsNullOrEmpty s) && s.Length > limit then 24 | s.Substring(0, limit) 25 | else 26 | s 27 | 28 | let logAndTrash ss = 29 | let log = System.Text.StringBuilder() 30 | for s in ss do 31 | sprintf "%A" s|> log.AppendLine |> ignore 32 | (ss :> System.IDisposable).Dispose() 33 | log 34 | -------------------------------------------------------------------------------- /Chapter07/Ch7_2.fsx: -------------------------------------------------------------------------------- 1 | // https://msdn.microsoft.com/en-us/library/dd233232.aspx 2 | // BEWARE: Does not work for test cases like Odd (even number) - recursion runs away! 3 | let rec Even x = if x = 0 then true else Odd (x - 1) 4 | and Odd x = if x = 1 then true else Even (x - 1) 5 | 6 | // Prime number generator using mutual recursion 7 | // The implementation is taken from my Stack Overflow answer at http://stackoverflow.com/a/9772027/917053 8 | #nowarn "40" 9 | 10 | let rec primes = 11 | Seq.cache <| seq { yield 2; yield! Seq.unfold nextPrime 3 } 12 | and nextPrime n = 13 | let next = n + if n%6 = 1 then 4 else 2 in 14 | if isPrime n then Some(n, next) else nextPrime next 15 | and isPrime n = 16 | if n >= 2 then 17 | primes 18 | |> Seq.tryFind (fun x -> n % x = 0 || x * x > n) 19 | |> fun x -> x.Value * x.Value > n 20 | else false 21 | 22 | let problem010 () = 23 | primes 24 | |> Seq.takeWhile ((>) 2000000) 25 | |> (Seq.map int64 >> Seq.sum) 26 | -------------------------------------------------------------------------------- /Chapter09/Ch9_1_6.fsx: -------------------------------------------------------------------------------- 1 | open System.Data 2 | open System.Data.SqlClient 3 | 4 | let connStr = @"Data Source=(localdb)\projectsv12;Initial Catalog=Adventureworks2014;Integrated Security=true;" 5 | let dbConnection = new SqlConnection(connStr) 6 | dbConnection.Open() 7 | 8 | let dbCommandF = 9 | new SqlCommand("select SUBSTRING(FirstName, 1, 1),count(distinct FirstName) as \"count\" 10 | from [Adventureworks2014].[Person].[Person] 11 | group by SUBSTRING(FirstName, 1, 1) 12 | order by count",dbConnection) 13 | 14 | let frequences = seq { 15 | printfn "reading from db" 16 | use reader = dbCommandF.ExecuteReader(CommandBehavior.Default) 17 | while reader.Read() do yield (reader.GetString(0), reader.GetInt32(1)) } 18 | 19 | let distribution = 20 | query { 21 | for freq in frequences do 22 | select freq 23 | } 24 | #time "on" 25 | distribution |> Seq.toList |> printfn "%A" 26 | -------------------------------------------------------------------------------- /Chapter09/Ch9_1_5.fsx: -------------------------------------------------------------------------------- 1 | open System.Data 2 | open System.Data.SqlClient 3 | 4 | let alphabet = seq { 'A' .. 'Z' } 5 | 6 | let connStr = @"Data Source=(localdb)\projectsv12;Initial Catalog=Adventureworks2014;Integrated Security=true;" 7 | let dbConnection = new SqlConnection(connStr) 8 | dbConnection.Open() 9 | 10 | let dbCommandR l = 11 | new SqlCommand( 12 | (sprintf "%s%s%s" "select distinct FirstName from [Person].[Person] where FirstName like '" l "%'"), 13 | dbConnection) 14 | 15 | let names l = seq { 16 | printfn "reading from db" 17 | use reader = (dbCommandR l).ExecuteReader(CommandBehavior.Default) 18 | while reader.Read() do yield reader.GetString(0) } 19 | 20 | let distribution = 21 | query { 22 | for letter in alphabet do 23 | let howMuch = names (string letter) |> Seq.length 24 | sortBy howMuch 25 | select (letter, howMuch) 26 | } 27 | #time "on" 28 | distribution |> Seq.toList |> printfn "%A" 29 | -------------------------------------------------------------------------------- /Chapter03/Ch3_3.fsx: -------------------------------------------------------------------------------- 1 | let stopWatchGenerator (f:('a->'b)) (x: 'a) : (('a->'b)->'a->'b) = 2 | let whoRunsMe = 3 | System 4 | .Diagnostics 5 | .Process 6 | .GetCurrentProcess() 7 | .MainModule 8 | .FileName 9 | |> System.IO.Path.GetFileNameWithoutExtension 10 | |> sprintf "[%s]:" in 11 | fun f x -> 12 | let stopWatch = System.Diagnostics.Stopwatch() in 13 | try 14 | stopWatch.Start() 15 | f x 16 | finally 17 | printf "Took %dms in %s\n" 18 | stopWatch.ElapsedMilliseconds 19 | whoRunsMe 20 | 21 | let whatItTakes f x = (stopWatchGenerator f x) f x 22 | 23 | whatItTakes (fun x -> seq {1L .. x} |> Seq.sum) 10000000L 24 | 25 | whatItTakes (fun cutoff -> 26 | (Seq.initInfinite (fun k -> (if k%2 = 0 then - 1.0 else 1.0)/((float k) * 2.0 - 1.0)) 27 | |> Seq.skip 1 28 | |> Seq.take cutoff 29 | |> Seq.sum) * 4.0) 2000000 30 | -------------------------------------------------------------------------------- /Chapter06/Ch6_2.fsx: -------------------------------------------------------------------------------- 1 | type private DummyEnumerate<'T>() = 2 | interface System.Collections.Generic.IEnumerator<'T> with 3 | member x.Current = Unchecked.defaultof<'T> 4 | 5 | interface System.Collections.IEnumerator with 6 | member x.Current = box Unchecked.defaultof<'T> 7 | member x.MoveNext() = false 8 | member x.Reset() = () 9 | 10 | interface System.IDisposable with 11 | member x.Dispose() = () 12 | 13 | let makeDummyEnumerator<'T>() = 14 | fun() -> (new DummyEnumerate<'T>() 15 | :> System.Collections.Generic.IEnumerator<'T>) 16 | 17 | let makeSeq enumerator = 18 | { 19 | new System.Collections.Generic.IEnumerable<_> with 20 | member x.GetEnumerator() = enumerator() 21 | interface System.Collections.IEnumerable with 22 | member x.GetEnumerator() = 23 | (enumerator() :> System.Collections.IEnumerator) 24 | } 25 | 26 | let ss = makeSeq (makeDummyEnumerator()) 27 | 28 | ss |> Seq.isEmpty 29 | ss |> Seq.length 30 | ss |> Seq.skip 10 31 | -------------------------------------------------------------------------------- /Chapter08/Ch8_6.fsx: -------------------------------------------------------------------------------- 1 | /// P A R T I T I O N I N G /// 2 | List.chunkBySize 2 ['a'..'g'] 3 | // val it : char list list = [['a'; 'b']; ['c'; 'd']; ['e'; 'f']; ['g']] 4 | 5 | List.groupBy (fun n -> n / 3) [1..7] 6 | // val it : (int * int list) list = [(0, [1; 2]); (1, [3; 4; 5]); (2, [6; 7])] 7 | 8 | List.pairwise [1..2..10] 9 | // val it : (int * int) list = [(1, 3); (3, 5); (5, 7); (7, 9)] 10 | 11 | ["angle";"delta";"cheese";"America"] 12 | |> List.partition (fun (x:string) -> (System.Char.ToUpper x.[0]) = 'A') 13 | // val it : string list * string list = 14 | // (["angle"; "America"], ["delta"; "cheese"]) 15 | 16 | ["angle";"delta";"cheese";"America"] 17 | |> List.splitAt 2 18 | // val it : string list * string list = 19 | // (["angle"; "delta"], ["cheese"; "America"]) 20 | 21 | ["angle";"delta";"cheese";"America"] 22 | |> List.splitInto 3 23 | // val it : string list list = 24 | // [["angle"; "delta"]; ["cheese"]; ["America"]] 25 | 26 | ["angle";"delta";"cheese";"America"] 27 | |> List.windowed 2 28 | // val it : string list list = 29 | // [["angle"; "delta"]; ["delta"; "cheese"]; ["cheese"; "America"]] -------------------------------------------------------------------------------- /Chapter09/Ch9_1_4.fsx: -------------------------------------------------------------------------------- 1 | open System.Data 2 | open System.Data.SqlClient 3 | 4 | let alphabet = seq { 'A' .. 'Z' } 5 | 6 | let connStr = @"Data Source=(localdb)\projectsv12;Initial Catalog=Adventureworks2014;Integrated Security=true;" 7 | let dbConnection = new SqlConnection(connStr) 8 | dbConnection.Open() 9 | 10 | let dbCommand = new SqlCommand("select FirstName from [Person].[Person]",dbConnection) 11 | let names = seq { 12 | printfn "reading from db" 13 | use reader = dbCommand.ExecuteReader(CommandBehavior.Default) 14 | while reader.Read() do yield reader.GetString(0) } 15 | let distribution = 16 | query { 17 | for letter in alphabet do 18 | let howMuch = 19 | query { 20 | for name in names do 21 | where (name.StartsWith(string letter)) 22 | distinct 23 | select name 24 | } |> Seq.length 25 | sortBy howMuch 26 | select (letter, howMuch) 27 | } 28 | #time "on" 29 | distribution |> Seq.toList |> printfn "%A" -------------------------------------------------------------------------------- /License: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016 Packt 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Chapter13/Ch13_4.fsx: -------------------------------------------------------------------------------- 1 | open System 2 | open System.Collections.Generic 3 | 4 | let size = 1000 5 | 6 | let keys = Array.zeroCreate size 7 | let mutable dictionary : IDictionary = 8 | Unchecked.defaultof> 9 | 10 | let generate () = 11 | for i in 0..(size-1) do 12 | keys.[i] <- Guid.NewGuid() 13 | 14 | dictionary <- seq { for i in 0..(size-1) -> (keys.[i],i) } |> dict 15 | 16 | generate() 17 | 18 | let trials = 10000000 19 | let rg = Random() 20 | 21 | let mutable result = 0 22 | for i in 0..trials-1 do 23 | result <- dictionary.Item(keys.[rg.Next(size-1)]) 24 | ////////////////////////////////////////// 25 | let keys' = Array.zeroCreate size 26 | let mutable dictionary' : IDictionary = 27 | Unchecked.defaultof> 28 | 29 | let generate' () = 30 | for i in 0..(size-1) do 31 | keys'.[i] <- keys.[i].ToString("N") 32 | 33 | dictionary' <- seq { for i in 0..(size-1) -> (keys'.[i],i) } |> dict 34 | 35 | generate'() 36 | 37 | for i in 0..trials-1 do 38 | result <- dictionary'.Item(keys'.[rg.Next(size-1)]) 39 | -------------------------------------------------------------------------------- /Chapter01/Ch1_2.fsx: -------------------------------------------------------------------------------- 1 | // Object-oriented solution a-la C# with Iterator pattern 2 | #load "HugeNumber.fs" 3 | 4 | open System 5 | open System.Collections.Generic 6 | 7 | type OfDigits(digits: char[]) = 8 | let mutable product = 1 9 | do 10 | if digits.Length > 9 then // (9 ** 10) > Int32.MaxValue 11 | raise <| ArgumentOutOfRangeException("Constrained to max 9 digit numbers") 12 | let charZero = int '0' in 13 | for d in digits do 14 | product <- product * ((int d) - charZero) 15 | member this.Product 16 | with get() = product 17 | 18 | type SequenceOfDigits(digits: string, itemLen: int) = 19 | let collection: OfDigits[] = Array.zeroCreate (digits.Length - itemLen + 1) 20 | do 21 | for i in 0 .. digits.Length - itemLen do 22 | collection.[i] <- OfDigits(digits.[i..(i+itemLen-1)].ToCharArray()) 23 | member this.GetEnumerator() = 24 | (collection :> IEnumerable).GetEnumerator() 25 | 26 | let mutable maxProduct = 1 27 | for item in SequenceOfDigits(hugeNumber,5) do 28 | maxProduct <- max maxProduct item.Product 29 | 30 | printfn "%s %d" "Object-oriented solution:" maxProduct -------------------------------------------------------------------------------- /Chapter11/Ch11_1.fsx: -------------------------------------------------------------------------------- 1 | #I __SOURCE_DIRECTORY__ 2 | #r @"../packages/FSharp.Data.SqlClient.1.8.1/lib/net40/FSharp.Data.SqlClient.dll" 3 | open FSharp.Data 4 | open System.Diagnostics 5 | 6 | [] 7 | let connStr = @"Data Source=(localdb)\ProjectsV12;Initial Catalog=demo;Integrated Security=True" 8 | 9 | type Mock = SqlCommandProvider<"exec MockQuery", connStr> 10 | 11 | let querySync nReq = 12 | use cmd = new Mock() 13 | seq { 14 | for i in 1..nReq do 15 | yield (cmd.Execute() |> Seq.head) 16 | } |> Seq.sum 17 | 18 | let query _ = 19 | use cmd = new Mock() 20 | async { 21 | let! resp = cmd.AsyncExecute() 22 | return (resp |> Seq.head) 23 | } 24 | 25 | let queryAsync nReq = 26 | [| for i in 1..nReq -> i |] 27 | |> Array.map query 28 | |> Async.Parallel 29 | |> Async.RunSynchronously 30 | |> Array.sum 31 | 32 | let timing header f args = 33 | let watch = Stopwatch.StartNew() 34 | f args |> printfn "%s %s %d" header "result =" 35 | let elapsed = watch.ElapsedMilliseconds 36 | watch.Stop() 37 | printfn "%s: %d %s %d %s" header elapsed "ms. for" args "requests" 38 | 39 | timing "SyncIO" querySync 100 40 | timing "AsyncIO" queryAsync 100 -------------------------------------------------------------------------------- /Chapter01/HugeNumber.fs: -------------------------------------------------------------------------------- 1 | [] 2 | module HugeNumber 3 | let hugeNumber = 4 | "73167176531330624919225119674426574742355349194934\ 5 | 96983520312774506326239578318016984801869478851843\ 6 | 85861560789112949495459501737958331952853208805511\ 7 | 12540698747158523863050715693290963295227443043557\ 8 | 66896648950445244523161731856403098711121722383113\ 9 | 62229893423380308135336276614282806444486645238749\ 10 | 30358907296290491560440772390713810515859307960866\ 11 | 70172427121883998797908792274921901699720888093776\ 12 | 65727333001053367881220235421809751254540594752243\ 13 | 52584907711670556013604839586446706324415722155397\ 14 | 53697817977846174064955149290862569321978468622482\ 15 | 83972241375657056057490261407972968652414535100474\ 16 | 82166370484403199890008895243450658541227588666881\ 17 | 16427171479924442928230863465674813919123162824586\ 18 | 17866458359124566529476545682848912883142607690042\ 19 | 24219022671055626321111109370544217506941658960408\ 20 | 07198403850962455444362981230987879927244284909188\ 21 | 84580156166097919133875499200524063689912560717606\ 22 | 05886116467109405077541002256983155200055935729725\ 23 | 71636269561882670428252483600823257530420752963450" 24 | -------------------------------------------------------------------------------- /Chapter12/Ch12_4_Strategy.fsx: -------------------------------------------------------------------------------- 1 | open System 2 | open System.Data 3 | 4 | type InvoiceFormat = 5 | | Excel 6 | | Csv 7 | 8 | let load (format: InvoiceFormat) (path: String) = 9 | printfn "loading %s" path 10 | let dt = new DataTable() in 11 | (* IMPLEMENTATION GOES HERE *) 12 | dt 13 | let merge (target: string) (dt: DataTable) = 14 | (* IMPLEMENTATION GOES HERE *) 15 | () 16 | 17 | type ILoadVendorInvoices = 18 | abstract LoadInvoices: String -> DataTable 19 | abstract member MergeInvoices: DataTable -> unit 20 | 21 | let LoadFedex = 22 | { new ILoadVendorInvoices with 23 | member __.LoadInvoices path = load Csv path 24 | member __.MergeInvoices dataTable = 25 | merge "Fedex" dataTable 26 | } 27 | 28 | let LoadLasership = 29 | { new ILoadVendorInvoices with 30 | member __.LoadInvoices path = load Excel path 31 | member __.MergeInvoices dataTable = 32 | merge "Lasership" dataTable 33 | } 34 | 35 | let importEDIData (loader: ILoadVendorInvoices) path = 36 | loader.LoadInvoices path |> loader.MergeInvoices 37 | 38 | [(LoadFedex,"inv2016_8_10.csv"); 39 | (LoadLasership,"inv2016_8_10.xlsx"); 40 | (LoadFedex,"inv2016_8_11.csv")] 41 | |> List.iter (fun x -> x ||> importEDIData) -------------------------------------------------------------------------------- /Chapter08/Ch8_8.fsx: -------------------------------------------------------------------------------- 1 | // Converting from recursive integerPow 2 | let rec power (value: double) = function 3 | | neg when neg < 0 -> 1./power value (-neg) 4 | | 0 -> 1. 5 | | 1 -> value 6 | | pow -> match pow % 2 with 7 | | 0 -> let half = (power value (pow / 2)) in half * half 8 | | _ -> let half = (power value (pow / 2)) in value * half * half 9 | 10 | // to folding 11 | let intPow ``base`` exp = 12 | seq { 13 | let exp = ref exp in 14 | while !exp > 0 do 15 | yield !exp &&& 1 16 | exp := !exp >>> 1 17 | } 18 | |> Seq.fold (fun (b,r) i -> if i = 1 then (b*b, r * b) else (b * b, r)) (``base``,1) 19 | |> snd 20 | 21 | // to unfold 22 | let intPow'' ``base`` exp = 23 | Seq.unfold ( 24 | function 25 | | (_,_,0) -> None 26 | | (result,``base``,exp) -> 27 | let ``base*base``,halfexp = ``base``*``base``,exp >>> 1 in 28 | if exp &&& 1 = 1 then 29 | let ``result*base`` = result * ``base`` in 30 | Some(``result*base``,(``result*base``,``base*base``,halfexp)) 31 | else 32 | Some(result,(result,``base*base``,halfexp)) 33 | ) 34 | (1,``base``,exp) 35 | |> Seq.last 36 | 37 | 38 | 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /Chapter11/KeyTypeProvider.fs: -------------------------------------------------------------------------------- 1 | namespace FSharp.IO.DesignTime 2 | 3 | #nowarn "0025" 4 | 5 | open System.Reflection 6 | open System.IO 7 | open Microsoft.FSharp.Core.CompilerServices 8 | open ProviderImplementation.ProvidedTypes 9 | 10 | [] 11 | type public KeyStringProvider(config : TypeProviderConfig) as this = 12 | inherit TypeProviderForNamespaces() 13 | 14 | let nameSpace = "FSharp.IO" 15 | let assembly = Assembly.LoadFrom(config.RuntimeAssembly) 16 | let providerType = ProvidedTypeDefinition(assembly, nameSpace, "SecretKey", baseType = None, HideObjectMethods = true) 17 | 18 | do 19 | providerType.DefineStaticParameters( 20 | parameters = [ ProvidedStaticParameter("Path", typeof) ], 21 | instantiationFunction = fun typeName [| :? string as path |] -> 22 | let t = ProvidedTypeDefinition(assembly, nameSpace, typeName, baseType = Some typeof, HideObjectMethods = true) 23 | let fullPath = if Path.IsPathRooted(path) then path else Path.Combine(config.ResolutionFolder, path) 24 | let content = File.ReadAllText(fullPath) 25 | t.AddMember <| ProvidedLiteralField("Key", typeof, content) 26 | t 27 | ) 28 | 29 | this.AddNamespace(nameSpace, [ providerType ]) 30 | 31 | [] 32 | do() -------------------------------------------------------------------------------- /Chapter06/Ch6_5.fsx: -------------------------------------------------------------------------------- 1 | let makeSeq f = 2 | { 3 | new System.Collections.Generic.IEnumerable<'U> with 4 | member x.GetEnumerator() = printfn "Fresh enumerator given"; f() 5 | interface System.Collections.IEnumerable with 6 | member x.GetEnumerator() = 7 | (f() :> System.Collections.IEnumerator) 8 | } 9 | 10 | //caching 11 | let nums = (seq {1..100}).GetEnumerator |> makeSeq 12 | // non-cached - double enumeration 13 | ((nums |> Seq.sum),(nums |> Seq.length)) 14 | //Fresh enumerator given 15 | //Fresh enumerator given 16 | //val it : int * int = (5050, 100) 17 | 18 | let cache = nums |> Seq.cache 19 | // cached - single enumeration 20 | ((cache |> Seq.sum),(cache |> Seq.length)) 21 | //Fresh enumerator given 22 | //val it : int * int = (5050, 100) 23 | // just another time - no enumerations at all 24 | ((cache |> Seq.sum),(cache |> Seq.length)) 25 | //val it : int * int = (5050, 100) 26 | 27 | 28 | // fusion 29 | let series = (seq {1..100}).GetEnumerator |> makeSeq 30 | let average dd = (Seq.sum dd) / (Seq.length dd) 31 | average series 32 | //Fresh enumerator given 33 | //Fresh enumerator given 34 | //val it : int = 50 35 | 36 | let averageFused dd = 37 | dd 38 | |> Seq.fold (fun acc x -> (fst acc + x, snd acc + 1)) (0,0) 39 | |> fun x -> fst x / snd x 40 | averageFused series 41 | //Fresh enumerator given 42 | //val it : int = 50 43 | 44 | -------------------------------------------------------------------------------- /Chapter10/Ch10_3.fsx: -------------------------------------------------------------------------------- 1 | let inline nextHigher number = 2 | let g0 = LanguagePrimitives.GenericZero<'a> 3 | let g1 = LanguagePrimitives.GenericOne<'a> 4 | let g10 = (g1 <<< 3) + (g1 <<< 1) 5 | 6 | let toDigits n = 7 | let rec toDigitList digits n = 8 | if n = g0 then digits 9 | else toDigitList ((n % g10) :: digits) (n / g10) 10 | toDigitList [] n 11 | 12 | let fromDigits digits = 13 | let rec fromDigitList n = function 14 | | [] -> n 15 | | h::t -> fromDigitList (n * g10 + h) t 16 | fromDigitList g0 digits 17 | 18 | let make p ll = 19 | ll |> List.rev |> List.partition ((<) p) 20 | |> fun (x,y) -> (x.Head::y) @ (p::(x.Tail)) 21 | 22 | let rec scan (changing: 'a list) source = 23 | match source with 24 | | [] -> changing 25 | | h::t -> if h >= changing.Head then 26 | scan (h::changing) t 27 | else 28 | (List.rev t) @ (make h changing) 29 | 30 | number |> toDigits |> List.rev 31 | |> fun x -> scan [(x.Head)] (x.Tail) |> fromDigits 32 | 33 | nextHigher 1987654321 34 | nextHigher 987654321L 35 | nextHigher 32154321 36 | nextHigher 12uy 37 | nextHigher 5598734987954054911111111111111I 38 | nextHigher 12222 39 | nextHigher 136442n // It even works with nativeInts!! 40 | //nextHigher 10.0 error: float does not support <<< 41 | nextHigher 'A' 42 | -------------------------------------------------------------------------------- /Chapter08/Ch8_4.fsx: -------------------------------------------------------------------------------- 1 | let eagerList = [ 2 | printfn "Evaluating eagerList" 3 | yield "I" 4 | yield "am" 5 | yield "an" 6 | yield "eager" 7 | yield "list" 8 | ] 9 | // Evaluating eagerList 10 | // val eagerList : string list = ["I"; "am"; "an"; "eager"; "list"] 11 | 12 | let delayedEagerList = Seq.delay(fun () -> ([ 13 | printfn "Evaluating eagerList" 14 | yield "I" 15 | yield "am" 16 | yield "an" 17 | yield "eager" 18 | yield "list" 19 | ] |> Seq.ofList)) 20 | // val delayedEagerList : seq 21 | 22 | delayedEagerList |> Seq.toList 23 | // Evaluating eagerList 24 | // val it : string list = ["I"; "am"; "an"; "eager"; "list"] 25 | 26 | let src = [|1;2;3|] 27 | let srcAsSeq = src :> seq<_> 28 | let backdoor = srcAsSeq :?> int array 29 | backdoor.[0] <- 10 30 | printfn "%A" src 31 | 32 | let srcAsROSeq = src |> Seq.readonly 33 | let tryBackDoor = srcAsROSeq :?> int array // incur exception 34 | // System.InvalidCastException: Unable to cast object of type 'mkSeq@541[System.Int32]' to type 'System.Int32[]'. 35 | tryBackDoor.[0] <- 20 36 | printfn "%A" src 37 | 38 | let s = System.Collections.Stack() 39 | s.Push(1) 40 | s.Push('2') 41 | s.Push("xyzzy") 42 | s |> Seq.cast<_> |> printfn "%A" //!!! 43 | -------------------------------------------------------------------------------- /Chapter07/Ch7_8.fsx: -------------------------------------------------------------------------------- 1 | // Partial AP 2 | open System.IO 3 | 4 | type Processable = 5 | | FedexFile 6 | | OnTracFile 7 | | BrainTreeFile 8 | with 9 | override this.ToString() = match this with FedexFile -> "Fedex" | OnTracFile -> "OnTrac" | BrainTreeFile -> "BrainTree" 10 | 11 | let BraintreeHdr = "Transaction ID,Subscription ID,Transaction Type,Transaction Status,Escrow Status,Created Datetime,Created Timezone,Settlement Date,Disbursement Date,..." 12 | let FedexHdr = "\"Bill to Account Number\";\"Invoice Date\";\"Invoice Number\";..." 13 | let OntracHdr = "AccountNum,InvoiceNum,Reference,ShipDate,TotalCharge,Tracking,..." 14 | 15 | //let (|IsProcessable|_|) (stream: Stream) : Processable option = 16 | let (|IsProcessable|_|) (stream: Stream) = 17 | use streamReader = new StreamReader(stream) 18 | let hdr = streamReader.ReadLine() 19 | [(Processable.BrainTreeFile,BraintreeHdr);(Processable.FedexFile,FedexHdr);(Processable.OnTracFile,OntracHdr)] 20 | |> List.tryFind (fun x -> (snd x) = hdr) 21 | |> function None -> (if hdr.StartsWith("\"1\",") then Some (Processable.OnTracFile) else None) | _ as zx -> Some (fst zx.Value) 22 | 23 | // Usage: 24 | // use contents = getContents uploadedFileName // getContents returns MemoryStream containing uploaded CSV off the latter name 25 | // match (contents) with 26 | // | LoadCSVtoSQL.Tools.IsProcessable csvType -> processContents uploadedFileName csvType 27 | // | _ -> Logger.logger.Info (sprintf "Uploaded %s contents does not belong to processable CSV types; skipping without registering" uploadedFileName) 28 | -------------------------------------------------------------------------------- /Chapter06/Ch6_3.fsx: -------------------------------------------------------------------------------- 1 | type private Repeater<'T>(repeated) = 2 | let _repeated = repeated 3 | interface System.Collections.Generic.IEnumerator<'T> with 4 | member x.Current = _repeated 5 | 6 | interface System.Collections.IEnumerator with 7 | member x.Current = box _repeated 8 | member x.MoveNext() = true 9 | member x.Reset() = () 10 | 11 | interface System.IDisposable with 12 | member x.Dispose() = () 13 | 14 | let repeat<'T>(i) = 15 | (new Repeater<'T>(i) 16 | :> System.Collections.Generic.IEnumerator<'T>) 17 | 18 | let makeSeq enumerator = 19 | { 20 | new System.Collections.Generic.IEnumerable<'U> with 21 | member x.GetEnumerator() = enumerator 22 | interface System.Collections.IEnumerable with 23 | member x.GetEnumerator() = 24 | (enumerator :> System.Collections.IEnumerator) 25 | } 26 | 27 | makeSeq (repeat '.') 28 | repeat 42 |> makeSeq 29 | makeSeq <| repeat "Hooray!" 30 | 31 | let inline traverse n s = 32 | let counter = 33 | (Seq.zip 34 | (seq { LanguagePrimitives.GenericOne..n }) s) 35 | .GetEnumerator() 36 | let i = ref LanguagePrimitives.GenericOne 37 | let mutable last = Unchecked.defaultof<_> 38 | while counter.MoveNext() do 39 | if !i = n then last <- counter.Current 40 | i := !i + LanguagePrimitives.GenericOne 41 | last 42 | 43 | makeSeq <| repeat '.' |> traverse 10000I 44 | makeSeq <| repeat 42 |> traverse ((System.Int32.MaxValue |> int64) + 10L) 45 | 46 | 47 | -------------------------------------------------------------------------------- /Chapter12/Ch12_3_Template.fsx: -------------------------------------------------------------------------------- 1 | // Template design pattern 2 | open System 3 | 4 | type PayBy = ACH | Check | Wire 5 | override x.ToString() = 6 | match x with 7 | | ACH -> "By ACH" 8 | | Check -> "By Check" 9 | | Wire -> "By Wire" 10 | 11 | type Payment = string 12 | type BankReqs = { ABA: string; Account: string} 13 | type Merchant = { MerchantId: Guid; Requisites: BankReqs } 14 | 15 | type ITemplate = 16 | abstract GetPaymentDue: Guid -> Merchant*decimal 17 | abstract FormatPayment: Merchant*decimal -> Payment 18 | abstract SubmitPayment: Payment -> bool 19 | 20 | let Template payBy = 21 | { new ITemplate with 22 | member __.GetPaymentDue merchantId = 23 | printfn "Getting payment due of %s" (merchantId.ToString()) 24 | (* mock access to ERP getting Accounts payable due for merchantId *) 25 | ({ MerchantId = merchantId; Requisites = {ABA="021000021"; Account="123456789009"} }, 25366.76M) 26 | member __.FormatPayment (m,t) = 27 | printfn "Formatting payment of %s" (m.MerchantId.ToString()) 28 | sprintf "%s:%s:%s:%s:%.2f" "Payment to" m.Requisites.ABA m.Requisites.Account (payBy.ToString()) t 29 | member __.SubmitPayment p = 30 | printfn "Submitting %s..." p 31 | true 32 | } 33 | 34 | let makePayment merchantId payBy = 35 | let template = Template payBy in 36 | template.GetPaymentDue merchantId 37 | |> template.FormatPayment 38 | |> template.SubmitPayment 39 | 40 | makePayment (Guid.NewGuid()) Check 41 | makePayment (Guid.NewGuid()) ACH -------------------------------------------------------------------------------- /Chapter07/Ch7_4.fsx: -------------------------------------------------------------------------------- 1 | // Memoization (F# 4.0 is required) 2 | let memoize f = 3 | let mutable cache = Map.empty 4 | fun x -> 5 | match cache.TryFind(x) with 6 | | Some res -> printfn "returned memoized";res 7 | | None -> let res = f x in 8 | cache <- cache.Add(x,res) 9 | printfn "memoized, then returned"; res 10 | 11 | let fm = memoize (fun x -> x * x) 12 | fm 10 13 | fm 42 14 | fm 10 15 | 16 | let memoize' f = 17 | let cache = System.Collections.Generic.Dictionary() 18 | fun x -> 19 | match cache.TryGetValue(x) with 20 | | true,res -> printfn "returned memoized";res 21 | | _ -> let res = f x 22 | cache.Add(x,res) 23 | printfn "memoized, then returned" 24 | res 25 | 26 | let disaster = memoize' (fun () -> 5) 27 | disaster() 28 | 29 | #nowarn "40" 30 | let rec binomial n k = 31 | if k = 0 || k = n then 1 32 | else 33 | binomial (n - 1) k + binomial (n - 1) (k - 1) 34 | 35 | let rec memoizedBinomial = 36 | let memoize f = 37 | let cache = System.Collections.Generic.Dictionary() 38 | fun x -> 39 | match cache.TryGetValue(x) with 40 | | true,res -> res 41 | | _ -> let res = f x 42 | cache.Add(x,res) 43 | res 44 | memoize 45 | (fun (n,k) -> 46 | if k = 0 || k = n then 1 47 | else 48 | memoizedBinomial (n - 1, k) + memoizedBinomial (n - 1,k - 1)) 49 | 50 | for i in [0..10000] do ignore <| binomial 500 2 51 | for i in [0..10000] do ignore <| memoizedBinomial (500,2) 52 | -------------------------------------------------------------------------------- /Chapter10/Ch10_1.fsx: -------------------------------------------------------------------------------- 1 | open System 2 | 3 | let reverse ls = 4 | let rec rev acc = function 5 | | h::t -> rev (h::acc) t 6 | | [] -> acc 7 | rev [] ls 8 | 9 | reverse [1;2;3] 10 | // val it : int list = [3; 2; 1] 11 | reverse ["1";"2";"3"] 12 | // val it : string list = ["3"; "2"; "1"] 13 | reverse [box 1.0; box 2.0M; box 3I] 14 | //val it : obj list = [3 {IsEven = false; 15 | // IsOne = false; 16 | // IsPowerOfTwo = false; 17 | // IsZero = false; 18 | // Sign = 1;}; 2.0M; 1.0] 19 | 20 | ///////////////Demoing the problem with static constrains 21 | let twice x = x <<< 1 22 | twice 10L 23 | // twice 10 - compilation error! 24 | 25 | let inline twice' x = x <<< 1 26 | twice' 5 // int32 27 | twice' 5u // uint32 28 | twice' 5L // int64 29 | twice' 5UL // uint64 30 | twice' 5y // sbyte 31 | twice' 5uy // byte 32 | twice' 5s // int16 33 | twice' 5us // uint16 34 | twice' 5I // biginteger 35 | twice' 5n // nativeint 36 | 37 | twice' 5m 38 | twice' 5.0 39 | twice' "5" 40 | twice' '5' 41 | 42 | /////////////////////////////////////////// 43 | let floats = [|1.0..100000000.0|] 44 | 45 | let inline sum' x y = x + y 46 | 47 | let inline fold f a (xs: _ []) = 48 | let mutable a = a 49 | for i=0 to xs.Length-1 do 50 | a <- f a xs.[i] 51 | a 52 | 53 | let sum'' (x:float) (y: float) = x + y 54 | 55 | let fold' f a (xs: _ []) = 56 | let mutable a = a 57 | for i=0 to xs.Length-1 do 58 | a <- f a xs.[i] 59 | a 60 | fold' sum'' 0.0 floats 61 | 62 | 63 | fold sum' 0.0 floats 64 | floats |> Array.fold (+) 0.0 65 | 66 | -------------------------------------------------------------------------------- /Chapter09/SCHEMA_LaserShip.sql: -------------------------------------------------------------------------------- 1 | IF OBJECT_ID('[dbo].[LaserShip]','U') IS NOT NULL 2 | DROP TABLE [dbo].[LaserShip] 3 | GO 4 | CREATE TABLE [dbo].[LaserShip]( 5 | [invno] nvarchar(13) NOT NULL, 6 | [JobNumber] nvarchar(14) NOT NULL, 7 | [TDate] nvarchar(18) NOT NULL, 8 | [Reference] nvarchar(49) NULL, 9 | [LSTrackingNumber] nvarchar(20) NULL, 10 | [Caller] nvarchar(36) NULL, 11 | [FromName] nvarchar(19) NULL, 12 | [FromNumber] nvarchar(10) NULL, 13 | [FromStreet] nvarchar(20) NULL, 14 | [FromRoom] nvarchar(17) NULL, 15 | [FromCity] nvarchar(10) NULL, 16 | [FromZip] nvarchar(10) NULL, 17 | [ToName] nvarchar(50) NOT NULL, 18 | [ToNumber] nvarchar(13) NULL, 19 | [ToStreet] nvarchar(50) NULL, 20 | [ToRoom] nvarchar(50) NULL, 21 | [ToCity] nvarchar(23) NOT NULL, 22 | [ToZip] nvarchar(5) NOT NULL, 23 | [ServiceCode] nvarchar(11) NOT NULL, 24 | [ServiceAmount] decimal(18,2) NULL, 25 | [ExtraCode1] nvarchar(10) NULL, 26 | [Extra1Amount] decimal(18,2) NULL, 27 | [ExtraCode2] nvarchar(10) NULL, 28 | [Extra2Amount] decimal(18,2) NULL, 29 | [ExtraCode3] nvarchar(10) NULL, 30 | [Extra3Amount] decimal(18,2) NULL, 31 | [ExtraCode4] nvarchar(10) NULL, 32 | [Extra4Amount] decimal(18,2) NULL, 33 | [EN] decimal(18,2) NULL, 34 | [Tax] decimal(18,2) NULL, 35 | [Total] decimal(18,2) NULL, 36 | [Zone] nvarchar(4) NULL, 37 | [Weight] decimal(18,2) NULL, 38 | [POD] nvarchar(50) NULL, 39 | [PODDate] nvarchar(50) NOT NULL, 40 | [PODTime] nvarchar(8) NOT NULL, 41 | [PickupDate] nvarchar(50) NULL, 42 | [SourceId] int NOT NULL, 43 | [RowKey] BigInt IDENTITY(1,1) NOT NULL 44 | CONSTRAINT [PK_LaserShip] PRIMARY KEY ([RowKey]) 45 | ) 46 | -------------------------------------------------------------------------------- /Chapter09/Ch9_3.fsx: -------------------------------------------------------------------------------- 1 | #r "FSharp.Data.TypeProviders" 2 | #r "System.Data" 3 | #r "System.Data.Linq" 4 | 5 | open Microsoft.FSharp.Data.TypeProviders 6 | open System.Linq 7 | 8 | [] 9 | let runTimeCsusCS = @"Data Source=***;Initial Catalog=SQL.Colossus;User ID=***;Password=***" 10 | 11 | type Colossus = SqlDataConnection 12 | 13 | let pmtContext = Colossus.GetDataContext(runTimeCsusCS) 14 | pmtContext.Payments.Context.Log <- new System.IO.StreamWriter(@"C:\users\gene\downloads\0\pmtlinq.log", AutoFlush = true) 15 | //// COMPOSABLE //// 16 | type PartialQueryBuilder() = 17 | inherit Linq.QueryBuilder() 18 | member __.Run(e: Quotations.Expr>) = e 19 | 20 | let pquery = PartialQueryBuilder() 21 | 22 | type Linq.QueryBuilder with 23 | [] 24 | member __.Source(qs: Linq.QuerySource<'T,_>) = qs 25 | 26 | let mostPaid = pquery { 27 | for payment in pmtContext.Payments do 28 | where (payment.IsDeposited.HasValue && payment.IsDeposited.Value) 29 | groupBy payment.MerchantId into p 30 | let total = pquery { for payment in p do sumBy payment.Amount} 31 | sortByDescending total 32 | select (p.Key,total) 33 | take 10 34 | } 35 | 36 | let dashboard = pquery { 37 | for merchant in pmtContext.Partner do 38 | for (id,total) in %mostPaid do 39 | where (merchant.MerchantId = id ) 40 | select (merchant.DisplayName, total) 41 | } 42 | 43 | query { for m in %dashboard do 44 | select m } |> Seq.iter (fun x -> printfn "%s: %.2f" (fst x) (snd x)) -------------------------------------------------------------------------------- /Chapter06/Ch6_4.fsx: -------------------------------------------------------------------------------- 1 | // Sequence comprehensions 2 | // Range 3 | let int64odds = seq { 1L..2L..1000L } 4 | seq { 'A'..'Z' } 5 | 6 | // Maps 7 | seq { for i in 1..2..999 -> ((+) 1 i) } 8 | seq { for i in 1..10 do for j in 1..10 -> if i = j then 1 else 0} 9 | seq { for i in 1..10 do for j in 1..10 -> (i,j) } 10 | seq { for i in seq {'a'..'b'} do for j in 1..2 -> (i,j) } 11 | 12 | // Arbitrary sequence expressions 13 | #nowarn "40" 14 | 15 | 16 | // Finite sequence with pattern match for halting 17 | let rec descend top = 18 | seq { 19 | match top with 20 | | _ when top < 0 -> () 21 | | _ -> 22 | yield top 23 | yield! descend (top - 1) 24 | } 25 | 26 | descend 3 27 | descend -3 28 | 29 | // Dumb infinite word list 30 | let rec fizzbuzz = seq { 31 | yield "Fizz" 32 | yield "Buzz" 33 | yield! fizzbuzz 34 | } 35 | in fizzbuzz 36 | 37 | // Turning any sequence into infinite circular 38 | let rec circular ss = 39 | seq { yield! ss; yield! circular ss } 40 | 41 | circular (seq { yield '+'; yield '-' }) 42 | // val it : seq = seq ['+'; '-'; '+'; '-'; ...] 43 | 44 | // Seq.init 45 | Seq.init 10 (sprintf "%s%d" "I'm element #") 46 | //val it : seq = 47 | // seq 48 | // ["I'm element # 0"; "I'm element # 1"; "I'm element # 2"; 49 | // "I'm element # 3"; ...] 50 | 51 | Seq.initInfinite (fun _ -> ()) 52 | |> Seq.skip (System.Int32.MaxValue) 53 | //> 54 | //val it : seq = 55 | // Error: Enumeration based on System.Int32 exceeded System.Int32.MaxValue. 56 | 57 | // Seq.unfold 58 | // Oh NO! Not Fibonacci again! 59 | let fibnums = Seq.unfold (fun (current, next) -> 60 | Some(current, (next, current+next)))(1,1) 61 | 62 | fibnums |> Seq.take 10 |> Seq.toList 63 | // val it : int list = [1; 1; 2; 3; 5; 8; 13; 21; 34; 55] 64 | 65 | -------------------------------------------------------------------------------- /Chapter10/Ch10_4.fsx: -------------------------------------------------------------------------------- 1 | // 2 | //[] // Uncomment to augment the type 3 | type Outcome = 4 | | Success 5 | | Failure 6 | with 7 | member x.IsFailure = 8 | match x with 9 | | Failure -> true 10 | | _ -> false 11 | member x.IsSuccess = not x.IsFailure 12 | 13 | ///////////////////////// Augmentation 14 | type ITransaction = interface end 15 | 16 | type Sale = 17 | | DirectSale of decimal 18 | | ManualSale of decimal 19 | interface ITransaction 20 | 21 | type Refund = 22 | | Refund of decimal 23 | interface ITransaction 24 | 25 | //type Transaction = 26 | // | Sale of Sale 27 | // | Refund of Refund 28 | // 29 | //let ll: Transaction list = [Sale (DirectSale 5.00M); Sale (ManualSale 5.00M); Refund (Refund.Refund -1.00M)] 30 | 31 | let ll': obj list = [box (DirectSale 10.00M); box (Refund -3.99M)] 32 | 33 | let mixer (x: ITransaction) = x 34 | 35 | let ll'': ITransaction list = [mixer(DirectSale 10.00M); mixer(Refund -3.99M)] 36 | let ll''': list<_> = [mixer(DirectSale 10.00M); mixer(Refund -3.99M)] 37 | 38 | #nowarn "25" 39 | let disassemble (x: ITransaction) = 40 | match x with 41 | | :? Sale as sale -> (function DirectSale amount -> (sprintf "%s%.2f" "Direct sale: " amount, amount) 42 | | ManualSale amount -> (sprintf "%s%.2f" "Manual sale: " amount, amount)) sale 43 | | :? Refund as refund -> (function Refund amount -> (sprintf "%s%.2f" "Refund: " amount, amount)) refund 44 | 45 | [mixer(DirectSale 4.12M);mixer(Refund -0.10M);mixer(ManualSale 3.62M)] 46 | |> List.fold (fun (details, total) transaction -> 47 | let message, amount = disassemble transaction in 48 | (message::details, total + amount)) 49 | ([],0.00M) 50 | |> fun (details,total) -> 51 | (sprintf "%s%.2f" "Total: " total) :: details 52 | |> List.iter (printfn "%s") 53 | -------------------------------------------------------------------------------- /Chapter10/Ch10_2.fsx: -------------------------------------------------------------------------------- 1 | let inline constrained (param: ^a 2 | when ^a: equality and ^a: comparison) = () 3 | 4 | type Good = Good 5 | 6 | []type Bad = Bad 7 | 8 | Good |> constrained 9 | // Compiles just fine 10 | Bad |> constrained 11 | // Error: type Bad does not support comparison constraint 12 | 13 | //////////////////////////////////////////////////////////////////////////// 14 | [] 15 | module Restrict = 16 | let inline private impl restricted = 17 | printfn "%s type is OK" (restricted.GetType().FullName) 18 | 19 | type Restricting = Restrict with 20 | static member ($) (Restrict, value: byte) = impl value 21 | static member ($) (Restrict, value: sbyte) = impl value 22 | static member ($) (Restrict, value: int) = impl value 23 | static member ($) (Restrict, value: uint32) = impl value 24 | static member ($) (Restrict, value: bigint) = impl value 25 | 26 | let inline doit restricted = Restrict $ restricted 27 | 28 | doit 1uy 29 | doit 1y 30 | doit 1 31 | doit 1u 32 | doit 1I 33 | doit 1L // does not compile 34 | doit 1.0 // does not compile 35 | doit 1.0m // does not compile 36 | doit '1' // does not compile 37 | 38 | ////////////////////////////////////////////////////////////////////////////////// 39 | type Bar() = 40 | static member doIt() = 42 41 | 42 | type Foo< ^T when ^T: (static member doIt: unit -> int)>(data: ^T []) = 43 | member inline this.Invoke () = (^T : (static member doIt : unit -> int) ()) 44 | 45 | let result = (Foo([|Bar()|]).Invoke()) 46 | 47 | /////////////// Optimizations///////////////////////////// 48 | open System 49 | #time "on" 50 | let x, y = DateTime.MinValue, DateTime.MaxValue 51 | for i = 0 to 10000000 do x = y |> ignore 52 | //Real: 00:00:00.421, CPU: 00:00:00.406, GC gen0: 115, gen1: 2, gen2: 1 53 | 54 | open System 55 | #time "on" 56 | let inline eq<'a when 'a :> IEquatable<'a>> (x:'a) (y:'a) = x.Equals y 57 | let inline (==) x y = eq x y 58 | for i = 0 to 10000000 do x == y |> ignore 59 | //Real: 00:00:00.022, CPU: 00:00:00.015, GC gen0: 0, gen1: 0, gen2: 0 -------------------------------------------------------------------------------- /Chapter11/Ch11_3.fsx: -------------------------------------------------------------------------------- 1 | #I __SOURCE_DIRECTORY__ 2 | #r "../packages/FSharp.Control.Reactive.3.4.1/lib/net45/FSharp.Control.Reactive.dll" 3 | #r "../packages/Rx-Core.2.2.5/lib/net45/System.Reactive.Core.dll" 4 | #r "../packages/Rx-Interfaces.2.2.5/lib/net45/System.Reactive.Interfaces.dll" 5 | #r "../packages/Rx-Linq.2.2.5/lib/net45/System.Reactive.Linq.dll" 6 | 7 | open System.Reactive.Subjects 8 | 9 | type PaymentFlowEvent = 10 | | HeartBeat 11 | | ACHOrigination 12 | | GuardOn 13 | 14 | type GuardACHOrigination(flow: Subject, alerter: Subject) = 15 | let threshold = 3 16 | let mutable beats = 0 17 | let mutable guardOn = false 18 | 19 | member x.Guard() = 20 | beats <- 0 21 | guardOn <- false 22 | flow.Subscribe(function 23 | | HeartBeat -> if guardOn then beats <- beats + 1; 24 | printfn "Heartbeat processed"; 25 | if beats > threshold && guardOn then alerter.OnNext "No timely ACHOrigination" 26 | | ACHOrigination -> beats <- 0; 27 | guardOn <- false 28 | printfn "ACHOrigination processed" 29 | | GuardOn -> beats <- 0; guardOn <- true; printfn "ACHOrigination is guarded") 30 | 31 | let paymentFlow = new Subject() 32 | let alerter = new Subject() 33 | let notifier = alerter.Subscribe(fun x -> printfn "Logged error %s" x) 34 | 35 | ignore <| GuardACHOrigination(paymentFlow,alerter).Guard() 36 | 37 | paymentFlow.OnNext(HeartBeat) 38 | paymentFlow.OnNext(GuardOn) 39 | paymentFlow.OnNext(HeartBeat) 40 | paymentFlow.OnNext(ACHOrigination) 41 | paymentFlow.OnNext(GuardOn) 42 | paymentFlow.OnNext(HeartBeat) 43 | paymentFlow.OnNext(HeartBeat) 44 | paymentFlow.OnNext(HeartBeat) 45 | paymentFlow.OnNext(HeartBeat) 46 | paymentFlow.OnNext(ACHOrigination) 47 | paymentFlow.OnNext(HeartBeat) 48 | paymentFlow.OnNext(HeartBeat) 49 | paymentFlow.OnNext(HeartBeat) 50 | paymentFlow.OnNext(HeartBeat) 51 | -------------------------------------------------------------------------------- /Chapter08/Ch8_5.fsx: -------------------------------------------------------------------------------- 1 | /// SELECTION /// 2 | List.head [] 3 | // System.ArgumentException: The input list was empty. 4 | List.tryHead [] 5 | // val it : int option = None 6 | 7 | let ll = [1;2;3;4] 8 | List.head ll = ll.[0] 9 | //val it : bool = true 10 | 11 | let aa = [|1;2;3;4|] 12 | Array.get aa 2 = aa.[2] 13 | // val it : bool = true 14 | 15 | [|10;20;30;40;50;60|].[2..4] 16 | // val it : int [] = [|30; 40; 50|] 17 | 18 | let numbers = [1;2;3;4;5;6;7;8] 19 | List.filter (fun x -> (%) x 2 = 0) numbers = List.where (fun x -> (%) x 2 = 0) numbers 20 | // val it : bool = true 21 | 22 | List.find (fun x -> (%) x 2 = 0) <| [1;3;5] 23 | // System.Collections.Generic.KeyNotFoundException: 24 | // Exception of type 'System.Collections.Generic.KeyNotFoundException' was thrown. 25 | List.tryFind (fun x -> (%) x 2 = 0) <| [1;3;5] 26 | // val it : int option = None 27 | List.find (fun x -> (%) x 2 <> 0) <| [1;3;5] 28 | // val it : int = 1 29 | List.tryFind (fun x -> (%) x 2 <> 0) <| [1;3;5] 30 | // val it : int option = Some 1 31 | List.findIndex (fun x -> (%) x 2 <> 0) <| [1;3;5] 32 | // val it : int = 0 33 | List.tryFindIndex (fun x -> (%) x 2 <> 0) <| [1;3;5] 34 | // val it : int option = Some 0 35 | List.findBack (fun x -> (%) x 2 <> 0) <| [1;3;5] 36 | // val it : int = 5 37 | List.tryFindBack (fun x -> (%) x 2 <> 0) <| [1;3;5] 38 | // val it : int option = Some 5 39 | List.findIndexBack (fun x -> (%) x 2 <> 0) <| [1;3;5] 40 | // val it : int = 2 41 | List.tryFindIndexBack (fun x -> (%) x 2 <> 0) <| [1;3;5] 42 | // val it : int option = Some 2 43 | 44 | [(9,"Nine");(42,"FortyTwo");(0,"Zero")] 45 | |> List.pick (fun (x,y) -> if x = 42 then Some y else None) 46 | // val it : string = "FortyTwo" 47 | [(9,"Nine");(42,"FortyTwo");(0,"Zero")] 48 | |> List.tryPick (fun (x,y) -> if x = 42 then Some y else None) 49 | // val it : string option = Some "FortyTwo" 50 | [(9,"Nine");(42,"FortyTwo");(0,"Zero")] 51 | |> List.pick (fun (x,y) -> if x = 14 then Some y else None) 52 | // System.Collections.Generic.KeyNotFoundException: 53 | // Exception of type 'System.Collections.Generic.KeyNotFoundException' was thrown. 54 | [(9,"Nine");(42,"FortyTwo");(0,"Zero")] 55 | |> List.tryPick (fun (x,y) -> if x = 14 then Some y else None) 56 | // val it : string option = None -------------------------------------------------------------------------------- /Chapter09/Ch9_2.fsx: -------------------------------------------------------------------------------- 1 | //select top (10) p.[MerchantId], min(r.DisplayName) as Name, sum(p.[Amount]) as Total 2 | //from [sql.colossus].[dbo].[Payments] p 3 | //join [sql.ironmandata].[dbo].[Partner] r on r.MerchantId = p.MerchantId 4 | //where p.[IsDeposited] = 1 5 | //group by p.[MerchantId] 6 | //order by total desc 7 | 8 | #r "FSharp.Data.TypeProviders" 9 | #r "System.Data" 10 | #r "System.Data.Linq" 11 | 12 | open Microsoft.FSharp.Data.TypeProviders 13 | open System.Linq 14 | 15 | [] 16 | let compileTimeCsusCS = @"Data Source=(localdb)\projectsv12;Initial Catalog=Colossus.DB;Integrated Security=SSPI" 17 | let runTimeCsusCS = @"Data Source=***;Initial Catalog=SQL.Colossus;User ID=***;Password=***" 18 | [] 19 | let compileTimeImCS = @"Data Source=(localdb)\projectsv12;Initial Catalog=SQL.Ironman;Integrated Security=SSPI" 20 | let runTimeImCS = @"Data Source=***;Initial Catalog=SQL.IronmanData;User ID=***;Password=***" 21 | 22 | type Colossus = SqlDataConnection 23 | type IronManData = SqlDataConnection 24 | 25 | let pmtContext = Colossus.GetDataContext(runTimeCsusCS) 26 | let imContext = IronManData.GetDataContext(runTimeImCS) 27 | 28 | // Uncomment to see the T-SQL into which the LINQ from query {...} is translated 29 | //pmtContext.Payments.Context.Log <- new System.IO.StreamWriter(@"C:\users\gene\downloads\0\pmtlinq.log", AutoFlush = true) 30 | //imContext.Partner.Context.Log <- new System.IO.StreamWriter(@"C:\users\gene\downloads\0\imlinq.log", AutoFlush = true) 31 | 32 | let mostPaid = 33 | fun x -> query { 34 | for payment in pmtContext.Payments do 35 | where (payment.IsDeposited.HasValue && payment.IsDeposited.Value) 36 | groupBy payment.MerchantId into p 37 | let total = query { for payment in p do sumBy payment.Amount} 38 | sortByDescending total 39 | select (p.Key,total) 40 | take x 41 | } 42 | 43 | let active = (mostPaid 10) 44 | let activeIds = active |> Seq.map fst 45 | 46 | let mostActiveNames = 47 | query { 48 | for merchant in imContext.Partner do 49 | where (activeIds.Contains(merchant.MerchantId)) 50 | select (merchant.MerchantId,merchant.DisplayName) 51 | } |> dict 52 | 53 | active 54 | |> Seq.map (fun (id, total) -> (mostActiveNames.[id],total)) 55 | |> Seq.iter (fun x -> printfn "%s: %.2f" (fst x) (snd x)) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | #F# 4.0 Design Patterns 2 | This is the code repository for [F# 4.0 Design Patterns](https://www.packtpub.com/application-development/f-40-design-patterns?utm_source=github&utm_campaign=9781785884726&utm_medium=repository) By Packt. It contains all the supporting project files necessary to work through the book from start to finish. 3 | 4 | #About the Book 5 | Following design patterns is a well-known approach to writing better programs that captures and reuses high-level abstractions that are common in many applications. This book will encourage you to develop an idiomatic F# coding skillset by fully embracing the functional-first F# paradigm. It will also help you harness this powerful instrument to write succinct, bug-free, and cross-platform code. 6 | 7 | ##Instructions and Navigation 8 | All of the code is organized into folders. Each folder starts with number followed by the application name. For example, Chapter02. 9 | 10 | You will see code something similar to the following: 11 | 12 | ``` 13 | type IMyInterface = 14 | abstract member DoIt: unit -> unit 15 | 16 | type MyImpl() = 17 | interface IMyInterface with 18 | member __.DoIt() = printfn "Did it!" 19 | 20 | MyImpl().DoIt() // Error: member 'DoIt' is not defined 21 | 22 | (MyImpl() :> IMyInterface).DoIt() 23 | 24 | // ... but 25 | let doit (doer: IMyInterface) = 26 | doer.DoIt() 27 | 28 | doit (MyImpl()) 29 | 30 | ``` 31 | 32 | ##Software and Hardware List 33 | 34 | | Chapter | Software required | OS required | 35 | | -------- | --------------------------------------------- | ------------------- | 36 | | 1 to 13 | LINQPad (http://www.linqpad.net/) | Windows/ MAC OS | 37 | | 1 to 13 | .NET Fiddle website https://dotnetfiddle.net/ | Windows/ MAC/ Linux | 38 | 39 | 40 | ##Related F# Products: 41 | * [Learning F# Functional Data Structures and Algorithms](https://www.packtpub.com/application-development/learning-f-functional-data-structures-and-algorithms?utm_source=github&utm_campaign=9781783558476&utm_medium=repository) 42 | * [F# for Machine Learning Essentials](https://www.packtpub.com/big-data-and-business-intelligence/f-machine-learning?utm_source=github&utm_campaign=9781783989348&utm_medium=repository) 43 | * [F# 4.0 Programming Cookbook](https://www.packtpub.com/application-development/f-40-programming-cookbook?utm_source=github&utm_campaign=9781786468369&utm_medium=repository) 44 | 45 | 46 | 47 | 48 | 49 | 50 | ### Suggestions and Feedback 51 | [Click here] (https://docs.google.com/forms/d/e/1FAIpQLSe5qwunkGf6PUvzPirPDtuy1Du5Rlzew23UBp2S-P3wB-GcwQ/viewform) if you have any feedback or suggestions. 52 | -------------------------------------------------------------------------------- /Chapter11/Ch11_4.fsx: -------------------------------------------------------------------------------- 1 | #I __SOURCE_DIRECTORY__ 2 | #r "../packages/FSharp.Quotations.Evaluator.1.0.7/lib/net40/FSharp.Quotations.Evaluator.dll" 3 | open FSharp.Quotations.Evaluator 4 | 5 | ///////////// Demo abilities ///////////// 6 | let mutable divider = Quotations.Expr.Value (5) 7 | let is5Divisor = <@ fun x -> x % %%divider = 0 @> |> QuotationEvaluator.Evaluate 8 | is5Divisor 14 9 | is5Divisor 15 10 | divider <- Quotations.Expr.Value (7) 11 | is5Divisor 14 12 | let is7Divisor = <@ fun x -> x % %%divider = 0 @> |> QuotationEvaluator.Evaluate 13 | is7Divisor 14 14 | ///////////////////////////////////////////// 15 | 16 | open System.Collections.Generic 17 | open System 18 | 19 | type Adjustment = 20 | | Absent 21 | | Premium of TimeSpan * decimal 22 | | Penalty of TimeSpan * decimal 23 | 24 | type Terms(?premium: Adjustment, ?penalty: Adjustment) = 25 | let penalty = defaultArg penalty Absent 26 | let premium = defaultArg premium Absent 27 | 28 | member x.Adjust() = 29 | match premium,penalty with 30 | | Absent,Absent -> None 31 | | Absent,Penalty (d,m) -> Some(<@ fun ((date:DateTime),amount) -> if DateTime.UtcNow.Date - date.Date > d then Decimal.Round(amount * (1M + m),2) else amount @> |> QuotationEvaluator.Evaluate) 32 | | Premium(d,m),Absent -> Some(<@ fun ((date:DateTime),amount) -> if DateTime.UtcNow.Date - date.Date < d then Decimal.Round(amount * (1M - m),2) else amount @> |> QuotationEvaluator.Evaluate) 33 | | Premium(d',m'),Penalty (d,m) -> Some(<@ fun ((date:DateTime),amount) -> 34 | if DateTime.UtcNow.Date - date.Date > d then Decimal.Round(amount * (1M + m),2) 35 | elif DateTime.UtcNow.Date - date.Date < d' then Decimal.Round(amount * (1M - m'),2) 36 | else amount @> |> QuotationEvaluator.Evaluate) 37 | | _,_ -> None 38 | 39 | 40 | //////////////////////////////////////////////////////////////////////////////////////////// 41 | 42 | type Invoice = { total:decimal ; date:System.DateTime; } 43 | 44 | let invoices = [ 45 | { total=1005.20M; date=System.DateTime.Today.AddDays(-3.0) } 46 | { total=5027.78M; date=System.DateTime.Today.AddDays(-29.0) } 47 | { total=51400.49M; date=System.DateTime.Today.AddDays(-36.0) } 48 | ] 49 | 50 | let payment (terms: Terms) invoice = let adjust = terms.Adjust() in if adjust.IsSome then (adjust.Value) (invoice.date, invoice.total) else invoice.total 51 | 52 | let terms = Terms(penalty=Penalty(TimeSpan.FromDays(31.),0.015M),premium=Premium(TimeSpan.FromDays(5.),0.02M)) 53 | let termsA = Terms() 54 | let termsB = Terms(Premium(TimeSpan.FromDays(4.),0.02M)) 55 | let termsC = Terms(penalty=Penalty(TimeSpan.FromDays(30.),0.02M)) 56 | 57 | List.map (payment terms) invoices 58 | List.map (payment termsA) invoices 59 | List.map (payment termsB) invoices 60 | List.map (payment termsC) invoices 61 | -------------------------------------------------------------------------------- /Chapter08/Ch8_2.fsx: -------------------------------------------------------------------------------- 1 | /// G E N E R A T O R S /// 2 | let el = List.empty 3 | // val el : string list = [] 4 | let ea = Array.empty 5 | // val ea : float [] = [||] 6 | let es = Seq.empty string> 7 | // val es : seq<(int -> string)> 8 | // es;; 9 | // val it : seq<(int -> string)> = seq [] 10 | 11 | let ell: string list = [] 12 | // val ell : string list = [] 13 | let eal: float[] = [||] 14 | // val eal : float [] = [||] 15 | let esl: seq string> = seq [] 16 | // val esl : seq<(int -> string)> = [] 17 | // esl;; 18 | // val it : seq<(int -> string)> = [] 19 | 20 | let sl = List.singleton "I'm alone" 21 | // val sl : string list = ["I'm alone"] 22 | let sa = Array.singleton 42.0 23 | // val sa : float [] = [|42.0|] 24 | let ss = Seq.singleton (fun (x:int) -> x.ToString()) 25 | // val ss : seq<(int -> string)> 26 | // ss;; 27 | // val it : seq<(int -> string)> = seq [] 28 | 29 | let sll = ["I'm alone"] 30 | // val sll : string list = ["I'm alone"] 31 | let sal = [| 42.0 |] 32 | // val sal : float [] = [|42.0|] 33 | let ssl = seq [fun (x:int) -> x.ToString()] 34 | // val ssl : seq<(int -> string)> = [] 35 | 36 | let fl = List.replicate 3 "blah" 37 | // val fl : string list = ["blah"; "blah"; "blah"] 38 | let fa = Array.replicate 3 42 39 | // val fa : int [] = [|42; 42; 42|] 40 | let fs = Seq.replicate 3 42.0 41 | // val fs : seq 42 | // fs;; 43 | // val it : seq = seq [42.0; 42.0; 42.0] 44 | 45 | let fll = ["blah";"blah";"blah"] 46 | // val fll : string list = ["blah"; "blah"; "blah"] 47 | let fal = [| for i in 1..3 -> 42 |] 48 | // val fal : int [] = [|42; 42; 42|] 49 | let fsl = seq { for i in 1..3 do yield 42.0 } 50 | // val fsl : seq 51 | // fsl;; 52 | // val it : seq = seq [42.0; 42.0; 42.0] 53 | 54 | let fac = Array.create 3 "blah" 55 | // val fac : string [] = [|"blah"; "blah"; "blah"|] 56 | 57 | let fazc: string[] = Array.zeroCreate 3 58 | // val fazc : string [] = [|null; null; null|] 59 | 60 | let fazci = Array.zeroCreate 3 61 | // val fazci : int [] = [|0; 0; 0|] 62 | 63 | let vl = List.init 4 ((*) 2) 64 | // val vl : int list = [0; 2; 4; 6] 65 | let va = let src = "closure" in Array.init src.Length (fun i -> src.[i]) 66 | // val va : char [] = [|'c'; 'l'; 'o'; 's'; 'u'; 'r'; 'e'|] 67 | let vs = Seq.init 3 id 68 | // val vs : seq 69 | // vs;; 70 | // val it : seq = seq [0; 1; 2] 71 | 72 | let vll = [0; 2; 4; 6] 73 | // val vll : int list = [0; 2; 4; 6] 74 | let vlc = [ for i in 0..3 -> i * 2 ] 75 | // val vlc : int list = [0; 2; 4; 6] 76 | let vlcy = [ for i in 0..3 do yield i * 2 ] 77 | // val vlcy : int list = [0; 2; 4; 6] 78 | let ``val`` = 79 | let src = "closure" in 80 | [| src.[0]; src.[1]; src.[2]; src.[3]; src.[4]; src.[5]; src.[6] |] 81 | // val val : char [] = [|'c'; 'l'; 'o'; 's'; 'u'; 'r'; 'e'|] 82 | let vac = 83 | let src = "closure" in 84 | [| for i in 1..src.Length -> src.[i - 1] |] 85 | // val vac : char [] = [|'c'; 'l'; 'o'; 's'; 'u'; 'r'; 'e'|] 86 | let vacy = 87 | let src = "closure" in 88 | [| for i in 1..src.Length do 89 | yield src.[i - 1] |> System.Char.ToUpper |] 90 | // val vacy : char [] = [|'C'; 'L'; 'O'; 'S'; 'U'; 'R'; 'E'|] 91 | let vsc = seq { for i in 0..2..6 -> i} 92 | // vsc;; 93 | // val it : seq = seq [0; 2; 4; 6] 94 | let vscy = seq { for i in 0..2..6 do yield 6 - i } 95 | // vscy;; 96 | // val it : seq = seq [6; 4; 2; 0] 97 | 98 | // List of random numbers generator 99 | let randoms lo hi len = 100 | let r = System.Random() 101 | let max = hi + 1 102 | let rec generate n = [ 103 | if n < len then 104 | yield r.Next(lo,max) 105 | yield! generate (n + 1) 106 | ] 107 | generate 0 108 | 109 | 110 | // with Seq.unfold 111 | let collatzLib n = 112 | Seq.unfold (fun n -> match n with 113 | | 0L -> None 114 | | 1L -> Some(1L, 0L) 115 | | n when n % 2L = 0L -> Some(n, n/2L) 116 | | n -> Some(n, 3L * n + 1L)) n 117 | 118 | // Collatz sequence generator 119 | // with sequence expression 120 | let rec collatzCustom num = 121 | seq { 122 | yield num 123 | match num with 124 | | 1L -> () 125 | | x when x % 2L = 0L -> yield! collatzCustom (x/2L) 126 | | x -> yield! collatzCustom ((x * 3L) + 1L) 127 | } 128 | 129 | [2L..1000000L] |> Seq.map (collatzLib >> Seq.length) |> Seq.max 130 | [2L..1000000L] |> Seq.map (collatzCustom >> Seq.length) |> Seq.max 131 | -------------------------------------------------------------------------------- /Chapter09/Ch9_4.fsx: -------------------------------------------------------------------------------- 1 | #r @"C:\code\WebJobSQL\packages\ExcelProvider.0.8.0\lib\ExcelProvider.dll" 2 | #r "System.Data" 3 | open FSharp.ExcelProvider 4 | open System.Data 5 | open System.Data.SqlClient 6 | open System.Collections.Generic 7 | 8 | type LaserShip = ExcelFile< @"C:\code\PacktBook\Code\Chapter11\lasership invoice format.xlsx", HasHeaders=true, ForceString=true> 9 | 10 | let asNullableString = function | null -> box System.DBNull.Value 11 | | (s: string) -> s.Trim() |> function "" -> box System.DBNull.Value | l -> box l 12 | let asString fieldName = function | null -> failwith (sprintf "%s %s" "asString: null for not-nullable field " fieldName) 13 | | (s: string) -> s.Trim() |> box 14 | let asNullableDate = function | null -> box System.DBNull.Value 15 | | (s: string) -> s.Trim() |> System.DateTime.TryParse |> function (true,s) -> box s.Date | _ -> box System.DBNull.Value 16 | let asNullableMoney = function | null -> box System.DBNull.Value 17 | | (s: string) -> s.Trim().Replace("$", "") |> System.Decimal.TryParse |> function (true,s) -> box s | _ -> box System.DBNull.Value 18 | let asNullableDecimal = function | null -> box System.DBNull.Value 19 | | (s: string) -> s.Trim() |> System.Decimal.TryParse |> function (true,s) -> box s | _ -> box System.DBNull.Value 20 | let asNullableTime = function | null -> box System.DBNull.Value 21 | | (s: string) -> s.Trim() |> fun x -> 22 | System.DateTime.TryParseExact(x,"hh:mm:ss",System.Globalization.CultureInfo.InvariantCulture,System.Globalization.DateTimeStyles.AssumeLocal) 23 | |> function (false,_) -> box System.DBNull.Value | (true,x) -> box (x - x.Date) 24 | let asNullableDateTime = function | null -> box System.DBNull.Value 25 | | (s: string) -> s.Trim() |> System.DateTime.TryParse |> function (true,s) -> box s | _ -> box System.DBNull.Value 26 | 27 | let headers = ["invno";"JobNumber";"TDate";"Reference";"LSTrackingNumber";"Caller";"FromName";"FromNumber";"FromStreet";"FromRoom"; 28 | "FromCity";"FromZip";"ToName";"ToNumber";"ToStreet";"ToRoom";"ToCity";"ToZip";"ServiceCode";"ServiceAmount"; 29 | "ExtraCode1";"Extra1Amount";"ExtraCode2";"Extra2Amount";"ExtraCode3";"Extra3Amount";"ExtraCode4";"Extra4Amount";"EN";"Tax"; 30 | "Total";"Zone";"Weight";"POD";"PODDate";"PODTime";"PickupDate";"SourceId";"RowKey";] 31 | 32 | let loadLaserShip excelPath = 33 | (new LaserShip(excelPath)).Data 34 | 35 | let fillDataTable sourceId (rows: IEnumerable) = 36 | let dt = new DataTable() 37 | do headers |> Seq.iter(fun h-> dt.Columns.Add(new DataColumn(h))) 38 | for row in rows do 39 | let dr = dt.NewRow() 40 | dr.Item(0) <- unbox (row.invno |> asString "invno") 41 | dr.Item(1) <- unbox (row.JobNumber |> asString "JobNumber") 42 | dr.Item(2) <- unbox (row.TDate |> asString "TDate") 43 | dr.Item(3) <- unbox (row.Reference |> asNullableString) 44 | dr.Item(4) <- unbox (row.LSTrackingNumber |> asNullableString) 45 | dr.Item(5) <- unbox (row.Caller |> asNullableString) 46 | dr.Item(6) <- unbox (row.FromName |> asNullableString) 47 | dr.Item(7) <- unbox (row.FromNumber |> asNullableString) 48 | dr.Item(8) <- unbox (row.FromStreet |> asNullableString) 49 | dr.Item(9) <- unbox (row.FromRoom |> asNullableString) 50 | dr.Item(10) <- unbox (row.FromCity |> asNullableString) 51 | dr.Item(11) <- unbox (row.FromZip |> asNullableString) 52 | dr.Item(12) <- unbox (row.ToName |> asString "ToName") 53 | dr.Item(13) <- unbox (row.ToNumber |> asNullableString) 54 | dr.Item(14) <- unbox (row.ToStreet |> asNullableString) 55 | dr.Item(15) <- unbox (row.ToRoom |> asNullableString) 56 | dr.Item(16) <- unbox (row.ToCity |> asString "ToCity") 57 | dr.Item(17) <- unbox (row.ToZip |> asString "ToZip") 58 | dr.Item(18) <- unbox (row.ServiceCode |> asString "ServiceCode") 59 | dr.Item(19) <- unbox (row.ServiceAmount |> asNullableMoney) 60 | dr.Item(20) <- unbox (row.ExtraCode1 |> asNullableString) 61 | dr.Item(21) <- unbox (row.Extra1Amount |> asNullableMoney) 62 | dr.Item(22) <- unbox (row.ExtraCode2 |> asNullableString) 63 | dr.Item(23) <- unbox (row.Extra2Amount |> asNullableMoney) 64 | dr.Item(24) <- unbox (row.ExtraCode3 |> asNullableString) 65 | dr.Item(25) <- unbox (row.Extra3Amount |> asNullableMoney) 66 | dr.Item(26) <- unbox (row.ExtraCode4 |> asNullableString) 67 | dr.Item(27) <- unbox (row.Extra4Amount |> asNullableMoney) 68 | dr.Item(28) <- unbox (row.EN |> asNullableMoney) 69 | dr.Item(29) <- unbox (row.Tax |> asNullableMoney) 70 | dr.Item(30) <- unbox (row.Total |> asNullableMoney) 71 | dr.Item(31) <- unbox (row.Zone |> asNullableString) 72 | dr.Item(32) <- unbox (row.Weight |> asNullableDecimal) 73 | dr.Item(33) <- unbox (row.POD |> asNullableString) 74 | dr.Item(34) <- unbox (row.PODDate |> asNullableString) 75 | dr.Item(35) <- unbox (row.PODTime |> asNullableString) 76 | dr.Item(36) <- unbox (row.PickupDate |> asNullableString) 77 | dr.Item(37) <- sourceId 78 | dt.Rows.Add(dr) 79 | printfn "loaded %d rows" dt.Rows.Count 80 | dt 81 | 82 | let loadIntoSQL tableName connStr (dataTable: DataTable) = 83 | use con = new SqlConnection(connStr) 84 | con.Open() 85 | use bulkCopy = new SqlBulkCopy(con, DestinationTableName = tableName) 86 | bulkCopy.WriteToServer(dataTable) 87 | printfn "Finished write to server" 88 | 89 | loadLaserShip @"C:\users\gene\Downloads\Book1.xlsx" 90 | |> fillDataTable 42 // Source File Id 91 | |> loadIntoSQL "LaserShip" @"Data Source=(localdb)\ProjectsV12;Initial Catalog=Colossus.DB;Integrated Security=True;Pooling=False;Connect Timeout=30" 92 | 93 | --------------------------------------------------------------------------------