module Clean.Traversable(
module Clean.Applicative,
Traversable(..),Contravariant(..),
traverse,foreach,transpose,flip
) where
import Clean.Classes
import Clean.Core hiding (flip,(&))
import Clean.Applicative
import Data.Tree
class Traversable t where
sequence :: Applicative f => t (f a) -> f (t a)
instance Traversable (Either a) where
sequence = pure . Left <|> map Right
instance Traversable [] where
sequence (x:xs) = (:)<$>x<*>sequence xs
sequence [] = pure []
deriving instance Traversable ZipList
instance Traversable Tree where
sequence (Node a subs) = Node<$>a<*>sequence (map sequence subs)
deriving instance Traversable ZipTree
class Contravariant t where
collect :: Functor f => f (t a) -> t (f a)
instance Contravariant Id where collect f = Id (map getId f)
instance Contravariant ((->) a) where collect f = \a -> map ($a) f
instance (Applicative f,Contravariant f,Semigroup m) => Semigroup (f m) where
fa + fb = (+)<$>fa<*>fb
instance (Applicative f,Contravariant f,Monoid m) => Monoid (f m) where
zero = pure zero
instance (Applicative f,Contravariant f,Ring r) => Ring (f r) where
one = pure one
fa * fb = (*)<$>fa<*>fb
traverse f t = sequence (map f t)
foreach = flip traverse
transpose = sequence
flip = collect