Skip to content

Instantly share code, notes, and snippets.

@wraithm
Last active August 29, 2015 14:12
Show Gist options
  • Save wraithm/0e78c43c8725cdb90d54 to your computer and use it in GitHub Desktop.
Save wraithm/0e78c43c8725cdb90d54 to your computer and use it in GitHub Desktop.
Monad with modular implicits
module type Functor = sig
type 'a t
val map : ('a -> 'b) -> 'a t -> 'b t
end
let fmap (implicit F : Functor) = F.map
implicit module FunctorList = struct
type 'a t = 'a list
let map = List.map
end
implicit module FunctorOption = struct
type 'a t = 'a option
let map f = function
| Some x -> Some (f x)
| None -> None
end
module type Applicative = sig
module F : Functor
val return : 'a -> 'a F.t
end
implicit module ApplicativeOption = struct
module F = FunctorOption
let return x = Some x
end
implicit module ApplicativeList = struct
module F = FunctorList
let return x = [x]
end
module type Monad = sig
module A : Applicative
val bind : 'a A.F.t -> ('a -> 'b A.F.t) -> 'b A.F.t
end
let return (implicit M : Monad) = M.A.return
let (>>=) (implicit M : Monad) = M.bind
let join (implicit M : Monad) n = M.bind n (fun x -> x)
let sequence (implicit M : Monad) ms =
let k m n = m >>= (fun x -> n >>= (fun xs -> return (x :: xs))) in
List.fold_right k ms (return [])
let mapM (implicit M : Monad) f xs = sequence (List.map f xs)
implicit module MonadOption = struct
module A = ApplicativeOption
let bind mx f = match mx with
| Some x -> f x
| None -> None
end
implicit module MonadList = struct
module A = ApplicativeList
let bind x f =
let (<<) h g y = h (g y) in
List.fold_right (List.append << f) x []
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment