fixedLenghList.hs

import Control.Applicative
import Control.Monad
import Data.Foldable
import Data.Traversable
import Data.Monoid
import Data.Maybe

import Prelude hiding (head, tail)

data Cons f a = a :. (f a)
  deriving (Eq, Ord)
data Nil a = Nil
  deriving (Eq, Ord)

infixr 5 :.

instance (Foldable f, Show a) => Show (Cons f a) where
  show x = "|" ++ show (toList x) ++ "|"

instance Show (Nil a) where
  show Nil = "|[]|"

fromFoldable :: (Foldable f, Applicative g, Traversable g) => f a -> Maybe (g a)
fromFoldable t = sequenceA $ snd $ mapAccumL f (toList t) (pure undefined)
  where
    f [] _ = ([], Nothing)
    f (x:xs) _ = (xs, Just x)

-- this can crash if the foldable is smaller than the new structure
fromFoldable' :: (Foldable f, Applicative g, Traversable g) => f a -> g a
fromFoldable' a = fromJust $ fromFoldable a

instance (Functor f) => Functor (Cons f) where
  fmap f (a :. b) = (f a) :. (fmap f b)

instance (Foldable f) => Foldable (Cons f) where
  foldMap f (a :. b) = f a `mappend` foldMap f b

instance (Traversable f) => Traversable (Cons f) where
  traverse f (a :. b) = (:.) <$> f a <*> traverse f b

instance (Monad f) => Monad (Cons f) where
  return x = x :. (return x)
  (a :. b) >>= k = (head $ k a) :. (b >>= (tail . k))

instance (Monad f, Applicative f) => Applicative (Cons f) where
  pure = return
  (<*>) = ap


instance Functor Nil where
  fmap _ Nil = Nil

instance Foldable Nil where
  foldMap _ Nil = mempty

instance Traversable Nil where
  traverse _ Nil = pure Nil

instance Monad Nil where
  return _  = Nil
  Nil >>= _ = Nil -- should I define this as _ >>= _ = Nil ? wouldn't have the right behavior with bottom

instance Applicative Nil where
  pure = return
  (<*>) = ap

head :: Cons f a -> a
head (a :. _) = a

tail :: Cons f a -> f a
tail (_ :. b) = b

t1 :: Cons (Cons (Cons Nil)) Integer
t1 = 1 :. 3 :. 5 :. Nil

t2 :: Cons (Cons (Cons Nil)) Integer
t2 = 4 :. 1 :. 0 :. Nil

t3 :: Cons (Cons (Cons Nil)) (Cons (Cons (Cons Nil)) Integer)
t3 = t1 :. t1 :. t2 :. Nil

-- get the diagonal of the transpose of t3
test :: Cons (Cons (Cons Nil)) Integer
test = join $ sequenceA $ t3