F# port of John A De Goes "FP to the max"

FP2TheMax.fs

open System

type Eff<'Ctx, 'T> = 'Ctx -> 'T

type EffBuilder() =
	member __.Return x : Eff<'Ctx,'T> = 
		fun _ -> x 
	member __.Bind(f : Eff<'Ctx, 'T>, g : 'T -> Eff<'Ctx, 'S>) : Eff<'Ctx, 'S> = 
		fun c -> g (f c) c 
	member __.Zero() : Eff<'Ctx, unit> = 
		ignore 
	member __.ReturnFrom (x : Eff<'Ctx, 'T>) = 
		x 
		
let eff = new EffBuilder() 
let getCtx<'Ctx> () : Eff<'Ctx, 'Ctx> = 
	id 
let run ctx (eff : Eff<'Ctx, 'T>) = 
	eff ctx

module Logger = 
	type ILogger = 
		abstract Log : string -> unit 
	let log (msg : string) = eff { 
		let! logger = getCtx<#ILogger> () 
		logger.Log msg 
	} 
	let logf fmt = Printf.ksprintf log fmt

module Reader =
	type IReader =
		abstract Read : unit -> string
	let read () = eff {
		let! reader = getCtx<#IReader> ()
		return reader.Read ()
	}
	
module Producer =
	type IProducer =
		abstract Produce : int -> int
	let produce upper = eff {
		let! producer = getCtx<#IProducer> ()
		return producer.Produce upper
	}

let askMe question  name = eff {
	do! Logger.logf question name
	return! Reader.read()
}

let askContinue name = 
	askMe "Do you want to continue, %s?" name

let askNumber name =
	askMe "%s, guess a number!" name

let rec checkContinue name = eff {
	let! answer = askContinue name
	do! Logger.logf "%s, you answered: %s" name answer
	match answer.ToLower() with
	| "y" -> return true
	| "n" -> return false
	| _ -> return! checkContinue name
}

let parseInt s = Int32.TryParse s |> function | true, x -> Some x | false, _ -> None

let rec checkNumber name = eff {
	let! answer = askNumber name
	match parseInt answer with
	| Some n -> return n
	| _ -> 
		do! Logger.logf "%s, you didn't type a number" name
		return! checkNumber name
}

let rec looper checker f name = eff {
	let! loop = checker name
	if loop then 
		do! f name
		do! looper checker f name
}

let playGame name = eff {
	let! num = checkNumber name
	do! Logger.logf "Your number is %d." num
	let! guess = Producer.produce 100
	match num = guess with
	| true -> do! Logger.log "You guessed right."
	| _ -> do! Logger.logf "Wrong, the number was %d." guess
} 	

let combinedEffects() = eff { 
	do! Logger.logf "What is your name?" 
	let! name = Reader.read()
	do! Logger.logf "Hello %s! Welcome to the game." name
	do! playGame name
	do! looper checkContinue playGame name
}

type ConsoleLogger() = 
	interface Logger.ILogger with 
		member __.Log msg = printfn "%s" msg 

type ConsoleReader () =
	interface Reader.IReader with
		member __.Read () = Console.ReadLine ()

type RandomProducer() =
	let r = Random()
	interface Producer.IProducer with
		member __.Produce upper = 
			r.Next(0, upper)

type combinedHandlers() = 
	let logger = new ConsoleLogger() :> Logger.ILogger 
	let reader = new ConsoleReader() :> Reader.IReader
	let producer = new RandomProducer() :>  Producer.IProducer
	interface Logger.ILogger with 
		member __.Log m = logger.Log m
	interface Reader.IReader with
		member __.Read () = reader.Read ()
	interface  Producer.IProducer with
		member __.Produce upper = producer.Produce upper

run (combinedHandlers()) (combinedEffects())

type TestLogger() = 
	let mutable output = []
	member __.show() = output
	interface Logger.ILogger with 
		member __.Log msg = 
			output <- output @ [msg+"\n"]
	
type TestReader (test_input) =
	let mutable input = test_input
	interface Reader.IReader with
		member __.Read () = 
			match input with
			| h :: l -> 
				input <- l
				h
			| _ -> failwith "not enough inputs"

type TestProducer(test_numbers) =
	let mutable numbers = test_numbers
	interface Producer.IProducer with
		member __.Produce upper = 
			match numbers with
			| h :: l -> 
				numbers <- l
				h
			| _ -> failwith "not enough numbers"

type TestHandlers(data, numbers) = 
	let log = new TestLogger() 
	let logger = log :> Logger.ILogger 
	let reader = new TestReader(data) :> Reader.IReader
	let producer = new TestProducer(numbers) :>  Producer.IProducer
	member __.show() = log.show()
	interface Logger.ILogger with 
		member __.Log m = logger.Log m
	interface Reader.IReader with
		member __.Read () = reader.Read ()
	interface  Producer.IProducer with
		member __.Produce upper = producer.Produce upper

let data = ["giulio";"blabla";"37";"again?";"y";"98";"n"]
let numbers = [37;73]
let test = TestHandlers(data, numbers)
combinedEffects() |> run test 
test.show() |> List.fold (+) "" |> printfn "%s"