Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Code examples from fsharpforfunandprofit.com/posts/dependencies-4/
(* ===================================
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