读取器单子

Monads/ReaderMonad.fs

@@ -0,0 +1,26 @@
+namespace Sanchime.Monads
+
+[<AutoOpen>]
+module Reader =
+
+    // 读取器单子是计算状态并产生一个值't的单子
+    type Reader<'s, 't> = Reader of ('s -> 't)
+
+    // 单位元不读取任何操作，因此产生Reader<unit, 'a>
+    let unit v = Reader (fun () -> v)
+
+    // 绑定操作接受Reader和一个读取状态另一部分的函数'a -> Reader<'b, 'c>
+    // 并在一个元组中产生一个读取两个状态值的Reader<('d * 'b), 'c>
+    let bind f (Reader (g)) = Reader (fun (a, b) ->
+        let v = g a in
+        let (Reader h) = f v in
+        h b)
+
+    type ReaderBuilder () =
+        member __.Return(v) = unit v
+        member __.Bind(v, f) = bind f v
+        member __.Delay(f) = Reader (fun s ->
+            let (Reader h) = f ()
+            h s)
+
+    let reader = ReaderBuilder ()

Monads/Test.fs

@@ -2,4 +2,28 @@ namespace Sanchime.Monads
 
 module Test =
 
-    let test = 0
+    let reader_example () =
+
+        let cache (Reader(f)) = (Reader (fun (v1, v2) ->
+            match v1 with
+            | None -> f v2
+            | Some v -> v))
+
+        let read s n = reader {
+            printfn "读取：%s" s
+            return n
+        }
+
+        let m = reader {
+            let! a = cache <| read "A" 1
+            let! b = cache <| read "B" 2
+            let! c = read "C" 3
+            return a + b + c
+        }
+
+        let (Reader f) = m
+
+        f ((None, ()), ((None, ()), ((), ()))) |> ignore
+        f ((Some 1, ()), ((None, ()), ((), ()))) |> ignore
+        f ((None, ()), ((Some 2, ()), ((), ()))) |> ignore
+        f ((Some 1, ()), ((Some 2, ()), ((), ()))) |> ignore

Program.fs

@@ -7,5 +7,5 @@ open Sanchime.Algrithm.Sort.Merge
 open Sanchime.Algrithm.Sort.Select
 
 
-
+Sanchime.Monads.Test.reader_example () |> ignore
 // qsort |> test 

Sanchime.Learn.fsproj

@@ -10,6 +10,7 @@
     <Compile Include="Algrithms/Sorts/InsertSort.fs" />
     <Compile Include="Algrithms/Sorts/BubbleSort.fs" />
     <Compile Include="Algrithms/Sorts/Test.fs" />
+    <Compile Include="Monads/ReaderMonad.fs" />
     <Compile Include="Monads/FreeMonad.fs" />
     <Compile Include="Monads/Test.fs" />
     <Compile Include="Program.fs" />