deps

      base >=4.7 && <5
    , bytestring
    , colour
    , comonad
    , data-memocombinators
    , diagrams-lib
    , diagrams-svg
    , lens
    , svg-builder
    , yesod

foo.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Comonad (Comonad, extract, duplicate, extend)
import Control.Lens as L ((&), partsOf, (.~), taking)
import Data.Bits (testBit)
import Data.Bits.Lens as L (bits)
import qualified Data.ByteString as Strict (ByteString)
import qualified Data.ByteString.Lazy as Lazy (toStrict)
import Data.MemoCombinators (Memo, integral)
import Data.Word (Word8)
import Diagrams.Backend.SVG (SVG(..), Options(..))
import Graphics.Svg.Core (renderBS)
import Diagrams as D (Diagram, (#), cat, unitY, hcat, unitSquare, fc, renderDia, mkWidth)
import Data.Colour.Names (white, black)
import Yesod

data Store s a = Store (s -> a) s deriving Functor

instance Comonad (Store s) where
  extract (Store f s) = f s
  duplicate (Store f s) = Store (Store f) s

experiment :: Functor f => (s -> f s) -> Store s a -> f a
experiment k (Store f s) = f <$> k s

rule :: Num s => Word8 -> Store s Bool -> Bool
rule w (Store f s) = testBit w $ 0 L.& partsOf (taking 3 L.bits) .~ [f (s+1), f s, f (s-1)]

tab :: Memo s -> Store s a -> Store s a
tab opt (Store f s) = Store (opt f) s

loop :: Integral s => (Store s a -> a) -> Store s a -> [Store s a]
loop f = iterate (extend f . tab integral)

window :: (Enum s, Num s) => s -> s -> Store s a -> [a]
window l h = experiment $ \ s -> [s-l..s+h]

grid :: [[Bool]] -> Diagram SVG
grid = cat unitY . reverse . map (hcat . map cell) where
  cell b = unitSquare D.# fc (if b then black else white)

svg :: Diagram SVG -> Strict.ByteString
--svg = Strict.concat . Lazy.toChunks . renderSvg . renderDia SVG (SVGOptions (Width 400) Nothing)
svg = Lazy.toStrict . renderBS . renderDia SVG (SVGOptions (mkWidth 400) Nothing mempty [] True)
data App = App

instance Yesod App

mkYesod "App" [parseRoutes| / ImageR GET |]

getImageR :: MonadHandler m => m TypedContent
getImageR = sendResponse $ toTypedContent (typeSvg, toContent img)

img = svg . grid . map (window 49 0) . take 50 . loop (rule 110) $ Store (==0) (0 :: Int)

main = warpEnv App