mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-12-21 02:31:50 +03:00
70 lines
1.8 KiB
Idris
70 lines
1.8 KiB
Idris
module Biapplicative
|
|
|
|
import Apply
|
|
|
|
infixl 4 <<*>>, <<*, *>>, <<**>>
|
|
|
|
||| Biapplicatives
|
|
||| @p the action of the Biapplicative on pairs of objects
|
|
public export
|
|
interface Bifunctor p => Biapplicative p where -- (p : Type -> Type -> Type) where
|
|
|
|
||| Lifts two values into a Biapplicative
|
|
|||
|
|
||| ````idris example
|
|
||| bipure 1 "hello" = (1, "hello")
|
|
||| ````
|
|
|||
|
|
bipure : a -> b -> p a b
|
|
|
|
||| Applies a Biapplicative of functions to a second Biapplicative
|
|
|||
|
|
||| ````idris example
|
|
||| ( (\x => x + 1), reverse ) <<*>> (1, "hello") == (2, "olleh")
|
|
||| ````
|
|
|||
|
|
(<<*>>) : p (a -> b) (c -> d) -> p a c -> p b d
|
|
|
|
||| Sequences two Biapplicatives rightwards
|
|
|||
|
|
||| ````idris example
|
|
||| (1, "hello") *>> (2, "goodbye") = (2, "goodbye")
|
|
||| ````
|
|
|||
|
|
(*>>) : p a b -> p c d -> p c d
|
|
a *>> b = bimap (const id) (const id) <<$>> a <<*>> b
|
|
|
|
||| Sequences two Biapplicatives leftwards
|
|
|||
|
|
||| ````idris example
|
|
||| (1, "hello") <<* (2, "goodbye") = (1, "hello")
|
|
||| ````
|
|
|||
|
|
(<<*) : p a b -> p c d -> p a b
|
|
a <<* b = bimap const const <<$>> a <<*>> b
|
|
|
|
||| Applies the second of two Biapplicatives to the first
|
|
|||
|
|
||| ````idris example
|
|
||| (1, "hello") <<**>> ( (\x => x + 1), reverse ) == (2, "olleh")
|
|
||| ````
|
|
|||
|
|
export
|
|
(<<**>>) : Biapplicative p => p a c -> p (a -> b) (c -> d) -> p b d
|
|
(<<**>>) = flip (<<*>>)
|
|
|
|
export
|
|
biliftA2 : Biapplicative p => (a -> b -> c) ->
|
|
(d -> e -> f) -> p a d -> p b e -> p c f
|
|
biliftA2 f g a b = bimap f g <<$>> a <<*>> b
|
|
|
|
export
|
|
biliftA3 : Biapplicative p =>
|
|
(a -> b -> c -> d) -> (e -> f -> g -> h) -> p a e -> p b f -> p c g -> p d h
|
|
biliftA3 f g a b c = bimap f g <<$>> a <<*>> b <<*>> c
|
|
|
|
public export
|
|
implementation Biapplicative Pair where
|
|
bipure a b = (a, b)
|
|
(f, g) <<*>> (a, b) = (f a, g b)
|