{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	The ordered sequence of /turn/s made by the players of each /logical colour/.
-}

module BishBosh.State.TurnsByLogicalColour(
-- * Types
-- ** Type-synonyms
--	Transformation
-- ** Data-types
        TurnsByLogicalColour(
--		MkTurnsByLogicalColour,
--		getTurnsByLogicalColour,
                getNPlies
        ),
-- * Functions
        inferNextLogicalColour,
        countPlies,
        dereference,
-- ** Constructors
        fromAssocs,
-- ** Mutators
        update,
        prepend
) where

import                  Control.Arrow((&&&), (***))
import                  Data.Array.IArray((!), (//))
import qualified        BishBosh.Attribute.LogicalColour        as Attribute.LogicalColour
import qualified        BishBosh.Component.Move                 as Component.Move
import qualified        BishBosh.Data.Exception                 as Data.Exception
import qualified        BishBosh.Property.Empty                 as Property.Empty
import qualified        BishBosh.Property.Null                  as Property.Null
import qualified        BishBosh.Property.Opposable             as Property.Opposable
import qualified        BishBosh.Property.Reflectable           as Property.Reflectable
import qualified        Control.Arrow
import qualified        Control.DeepSeq
import qualified        Control.Exception
import qualified        Data.Array.IArray
import qualified        Data.Default
import qualified        Data.Foldable
import qualified        Data.List.Extra

-- | The type used to hold a record of each player's /turn/s.
data TurnsByLogicalColour turn  = MkTurnsByLogicalColour {
        getTurnsByLogicalColour :: Attribute.LogicalColour.ByLogicalColour [turn],
        getNPlies               :: Component.Move.NPlies        -- ^ The number of plies applied to the game; this could alternatively be derived using 'countPlies'.
}

instance Eq turn => Eq (TurnsByLogicalColour turn) where
        MkTurnsByLogicalColour { getTurnsByLogicalColour = aL } == MkTurnsByLogicalColour { getTurnsByLogicalColour = aR }      = aL == aR

instance (Read turn, Show turn) => Read (TurnsByLogicalColour turn) where
        readsPrec _ s   = Control.Arrow.first fromAssocs `map` reads s

instance Show turn => Show (TurnsByLogicalColour turn) where
        showsPrec _ MkTurnsByLogicalColour { getTurnsByLogicalColour = byLogicalColour }        = shows $ Data.Array.IArray.assocs byLogicalColour

instance Control.DeepSeq.NFData turn => Control.DeepSeq.NFData (TurnsByLogicalColour turn) where
        rnf MkTurnsByLogicalColour { getTurnsByLogicalColour = byLogicalColour }        = Control.DeepSeq.rnf byLogicalColour

instance Data.Default.Default (TurnsByLogicalColour turn) where
        def = MkTurnsByLogicalColour {
                getTurnsByLogicalColour = Attribute.LogicalColour.listArrayByLogicalColour $ repeat [],
                getNPlies               = 0
        }

instance Property.Empty.Empty (TurnsByLogicalColour turn) where
        empty   = Data.Default.def

instance Property.Null.Null (TurnsByLogicalColour turn) where
        isNull MkTurnsByLogicalColour { getNPlies = 0 } = True
        isNull _                                        = False

instance Property.Reflectable.ReflectableOnX turn => Property.Reflectable.ReflectableOnX (TurnsByLogicalColour turn) where
        reflectOnX turnsByLogicalColour@MkTurnsByLogicalColour { getTurnsByLogicalColour = byLogicalColour }    = turnsByLogicalColour {
                getTurnsByLogicalColour = Data.Array.IArray.array (minBound, maxBound) . map (
                        Property.Opposable.getOpposite {-logical colour-} *** map Property.Reflectable.reflectOnX {-turn-}
                ) $ Data.Array.IArray.assocs byLogicalColour
         }

-- | Smart constructor.
fromAssocs :: Show turn => [(Attribute.LogicalColour.LogicalColour, [turn])] -> TurnsByLogicalColour turn
fromAssocs assocs
        | length assocs /= Attribute.LogicalColour.nDistinctLogicalColours      = Control.Exception.throw . Data.Exception.mkInsufficientData . showString "BishBosh.State.TurnsByLogicalColour.fromAssocs:\tboth logical colours must be defined; " $ shows assocs "."
        | Data.List.Extra.anySame $ map fst {-logicalColour-} assocs            = Control.Exception.throw . Data.Exception.mkDuplicateData . showString "BishBosh.State.TurnsByLogicalColour.fromAssocs:\tduplicates specified; " $ shows assocs "."
        | (> 1) . abs {-allow for Property.Reflectable.reflectOnX-} . uncurry (-) $ (
                length . (! Attribute.LogicalColour.White) &&& length . (! Attribute.LogicalColour.Black)
        ) byLogicalColour                                                       = Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.State.TurnsByLogicalColour.fromAssocs:\tany difference in the number of turns taken by each player, can't exceed one " $ shows assocs "."
        | otherwise     = turnsByLogicalColour
        where
                byLogicalColour         = Data.Array.IArray.array (minBound, maxBound) assocs
                turnsByLogicalColour    = MkTurnsByLogicalColour {
                        getTurnsByLogicalColour = byLogicalColour,
                        getNPlies               = countPlies turnsByLogicalColour       -- Infer.
                }

{- |
	* Derive the /logical colour/ of the next player to move.

	* CAVEAT: the result can't be guaranteed if 'Property.Reflectable.reflectOnX' has been called.
-}
inferNextLogicalColour :: TurnsByLogicalColour turn -> Attribute.LogicalColour.LogicalColour
inferNextLogicalColour MkTurnsByLogicalColour { getNPlies = nPlies }
        | even nPlies   = Attribute.LogicalColour.White
        | otherwise     = Attribute.LogicalColour.Black

{- |
	* Count the number of plies.

	* N.B.: 'getNPlies' is more efficient.
-}
countPlies :: TurnsByLogicalColour turn -> Component.Move.NPlies
countPlies MkTurnsByLogicalColour { getTurnsByLogicalColour = byLogicalColour } = Data.Foldable.foldl' (\acc -> (+ acc) . length) 0 byLogicalColour

-- | Dereference.
dereference :: Attribute.LogicalColour.LogicalColour -> TurnsByLogicalColour turn -> [turn]
dereference logicalColour MkTurnsByLogicalColour { getTurnsByLogicalColour = byLogicalColour }  = byLogicalColour ! logicalColour

-- | Update.
update :: TurnsByLogicalColour turn -> [(Attribute.LogicalColour.LogicalColour, [turn])] -> TurnsByLogicalColour turn
update MkTurnsByLogicalColour { getTurnsByLogicalColour = byLogicalColour } assocs      = turnsByLogicalColour where
        turnsByLogicalColour    = MkTurnsByLogicalColour {
                getTurnsByLogicalColour = byLogicalColour // assocs,
                getNPlies               = countPlies turnsByLogicalColour       -- Infer.
        }

-- | Self-documentation.
type Transformation turn        = TurnsByLogicalColour turn -> TurnsByLogicalColour turn

-- | Prepend the specified /turn/.
prepend :: Attribute.LogicalColour.LogicalColour -> turn -> Transformation turn
prepend logicalColour turn MkTurnsByLogicalColour {
        getTurnsByLogicalColour = byLogicalColour,
        getNPlies               = nPlies
} = MkTurnsByLogicalColour {
        getTurnsByLogicalColour = byLogicalColour // [
                (
                        logicalColour,
                        turn : byLogicalColour ! logicalColour
                ) -- Pair.
        ], -- Singleton.
        getNPlies       = succ nPlies
}