{-# LANGUAGE Trustworthy #-}
module Data.Traversable (
    
    Traversable(..),
    
    for,
    forM,
    mapAccumL,
    mapAccumR,
    
    fmapDefault,
    foldMapDefault,
    ) where
import Prelude hiding (mapM, sequence, foldr)
import qualified Prelude (mapM, foldr)
import Control.Applicative
import Data.Foldable (Foldable())
import Data.Monoid (Monoid)
import Data.Proxy
import GHC.Arr
class (Functor t, Foldable t) => Traversable t where
    
    
    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
    traverse f = sequenceA . fmap f
    
    
    sequenceA :: Applicative f => t (f a) -> f (t a)
    sequenceA = traverse id
    
    
    mapM :: Monad m => (a -> m b) -> t a -> m (t b)
    mapM f = unwrapMonad . traverse (WrapMonad . f)
    
    
    sequence :: Monad m => t (m a) -> m (t a)
    sequence = mapM id
    
instance Traversable Maybe where
    traverse _ Nothing = pure Nothing
    traverse f (Just x) = Just <$> f x
instance Traversable [] where
    {-# INLINE traverse #-} 
    traverse f = Prelude.foldr cons_f (pure [])
      where cons_f x ys = (:) <$> f x <*> ys
    mapM = Prelude.mapM
instance Traversable (Either a) where
    traverse _ (Left x) = pure (Left x)
    traverse f (Right y) = Right <$> f y
instance Traversable ((,) a) where
    traverse f (x, y) = (,) x <$> f y
instance Ix i => Traversable (Array i) where
    traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
instance Traversable Proxy where
    traverse _ _ = pure Proxy
    {-# INLINE traverse #-}
    sequenceA _ = pure Proxy
    {-# INLINE sequenceA #-}
    mapM _ _ = return Proxy
    {-# INLINE mapM #-}
    sequence _ = return Proxy
    {-# INLINE sequence #-}
instance Traversable (Const m) where
    traverse _ (Const m) = pure $ Const m
for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
{-# INLINE for #-}
for = flip traverse
forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
{-# INLINE forM #-}
forM = flip mapM
newtype StateL s a = StateL { runStateL :: s -> (s, a) }
instance Functor (StateL s) where
    fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)
instance Applicative (StateL s) where
    pure x = StateL (\ s -> (s, x))
    StateL kf <*> StateL kv = StateL $ \ s ->
        let (s', f) = kf s
            (s'', v) = kv s'
        in (s'', f v)
mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s
newtype StateR s a = StateR { runStateR :: s -> (s, a) }
instance Functor (StateR s) where
    fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)
instance Applicative (StateR s) where
    pure x = StateR (\ s -> (s, x))
    StateR kf <*> StateR kv = StateR $ \ s ->
        let (s', v) = kv s
            (s'', f) = kf s'
        in (s'', f v)
mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s
fmapDefault :: Traversable t => (a -> b) -> t a -> t b
{-# INLINE fmapDefault #-}
fmapDefault f = getId . traverse (Id . f)
foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m
foldMapDefault f = getConst . traverse (Const . f)
newtype Id a = Id { getId :: a }
instance Functor Id where
    fmap f (Id x) = Id (f x)
instance Applicative Id where
    pure = Id
    Id f <*> Id x = Id (f x)