```------------------------------------------------------------------------
-- |
-- Module      :  Math.Geometry.GridInternal
-- Copyright   :  (c) Amy de Buitléir 2012
-- License     :  BSD-style
-- Maintainer  :  amy@nualeargais.ie
-- Stability   :  experimental
-- Portability :  portable
--
-- A module containing private @Grid@ internals. Most developers should
-- use @Grid@ instead. This module is subject to change without notice.
--
------------------------------------------------------------------------
{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}

module Math.Geometry.GridInternal
(
Grid(..),
FiniteGrid(..),
BoundedGrid(..),
WrappedGrid(..),
UnboundedTriGrid,
TriTriGrid,
triTriGrid,
ParaTriGrid,
paraTriGrid,
RectTriGrid,
rectTriGrid,
TorTriGrid,
torTriGrid,
UnboundedSquareGrid,
RectSquareGrid,
rectSquareGrid,
TorSquareGrid,
torSquareGrid,
UnboundedHexGrid,
HexHexGrid,
hexHexGrid,
ParaHexGrid,
paraHexGrid
) where

import Prelude hiding (null)

import Data.Eq.Unicode ((≡), (≠))
import Data.Function (on)
import Data.List (groupBy, nub, nubBy, sortBy)
import Data.Ord (comparing)
import Data.Ord.Unicode ((≤), (≥))

-- | A regular arrangement of tiles.
--   Minimal complete definition: @indices@ and @distance@.
class Grid g where
type Index g

-- | Returns the indices of all tiles in a grid.
indices ∷ g → [Index g]

-- | @'distance' g a b@ returns the minimum number of moves required
--   to get from the tile at index @a@ to the tile at index @b@ in
--   grid @g@, moving between adjacent tiles at each step. (Two tiles
--   are adjacent if they share an edge.) If @a@ or @b@ are not
--   contained within @g@, the result is undefined.
distance ∷ g → Index g → Index g → Int

-- | @'minDistance' g bs a@ returns the minimum number of moves
--   required to get from any of the tiles at indices @bs@ to the tile
--   at index @a@ in grid @g@, moving between adjacent tiles at each
--   step. (Two tiles are adjacent if they share an edge.) If @a@ or
--   any of @bs@ are not contained within @g@, the result is
--   undefined.
minDistance ∷ g → [Index g] → Index g → Int
minDistance g xs x = minimum . map (distance g x) \$ xs

-- | @'neighbours' g x@ returns the indices of the tiles in the grid
--   @g@ which are adjacent to the tile with index @x@.
neighbours ∷ g → Index g → [Index g]
neighbours g x = filter (\a → distance g x a ≡ 1 ) \$ indices g

-- | @'numNeighbours' g x@ returns the number of tiles in the grid
--   @g@ which are adjacent to the tile with index @x@.
numNeighbours ∷ g → Index g → Int
numNeighbours g = length . neighbours g

-- | @g `'contains'` x@ returns @True@ if the index @x@ is contained
--   within the grid @g@, otherwise it returns false.
contains ∷ Eq (Index g) ⇒ g → Index g → Bool
contains g x = x `elem` indices g

-- | @'viewpoint' g x@ returns a list of pairs associating the index
--   of each tile in @g@ with its distance to the tile with index @x@.
--   If @x@ is not contained within @g@, the result is undefined.
viewpoint ∷ g → Index g → [(Index g, Int)]
viewpoint g p = map f (indices g)
where f x = (x, distance g p x)

-- | Returns the number of tiles in a grid. Compare with @'size'@.
tileCount ∷ g → Int
tileCount = length . indices

-- | Returns @True@ if the number of tiles in a grid is zero, @False@
--   otherwise.
null ∷ g → Bool
null g = tileCount g ≡ 0

-- | Returns @False@ if the number of tiles in a grid is zero, @True@
--   otherwise.
nonNull ∷ g → Bool
nonNull = not . null

-- | A list of all edges in a grid, where the edges are represented by
--   a pair of indices of adjacent tiles.
edges ∷ Eq (Index g) ⇒ g → [(Index g,Index g)]
edges g = nubBy sameEdge \$ concatMap (`adjacentEdges` g) \$ indices g

-- | @'isAdjacent' g a b@ returns @True@ if the tile at index @a@ is
--   adjacent to the tile at index @b@ in @g@. (Two tiles are adjacent
--   if they share an edge.) If @a@ or @b@ are not contained within
--   @g@, the result is undefined.
isAdjacent ∷ Eq (Index g) ⇒ g → Index g → Index g → Bool
isAdjacent g a b = a `elem` (neighbours g b)

-- | @'adjacentTilesToward' g a b@ returns the indices of all tiles
--   which are neighbours of the tile at index @a@, and which are
--   closer to the tile at @b@ than @a@ is. In other words, it returns
--   the possible next steps on a minimal path from @a@ to @b@. If @a@
--   or @b@ are not contained within @g@, or if there is no path from
--   @a@ to @b@ (e.g., a disconnected grid), the result is undefined.
adjacentTilesToward ∷ g → Index g → Index g → [Index g]
adjacentTilesToward g a b = filter f \$ neighbours g a
where f x = distance g x b ≡ distance g a b - 1

-- | @'minimalPaths' g a b@ returns a list of all minimal paths from
--   the tile at index @a@ to the tile at index @b@ in grid @g@. A
--   path is a sequence of tiles where each tile in the sequence is
--   adjacent to the previous one. (Two tiles are adjacent if they
--   share an edge.) If @a@ or @b@ are not contained within @g@, the
--   result is undefined.
--
--   Tip: The default implementation of this function calls
--   @'adjacentTilesToward'@. If you want to use a custom algorithm,
--   consider modifying @'adjacentTilesToward'@ instead of
--   @'minimalPaths'@.
minimalPaths ∷ Eq (Index g) ⇒ g → Index g → Index g → [[Index g]]
minimalPaths g a b | a ≡ b              = [[a]]
| distance g a b ≡ 1 = [[a,b]]
| otherwise          = map (a:) xs
where xs = concatMap (\x → minimalPaths g x b) ys
ys = adjacentTilesToward g a b

sameEdge ∷ Eq t ⇒ (t, t) → (t, t) → Bool
sameEdge (a,b) (c,d) = (a,b) ≡ (c,d) || (a,b) ≡ (d,c)

adjacentEdges ∷ Grid g ⇒ Index g → g → [(Index g, Index g)]
adjacentEdges i g = map (\j → (i,j)) \$ neighbours g i

-- | A regular arrangement of tiles where the number of tiles is finite.
--   Minimal complete definition: @size@.
class Grid g ⇒ FiniteGrid g where
type Size s
-- | Returns the dimensions of the grid.
--   For example, if @g@ is a 4x3 rectangular grid, @'size' g@ would
--   return @(4, 3)@, while @'tileCount' g@ would return @12@.
size ∷ g → Size g

-- | A regular arrangement of tiles with an edge.
--   Minimal complete definition: @tileSideCount@.
class Grid g ⇒ BoundedGrid g where
-- | Returns the number of sides a tile has
tileSideCount ∷ g → Int

-- | Returns a the indices of all the tiles at the boundary of a grid.
boundary ∷ g → [Index g]
boundary g = map fst . filter f \$ xds
where xds = map (\y → (y, numNeighbours g y)) \$ indices g
f (_,n) = n < tileSideCount g

-- | @'isBoundary' g x@' returns @True@ if the tile with index @x@ is
--   on a boundary of @g@, @False@ otherwise. (Corner tiles are also
--   boundary tiles.)
isBoundary ∷ Eq (Index g) ⇒ g → Index g → Bool
isBoundary g x = x `elem` boundary g

-- | Returns the index of the tile(s) that require the maximum number
--   of moves to reach the nearest boundary tile. A grid may have more
--   than one central tile (e.g., a rectangular grid with an even
--   number of rows and columns will have four central tiles).
centre ∷ g → [Index g]
centre g = map fst . head . reverse . groupBy ((≡) `on` snd) .
sortBy (comparing snd) \$ xds
where xds = map (\y → (y, minDistance g bs y)) \$ indices g
bs = boundary g

-- | @'isCentre' g x@' returns @True@ if the tile with index @x@ is
--   a centre tile of @g@, @False@ otherwise.
isCentre ∷ Eq (Index g) ⇒ g → Index g → Bool
isCentre g x = x `elem` centre g

class (Grid g) ⇒ WrappedGrid g where
normalise ∷ g → Index g → Index g

-- Calculate the neighbours of a tile in a bounded grid by as we would
-- in an unbounded grid, but then filter out the tiles that are not in
-- bounds.
neighboursBasedOn
∷ (Eq (Index g), Grid u, Grid g, Index u ~ Index g) ⇒
g → u → Index g → [Index g]
neighboursBasedOn u g = filter (g `contains`) . neighbours u

-- Calculate the distance between two tiles in a bounded grid by as we
-- would in an unbounded grid, but only if both tiles are in bounds.
distanceBasedOn
∷ (Eq (Index g), Grid u, Grid g, Index u ~ Index g) ⇒
g → u → Index g → Index g → Int
distanceBasedOn u g a b =
if g `contains` a && g `contains` b
then distance u a b
else undefined

--
-- Triangular tiles
--

data UnboundedTriGrid = UnboundedTriGrid deriving Show

instance Grid UnboundedTriGrid where
type Index UnboundedTriGrid = (Int, Int)
indices _ = undefined
neighbours _ (x,y) = if even y
then [(x-1,y+1), (x+1,y+1), (x+1,y-1)]
else [(x-1,y-1), (x-1,y+1), (x+1,y-1)]
distance _ (x1, y1) (x2, y2) =
maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]
where z1 = triZ x1 y1
z2 = triZ x2 y2
contains _ _ = True

-- | For triangular tiles, it is convenient to define a third component
--   z.
triZ ∷ Int → Int → Int
triZ x y = if even y then -x - y else -x - y + 1

--
-- Triangular grids with triangular tiles
--

-- | A triangular grid with triangular tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data TriTriGrid = TriTriGrid Int [(Int, Int)] deriving Eq

instance Show TriTriGrid where
show (TriTriGrid s _) = "triTriGrid " ++ show s

instance Grid TriTriGrid where
type Index TriTriGrid = (Int, Int)
indices (TriTriGrid _ xs) = xs
neighbours = neighboursBasedOn UnboundedTriGrid
distance = distanceBasedOn UnboundedTriGrid
contains (TriTriGrid s _) (x, y) = inTriTriGrid (x,y) s

inTriTriGrid ∷ (Int, Int) → Int → Bool
inTriTriGrid (x, y) s = x ≥ 0 && y ≥ 0 && even (x+y) && abs z ≤ 2*s-2
where z = triZ x y

instance FiniteGrid TriTriGrid where
type Size TriTriGrid = Int
size (TriTriGrid s _) = s

instance BoundedGrid TriTriGrid where
tileSideCount _ = 3
boundary g = west ++ east ++ south
where s = size g
west = [(0,k) | k ← [0,2..2*s-2]]
east = [(k,2*s-2-k) | k ← [2,4..2*s-2]]
south = [(k,0) | k ← [2*s-4,2*s-6..2]]
centre g = case s `mod` 3 of
0 → trefoilWithTop (k-1,k+1) where k = (2*s) `div` 3
1 → [(k,k)] where k = (2*(s-1)) `div` 3
2 → [(k+1,k+1)] where k = (2*(s-2)) `div` 3
_ → error "This will never happen."
where s = size g
trefoilWithTop (i,j) = [(i,j), (i+2, j-2), (i,j-2)]

-- | @'triTriGrid' s@ returns a triangular grid with sides of
--   length @s@, using triangular tiles. If @s@ is nonnegative, the
--   resulting grid will have @s^2@ tiles. Otherwise, the resulting grid
--   will be null and the list of indices will be null.
triTriGrid ∷ Int → TriTriGrid
triTriGrid s =
TriTriGrid s [(xx,yy) | xx ← [0..2*(s-1)],
yy ← [0..2*(s-1)],
(xx,yy) `inTriTriGrid` s]

--
-- Parallelogrammatical grids with triangular tiles
--

-- | A Parallelogrammatical grid with triangular tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data ParaTriGrid = ParaTriGrid (Int, Int) [(Int, Int)] deriving Eq

instance Show ParaTriGrid where
show (ParaTriGrid (r,c) _) = "paraTriGrid " ++ show r ++ " " ++ show c

instance Grid ParaTriGrid where
type Index ParaTriGrid = (Int, Int)
indices (ParaTriGrid _ xs) = xs
neighbours = neighboursBasedOn UnboundedTriGrid
distance = distanceBasedOn UnboundedTriGrid

instance FiniteGrid ParaTriGrid where
type Size ParaTriGrid = (Int, Int)
size (ParaTriGrid s _) = s

instance BoundedGrid ParaTriGrid where
tileSideCount _ = 3
boundary g = west ++ north ++ east ++ south
where (r,c) = size g
west = [(0,k) | k ← [0,2..2*r-2], c>0]
north = [(k,2*r-1) | k ← [1,3..2*c-1], r>0]
east = [(2*c-1,k) | k ← [2*r-3,2*r-5..1], c>0]
south = [(k,0) | k ← [2*c-2,2*c-4..2], r>0]
centre g = f . size \$ g
where f (r,c)
| odd r && odd c
= [(c-1,r-1), (c,r)]
| even r && even c && r ≡ c
= bowtie (c-1,r-1)
| even r && even c && r > c
= bowtie (c-1,r-3) ++ bowtie (c-1,r-1) ++ bowtie (c-1,r+1)
| even r && even c && r < c
= bowtie (c-3,r-1) ++ bowtie (c-1,r-1) ++ bowtie (c+1,r-1)
| otherwise
= [(c-1,r), (c,r-1)]
bowtie (i,j) = [(i,j), (i+1,j+1)]

-- | @'paraTriGrid' r c@ returns a grid in the shape of a
--   parallelogram with @r@ rows and @c@ columns, using triangular
--   tiles. If @r@ and @c@ are both nonnegative, the resulting grid will
--   have @2*r*c@ tiles. Otherwise, the resulting grid will be null and
--   the list of indices will be null.
paraTriGrid ∷ Int → Int → ParaTriGrid
paraTriGrid r c =
ParaTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]

--
-- Rectangular grids with triangular tiles
--

-- | A rectangular grid with triangular tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data RectTriGrid = RectTriGrid (Int, Int) [(Int, Int)] deriving Eq

instance Show RectTriGrid where
show (RectTriGrid (r,c) _) = "rectTriGrid " ++ show r ++ " " ++ show c

instance Grid RectTriGrid where
type Index RectTriGrid = (Int, Int)
indices (RectTriGrid _ xs) = xs
neighbours = neighboursBasedOn UnboundedTriGrid
distance = distanceBasedOn UnboundedTriGrid

instance FiniteGrid RectTriGrid where
type Size RectTriGrid = (Int, Int)
size (RectTriGrid s _) = s

instance BoundedGrid RectTriGrid where
tileSideCount _ = 3

-- | @'rectTriGrid' r c@ returns a grid in the shape of a
--   rectangle (with jagged edges) that has @r@ rows and @c@ columns,
--   using triangular tiles. If @r@ and @c@ are both nonnegative, the
--   resulting grid will have @2*r*c@ tiles. Otherwise, the resulting grid will be null and
--   the list of indices will be null.
rectTriGrid ∷ Int → Int → RectTriGrid
rectTriGrid r c = RectTriGrid (r,c) [(x,y) | y ← [0..2*r-1], x ← [xMin y .. xMax c y], even (x+y)]
where xMin y = if even y then w else w+1
where w = -2*((y+1) `div` 4)
xMax c2 y = xMin y + 2*(c2-1)

--
-- Toroidal grids with triangular tiles
--

-- | A toroidal grid with triangular tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data TorTriGrid = TorTriGrid (Int, Int) [(Int, Int)] deriving Eq

instance Show TorTriGrid where
show (TorTriGrid (r,c) _) = "torTriGrid " ++ show r ++ " " ++ show c

instance Grid TorTriGrid where
type Index TorTriGrid = (Int, Int)
indices (TorTriGrid _ xs) = xs
neighbours g = nub . map (normalise g) . neighbours UnboundedTriGrid
distance g (xa, ya) (xb, yb) =
if g `contains` (xa, ya) && g `contains` (xb, yb)
then minimum [distance UnboundedTriGrid (xa, ya) (xb, yb),
distance UnboundedTriGrid (xa, ya) (xb + 2*c, yb),
distance UnboundedTriGrid (xa, ya) (xb - r, yb + 2*r),
distance UnboundedTriGrid (xa, ya) (xb, yb),
distance UnboundedTriGrid (xa + 2*c, ya) (xb, yb),
distance UnboundedTriGrid (xa - r, ya + 2*r) (xb, yb)]
else undefined
where (r,c) = size g

xMinTorTri ∷ Int → Int
xMinTorTri y = if even y then w else w+1
where w = -2*((y+1) `div` 4)

instance FiniteGrid TorTriGrid where
type Size TorTriGrid = (Int, Int)
size (TorTriGrid s _) = s

instance WrappedGrid TorTriGrid where
normalise g (x,y)
| y < 0            = normalise g (x-r,y+2*r)
| y > 2*r-1        = normalise g (x+r,y-2*r)
| x < xMin         = normalise g (x+2*c,y)
| x > xMin + 2*c-1 = normalise g (x-2*c,y)
| otherwise        = (x,y)
where xMin = xMinTorTri y
(r, c) = size g

-- | @'torTriGrid' r c@ returns a toroidal grid with @r@ rows and @c@
--   columns, using triangular tiles. If @r@ is odd, the result is
--   undefined because the grid edges would overlap. If @r@ and @c@
--   are both nonnegative, the resulting grid will have @2*r*c@ tiles.
--   Otherwise, the resulting grid will be null and the list of indices
--   will be null.
torTriGrid ∷ Int → Int → TorTriGrid
torTriGrid r c =
if even r
then TorTriGrid (r,c) [(x,y) | y ← [0..2*r-1],
x ← [xMinTorTri y .. xMax c y],
even (x+y)]
else undefined
where xMax c2 y = xMinTorTri y + 2*(c2-1)

--
-- Square tiles
--

data UnboundedSquareGrid = UnboundedSquareGrid deriving Show

instance Grid UnboundedSquareGrid where
type Index UnboundedSquareGrid = (Int, Int)
indices _ = undefined
neighbours _ (x,y) = [(x,y+1), (x,y-1), (x+1,y), (x-1,y)]
distance _ (x1, y1) (x2, y2) = abs (x2-x1) + abs (y2-y1)
contains _ _ = True

--
-- Rectangular grids with square tiles
--

-- | A rectangular grid with square tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data RectSquareGrid = RectSquareGrid (Int, Int) [(Int, Int)] deriving Eq

instance Show RectSquareGrid where
show (RectSquareGrid (r,c) _) =
"rectSquareGrid " ++ show r ++ " " ++ show c

instance Grid RectSquareGrid where
type Index RectSquareGrid = (Int, Int)
indices (RectSquareGrid _ xs) = xs
neighbours = neighboursBasedOn UnboundedSquareGrid
distance = distanceBasedOn UnboundedSquareGrid
adjacentTilesToward g a@(x1, y1) (x2, y2) =
filter (\i → g `contains` i && i ≠ a) \$ nub [(x1,y1+dy),(x1+dx,y1)]
where dx = signum (x2-x1)
dy = signum (y2-y1)

instance FiniteGrid RectSquareGrid where
type Size RectSquareGrid = (Int, Int)
size (RectSquareGrid s _) = s

instance BoundedGrid RectSquareGrid where
tileSideCount _ = 4
boundary g = cartesianIndices . size \$ g
centre g = cartesianCentre . size \$ g

cartesianIndices
∷ (Enum r, Enum c, Num r, Num c, Ord r, Ord c) ⇒
(r, c) → [(c, r)]
cartesianIndices (r, c) = west ++ north ++ east ++ south
where west = [(0,k) | k ← [0,1..r-1], c>0]
north = [(k,r-1) | k ← [1,2..c-1], r>0]
east = [(c-1,k) | k ← [r-2,r-3..0], c>1]
south = [(k,0) | k ← [c-2,c-3..1], r>1]

cartesianCentre ∷ (Int, Int) → [(Int, Int)]
cartesianCentre (r,c) = [(i,j) | i ← midpoints c, j ← midpoints r]

midpoints ∷ Int → [Int]
midpoints k = if even k then [m-1,m] else [m]
where m = floor (k'/2.0)
k' = fromIntegral k ∷ Double

-- | @'rectSquareGrid' r c@ produces a rectangular grid with @r@ rows
--   and @c@ columns, using square tiles. If @r@ and @c@ are both
--   nonnegative, the resulting grid will have @r*c@ tiles. Otherwise,
--   the resulting grid will be null and the list of indices will be
--   null.
rectSquareGrid ∷ Int → Int → RectSquareGrid
rectSquareGrid r c =
RectSquareGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]]

--
-- Toroidal grids with square tiles.
--

-- | A toroidal grid with square tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data TorSquareGrid = TorSquareGrid (Int, Int) [(Int, Int)] deriving Eq

instance Show TorSquareGrid where
show (TorSquareGrid (r,c) _) = "torSquareGrid " ++ show r ++ " " ++ show c

instance Grid TorSquareGrid where
type Index TorSquareGrid = (Int, Int)
indices (TorSquareGrid _ xs) = xs
--  neighbours (TorSquareGrid (r,c) _) (x,y) =
--    nub \$ filter (\(xx,yy) → xx ≠ x || yy ≠ y)
--      [((x-1) `mod` c,y), (x,(y+1) `mod` r), ((x+1) `mod` c,y),
--        (x,(y-1) `mod` r)]
neighbours g = nub . map (normalise g) . neighbours UnboundedSquareGrid
distance g@(TorSquareGrid (r,c) _) (x1, y1) (x2, y2) =
if g `contains` (x1, y1) && g `contains` (x2, y2)
then min adx (abs (c-adx)) + min ady (abs (r-ady))
else undefined
where adx = abs (x2 - x1)
ady = abs (y2 - y1)

instance FiniteGrid TorSquareGrid where
type Size TorSquareGrid = (Int, Int)
size (TorSquareGrid s _) = s

instance WrappedGrid TorSquareGrid where
normalise g (x,y) = (x `mod` c, y `mod` r)
where (r, c) = size g

-- | @'torSquareGrid' r c@ returns a toroidal grid with @r@
--   rows and @c@ columns, using square tiles. If @r@ and @c@ are
--   both nonnegative, the resulting grid will have @r*c@ tiles. Otherwise,
--   the resulting grid will be null and the list of indices will be null.
torSquareGrid ∷ Int → Int → TorSquareGrid
torSquareGrid r c = TorSquareGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]

--
-- Hexagonal tiles
--

data UnboundedHexGrid = UnboundedHexGrid deriving Show

instance Grid UnboundedHexGrid where
type Index UnboundedHexGrid = (Int, Int)
indices _ = undefined
neighbours _ (x,y) =
[(x-1,y), (x-1,y+1), (x,y+1), (x+1,y), (x+1,y-1), (x,y-1)]
distance _ (x1, y1) (x2, y2) =
maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]
where z1 = -x1 - y1
z2 = -x2 - y2
contains _ _ = True

--
-- Hexagonal grids with hexagonal tiles
--

-- | A hexagonal grid with hexagonal tiles
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data HexHexGrid = HexHexGrid Int [(Int, Int)] deriving Eq

instance Show HexHexGrid where show (HexHexGrid s _) = "hexHexGrid " ++ show s

instance Grid HexHexGrid where
type Index HexHexGrid = (Int, Int)
indices (HexHexGrid _ xs) = xs
neighbours = neighboursBasedOn UnboundedHexGrid
distance = distanceBasedOn UnboundedHexGrid

instance FiniteGrid HexHexGrid where
type Size HexHexGrid = Int
size (HexHexGrid s _) = s

instance BoundedGrid HexHexGrid where
tileSideCount _ = 6
boundary g =
north ++ northeast ++ southeast ++ south ++ southwest ++ northwest
where s = size g
north = [(k,s-1) | k ← [-s+1,-s+2..0]]
northeast = [(k,s-1-k) | k ← [1,2..s-1]]
southeast = [(s-1,k) | k ← [-1,-2..(-s)+1]]
south = [(k,(-s)+1) | k ← [s-2,s-3..0]]
southwest = [(k,(-s)+1-k) | k ← [-1,-2..(-s)+1]]
northwest = [(-s+1,k) | k ← [1,2..s-2]]
centre _ = [(0,0)]

-- | @'hexHexGrid' s@ returns a grid of hexagonal shape, with
--   sides of length @s@, using hexagonal tiles. If @s@ is nonnegative, the
--   resulting grid will have @3*s*(s-1) + 1@ tiles. Otherwise, the resulting
--   grid will be null and the list of indices will be null.
hexHexGrid ∷ Int → HexHexGrid
hexHexGrid r = HexHexGrid r [(x, y) | x ← [-r+1..r-1], y ← f x]
where f x = if x < 0 then [1-r-x .. r-1] else [1-r .. r-1-x]

--
-- Parallelogrammatical grids with hexagonal tiles
--

-- | A parallelogramatical grid with hexagonal tiles
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data ParaHexGrid = ParaHexGrid (Int, Int) [(Int, Int)] deriving Eq

instance Show ParaHexGrid where
show (ParaHexGrid (r,c) _) = "paraHexGrid " ++ show r ++ " " ++ show c

instance Grid ParaHexGrid where
type Index ParaHexGrid = (Int, Int)
indices (ParaHexGrid _ xs) = xs
neighbours = neighboursBasedOn UnboundedHexGrid
distance = distanceBasedOn UnboundedHexGrid

instance FiniteGrid ParaHexGrid where
type Size ParaHexGrid = (Int, Int)
size (ParaHexGrid s _) = s

instance BoundedGrid ParaHexGrid where
tileSideCount _ = 6
boundary g = cartesianIndices . size \$ g
centre g = cartesianCentre . size \$ g

-- | @'paraHexGrid' r c@ returns a grid in the shape of a
--   parallelogram with @r@ rows and @c@ columns, using hexagonal tiles. If
--   @r@ and @c@ are both nonnegative, the resulting grid will have @r*c@ tiles.
--   Otherwise, the resulting grid will be null and the list of indices will
--   be null.
paraHexGrid ∷ Int → Int → ParaHexGrid
paraHexGrid r c =
ParaHexGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]

```