Code examples from fsharpforfunandprofit.com/posts/dependencies-4/
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(* =================================== | |
Code from my series of posts "Six approaches to dependency injection" | |
=================================== *) | |
open System | |
(* ====================================================================== | |
5. Dependency Interpretation | |
In which we create a data structure and then interpret it later | |
====================================================================== *) | |
//---------------------------------------- | |
// Version 1 - a bad attempt to return commands | |
//---------------------------------------- | |
module ReadFromConsole_v1 = | |
type Instruction = | |
| ReadLn | |
| WriteLn of string | |
let readFromConsole() = | |
let cmd1 = WriteLn "Enter the first value" | |
let cmd2 = ReadLn | |
let cmd3 = WriteLn "Enter the second value" | |
let cmd4 = ReadLn | |
// return all the instructions I want the I/O part to do | |
[cmd1; cmd2; cmd3; cmd4] | |
// doesn't compile! | |
(* | |
let interpretInstruction instruction = | |
match instruction with | |
| ReadLn -> Console.ReadLine() | |
| WriteLn str -> printfn "%s" str | |
*) | |
//---------------------------------------- | |
// Version 2 - a correct attempt to using a Program structure | |
//---------------------------------------- | |
module ReadFromConsole_v2 = | |
// normal ReadLn is unit -> string | |
// it becomes unit * (string -> Program) | |
// | |
// normal WriteLn is string -> unit | |
// it becomes string * (unit -> Program) | |
type Program<'a> = | |
// input to output of | |
// interpreter interpreter | |
| ReadLn of unit * next:(string -> Program<'a>) | |
| WriteLn of string * next:(unit -> Program<'a>) | |
| Stop of 'a | |
let readFromConsole = | |
WriteLn ("Enter the first value" , fun () -> | |
ReadLn ( () , fun str1 -> | |
WriteLn ("Enter the second value", fun () -> | |
ReadLn ( () , fun str2 -> | |
Stop (str1,str2) // no "next" function | |
)))) | |
let rec interpret program = | |
match program with | |
| ReadLn ((), next) -> | |
// 1. interpret the meaning of "ReadLn" to do actual I/O | |
let str = Console.ReadLine() | |
// 2. call "next" with the output of the interpretation. | |
// This gives us another Program | |
let nextProgram = next str | |
// 3. interpret the new Program (recursively) | |
interpret nextProgram | |
| WriteLn (str,next) -> | |
printfn "%s" str | |
let nextProgram = next() | |
interpret nextProgram | |
| Stop value -> | |
// return the overall result of the Program | |
value | |
// test | |
(* | |
open ReadFromConsole_v2 | |
interpret readFromConsole | |
*) | |
//---------------------------------------- | |
// Version 3 - Same as above, but using computation expressions | |
//---------------------------------------- | |
module ReadFromConsole_v3 = | |
open ReadFromConsole_v2 | |
// same as before | |
type Program<'a> = ReadFromConsole_v2.Program<'a> | |
module Program = | |
let rec bind f program = | |
match program with | |
| ReadLn ((),next) -> ReadLn ((),next >> bind f) | |
| WriteLn (str,next) -> WriteLn (str, next >> bind f) | |
| Stop x -> f x | |
type ProgramBuilder() = | |
member __.Return(x) = Stop x | |
member __.Bind(x,f) = Program.bind f x | |
member __.Zero() = Stop () | |
// the builder instance | |
let program = ProgramBuilder() | |
// helpers to use within the computation expression | |
let writeLn str = WriteLn (str,Stop) | |
let readLn() = ReadLn ((),Stop) | |
let readFromConsole = program { | |
do! writeLn "Enter the first value" | |
let! str1 = readLn() | |
do! writeLn "Enter the second value" | |
let! str2 = readLn() | |
return (str1,str2) | |
} | |
// same as before | |
let interpret = ReadFromConsole_v2.interpret | |
// test | |
(* | |
open ReadFromConsole_v3 | |
interpret readFromConsole | |
*) | |
//---------------------------------------- | |
// The complete mini-application | |
//---------------------------------------- | |
module MiniApplication_v1 = | |
// 1. Define the set of instructions we want to support | |
type ConsoleInstruction<'a> = | |
| ReadLn of unit * next:(string -> 'a) | |
| WriteLn of string * next:(unit -> 'a) | |
type LoggerInstruction<'a> = | |
| LogDebug of string * next:(unit -> 'a) | |
| LogInfo of string * next:(unit -> 'a) | |
type Program<'a> = | |
| ConsoleInstruction of ConsoleInstruction<Program<'a>> | |
| LoggerInstruction of LoggerInstruction<Program<'a>> | |
| Stop of 'a | |
// 2. Define a "map" for each group of instructions | |
module ConsoleInstruction = | |
let rec map f program = | |
match program with | |
| ReadLn ((),next) -> ReadLn ((),next >> f) | |
| WriteLn (str,next) -> WriteLn (str, next >> f) | |
module LoggerInstruction = | |
let rec map f program = | |
match program with | |
| LogDebug (str,next) -> LogDebug (str,next >> f) | |
| LogInfo (str,next) -> LogInfo (str,next >> f) | |
// 3. Define the corresponding "bind" | |
module Program = | |
let rec bind f program = | |
match program with | |
| ConsoleInstruction inst -> | |
inst |> ConsoleInstruction.map (bind f) |> ConsoleInstruction | |
| LoggerInstruction inst -> | |
inst |> LoggerInstruction.map (bind f) |> LoggerInstruction | |
| Stop x -> | |
f x | |
// 4. Define the computation expression | |
type ProgramBuilder() = | |
member __.Return(x) = Stop x | |
member __.Bind(x,f) = Program.bind f x | |
member __.Zero() = Stop () | |
// the builder instance | |
let program = ProgramBuilder() | |
// 5. Define the interpreter | |
let rec interpret program = | |
let interpretConsole inst = | |
match inst with | |
| ReadLn ((), next) -> | |
let str = Console.ReadLine() | |
interpret (next str) | |
| WriteLn (str,next) -> | |
printfn "%s" str | |
interpret (next()) | |
let interpretLogger inst = | |
match inst with | |
| LogDebug (str, next) -> | |
printfn "DEBUG %s" str | |
interpret (next()) | |
| LogInfo (str, next) -> | |
printfn "INFO %s" str | |
interpret (next()) | |
match program with | |
| ConsoleInstruction inst -> interpretConsole inst | |
| LoggerInstruction inst -> interpretLogger inst | |
| Stop value -> value | |
// helpers to use within the computation expression | |
let writeLn str = ConsoleInstruction (WriteLn (str,Stop)) | |
let readLn() = ConsoleInstruction (ReadLn ((),Stop)) | |
let logDebug str = LoggerInstruction (LogDebug (str,Stop)) | |
let logInfo str = LoggerInstruction (LogInfo (str,Stop)) | |
type ComparisonResult = | |
| Bigger | |
| Smaller | |
| Equal | |
let readFromConsole = program { | |
do! writeLn "Enter the first value" | |
let! str1 = readLn() | |
do! writeLn "Enter the second value" | |
let! str2 = readLn() | |
return (str1,str2) | |
} | |
let compareTwoStrings str1 str2 = program { | |
do! logDebug "compareTwoStrings: Starting" | |
let result = | |
if str1 > str2 then | |
Bigger | |
else if str1 < str2 then | |
Smaller | |
else | |
Equal | |
do! logInfo (sprintf "compareTwoStrings: result=%A" result) | |
do! logDebug "compareTwoStrings: Finished" | |
return result | |
} | |
let writeToConsole (result:ComparisonResult) = program { | |
match result with | |
| Bigger -> | |
do! writeLn "The first value is bigger" | |
| Smaller -> | |
do! writeLn "The first value is smaller" | |
| Equal -> | |
do! writeLn "The values are equal" | |
} | |
let myProgram = program { | |
let! str1, str2 = readFromConsole | |
let! result = compareTwoStrings str1 str2 | |
do! writeToConsole result | |
} | |
(* | |
open MiniApplication_v1 | |
interpret myProgram | |
*) | |
//---------------------------------------- | |
// A generic program that does not know about specific instructions | |
//---------------------------------------- | |
module GenericProgram = | |
// 1. Define a instruction interface that contains a "map" | |
type IInstruction<'a> = | |
abstract member Map : ('a->'b) -> IInstruction<'b> | |
// 2, Use the interface in the Program type | |
type Program<'a> = | |
| Instruction of IInstruction<Program<'a>> | |
| Stop of 'a | |
// 3. Define the corresponding "bind" | |
module Program = | |
let rec bind f program = | |
match program with | |
| Instruction inst -> | |
inst.Map (bind f) |> Instruction | |
| Stop x -> f x | |
// 4. Define the computation expression | |
type ProgramBuilder() = | |
member __.Return(x) = Stop x | |
member __.Bind(x,f) = Program.bind f x | |
member __.Zero() = Stop () | |
// and the builder instance | |
let program = ProgramBuilder() | |
//---------------------------------------- | |
// The complete mini-application, using the generic program approach | |
//---------------------------------------- | |
module MiniApplication_v2 = | |
open GenericProgram | |
// to support a specific application: | |
// 1. Define the set of instructions we want to support, and their map | |
type ConsoleInstruction<'a> = | |
| ReadLn of unit * next:(string -> 'a) | |
| WriteLn of string * next:(unit -> 'a) | |
interface IInstruction<'a> with | |
member this.Map f = | |
match this with | |
| ReadLn ((),next) -> ReadLn ((),next >> f) | |
| WriteLn (str,next) -> WriteLn (str, next >> f) | |
:> IInstruction<_> | |
type LoggerInstruction<'a> = | |
| LogDebug of string * next:(unit -> 'a) | |
| LogInfo of string * next:(unit -> 'a) | |
interface IInstruction<'a> with | |
member this.Map f = | |
match this with | |
| LogDebug (str,next) -> LogDebug (str,next >> f) | |
| LogInfo (str,next) -> LogInfo (str,next >> f) | |
:> IInstruction<_> | |
// 2. Define the interpreter | |
// modular interpreter for ConsoleInstruction | |
let interpretConsole interpret inst = | |
match inst with | |
| ReadLn ((), next) -> | |
let str = Console.ReadLine() | |
interpret (next str) | |
| WriteLn (str,next) -> | |
printfn "%s" str | |
interpret (next()) | |
// modular interpreter for LoggerInstruction | |
let interpretLogger interpret inst = | |
match inst with | |
| LogDebug (str, next) -> | |
printfn "DEBUG %s" str | |
interpret (next()) | |
| LogInfo (str, next) -> | |
printfn "INFO %s" str | |
interpret (next()) | |
// interpreter for this particular workflow | |
let rec interpret program = | |
match program with | |
| Instruction inst -> | |
match inst with | |
| :? ConsoleInstruction<Program<_>> as i -> interpretConsole interpret i | |
| :? LoggerInstruction<Program<_>> as i -> interpretLogger interpret i | |
| _ -> failwithf "unknown instruction type %O" (inst.GetType()) | |
| Stop value -> value | |
// helpers to use within the computation expression | |
let writeLn str = Instruction (WriteLn (str,Stop)) | |
let readLn() = Instruction (ReadLn ((),Stop)) | |
let logDebug str = Instruction (LogDebug (str,Stop)) | |
let logInfo str = Instruction (LogInfo (str,Stop)) | |
type ComparisonResult = | |
| Bigger | |
| Smaller | |
| Equal | |
let readFromConsole = program { | |
do! writeLn "Enter the first value" | |
let! str1 = readLn() | |
do! writeLn "Enter the second value" | |
let! str2 = readLn() | |
return (str1,str2) | |
} | |
let compareTwoStrings str1 str2 = program { | |
do! logDebug "compareTwoStrings: Starting" | |
let result = | |
if str1 > str2 then | |
Bigger | |
else if str1 < str2 then | |
Smaller | |
else | |
Equal | |
do! logInfo (sprintf "compareTwoStrings: result=%A" result) | |
do! logDebug "compareTwoStrings: Finished" | |
return result | |
} | |
let writeToConsole (result:ComparisonResult) = program { | |
match result with | |
| Bigger -> | |
do! writeLn "The first value is bigger" | |
| Smaller -> | |
do! writeLn "The first value is smaller" | |
| Equal -> | |
do! writeLn "The values are equal" | |
} | |
let myProgram = program { | |
let! str1, str2 = readFromConsole | |
let! result = compareTwoStrings str1 str2 | |
do! writeToConsole result | |
} | |
(* | |
open MiniApplication_v2 | |
interpret myProgram | |
*) | |
//---------------------------------------- | |
// Demonstrates that this approach is modular | |
//---------------------------------------- | |
module ModularityDemo = | |
open GenericProgram | |
open MiniApplication_v2 | |
type DbInstruction<'a> = | |
| DbInsert of string * next:(unit -> 'a) | |
interface IInstruction<'a> with | |
member this.Map f = | |
match this with | |
| DbInsert (str,next) -> DbInsert (str, next >> f) | |
:> IInstruction<_> | |
// helpers to use within the computation expression | |
let dbInsert str = Instruction (DbInsert(str,Stop)) | |
let logStringsToDb str1 str2 = program { | |
do! dbInsert str1 | |
do! dbInsert str2 | |
} | |
let myProgram = program { | |
let! str1, str2 = readFromConsole | |
do! logStringsToDb str1 str2 | |
let! result = compareTwoStrings str1 str2 | |
do! writeToConsole result | |
} | |
// modular interpreter for LoggerInstruction | |
let interpretDbInstruction interpret inst = | |
match inst with | |
| DbInsert (str, next) -> | |
printfn "DbInsert %s" str | |
interpret (next()) | |
// interpreter for this particular workflow | |
let rec interpret program = | |
match program with | |
| Instruction inst -> | |
match inst with | |
| :? ConsoleInstruction<Program<_>> as i -> interpretConsole interpret i | |
| :? LoggerInstruction<Program<_>> as i -> interpretLogger interpret i | |
| :? DbInstruction<Program<_>> as i -> interpretDbInstruction interpret i | |
| _ -> failwithf "unknown instruction type %O" (inst.GetType()) | |
| Stop value -> value | |
(* | |
open ModularityDemo | |
interpret myProgram | |
*) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment