-
-
Save danieljsummers/eca04e64b903f08aecfb15e8f2536dd6 to your computer and use it in GitHub Desktop.
namespace ReaderMonad | |
// -- begin code lifted from #er demo -- | |
type ReaderM<'d, 'out> = 'd -> 'out | |
module Reader = | |
// basic operations | |
let run dep (rm : ReaderM<_,_>) = rm dep | |
let constant (c : 'c) : ReaderM<_,'c> = fun _ -> c | |
// lifting of functions and state | |
let lift1 (f : 'd -> 'a -> 'out) : 'a -> ReaderM<'d, 'out> = fun a dep -> f dep a | |
let lift2 (f : 'd -> 'a -> 'b -> 'out) : 'a -> 'b -> ReaderM<'d, 'out> = fun a b dep -> f dep a b | |
let lift3 (f : 'd -> 'a -> 'b -> 'c -> 'out) : 'a -> 'b -> 'c -> ReaderM<'d, 'out> = fun a b c dep -> f dep a b c | |
let liftDep (proj : 'd2 -> 'd1) (rm : ReaderM<'d1, 'output>) : ReaderM<'d2, 'output> = proj >> rm | |
// functor | |
let fmap (f : 'a -> 'b) (g : 'c -> 'a) : ('c -> 'b) = g >> f | |
let map (f : 'a -> 'b) (rm : ReaderM<'d, 'a>) : ReaderM<'d,'b> = rm >> f | |
let (<?>) = map | |
// applicative-functor | |
let apply (f : ReaderM<'d, 'a->'b>) (rm : ReaderM<'d, 'a>) : ReaderM<'d, 'b> = | |
fun dep -> | |
let f' = run dep f | |
let a = run dep rm | |
f' a | |
let (<*>) = apply | |
// monad | |
let bind (rm : ReaderM<'d, 'a>) (f : 'a -> ReaderM<'d,'b>) : ReaderM<'d, 'b> = | |
fun dep -> | |
f (rm dep) | |
|> run dep | |
let (>>=) = bind | |
type ReaderMBuilder internal () = | |
member __.Bind(m, f) = m >>= f | |
member __.Return(v) = constant v | |
member __.ReturnFrom(v) = v | |
member __.Delay(f) = f () | |
let Do = ReaderMBuilder() | |
// -- end code lifted from #er demo -- | |
open Reader | |
open RethinkDb.Driver | |
open RethinkDb.Driver.Net | |
module Test = | |
let private r = RethinkDB.R | |
let private conn = r.Connection().Hostname("my-server").Db("myWebLog").Connect() :> IConnection | |
let rethinkM = lift1 (fun () -> fun () -> conn) () | |
module DataAccess = | |
open System.Linq | |
open Test | |
let private r = RethinkDB.R | |
let getWebLogs (rethink : ReaderM<unit, IConnection>) = | |
let o = Do { | |
System.Console.WriteLine("Getting connection") | |
let! conn = rethink | |
System.Console.WriteLine("Getting weblogs") | |
let webLogs = | |
async { | |
System.Console.WriteLine("in async") | |
return! r.Table("WebLog").RunCursorAsync conn |> Async.AwaitTask | |
} |> Async.RunSynchronously | |
System.Console.WriteLine("Returning weblogs") | |
return webLogs.ToList () | |
} | |
o () | |
module Main = | |
[<EntryPoint>] | |
let main argv = | |
System.Console.WriteLine "Running now" | |
let q = DataAccess.getWebLogs Test.rethinkM | |
q |> Seq.iter (fun x -> System.Console.WriteLine (sprintf "%O" x)) | |
System.Console.WriteLine "Done" | |
0 |
Thanks for this code and your example, this was the first time I'd ever really tried to take on the reader monad, and now it makes a lot more sense to me.
Here's my take on your example, and it addresses all of your concerns. I left the ReaderM implementation uncopied, this is just the app code.
The problem partly stems from the typing you have for your monad. Right now you're asking for a unit as a dependency, and when you get that unit you use it to derive an IConnection. Instead you should be thinking more like "I need a connection, and when I get one I'll give back an Async<Cursor<'a>>". This means that we need to be looking for a Reader<IConnection, Async<Cursor<'a>>>
or a more filled-in type.
So from here I took a step back and thought about the core logic. I pulled out the IConnection -> Async<Cursor<'a>>
part into the getLogsUsingConnection
function to call out that that was really the business logic.
From there I needed to provide the connection somehow, so I used getWebLogs
to insert getLogsUsingConnection
into the reader monad, pulling out an IConnection from the 'container', which in this case the container was just the IConnection.
Then, in main, I just had to init all the dependencies (only the connection), like you would at any natural aggregation root.
Once my dependencies were initialized, then I could run my operation using them and the operation would pull out the dependencies that it required.
Looking at it now, the CE version of 'getWebLogs' isn't even necessary, we can just call liftDep directly to get Reader<IConnection, Async<Cursor<'a>>>
.
open Reader
open RethinkDb.Driver
open RethinkDb.Driver.Net
module DataAccess =
open System.Linq
// this is the missing piece. You need a mapping from your container to the actual dependency.
// for this simple example, the container is just an IConnection, so we just use id
// I just spell it out here for convenience
let getConnFromContainer container = container
// again with the value restriction... :-/
let getLogsUsingConnection conn = conn |> (RethinkDB.R.Table("WebLog").RunCursorAsync >> Async.AwaitTask)
let getWebLogsCE () = Do {
// this says get the dependency out using this function, then use it to run the following function
return! liftDep getConnFromContainer getLogsUsingConnection
}
// both this and the above have the same signature: unit -> ReaderM<IConnection, Async<Cursor<'a>>>
// the 'a is only because we don't do anything with the cursor directly here, instead the printf down below forces the type of 'obj
// you may need to type the printf call more strongly to enforce that these are strings.
let getWebLogsFn () = liftDep getConnFromContainer (RethinkDB.R.Table("WebLog").RunCursorAsync >> Async.AwaitTask)
module Main =
[<EntryPoint>]
let main argv =
System.Console.WriteLine "Running now"
// setup your dependency structures at the composition root
let dependencies = RethinkDB.R.Connection().Hostname("my-server").Db("myWebLog").Connect() :> IConnection
DataAccess.getWebLogsCE ()
|> run dependencies
|> Async.RunSynchronously
|> Seq.iter (printf "%O")
0
My code starts in line 40.
Things I think are wrong with this:
Things I know are wrong with this, but don't care for these purposes:
Feel free to provide constructive comments on how this can be more compositional, while still providing the "conn" that's needed as the parameter to pass to .RunResultAsync().