{-# language NoImplicitPrelude #-}
module MyQueens where
-- To run, type `stack ghci` then `:load MyQueens` then `main`

import Rebase.Prelude

data Rank = R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8
  deriving (Eq, Enum, Bounded, Show)

data RankOptions = RankOptions [Rank] | RankChoice Rank
  deriving (Show)

type Board = [RankOptions]
type PartialBoard = [RankOptions]

allOptionsColumn :: RankOptions
allOptionsColumn = RankOptions [R1 .. R8]

allOptionsBoard :: Board
allOptionsBoard = take 8 $ repeat allOptionsColumn

select :: Board -> [Board]
select (x@(RankChoice _):xs) = map (x:) (select xs)
select ((RankOptions rs):xs) = dropHopeless $ map (\r -> (RankChoice r):(restrict xs r)) rs
select []                    = error "select on invalid board"

dropHopeless :: [Board] -> [Board]
dropHopeless = filter (not . any hopeless)

hopeless :: RankOptions -> Bool
hopeless (RankOptions []) = True
hopeless _                = False

filterRankOptions :: (Rank -> Bool) -> RankOptions -> RankOptions
filterRankOptions f (RankOptions rs) = RankOptions (filter f rs)
filterRankOptions _ x                = x

restrict :: PartialBoard -> Rank -> PartialBoard
restrict rs r =
  (dropDiagonal pred minBound r) .
  (dropDiagonal succ maxBound r) .
  (map (filterRankOptions (/= r))) $
  rs

dropDiagonal :: (Rank -> Rank) -> Rank -> Rank -> PartialBoard -> PartialBoard
dropDiagonal _ _ _ []                 = []
dropDiagonal _ bound r x | r == bound = x
dropDiagonal next bound r (x:xs)      = (filterRankOptions (/= next r) x) : dropDiagonal next bound (next r) xs

select' :: [Board] -> [Board]
select' = concatMap select

queens :: [Board]
queens = select' . select' . select' . select' . select' . select' . select' . select' $ [allOptionsBoard]

main :: IO ()
main = do
  forM_ queens print
  print $ length queens