{-# LANGUAGE FlexibleContexts #-}

module Main where

import Control.Lens
import Linear.V2
import Linear.V3
import Data.Matrix
--import Numeric.LinearAlgebra
import System.Random
import Foreign.Storable


data Square = X                 -- Attacked
              | Qu              -- Queen
              | O               -- Open/available
  deriving (Show, Eq)


--board = V3 <$> [0..8] <*> [0..8] <*> [0]
--board = [(r,c,X) | r <- [0..8], c <- [0..8] ]

lo8 = [0..8] -- list of 8
initBoard = matrix 8 8 $ \_ -> O

placeQueen (r,c) b = placeQueen' $ markAttacked b
  where
    placeQueen' b = setElem Qu (r,c) b
    markAttacked b = rowAttacked $ colAttacked $ diagAttacked b
    fX = (\_ x -> X)
    rowAttacked b = mapRow fX r b
    colAttacked b = mapCol fX c b
    diagAttacked b = let d = diag r c
                         attack ap ab  = setElem X ap ab
                         attackall [x] = attack x b
                         attackall (x:xs) = attack x (attackall xs)
                     in attackall d
--                     in last $ map (\p -> setElem X p b) d
--                     in last $ scanr (\p -> setElem X p) b

--solve b = placeQueen (nextAvail b) b

nextAvail b = head [(x,y) | x <- [1..8], y <- [1..8], b ! (x,y) == O]

-- solve b = placeQueen n
--   where n = nextAvail b
--         next = placeQueen n
--         solve' =

-- solve b =
--   where solve' b = (\n = placeQueen $ nextAvail b)

solve b = second
  where first = placeQueen (nextAvail b) b
        second = placeQueen (nextAvail first) first

solve' b = s (nA b) b
  where s n b = placeQueen n b
        nA b = nextAvail b


--diag r c = [(x,y) | x <- [1..8], y <- [1..8], (abs x-y) == 1 ]
diag r c = let rl = [1..r]
               rr = [r..8]
               cu = [1..c]
               cd = [c..8]
           in zip rl cu ++ zip rr cd ++
              zip (reverse rl) cd ++ zip (reverse rr) cu

allops a b = [(a, a), (a, b), (b, a), (b, b)]
ops = allops (+1) (subtract 1)
applyop (x,y) (a,b)  = (a x,b y)
applyops p = map (applyop p) ops

mapDiag f c b = map (\(x,y) -> setElem f (x,y) b) ds
  where ds = diag'' c

mapDiag' f c b = map (on b f) ds
   where ds = diag'' c
         on b x p = let next bo = set x p bo
                    in map (next) b
         set x p b = setElem x p b

--mapDiag'' f c b = take 10 $ iterate (map (set f) ds) b
-- mapDiag'' f c b = take 10 $ iterate (
--    where ds = diag'' c
--          eachD' p = setElem f p
--          eachD [p] = eachD' p
--          eachD (p:ps) = eachD' p : eachD ps

markX p b = setElem X p b

mapDiag''' f p b = applyfs fs b
   where ds = diag'' p
         fs = map (\x y -> markX x y) ds
         applyfs [x] b = x b
         applyfs (x:xs) b = applyfs x (applyfs xs)


onBoard b f = let next n = f n
              in next b

--eB = mapDiag''' (\_ -> 1) (5,5) $ matrix 8 8 (\_ -> 0)

diag'' c = apply c
  where
    min = 1
    max = 8
    ops a b = [(a, a), (a, b), (b, a), (b, b)]
    allops = ops (+1) (subtract 1)
    applyop (x,y) (a,b)  = (a x,b y)
    applyopr (a,b) (x,y) = traverse' (\(d,f) -> (a d, b f)) (x,y)
    traverse' f x = takeWhile (within) $ iterate f x
    within (x,y) = let within' z = z >= min && z <= max
                   in within' x && within' y
    applyops ops p = map (\x -> applyopr x p) ops
    apply x = concat $ applyops allops x

--        opfs ops = map (\(o1,o2) -> (\(x,y) -> (o1 x, o2 y))) ops
--        applyops x = map x  opfs
--        ops = map (
        --applyops (x,y) = map (($ x), ($ y)) $ allops (+1) (-1)
--        fx a b = map \((oa,ob) -> ((cx,cy) -> (oa cx, ob cy))) $ allops (+1) (-1)
        --applyops x = [(((fst f) (fst x)), ((snd f) (snd x))) | f <- allops (+1) (-1)]
--        applyops x = (fst x, snd x)
--        applyops x = map \((p,m) -> (p (fst x), m (snd x))) $ allops (+1) (-1)
--        apply c = map (\(p,m) -> (p (fst c), m (snd c))) $ allops (+1) (-1)
--        apply ops c = [( (fst o) (fst c), (snd o) (snd c) | o <- ops
  


-- diag (r,c) b =
--   where l = (r-1,c-1)
--         r = (r+1,c+1)
--         lowbound = 1
--         highbound = 8
        

--initBoard = (8><8) $ repeat O

--firstOpen b = take 1 [(r,c)| r <- [1..8], c <- [1..8], b ! (r,c) == O]

-- firstOpen b = let 
--                 elem x y = b ! (x, y)
--             in map 

-- nextOpen b = 

-- solve = let board = initBoard

--avail r c b =

--rowOccupied r b = any (== Q) $ getRow r b



-- diags p = let r = r p
--               l = l p
--           in p : inRange r
--   where inRange x = x >= 1 && x <= 8
--         inRange' (x,y) = inRange (x) && inRange (y)
--         r x = (fst x + 1, snd x + 1)
--         l x = (fst x - 1, snd x - 1)
--         nexts x = diags' x
--         diags' x = [(fst x - 1, snd x -1), (fst x + 1, snd x + 1)]
--         -- down x = (fst x - 1, snd x - 1)
--         -- down (r,c) = let d = (r-1,c-1) in if inRange d then d : down d else 
--         -- up (r,c) = let u = (r+1,c+1) in u : up u
        

--mapDiag r c = undefined

--placeAll = repeat 8 placeQueen

winnable = undefined

nextOpen board = undefined 

-- placeQueen r c =

--b = getE

--placeQueen r c b = b ^.

-- rand = do
--   g <- newStdGen
--   print $ take 8 $ (randomRs (0, 8) g)


-- try r c = let next b = placeQueen r c b
--           in next initBoard

-- try' p = let next b = p b
--           in next initBoard


--res = [ try x y | x <- lo8, y <- lo8 ]

main :: IO ()
main = do
  putStrLn "Hi"