-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Board.Position
-- Copyright   : (c) Michael Szvetits, 2023
-- License     : BSD-3-Clause (see the file LICENSE)
-- Maintainer  : typedbyte@qualified.name
-- Stability   : stable
-- Portability : portable
--
-- Types and functions to represent and manipulate positions on a chess board.
-----------------------------------------------------------------------------
module Chess.Board.Position
  ( -- * Representing Positions
    Position(row, column)
  , mkPosition
  , boundedPosition
    -- * Manipulating Positions
  , offset
  , boundedOffset
  ) where

-- base
import Control.Applicative (Alternative, empty)

import Chess.Board.Direction (Direction(rowDelta, columnDelta))

-- | Represents a position on the chess board.
data Position = Position
  { Position -> Int
row :: Int
    -- ^ The row of the position, where 0 is row 1.
  , Position -> Int
column :: Int
    -- ^ The column of the position, where 0 is column A.
  }
  deriving (Position -> Position -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
Ord, ReadPrec [Position]
ReadPrec Position
Int -> ReadS Position
ReadS [Position]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Position]
$creadListPrec :: ReadPrec [Position]
readPrec :: ReadPrec Position
$creadPrec :: ReadPrec Position
readList :: ReadS [Position]
$creadList :: ReadS [Position]
readsPrec :: Int -> ReadS Position
$creadsPrec :: Int -> ReadS Position
Read, Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show)

-- | Creates a position from row and column indices.
mkPosition
  :: Alternative f
  => Int        -- ^ The row of the position, where 0 is the row labelled 1.
  -> Int        -- ^ The column of the position, where 0 is the column labelled A.
  -> f Position -- ^ The position, if it is within the bounds of the chess board.
mkPosition :: forall (f :: * -> *). Alternative f => Int -> Int -> f Position
mkPosition Int
row Int
column
  | forall {a}. Ord a => a -> a -> a -> Bool
between Int
0 Int
7 Int
row Bool -> Bool -> Bool
&& forall {a}. Ord a => a -> a -> a -> Bool
between Int
0 Int
7 Int
column =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Int -> Position
Position Int
row Int
column
  | Bool
otherwise =
      forall (f :: * -> *) a. Alternative f => f a
empty
  where
    between :: a -> a -> a -> Bool
between a
low a
high a
value =
      a
low forall a. Ord a => a -> a -> Bool
<= a
value Bool -> Bool -> Bool
&& a
value forall a. Ord a => a -> a -> Bool
<= a
high

-- | Creates a position from row and column indices.
boundedPosition
  :: Int      -- ^ The row of the position, where 0 is the row labelled 1.
  -> Int      -- ^ The column of the position, where 0 is the column labelled A.
  -> Position -- ^ The position, where out-of-bounds indices are limited to the valid range.
boundedPosition :: Int -> Int -> Position
boundedPosition Int
row Int
column =
  Int -> Int -> Position
Position
    ( forall {a}. Ord a => a -> a -> a -> a
clamp Int
0 Int
7 Int
row )
    ( forall {a}. Ord a => a -> a -> a -> a
clamp Int
0 Int
7 Int
column)
  where
    clamp :: a -> a -> a -> a
clamp a
lower a
upper a
value
      | a
value forall a. Ord a => a -> a -> Bool
< a
lower = a
lower
      | a
value forall a. Ord a => a -> a -> Bool
> a
upper = a
upper
      | Bool
otherwise     = a
value

-- | Adds an offset to a position, yielding a new position.
offset
  :: Alternative f
  => Direction  -- ^ The offset to be added to the position.
  -> Position   -- ^ The original position.
  -> f Position -- ^ The new position, if it is within the bounds of the chess board.
offset :: forall (f :: * -> *).
Alternative f =>
Direction -> Position -> f Position
offset Direction
direction Position
position =
  forall (f :: * -> *). Alternative f => Int -> Int -> f Position
mkPosition
    ( Position
position.row forall a. Num a => a -> a -> a
+ Direction
direction.rowDelta )
    ( Position
position.column forall a. Num a => a -> a -> a
+ Direction
direction.columnDelta )

-- | Adds an offset to a position, yielding a new position.
boundedOffset
  :: Direction -- ^ The offset to be added to the position.
  -> Position  -- ^ The original position.
  -> Position  -- ^ The new position, where out-of-bounds indices are limited to the valid range.
boundedOffset :: Direction -> Position -> Position
boundedOffset Direction
direction Position
position =
  Int -> Int -> Position
boundedPosition
    ( Position
position.row forall a. Num a => a -> a -> a
+ Direction
direction.rowDelta )
    ( Position
position.column forall a. Num a => a -> a -> a
+ Direction
direction.columnDelta )