Foldable and Traversable

Prelude Data.Sequence> map (\n -> replicate n 'a') [1,3,5]
["a","aaa","aaaaa"]
Prelude Data.Sequence> fmap (\n -> replicate n 'a') (1 <| 3 <| 5 <| empty)
fromList ["a","aaa","aaaaa"]

concatMap :: (a -> Seq b) -> Seq a -> Seq b
concatMap = foldMap

concatMap :: (Foldable f, Monoid (f b)) => (a -> f b) -> f a -> f b
concatMap = foldMap

filter :: (Applicative f, Foldable f, Monoid (f a)) => 
          (a -> Bool) -> f a -> f a
filter p = foldMap (\a -> if p a then pure a else mempty)

import Prelude hiding (sequence)
 
import Data.Sequence
import Data.Foldable
import Data.Traversable
import Control.Applicative
 
 
data Supply s v = Supply { unSupply :: [s] -> ([s],v) }
 
instance Functor (Supply s) where 
  fmap f av = Supply (\l -> let (l',v) = unSupply av l in (l',f v))
 
instance Applicative (Supply s) where
  pure v    = Supply (\l -> (l,v))
  af <*> av = Supply (\l -> let (l',f)  = unSupply af l
                                (l'',v) = unSupply av l'
                            in (l'',f v))
 
runSupply :: (Supply s v) -> [s] -> v
runSupply av l = snd $ unSupply av l
 
supply :: Supply s s
supply = Supply (\(x:xs) -> (xs,x))
 
zipTF :: (Traversable t, Foldable f) => t a -> f b -> t (a,b)
zipTF t f = runSupply (traverse (\a -> (,) a <$> supply) t) (toList f)
 
zipWithTF :: (Traversable t,Foldable f) => (a -> b -> c) -> t a -> f b -> t c
zipWithTF g t f = runSupply  (traverse (\a -> g a <$> supply) t) (toList f)
 
zipWithTFM :: (Traversable t,Foldable f,Monad m) => 
              (a -> b -> m c) -> t a -> f b -> m (t c)
zipWithTFM g t f = sequence (zipWithTF g t f)
 
zipWithTFA :: (Traversable t,Foldable f,Applicative m) => 
              (a -> b -> m c) -> t a -> f b -> m (t c)
zipWithTFA g t f = sequenceA (zipWithTF g t f)

module GenericZip 
 (zipWithTF,
  zipTF,
  zipWithTFA,
  zipWithTFM) where
 
 
import Data.Foldable
import Data.Traversable
import qualified Data.Traversable as T
import Control.Applicative
import Control.Monad.State 
 
-- | The state contains the list of values obtained form the foldable container
--   and a String indicating the name of the function currectly being executed
data ZipState a = ZipState {fName :: String,
                            list  :: [a]}
 
-- | State monad containing ZipState
type ZipM l a = State (ZipState l) a
 
-- | pops the first element of the list inside the state
pop :: ZipM l l
pop = do 
 st <- get 
 let xs = list st
     n = fName st
 case xs of
   (a:as) -> do put st{list=as}
                return a
   [] -> error $ n ++ ": insufficient input"
 
-- | pop a value form the state and supply it to the second 
--   argument of a binary function 
supplySecond :: (a -> b -> c) -> a -> ZipM b c
supplySecond f a = do b <- pop  
                      return $ f a b
 
zipWithTFError :: (Traversable t,Foldable f) => 
                  String -> (a -> b -> c) -> t a -> f b -> t c  
zipWithTFError str g t f = evalState (T.mapM (supplySecond g) t) 
                                     (ZipState str (toList f))
 
 
zipWithTF :: (Traversable t,Foldable f) => (a -> b -> c) -> t a -> f b -> t c
zipWithTF = zipWithTFError "GenericZip.zipWithTF"
 
zipTF :: (Traversable t, Foldable f) => t a -> f b -> t (a,b)
zipTF = zipWithTFError "GenericZip.zipTF"  (,) 
 
 
zipWithTFM :: (Traversable t,Foldable f,Monad m) => 
              (a -> b -> m c) -> t a -> f b -> m (t c)
zipWithTFM g t f = T.sequence (zipWithTFError "GenericZip.zipWithTFM"  g t f)
 
zipWithTFA :: (Traversable t,Foldable f,Applicative m) => 
              (a -> b -> m c) -> t a -> f b -> m (t c)
zipWithTFA g t f = sequenceA (zipWithTFError "GenericZip.zipWithTFA" g t f)

mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)

zipWithTF :: (Traversable t, Foldable f) => (a -> b -> c) -> t a -> f b -> t c
zipWithTF g t f = snd (mapAccumL map_one (toList f) t)
  where map_one (x:xs) y = (xs, g y x)

reverseT :: (Traversable t) => t a -> t a
reverseT t = snd (mapAccumR (\ (x:xs) _ -> (xs, x)) (toList t) t)