mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-12-19 01:01:59 +03:00
a972778eab
They don't all pass yet, for minor reasons. Coming shortly... Unfortunately the startup overhead for chez is really noticeable here!
71 lines
1.8 KiB
Idris
71 lines
1.8 KiB
Idris
module Biapplicative
|
|
|
|
import Bifunctor
|
|
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)
|