Skip to content

Instantly share code, notes, and snippets.

@emcake
Last active February 15, 2021 15:10
Show Gist options
  • Star 5 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save emcake/d6456fb45a0995b4afef00628a4557ff to your computer and use it in GitHub Desktop.
Save emcake/d6456fb45a0995b4afef00628a4557ff to your computer and use it in GitHub Desktop.
Applicative builders in F# by abusing For and IsLikeZip
type ListBuilder() =
/// map
member x.For(l,f) =
List.map f l
/// id
member x.Yield(v) =
v
/// merge + map
[<CustomOperation("zip", IsLikeZip = true)>]
member x.Zip(l1, l2, f) =
List.map2 f l1 l2
let list = ListBuilder()
list {
for x in [1;2;3] do
zip y in ["a";"b";"c"]
zip z in [true; false; true]
zip w in [4;5;6]
yield (x+w),y,z
}
//also works for not-lists...
type 'a SuperValue =
{
Sources : string list
Value : 'a
}
module SuperValue =
let make<'a> (v:'a) : 'a SuperValue =
{
Sources = [ sprintf "%+A" v ]
Value = v
}
let map f sp =
{
Sources = sp.Sources
Value = sp.Value |> f
}
let apply (xSp) (fSp) =
{
Sources = fSp.Sources @ xSp.Sources
Value = fSp.Value xSp.Value
}
let bind f xSp =
xSp.Value |> f
let x = SuperValue.make 1 // : int SuperValue = {Sources = ["1"]; Value = 1;}
let y = SuperValue.make 2 // : int SuperValue = {Sources = ["2"]; Value = 2;}
type SuperValueBuilder () =
// id
member __.Yield (f : 'a) = f
// f $ a <*> b
[< CustomOperation("also", IsLikeZip = true)>]
member __.Merge((a:'a SuperValue),(b:'b SuperValue),f : ('a -> 'b -> 'c)) =
SuperValue.make f
|> SuperValue.apply a
|> SuperValue.apply b
/// f $ a
member __.For(a,f) = SuperValue.map f a
let supervalue = SuperValueBuilder()
let z =
supervalue {
for x in x do
also y in y
yield (float x / float y)
}
// : float SuperValue = {Sources = ["<fun:z@78-4>"; "1"; "2"]; Value = 0.5;}
// also plays nice with binds..
type SuperValueBuilder with
member __.Return x = SuperValue.make x
member __.ReturnFrom x = x
member __.Bind(sv, f) = SuperValue.bind f sv
let divideOrAdd x y div =
let divide =
supervalue {
for x in x do
also y in y
yield (float x / float y)
}
supervalue {
let! d = div
if d then return! divide
else
return! supervalue {
for x in x do
also y in y
yield (float x + float y)
}
}
divideOrAdd x y (SuperValue.make true) // : float SuperValue = {Sources = ["<fun:divide@96-1>"; "1"; "2"]; Value = 0.5;}
divideOrAdd x y (SuperValue.make false) // : float SuperValue = {Sources = ["<fun:divideOrAdd@106-1>"; "1"; "2"]; Value = 3.0;}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment