Define the Traversing interface
This commit is contained in:
parent
85b9d77079
commit
81c9486124
54
Data/Profunctor/Traversing.idr
Normal file
54
Data/Profunctor/Traversing.idr
Normal file
|
@ -0,0 +1,54 @@
|
|||
module Data.Profunctor.Traversing
|
||||
|
||||
import Control.Monad.Identity
|
||||
import Data.Morphisms
|
||||
import Data.Profunctor.Types
|
||||
import Data.Profunctor.Functor
|
||||
import Data.Profunctor.Strong
|
||||
import Data.Profunctor.Closed
|
||||
|
||||
%default total
|
||||
|
||||
record Bazaar a b t where
|
||||
constructor MkBazaar
|
||||
getBazaar : forall f. Applicative f => (a -> f b) -> f t
|
||||
|
||||
Functor (Bazaar a b) where
|
||||
map f (MkBazaar g) = MkBazaar (map f . g)
|
||||
|
||||
Applicative (Bazaar a b) where
|
||||
pure a = MkBazaar $ \_ => pure a
|
||||
mf <*> ma = MkBazaar $ \k => getBazaar mf k <*> getBazaar ma k
|
||||
|
||||
sell : a -> Bazaar a b b
|
||||
sell a = MkBazaar ($ a)
|
||||
|
||||
record Baz t b a where
|
||||
constructor MkBaz
|
||||
getBaz : forall f. Applicative f => (a -> f b) -> f t
|
||||
|
||||
Functor (Baz t b) where
|
||||
map f (MkBaz g) = MkBaz (g . (. f))
|
||||
|
||||
|
||||
sold : Baz t a a -> t
|
||||
sold m = runIdentity (getBaz m Id)
|
||||
|
||||
Foldable (Baz t b) where
|
||||
foldr f i bz = getBaz bz @{appEndo} f i
|
||||
where
|
||||
-- Equivalent to `Const (Endomorphism acc)`
|
||||
appEndo : Applicative (\_ => acc -> acc)
|
||||
appEndo = MkApplicative @{MkFunctor (const id)} (const id) (.)
|
||||
|
||||
Traversable (Baz t b) where
|
||||
traverse f bz = map (\m => MkBaz (getBazaar m)) $ getBaz bz @{Compose} $ \x => sell <$> f x
|
||||
|
||||
|
||||
public export
|
||||
interface (Strong p, Choice p) => Traversing p where
|
||||
traverse' : Traversable f => p a b -> p (f a) (f b)
|
||||
traverse' = wander traverse
|
||||
|
||||
wander : (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t
|
||||
wander f = dimap (\s => MkBaz $ \afb => f afb s) sold . traverse'
|
Loading…
Reference in a new issue