module Data.Tup.Class where
import Control.Applicative
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
import qualified Data.Foldable as Foldable
import qualified Data.Traversable as Traversable
import Data.List
import Data.Proxy
class (Functor f, Applicative f, Foldable f, Traversable f) => Tup f where
tupSize :: f a -> Int
tupToList :: f a -> [a]
tupFromList :: [a] -> f a
tupProxy :: f a -> Proxy a
tupUndef :: f a -> a
constantTup :: a -> f a
undefinedTup :: f a
tupSize = Foldable.foldl (\c _ -> c+1) 0
tupToList = Foldable.toList
tupFromList = \ys -> snd $ Traversable.mapAccumL (\(x:xs) _ -> (xs,x)) ys (pure undefined)
tupUndef _ = undefined
tupProxy _ = Proxy
constantTup = pure
undefinedTup = pure undefined
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
transposeTup :: (Tup f, Tup g) => f (g a) -> g (f a)
transposeTup = tupFromList . (map tupFromList) . transpose . (map tupToList) . tupToList
maybeTupConcat :: (Tup f, Tup g, Tup h) => f a -> g a -> Maybe (h a)
maybeTupConcat x y =
if tupSize x + tupSize y == tupSize z
then Just z
else Nothing
where
z = tupFromList (tupToList x ++ tupToList y)
unsafeTupConcat :: (Tup f, Tup g, Tup h) => f a -> g a -> h a
unsafeTupConcat x y = z
where
z = tupFromList (tupToList x ++ tupToList y)
maybeConvertTup :: (Tup f, Tup g) => f a -> Maybe (g a)
maybeConvertTup x =
if tupSize x == tupSize y
then Just y
else Nothing
where
y = tupFromList (tupToList x)
unsafeConvertTup :: (Tup f, Tup g) => f a -> g a
unsafeConvertTup x = tupFromList (tupToList x)
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