Skip to content

Commit f17a734

Browse files
authored
Add pick related functions to SeqT (#608)
1 parent 43050e6 commit f17a734

File tree

2 files changed

+62
-0
lines changed

2 files changed

+62
-0
lines changed

src/FSharpPlus/Data/Seq.fs

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -797,6 +797,61 @@ module SeqT_V2 =
797797
let inline iteri<'T, .. > (f: int -> 'T -> unit) (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<unit>`` = iteriM (fun i x -> result (f i x)) source
798798
let inline iter<'T, .. > f (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<unit>`` = iterM (f >> result) source
799799

800+
let inline internal tryPickMAndMap<'T, 'U, .. > (f: 'T -> '``Monad<'U option>``) (source: SeqT<'``Monad<bool>``, 'T>) (postMap: 'U option -> 'V) : '``Monad<'V>`` = innerMonad2<_, '``Monad<unit>``> () {
801+
use ie = (source :> IEnumerableM<'``Monad<bool>``, 'T>).GetEnumerator ()
802+
let! (move: bool) = ie.MoveNext ()
803+
let mutable b = move
804+
let mutable res = None
805+
while b && res.IsNone do
806+
let! (fv: 'U option) = f ie.Current
807+
match fv with
808+
| Some _ as r -> res <- r
809+
| None ->
810+
let! moven = ie.MoveNext ()
811+
b <- moven
812+
return postMap res }
813+
814+
let inline internal tryPickAndMap<'T, 'U, .. > (f: 'T -> 'U option) (source: SeqT<'``Monad<bool>``, 'T>) (postMap: 'U option -> 'V) : '``Monad<'V>`` = innerMonad2<_, '``Monad<unit>``> () {
815+
use ie = (source :> IEnumerableM<'``Monad<bool>``, 'T>).GetEnumerator ()
816+
let! (move: bool) = ie.MoveNext ()
817+
let mutable b = move
818+
let mutable res = None
819+
while b && res.IsNone do
820+
let (fv: 'U option) = f ie.Current
821+
match fv with
822+
| Some _ as r -> res <- r
823+
| None ->
824+
let! moven = ie.MoveNext ()
825+
b <- moven
826+
return postMap res }
827+
828+
let inline tryPickM<'T, 'U, .. > (f: 'T -> '``Monad<'U option>``) (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<'U option>`` =
829+
tryPickMAndMap<_, 'U, _, '``Monad<unit>``, _, _, _> f source id
830+
831+
let inline pickM<'T, 'U, .. > (f: 'T -> '``Monad<'U option>``) (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<'U>`` =
832+
tryPickMAndMap<_, 'U, '``Monad<'U option>``, '``Monad<unit>``, _, _, _> f source (function Some v -> (v: 'U) | _ -> raise (KeyNotFoundException ()))
833+
834+
let inline tryPick<'T, 'U, .. > (f: 'T -> 'U option) (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<'U option>`` =
835+
tryPickAndMap<_, _, _, _, '``Monad<unit>``, _> f source id
836+
837+
let inline pick (f: 'T -> 'U option) (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<'U>`` =
838+
tryPickAndMap<_, _, _, _, '``Monad<unit>``, _> f source (function Some v -> (v: 'U) | _ -> raise (KeyNotFoundException ()))
839+
840+
let inline contains value (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<bool>`` =
841+
tryPickAndMap<_, _, _, _, '``Monad<unit>``, _> (fun v -> if v = value then Some () else None) source Option.isSome
842+
843+
let inline tryFind<'T, .. > f (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<'T option>`` =
844+
tryPickAndMap<_, _, _, _, '``Monad<unit>``, _> (fun v -> if f v then Some v else None) source id
845+
846+
let inline find f (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<'T>`` =
847+
tryPickAndMap<_, _, _, _, '``Monad<unit>``, _> (fun v -> if f v then Some v else None) source (function Some v -> (v: 'T) | _ -> raise (KeyNotFoundException ()))
848+
849+
let inline exists f (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<bool>`` =
850+
tryPickAndMap<_, _, _, _, '``Monad<unit>``, _> (fun v -> if f v then Some v else None) source Option.isSome
851+
852+
let inline forall f (source: SeqT<'``Monad<bool>``, 'T>) : '``Monad<bool>`` =
853+
tryPickAndMap<_, _, _, _, '``Monad<unit>``, _> (fun v -> if f v then None else Some v) source Option.isNone
854+
800855
[<RequireQualifiedAccess; EditorBrowsable(EditorBrowsableState.Never)>]
801856
type TryWithState<'``Monad<bool>``, 'T> =
802857
| NotStarted of SeqT<'``Monad<bool>``, 'T>

tests/FSharpPlus.Tests/SeqT.fs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,13 @@ module BasicTests =
6464
let y3 = SeqT.run x3 |> extract |> toList
6565
CollectionAssert.AreEqual (y3, [("0", 0, 0); ("1", 10, 1); ("2", 20, 2)])
6666

67+
[<Test>]
68+
let picks () =
69+
let infinite: SeqT<Async<_>, _> = SeqT.unfold (fun x -> Some (x, x + 1)) 0
70+
let five = SeqT.find ((<) 4) infinite |> Async.RunSynchronously
71+
Assert.AreEqual (5, five)
72+
73+
6774
// Compile tests
6875
let binds () =
6976
let res1 = SeqT [|seq [1..4] |] >>= fun x -> SeqT [|seq [x * 2] |]

0 commit comments

Comments
 (0)