fun with lists

Lists.hs

{-# LANGUAGE DeriveFunctor #-}

module Main where
import Data.Monoid
import Control.Comonad
import Data.Fix
import Data.Foldable as Foldable

newtype Cell a b = Cell { runCell :: Either () ((,) a b) } deriving (Functor)

newtype List a = List { runList :: Fix (Cell a) }

first :: (a -> b) -> (a, c) -> (b, c)
first f (a,c) = (f a, c)

instance Functor List where
  fmap f = cata (either (const nil) (uncurry cons . first f) . runCell) . runList

cons :: a -> List a -> List a
cons x xs = List (Fix (Cell (Right (x, runList xs))))

nil :: List a
nil = List (Fix (Cell (Left ())))

instance Monoid (List a) where
  mempty        = nil
  mappend xs ys = foldr cons ys xs

instance Foldable List where
  foldr f z = cata (either (const z) (uncurry f) . runCell) . runList

uncons :: List a -> Maybe (a, List a)
uncons = either (const Nothing) (Just . fmap List) . runCell . unFix . runList

maybeHead :: List a -> Maybe a
maybeHead = fmap fst . uncons

maybeTail :: List a -> Maybe (List a)
maybeTail = fmap snd . uncons

fromList :: [a] -> List a
fromList = foldr cons nil

main :: IO ()
main = do

  -- Difference list implementation using comonads!
  putStrLn $ extract $ ($ "Hello") <<= ($ ", world!") <<= id

  -- Implementation of the list interface (fmap, append) using only
  -- functions on Either and (,) (and of course our more abstract friends
  -- like cata and Monoid)
  print $ Foldable.toList $ fromList [4,5,6] <> fromList [1,2,3]
  print $ Foldable.toList $ succ <$> fromList [4,5,6]