63 lines
2.1 KiB
Text
63 lines
2.1 KiB
Text
/-
|
||
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
Authors: Leonardo de Moura, Sebastian Ullrich
|
||
-/
|
||
prelude
|
||
import init.control.alternative init.control.lift init.control.except
|
||
|
||
universes u v
|
||
|
||
structure option_t (m : Type u → Type v) (α : Type u) : Type v :=
|
||
(run : m (option α))
|
||
|
||
namespace option_t
|
||
variables {m : Type u → Type v} [monad m] {α β : Type u}
|
||
|
||
@[inline] protected def bind_cont {α β : Type u} (f : α → option_t m β) : option α → m (option β)
|
||
| (some a) := (f a).run
|
||
| none := pure none
|
||
|
||
@[inline] protected def bind (ma : option_t m α) (f : α → option_t m β) : option_t m β :=
|
||
⟨ma.run >>= option_t.bind_cont f⟩
|
||
|
||
@[inline] protected def pure (a : α) : option_t m α :=
|
||
⟨pure (some a)⟩
|
||
|
||
instance : monad (option_t m) :=
|
||
{ pure := @option_t.pure _ _, bind := @option_t.bind _ _ }
|
||
|
||
protected def orelse (ma : option_t m α) (mb : option_t m α) : option_t m α :=
|
||
⟨do some a ← ma.run | mb.run,
|
||
pure (some a)⟩
|
||
|
||
@[inline] protected def fail : option_t m α :=
|
||
⟨pure none⟩
|
||
|
||
instance : alternative (option_t m) :=
|
||
{ failure := @option_t.fail m _,
|
||
orelse := @option_t.orelse m _,
|
||
..option_t.monad }
|
||
|
||
@[inline] protected def lift (ma : m α) : option_t m α :=
|
||
⟨some <$> ma⟩
|
||
|
||
instance : has_monad_lift m (option_t m) :=
|
||
⟨@option_t.lift _ _⟩
|
||
|
||
@[inline] protected def monad_map {m'} [monad m'] {α} (f : ∀ {α}, m α → m' α) : option_t m α → option_t m' α :=
|
||
λ x, ⟨f x.run⟩
|
||
|
||
instance (m') [monad m'] : monad_functor m m' (option_t m) (option_t m') :=
|
||
⟨λ α, option_t.monad_map⟩
|
||
|
||
protected def catch (ma : option_t m α) (handle : unit → option_t m α) : option_t m α :=
|
||
⟨do some a ← ma.run | (handle ()).run,
|
||
pure a⟩
|
||
|
||
instance : monad_except unit (option_t m) :=
|
||
{ throw := λ _ _, option_t.fail, catch := @option_t.catch _ _ }
|
||
|
||
instance (m out) [monad_run out m] : monad_run (λ α, out (option α)) (option_t m) :=
|
||
⟨λ α, monad_run.run ∘ option_t.run⟩
|
||
end option_t
|