{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Exception
-- Copyright   : (c) Michael Szvetits, 2023
-- License     : BSD-3-Clause (see the file LICENSE)
-- Maintainer  : typedbyte@qualified.name
-- Stability   : stable
-- Portability : portable
--
-- Types and functions for exceptions that can occur when manipulating chess
-- games.
-----------------------------------------------------------------------------
module Chess.Exception where

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

import Chess.Board.PlacedPiece (PlacedPiece)
import Chess.Some              (Some(Some))

-- | Represents errors that can occur when manipulating chess games.
data ChessException
  = FieldOccupied (Some PlacedPiece)
  | PieceMissing (Some PlacedPiece)
  | UnexpectedPiece (Some PlacedPiece)

-- | Smart constructor for 'FieldOccupied'.
fieldOccupied :: PlacedPiece t -> ChessException
fieldOccupied :: forall (t :: PieceType'). PlacedPiece t -> ChessException
fieldOccupied = Some PlacedPiece -> ChessException
FieldOccupied forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some

-- | Smart constructor for 'PieceMissing'.
pieceMissing :: PlacedPiece t -> ChessException
pieceMissing :: forall (t :: PieceType'). PlacedPiece t -> ChessException
pieceMissing = Some PlacedPiece -> ChessException
PieceMissing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some

-- | Smart constructor for 'UnexpectedPiece'.
unexpectedPiece :: PlacedPiece t -> ChessException
unexpectedPiece :: forall (t :: PieceType'). PlacedPiece t -> ChessException
unexpectedPiece = Some PlacedPiece -> ChessException
UnexpectedPiece forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some

-- | Extracts the 'Right' value from an 'Either'.
assumeRight :: Alternative f => Either e a -> f a
assumeRight :: forall (f :: * -> *) e a. Alternative f => Either e a -> f a
assumeRight = \case
  Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  Left e
_  -> forall (f :: * -> *) a. Alternative f => f a
empty