module Algebra.Traversable(
  module Algebra.Applicative, module Algebra.Foldable,

  Traversable(..),Contravariant(..),

  traverse,foreach,transpose,flip
  ) where

import Algebra.Classes
import Algebra.Core hiding (flip,(&))
import Algebra.Applicative
import Algebra.Foldable
import Control.Lens
import Data.Tree

class Foldable t => Traversable t where
  sequence :: Applicative f => t (f a) -> f (t a)
instance Traversable ((,) c) where
  sequence ~(c,m) = (,) c<$>m
instance Traversable (Either a) where
  sequence = pure . Left <|> map Right
instance Traversable [] where
  sequence (x:xs) = (:)<$>x<*>sequence xs
  sequence [] = pure []
deriving instance Traversable Interleave
deriving instance Traversable OrdList
deriving instance Traversable ZipList
instance Traversable Tree where
  sequence (Node a subs) = Node<$>a<*>sequence (map sequence subs)
deriving instance Traversable ZipTree
instance (Traversable f,Traversable g) => Traversable (f:.:g) where
  sequence = getCompose >>> map sequence >>> sequence >>> map Compose
instance (Traversable f,Traversable g) => Traversable (f:**:g) where
  sequence (f:**:g) = (:**:)<$>sequence f<*>sequence g
instance (Traversable f,Traversable g) => Traversable (f:++:g) where
  sequence (Sum (Left f)) = Sum . Left<$>sequence f
  sequence (Sum (Right g)) = Sum . Right<$>sequence g
instance Traversable Maybe where
  sequence Nothing = pure Nothing
  sequence (Just a) = Just<$>a

class Functor t => 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

traverse :: (Applicative f,Traversable t) => (a -> f b) -> t a -> f (t b)
traverse f t = sequence (map f t)
foreach :: (Applicative f,Traversable t) => t a -> (a -> f b) -> f (t b)
foreach = flip traverse
transpose :: (Applicative f,Traversable t) => t (f a) -> f (t a)
transpose = sequence
flip :: (Contravariant c,Functor f) => f (c a) -> c (f a)
flip = collect

instance Compound a b [a] [b] where
  _each = traverse