minesweeper-0.9: Core/Square.hs

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Squares.
module Core.Square 
    (
    -- * Types
      BoardSize
    , boardSize
    , xSize
    , ySize

    , Square
    , coords
    , square
    , restrictSquare
    , squares
    , neighbours

    , SquareSet
    ) where

import Data.Binary
import Data.Bits
import Data.Maybe
import Data.Function
import Data.SetClass
import qualified Data.IntSet as IS
import Prelude hiding (null)
import Data.Data

----------------------- auxiliary functions

infix 4 `between`
a `between` (b, c) = b <= a && a <= c

packable :: Int -> Bool
packable i = i `between` (0, 255)

pack :: Int -> Int -> Int
pack i j = shiftL i 8 .|. j

unpack :: Int -> (Int, Int)
unpack i = (shiftR i 8, i .&. 255)

-----------

-- | Size of a board.
newtype BoardSize 
    = BS { unBS :: Int }
        deriving (Eq, Ord, Binary, Typeable, Data)

instance Show BoardSize where
    show = show . unBS

xSize, ySize :: BoardSize -> Int
xSize = fst . unpack . unBS
ySize = snd . unpack . unBS

boardSize :: Int -> Int -> BoardSize
boardSize i j | packable i && packable j 
    = BS $ pack i j

--------------------------

-- | Square on a board.
newtype Square 
    = S { unS :: Int } 
        deriving (Eq, Ord, Binary, Typeable, Data)

instance Show Square where
    show = show . coords 

coords :: Square -> (Int, Int)
coords (S i) = unpack i

square :: BoardSize -> Int -> Int -> Maybe Square
square s i j 
    | i `between` (1, xSize s) && j `between` (1, ySize s) 
        = Just $ S $ pack i j
    | otherwise 
        = Nothing

restrictSquare :: BoardSize -> Square -> Square
restrictSquare s (coords -> (i, j)) 
    = S $ pack (max 1 $ min (xSize s) i) (max 1 $ min (ySize s) j) 

---------------------------------

newtype SquareSet 
    = SS { unSS :: IS.IntSet } 
        deriving (Show, Binary, Typeable, Data)

instance Set SquareSet where

   type SetElem SquareSet = Square

   toList      = map S . toList . unSS
   fromList    = SS . fromList . map unS
   size        = size . unSS
   intersection = bi intersection
   (\\)        = bi (\\)
   union       = bi union
   null        = null . unSS
   empty       = SS empty

bi f = ((.) SS . f) `on` unSS

-----------------------------------

-- | Squares of a board.
squares :: BoardSize -> SquareSet
squares s 
    = SS $ IS.fromDistinctAscList 
        [p | x <- [1..xSize s], p <- take (ySize s) [pack x 1 ..]]

-- | Neighbours of a square on a boardSize.
neighbours :: BoardSize -> Square -> SquareSet
neighbours s (coords -> (i, j))
    = SS $ IS.fromDistinctAscList 
        [pack x y | x<-[max 1 (i-1)..min (xSize s) (i+1)]
                  , y<-[max 1 (j-1)..min (ySize s) (j+1)]
                  , (x,y)/=(i,j) ]