Blog: Mr. Mathiesen

F# - Functors, Applicatives, And Monads In F#

April 22, 2017.

Inline functions with member constraints Code Snippet

1
2
3
4
5
6

let inline fmap  f (x: ^t) =
  (^t : (static member fmap  : unit -> ((^a -> ^b) -> ^t -> ^c)) ()) f x
let inline liftA f (x: ^t) =
  (^t : (static member liftA : unit ->  (^a -> ^t  -> ^b)) ()) f x
let inline liftM (x: ^t) f =
  (^t : (static member liftM : unit ->  (^t -> ^a  -> ^b)) ()) x f

Inline functions with member constraints Code output:

> val inline fmap :
  f:( ^a ->  ^b) -> x: ^t ->  ^c
    when  ^t : (static member fmap : -> ( ^a ->  ^b) ->  ^t ->  ^c)
> val inline liftA :
  f: ^a -> x: ^t ->  ^b
    when  ^t : (static member liftA : ->  ^a ->  ^t ->  ^b)
> val inline liftM :
  x: ^t -> f: ^a ->  ^b
    when  ^t : (static member liftM : ->  ^t ->  ^a ->  ^b)

Inline operators with member constraints Code Snippet

1
2
3

let inline (<@>) f  m = fmap  f  m (* Sadly, <$> can't be used *)
let inline (<*>) fm m = liftA fm m
let inline (>>=) m  f = liftM m  f

Inline operators with member constraints Code output:

> val inline ( <@> ) :
  f:( ^a ->  ^b) -> m: ^c ->  ^d
    when  ^c : (static member fmap : -> ( ^a ->  ^b) ->  ^c ->  ^d)
> val inline ( <*> ) :
  fm: ^a -> m: ^b ->  ^c
    when  ^b : (static member liftA : ->  ^a ->  ^b ->  ^c)
> val inline ( >>= ) :
  m: ^a -> f: ^b ->  ^c
    when  ^a : (static member liftM : ->  ^a ->  ^b ->  ^c)

Maybe (Option) with fmap, liftA and liftM Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

type 'a Maybe = Just of 'a | Nothing

(* Functor *)
type 'a Maybe with
  static member fmap  () : ('a -> 'b) -> 'a Maybe -> 'b Maybe =
    fun f -> function | Just x -> f x |> Just | Nothing -> Nothing

(* Applicative *)
type 'a Maybe with
  static member liftA () : ('a -> 'b) Maybe -> 'a Maybe -> 'b Maybe =
    fun fm ->
      fun m ->
        match fm,m with
          | Just f, Just x -> f x |> Just
          | ______________ -> Nothing

(* Monad *)
type 'a Maybe with
  static member liftM () : 'a Maybe -> ('a -> 'b Maybe) -> 'b Maybe =
    fun m ->
      fun f ->
        match m with
          | Nothing -> Nothing
          | Just x  -> f x
		  
(* Maybe with functions, the amount of parenthesis is to damn high *)
fmap  ((+) 1)        (Just 42);;
liftA (Just ((+) 1)) (Just 42);;
liftM (Just 42)      (fun x -> x + 1 |> Just);;

(* Maybe with operators, fewer parenthesis *)
(     (+) 1) <@> Just 42;;
Just ((+) 1) <*> Just 42;;
Just 42      >>= fun x -> x + 1 |> Just;;

Maybe (Option) with fmap, liftA and liftM Code output:

>
type 'a Maybe =
  | Just of 'a
  | Nothing
  with
    static member fmap : unit -> (('a -> 'b) -> 'a Maybe -> 'b Maybe)
    static member liftA : unit -> (('a -> 'b) Maybe -> 'a Maybe -> 'b Maybe)
    static member liftM : unit -> ('a Maybe -> ('a -> 'b Maybe) -> 'b Maybe)
  end
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43

Vect (list) with fmap, liftA and liftM Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

(* A list in F# is just a type abbreviation of a FSharpList *)
typedefof<List<_>> = typedefof<_ list>

(* Functor *)
type 'a List with
  static member fmap  () : ('a -> 'b) -> 'a list -> 'b list = List.map

(* This works *)
List.fmap () ((+) 1) [ 0 .. 10 ]

(* but this doesn't *)
// fmap ((+) 1) <@> [ 42 ]
(* error FS0001: The type ''a list' does not support the operator 'fmap' *)

(* Therefore, lets create our own type wrapping native lists in a Vector *)
type 'a Vect = Vect of 'a list

(* Functor *)
type 'a Vect with
  static member fmap  () : ('a -> 'b) -> 'a Vect -> 'b Vect =
    fun f ->
      fun (Vect xs) ->
        List.map f xs |> Vect

(* Applicative *)
type 'a Vect with
  static member liftA () : ('a -> 'b) Vect -> 'a Vect -> 'b Vect =
    fun (Vect fs) ->
      fun (Vect xs) ->
        fs
        |> List.map (fun f -> xs |> List.map f)
        |> List.concat |> Vect

(* Monad *)
type 'a Vect with
  static member liftM () : 'a Vect -> ('a list -> 'b Vect) -> 'b Vect =
    fun (Vect xs) ->
      fun f ->
        f xs
		
(* Vect with operators, fewer parenthesis *)
(           (+) 1)   <@> Vect [ 0 .. 5 ];;
Vect [ id; ((+) 1) ] <*> Vect [ 0 .. 5 ];;
Vect [ 0   ..   5  ] >>= fun xs -> xs |> List.map ((+) 1) |> Vect;;

Vect (list) with fmap, liftA and liftM Code output:

> 
type List<'T> with
  static member fmap : unit -> (('T -> 'b) -> 'T list -> 'b list)
type 'a Vect =
  | Vect of 'a list
  with
    static member fmap : unit -> (('a -> 'b) -> 'a Vect -> 'b Vect)
    static member liftA : unit -> (('a -> 'b) Vect -> 'a Vect -> 'b Vect)
    static member liftM : unit -> ('a Vect -> ('a list -> 'b Vect) -> 'b Vect)
  end
> val it : int Vect = Vect [1; 2; 3; 4; 5; 6]
> val it : int Vect = Vect [0; 1; 2; 3; 4; 5; 1; 2; 3; 4; 5; 6]
> val it : int Vect = Vect [1; 2; 3; 4; 5; 6]

Result (Choice) with fmap, liftA and liftM Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

type ('error,'a) Result = Ok of 'a | Err of 'error

(* Functor *)
type ('c,'a) Result with
  static member fmap  () : ('a -> 'b) -> ('c,'a) Result -> ('c,'b) Result =
    fun f -> function | Ok x -> f x |> Ok | Err e -> Err e

(* Applicative *)
type ('c,'a) Result with
  static member liftA () :
    ('c,('a -> 'b)) Result -> ('c,'a) Result -> ('c,'b) Result =
    fun fm ->
      fun m ->
        match fm,m with
          | Ok  f, Ok x  -> f x |> Ok
          | Err e, _
          | _    , Err e -> Err e

(* Monad *)
type ('c,'a) Result with
  static member liftM () :
    ('c,'a) Result -> ('a -> ('c,'b) Result) -> ('c,'b) Result =
    fun m ->
      fun f ->
        match m with
          | Err e -> Err e
          | Ok  x -> f x

(* Result with operators, fewer parenthesis *)
(    ((+) 1) <@> Ok 42                  : (exn,int) Result);;
( Ok ((+) 1) <*> Ok 42                  : (exn,int) Result);;
( Ok 42      >>= (fun x -> x + 1 |> Ok) : (exn,int) Result);;

Result (Choice) with fmap, liftA and liftM Code output:

>
type ('error,'a) Result =
  | Ok of 'a
  | Err of 'error
  with
    static member
      fmap : unit -> (('a -> 'b) -> ('c,'a) Result -> ('c,'b) Result)
    static member
      liftA : unit ->
                (('c,('a -> 'b)) Result -> ('c,'a) Result -> ('c,'b) Result)
    static member
      liftM : unit ->
                (('c,'a) Result -> ('a -> ('c,'b) Result) -> ('c,'b) Result)
  end
> val it : (exn,int) Result = Ok 43
> val it : (exn,int) Result = Ok 43
> val it : (exn,int) Result = Ok 43

Combining Maybe and Result using (»=) Code Snippet

1
2
3
4
5
6
7
8
9
10
11

let inc  x = x + 1
let incM x = inc x    |> Just
let defM x = function |  Just y -> y | Nothing -> x
let incR x = inc x    |> Ok 
let defR   = function |  Ok   x -> x | Err e -> raise e

42
|> Just >>= incM >>= incM >>= incM >>= incM
|> defM 0
|> Ok   >>= incR >>= incR >>= incR >>= incR
|> defR

Combining Maybe and Result using (»=) Code output:

> val inc : x:int -> int
> val incM : x:int -> int Maybe
> val defM : x:'a -> _arg1:'a Maybe -> 'a
> val incR : x:int -> ('a,int) Result
> val defR : _arg1:(#System.Exception,'b) Result -> 'b
> val it : int = 50

References: