{- | Module : Type.Yoko.TSTSS Copyright : (c) The University of Kansas 2011 License : BSD3 Maintainer : nicolas.frisby@gmail.com Stability : experimental Portability : see LANGUAGE pragmas (... GHC) Classes for @* -> * -> *@ types. -} module Type.Yoko.TSTSS where import Control.Applicative class FunctorTSTSS ff where fmapTSTSS :: (a -> c) -> (b -> d) -> ff a b -> ff c d instance FunctorTSTSS Either where fmapTSTSS f g = (Left . f) `either` (Right . g) instance FunctorTSTSS (,) where fmapTSTSS f g ~(x, y) = (f x, g y) class TraversableTSTSS ff where traverseTSTSS :: Applicative i => (a -> i c) -> (b -> i d) -> ff a b -> i (ff c d) instance TraversableTSTSS Either where traverseTSTSS f g = either (fmap Left . f) (fmap Right . g) instance TraversableTSTSS (,) where traverseTSTSS f g ~(x, y) = (,) <$> f x <*> g y