diff --git a/src/FSharpPlus/Data/Seq.fs b/src/FSharpPlus/Data/Seq.fs index 05399e313..c24451752 100644 --- a/src/FSharpPlus/Data/Seq.fs +++ b/src/FSharpPlus/Data/Seq.fs @@ -797,6 +797,61 @@ module SeqT_V2 = let inline iteri<'T, .. > (f: int -> 'T -> unit) (source: SeqT<'``Monad``, 'T>) : '``Monad`` = iteriM (fun i x -> result (f i x)) source let inline iter<'T, .. > f (source: SeqT<'``Monad``, 'T>) : '``Monad`` = iterM (f >> result) source + let inline internal tryPickMAndMap<'T, 'U, .. > (f: 'T -> '``Monad<'U option>``) (source: SeqT<'``Monad``, 'T>) (postMap: 'U option -> 'V) : '``Monad<'V>`` = innerMonad2<_, '``Monad``> () { + use ie = (source :> IEnumerableM<'``Monad``, 'T>).GetEnumerator () + let! (move: bool) = ie.MoveNext () + let mutable b = move + let mutable res = None + while b && res.IsNone do + let! (fv: 'U option) = f ie.Current + match fv with + | Some _ as r -> res <- r + | None -> + let! moven = ie.MoveNext () + b <- moven + return postMap res } + + let inline internal tryPickAndMap<'T, 'U, .. > (f: 'T -> 'U option) (source: SeqT<'``Monad``, 'T>) (postMap: 'U option -> 'V) : '``Monad<'V>`` = innerMonad2<_, '``Monad``> () { + use ie = (source :> IEnumerableM<'``Monad``, 'T>).GetEnumerator () + let! (move: bool) = ie.MoveNext () + let mutable b = move + let mutable res = None + while b && res.IsNone do + let (fv: 'U option) = f ie.Current + match fv with + | Some _ as r -> res <- r + | None -> + let! moven = ie.MoveNext () + b <- moven + return postMap res } + + let inline tryPickM<'T, 'U, .. > (f: 'T -> '``Monad<'U option>``) (source: SeqT<'``Monad``, 'T>) : '``Monad<'U option>`` = + tryPickMAndMap<_, 'U, _, '``Monad``, _, _, _> f source id + + let inline pickM<'T, 'U, .. > (f: 'T -> '``Monad<'U option>``) (source: SeqT<'``Monad``, 'T>) : '``Monad<'U>`` = + tryPickMAndMap<_, 'U, '``Monad<'U option>``, '``Monad``, _, _, _> f source (function Some v -> (v: 'U) | _ -> raise (KeyNotFoundException ())) + + let inline tryPick<'T, 'U, .. > (f: 'T -> 'U option) (source: SeqT<'``Monad``, 'T>) : '``Monad<'U option>`` = + tryPickAndMap<_, _, _, _, '``Monad``, _> f source id + + let inline pick (f: 'T -> 'U option) (source: SeqT<'``Monad``, 'T>) : '``Monad<'U>`` = + tryPickAndMap<_, _, _, _, '``Monad``, _> f source (function Some v -> (v: 'U) | _ -> raise (KeyNotFoundException ())) + + let inline contains value (source: SeqT<'``Monad``, 'T>) : '``Monad`` = + tryPickAndMap<_, _, _, _, '``Monad``, _> (fun v -> if v = value then Some () else None) source Option.isSome + + let inline tryFind<'T, .. > f (source: SeqT<'``Monad``, 'T>) : '``Monad<'T option>`` = + tryPickAndMap<_, _, _, _, '``Monad``, _> (fun v -> if f v then Some v else None) source id + + let inline find f (source: SeqT<'``Monad``, 'T>) : '``Monad<'T>`` = + tryPickAndMap<_, _, _, _, '``Monad``, _> (fun v -> if f v then Some v else None) source (function Some v -> (v: 'T) | _ -> raise (KeyNotFoundException ())) + + let inline exists f (source: SeqT<'``Monad``, 'T>) : '``Monad`` = + tryPickAndMap<_, _, _, _, '``Monad``, _> (fun v -> if f v then Some v else None) source Option.isSome + + let inline forall f (source: SeqT<'``Monad``, 'T>) : '``Monad`` = + tryPickAndMap<_, _, _, _, '``Monad``, _> (fun v -> if f v then None else Some v) source Option.isNone + [] type TryWithState<'``Monad``, 'T> = | NotStarted of SeqT<'``Monad``, 'T> diff --git a/tests/FSharpPlus.Tests/SeqT.fs b/tests/FSharpPlus.Tests/SeqT.fs index c2bf4a87a..f28122141 100644 --- a/tests/FSharpPlus.Tests/SeqT.fs +++ b/tests/FSharpPlus.Tests/SeqT.fs @@ -64,6 +64,13 @@ module BasicTests = let y3 = SeqT.run x3 |> extract |> toList CollectionAssert.AreEqual (y3, [("0", 0, 0); ("1", 10, 1); ("2", 20, 2)]) + [] + let picks () = + let infinite: SeqT, _> = SeqT.unfold (fun x -> Some (x, x + 1)) 0 + let five = SeqT.find ((<) 4) infinite |> Async.RunSynchronously + Assert.AreEqual (5, five) + + // Compile tests let binds () = let res1 = SeqT [|seq [1..4] |] >>= fun x -> SeqT [|seq [x * 2] |]