Class.hs

module Data.Tup.Class where

--------------------------------------------------------------------------------

import Control.Applicative
import Data.List

--------------------------------------------------------------------------------
-- * the Tup class

class (Functor f, Applicative f) => Tup f where
  tupSize     :: f a -> Int
  tupToList   :: f a -> [a]
  tupFromList :: [a] -> f a

  tupUndef    :: f a -> a
  tupUndef     = undefined

--------------------------------------------------------------------------------
-- * misc 

-- | Safe version of 'tupFromList'.
maybeTupFromList :: Tup f => [a] -> Maybe (f a)
maybeTupFromList xs = result where
  result = if length xs == tupSize (undef result) 
    then Just (tupFromList xs)
    else Nothing    
  undef :: Maybe a -> a
  undef _ = undefined

-- | Transpose a Tup of Tups.
transposeTup :: (Tup f, Tup g) => f (g a) -> g (f a)
transposeTup = tupFromList . (map tupFromList) . transpose . (map tupToList) . tupToList

--------------------------------------------------------------------------------
-- * zipping 

zipTupWith :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
zipTupWith f t1 t2 = f <$> t1 <*> t2

zipTupWith3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
zipTupWith3 f t1 t2 t3 = f <$> t1 <*> t2 <*> t3

zipTupWith4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
zipTupWith4 f t1 t2 t3 t4 = f <$> t1 <*> t2 <*> t3 <*> t4

zipTup :: Applicative f => f a -> f b -> f (a,b)
zipTup t1 t2 = (,) <$> t1 <*> t2

zipTup3 :: Applicative f => f a -> f b -> f c -> f (a,b,c)
zipTup3 t1 t2 t3 = (,,) <$> t1 <*> t2 <*> t3

zipTup4 :: Applicative f => f a -> f b -> f c -> f d -> f (a,b,c,d)
zipTup4 t1 t2 t3 t4 = (,,,) <$> t1 <*> t2 <*> t3 <*> t4

--------------------------------------------------------------------------------