module Main (main) where

import Data.List
import Control.Monad
import Data.Functor

data Grid a = Grid { rows    :: Int
                   , cols    :: Int
                   , col     :: Int
                   , row       :: Int 
                   , matrix  :: [ [ a ] ] 
                   } deriving Show

getTile y x grid = matrix grid !! y !! x

getFocused grid = getTile ( row grid ) ( col grid ) grid

class Functor w => Comonad w where 
  extract :: w a -> a 
  duplicate :: w a -> w ( w a )
  extend :: ( w a -> b ) -> w a -> w b 
  extend f wa = fmap f ( duplicate wa )

( =>> ) = flip extend

instance Functor Grid where 
  fmap f grid = grid { matrix = fmap ( fmap f ) ( matrix grid ) }

instance Comonad Grid where
  extract grid = getTile ( row grid ) ( col grid ) grid
  duplicate grid = 
    let mat = matrix grid in
    grid { matrix = [ [ grid { row = i
                             , col = j
                             , matrix = mat } 
                        | ( j, value ) <- zip [ 0.. ] row ] 
                      | ( i, row ) <- zip [ 0.. ] mat ] }

f1 = \m -> extract ( ( playground 32 32 ) { col = 5, row = 28, matrix = m } =>> conwZip (&&) =>> conwStep )
  where 
    conwZip op focused = uncurry op ( extract focused ) 

f4 e [] = []
f4 e [ x ] = [ x ]
f4 e ( x : xs ) = x : e : f4 e xs

render grid = let renderedGrid = matrix ( grid =>> showFocused ) 
                  borderRow = replicate ( cols grid + 2 ) 'X' in 
              borderRow 
              ++ '\n' : concat ( f4 "\n" $ map ( surround 'X' . concat ) renderedGrid ) 
              ++ '\n' : borderRow 
  where 

    surround c s = c : s ++ [ c ]

    showFocused focused = showTile ( getFocused focused ) 
                                   ( row focused ) 
                                   ( col focused )

    showTile v y x  
      | x == col grid && y == row grid = if v then "O" else "·"
      | otherwise                      = if v then "o" else " " 


playground w h = Grid { rows = h
                      , cols = w
                      , col = 0
                      , row = 0
                      , matrix = replicate h ( replicate w False ) 
                      }

square a = playground a a

f2 = uncurry $ glider ( extract ( square 3 =>> ( \ f -> col f + row f ) ) ) 42

conwPreset preset grid = grid =>> init 
  where 
    init gridF = 
      preset ( row gridF ) ( col gridF )

pf <<>> pg = \ x y -> pf x y || pg x y 

glider px py x y = go ( x - px ) ( y - py )
  where 
    go 0 2 = True
    go 1 0 = True
    go 1 2 = True
    go 2 1 = True
    go 2 2 = True
    go _ _ = False

f3 x = foldr ( \x rest -> if x == '/' || x == '\\' then rest else x : rest ) "" [ x ]

conwStep focused = 
        let noAlive = sum ( map fromEnum ngh ) in 
        let alive = getFocused focused in 
            ( alive && 2 <= noAlive && noAlive <= 3 )
            || ( not alive && noAlive == 3 )
  where 
    inBounds y x grid = 0 <= y && y < rows grid
                     && 0 <= x && x < cols grid
    ngh = 
      let y = row focused in 
      let x = col focused in
      [ inBounds row col focused 
        && ( row, col ) /= ( y, x ) 
        && getTile row col focused
          | row <- [ y-1..y+1 ], col <- [ x-1..x+1 ] ]

newtype ShwString = ShwString String

instance Show ShwString where 
    show ( ShwString s ) = s

gameStep grid = do print . ShwString . render $ grid
                   return $ grid =>> conwStep
doNSteps n grid = void ( go n grid )
  where
    go 0 grid = return grid
    go n grid = gameStep grid >>= go ( n - 2 )

doNComonadicSteps 0 grid = grid
doNComonadicSteps n grid = doNComonadicSteps ( n - 1 ) grid =>> conwStep

f5 = extract . ( \ f -> f =>> ( \ g -> row g + col g + extract g ) ) . flip conwPreset ( square 3 ) 

foo x y = let grid = doNComonadicSteps y ( conwPreset ( glider ( x `mod` 20 ) ( y `mod` 20 ) 
                                                       <<>> glider ( y `mod` 20 ) ( x `mod` 20 ) )  
                                                              ( playground 32 32 ) ) 
           in ( read . take 12 . drop 4 . foldr1 (++) . join . matrix $ grid =>> fstep ) :: Integer
  where 
    fstep focused = if getFocused focused 
                      then show ( row focused * 3 ) ++ show ( col focused * 2 )
                      else "" 

main :: IO () 
main = doNSteps 100 ( conwPreset ( glider 5 5 <<>> glider 10 10 ) 
                                 ( playground 32 32 ) )