Instantly share code, notes, and snippets.

# Javran/gist:926296611a521cb00467Secret Created Aug 23, 2014

What would you like to do?
Comonad, Zipper and Conway's Game of Life (Part 2) - Second Solution
 {-# LANGUAGE DeriveFunctor #-} -- | LZipper data LZipper a = LZipper a [a] [a] deriving (Show, Functor) -- | shift left and right zipperMoveL, zipperMoveR :: LZipper a -> LZipper a zipperMoveL (LZipper a (x:xs') ys) = LZipper x xs' (a:ys) zipperMoveL _ = error "Invalid move" zipperMoveR (LZipper a xs (y:ys')) = LZipper y (a:xs) ys' zipperMoveR _ = error "Invalid move" -- | get the current focusing element current :: LZipper a -> a current (LZipper v _ _) = v -- | initial world to a zipper rangeToZipper :: a -> [a] -> LZipper a rangeToZipper v wd = case wd of [] -> LZipper v pad pad x:xs -> LZipper x pad (xs ++ pad) where pad = repeat v -- | a view range (coordinates), a zipper to a portion of the world zipperToRange :: (Int, Int) -> LZipper a -> [a] zipperToRange (i,j) zp = fmap current zippers where zippers = take (j - i + 1) (iterate zipperMoveR startZ) startZ = zipperMoveFocus i zp zipperMoveFocus :: Int -> LZipper a -> LZipper a zipperMoveFocus t z | t > 0 = zipperMoveFocus (t-1) (zipperMoveR z) | t < 0 = zipperMoveFocus (t+1) (zipperMoveL z) | otherwise = z waveRule :: LZipper Char -> Char waveRule (LZipper _ (l:_) (r:_)) | fromL && fromR = 'X' | fromL = '>' | fromR = '<' | otherwise = ' ' where fromL = l `elem` ">*X" fromR = r `elem` "<*X" waveRule _ = error "null zipper" nextGen :: LZipper Char -> LZipper Char nextGen z = LZipper c' ls' rs' where c' = waveRule z -- keep moving the zipper to its left or right -- apply `waveRule` to get next cell states ls' = map waveRule . tail \$ iterate zipperMoveL z rs' = map waveRule . tail \$ iterate zipperMoveR z main :: IO () main = mapM_ (putStrLn . zipperToRange (-20,40)) (take 20 (iterate nextGen startZ)) where startStr = "* > * * < **<" startZ = rangeToZipper ' ' startStr