------------------------------------------------------------------------ -- The Agda standard library -- -- Applicative functors ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. {-# OPTIONS --cubical-compatible --safe #-} module Effect.Applicative where open import Data.Bool.Base using (Bool; true; false) open import Data.Product.Base using (_×_; _,_) open import Data.Unit.Polymorphic.Base using () open import Effect.Choice using (RawChoice) open import Effect.Empty using (RawEmpty) open import Effect.Functor as Fun using (RawFunctor) open import Function.Base using (const; flip; _∘′_) open import Level using (Level; suc; _⊔_) open import Relation.Binary.PropositionalEquality.Core using (_≡_) private variable f g : Level A B C : Set f ------------------------------------------------------------------------ -- The type of raw applicatives record RawApplicative (F : Set f Set g) : Set (suc f g) where infixl 4 _<*>_ _<*_ _*>_ infixl 4 _⊛_ _<⊛_ _⊛>_ infix 4 _⊗_ field rawFunctor : RawFunctor F pure : A F A _<*>_ : F (A B) F A F B open RawFunctor rawFunctor public _<*_ : F A F B F A a <* b = const <$> a <*> b _*>_ : F A F B F B a *> b = flip const <$> a <*> b zipWith : (A B C) F A F B F C zipWith f x y = f <$> x <*> y zip : F A F B F (A × B) zip = zipWith _,_ -- Haskell-style alternative name for pure return : A F A return = pure -- backwards compatibility: unicode variants _⊛_ : F (A B) F A F B _⊛_ = _<*>_ _<⊛_ : F A F B F A _<⊛_ = _<*_ _⊛>_ : F A F B F B _⊛>_ = _*>_ _⊗_ : F A F B F (A × B) _⊗_ = zip module _ where open RawApplicative open RawFunctor -- Smart constructor mkRawApplicative : (F : Set f Set g) (pure : {A} A F A) (app : {A B} F (A B) F A F B) RawApplicative F mkRawApplicative F pure app .rawFunctor ._<$>_ = app ∘′ pure mkRawApplicative F pure app .pure = pure mkRawApplicative F pure app ._<*>_ = app ------------------------------------------------------------------------ -- The type of raw applicatives with a zero record RawApplicativeZero (F : Set f Set g) : Set (suc f g) where field rawApplicative : RawApplicative F rawEmpty : RawEmpty F open RawApplicative rawApplicative public open RawEmpty rawEmpty public guard : Bool F guard true = pure _ guard false = empty ------------------------------------------------------------------------ -- The type of raw alternative applicatives record RawAlternative (F : Set f Set g) : Set (suc f g) where field rawApplicativeZero : RawApplicativeZero F rawChoice : RawChoice F open RawApplicativeZero rawApplicativeZero public open RawChoice rawChoice public ------------------------------------------------------------------------ -- The type of applicative morphisms record Morphism {F₁ F₂ : Set f Set g} (A₁ : RawApplicative F₁) (A₂ : RawApplicative F₂) : Set (suc f g) where module A₁ = RawApplicative A₁ module A₂ = RawApplicative A₂ field functorMorphism : Fun.Morphism A₁.rawFunctor A₂.rawFunctor open Fun.Morphism functorMorphism public field op-pure : (x : A) op (A₁.pure x) A₂.pure x op-<*> : (f : F₁ (A B)) (x : F₁ A) op (f A₁.⊛ x) (op f A₂.⊛ op x) -- backwards compatibility: unicode variants op-⊛ = op-<*>