{-
	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@]	Defines options related to the application's user-interface.
-}

module BishBosh.Input.UIOptions(
-- * Types
-- ** Type-synonyms
	EitherNativeUIOrCECPOptions,
--	Transformation,
-- ** Data-types
	UIOptions(
--		MkUIOptions,
		getMoveNotation,
		getMaybePrintMoveTree,
		getNDecimalDigits,
		getEitherNativeUIOrCECPOptions,
		getVerbosity
	),
-- * Constants
	tag,
	printMoveTreeTag,
	nDecimalDigitsTag,
--	maxNDecimalDigits,
-- * Functions
-- ** Constructors
	mkUIOptions,
-- ** Mutators
	updateCECPFeature,
	deleteCECPFeature,
-- ** Predicates
	isCECPManualMode
) where

import			BishBosh.Data.Integral()	-- For 'HXT.XmlPickler NDecimalDigits'.
import			Control.Arrow((&&&))
import qualified	BishBosh.Data.Either		as Data.Either
import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Input.CECPFeatures	as Input.CECPFeatures
import qualified	BishBosh.Input.CECPOptions	as Input.CECPOptions
import qualified	BishBosh.Input.NativeUIOptions	as Input.NativeUIOptions
import qualified	BishBosh.Input.Verbosity	as Input.Verbosity
import qualified	BishBosh.Notation.MoveNotation	as Notation.MoveNotation
import qualified	BishBosh.Property.ShowFloat	as Property.ShowFloat
import qualified	BishBosh.Property.Tree		as Property.Tree
import qualified	BishBosh.Text.ShowList		as Text.ShowList
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Default
import qualified	Data.Maybe
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT

-- | Used to qualify XML.
tag :: String
tag :: String
tag			= String
"uiOptions"

-- | Used to qualify XML.
printMoveTreeTag :: String
printMoveTreeTag :: String
printMoveTreeTag	= String
"printMoveTree"

-- | Used to qualify XML.
nDecimalDigitsTag :: String
nDecimalDigitsTag :: String
nDecimalDigitsTag	= String
"nDecimalDigits"

-- | The maximum number of decimal digits that can be represented using a double-precision floating-point number.
maxNDecimalDigits :: Property.ShowFloat.NDecimalDigits
maxNDecimalDigits :: NDecimalDigits
maxNDecimalDigits	= Double -> NDecimalDigits
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> NDecimalDigits) -> Double -> NDecimalDigits
forall a b. (a -> b) -> a -> b
$ NDecimalDigits -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (
	Double -> NDecimalDigits
forall a. RealFloat a => a -> NDecimalDigits
floatDigits (
		Double
forall a. HasCallStack => a
undefined	:: Double	-- CAVEAT: the actual type could be merely 'Float', but that's currently unknown.
	)
 ) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 Double
2 :: Double)

-- | Self-documentation.
type EitherNativeUIOrCECPOptions row column	= Either (Input.NativeUIOptions.NativeUIOptions row column) Input.CECPOptions.CECPOptions

-- | Defines the application's user-interface.
data UIOptions row column = MkUIOptions {
	UIOptions row column -> MoveNotation
getMoveNotation			:: Notation.MoveNotation.MoveNotation,		-- ^ The notation used to describe /move/s.
	UIOptions row column -> Maybe NDecimalDigits
getMaybePrintMoveTree		:: Maybe Property.Tree.Depth,			-- ^ Print the move-tree to the specified depth.
	UIOptions row column -> NDecimalDigits
getNDecimalDigits		:: Property.ShowFloat.NDecimalDigits,		-- ^ The precision to which fractional auxiliary data is displayed.
	UIOptions row column -> EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions	:: EitherNativeUIOrCECPOptions row column,	-- ^ When a native display is configured some additional style-parameters are required.
	UIOptions row column -> Verbosity
getVerbosity			:: Input.Verbosity.Verbosity			-- ^ Set the threshold for ancillary information-output.
} deriving UIOptions row column -> UIOptions row column -> Bool
(UIOptions row column -> UIOptions row column -> Bool)
-> (UIOptions row column -> UIOptions row column -> Bool)
-> Eq (UIOptions row column)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall row column.
(Eq row, Eq column) =>
UIOptions row column -> UIOptions row column -> Bool
/= :: UIOptions row column -> UIOptions row column -> Bool
$c/= :: forall row column.
(Eq row, Eq column) =>
UIOptions row column -> UIOptions row column -> Bool
== :: UIOptions row column -> UIOptions row column -> Bool
$c== :: forall row column.
(Eq row, Eq column) =>
UIOptions row column -> UIOptions row column -> Bool
Eq

instance (
	Control.DeepSeq.NFData	column,
	Control.DeepSeq.NFData	row
 ) => Control.DeepSeq.NFData (UIOptions row column) where
	rnf :: UIOptions row column -> ()
rnf MkUIOptions {
		getMoveNotation :: forall row column. UIOptions row column -> MoveNotation
getMoveNotation			= MoveNotation
moveNotation,
		getMaybePrintMoveTree :: forall row column. UIOptions row column -> Maybe NDecimalDigits
getMaybePrintMoveTree		= Maybe NDecimalDigits
maybePrintMoveTree,
		getNDecimalDigits :: forall row column. UIOptions row column -> NDecimalDigits
getNDecimalDigits		= NDecimalDigits
nDecimalDigits,
		getEitherNativeUIOrCECPOptions :: forall row column.
UIOptions row column -> EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions	= EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions,
		getVerbosity :: forall row column. UIOptions row column -> Verbosity
getVerbosity			= Verbosity
verbosity
	} = (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
 EitherNativeUIOrCECPOptions row column, Verbosity)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (
		MoveNotation
moveNotation,
		Maybe NDecimalDigits
maybePrintMoveTree,
		NDecimalDigits
nDecimalDigits,
		EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions,
		Verbosity
verbosity
	 )

instance (Show row, Show column) => Show (UIOptions row column) where
	showsPrec :: NDecimalDigits -> UIOptions row column -> ShowS
showsPrec NDecimalDigits
_ MkUIOptions {
		getMoveNotation :: forall row column. UIOptions row column -> MoveNotation
getMoveNotation			= MoveNotation
moveNotation,
		getMaybePrintMoveTree :: forall row column. UIOptions row column -> Maybe NDecimalDigits
getMaybePrintMoveTree		= Maybe NDecimalDigits
maybePrintMoveTree,
		getNDecimalDigits :: forall row column. UIOptions row column -> NDecimalDigits
getNDecimalDigits		= NDecimalDigits
nDecimalDigits,
		getEitherNativeUIOrCECPOptions :: forall row column.
UIOptions row column -> EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions	= EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions,
		getVerbosity :: forall row column. UIOptions row column -> Verbosity
getVerbosity			= Verbosity
verbosity
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ ([(String, ShowS)] -> [(String, ShowS)])
-> (NDecimalDigits -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe NDecimalDigits
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [(String, ShowS)] -> [(String, ShowS)]
forall a. a -> a
id (
		(:) ((String, ShowS) -> [(String, ShowS)] -> [(String, ShowS)])
-> (NDecimalDigits -> (String, ShowS))
-> NDecimalDigits
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
printMoveTreeTag (ShowS -> (String, ShowS))
-> (NDecimalDigits -> ShowS) -> NDecimalDigits -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NDecimalDigits -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe NDecimalDigits
maybePrintMoveTree [
		(
			String
Notation.MoveNotation.tag,
			MoveNotation -> ShowS
forall a. Show a => a -> ShowS
shows MoveNotation
moveNotation
		), (
			String
nDecimalDigitsTag,
			NDecimalDigits -> ShowS
forall a. Show a => a -> ShowS
shows NDecimalDigits
nDecimalDigits
		),
		(NativeUIOptions row column -> (String, ShowS))
-> (CECPOptions -> (String, ShowS))
-> EitherNativeUIOrCECPOptions row column
-> (String, ShowS)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (
			(,) String
Input.NativeUIOptions.tag (ShowS -> (String, ShowS))
-> (NativeUIOptions row column -> ShowS)
-> NativeUIOptions row column
-> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NativeUIOptions row column -> ShowS
forall a. Show a => a -> ShowS
shows
		) (
			(,) String
Input.CECPOptions.tag (ShowS -> (String, ShowS))
-> (CECPOptions -> ShowS) -> CECPOptions -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CECPOptions -> ShowS
forall a. Show a => a -> ShowS
shows
		) EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions, (
			String
Input.Verbosity.tag,
			Verbosity -> ShowS
forall a. Show a => a -> ShowS
shows Verbosity
verbosity
		)
	 ]

instance (Num row, Num column) => Data.Default.Default (UIOptions row column) where
	def :: UIOptions row column
def = MkUIOptions :: forall row column.
MoveNotation
-> Maybe NDecimalDigits
-> NDecimalDigits
-> EitherNativeUIOrCECPOptions row column
-> Verbosity
-> UIOptions row column
MkUIOptions {
		getMoveNotation :: MoveNotation
getMoveNotation			= MoveNotation
forall a. Default a => a
Data.Default.def,
		getMaybePrintMoveTree :: Maybe NDecimalDigits
getMaybePrintMoveTree		= Maybe NDecimalDigits
forall a. Maybe a
Nothing,
		getNDecimalDigits :: NDecimalDigits
getNDecimalDigits		= NDecimalDigits
3,
		getEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions	= NativeUIOptions row column
-> EitherNativeUIOrCECPOptions row column
forall a b. a -> Either a b
Left NativeUIOptions row column
forall a. Default a => a
Data.Default.def,
		getVerbosity :: Verbosity
getVerbosity			= Verbosity
forall a. Default a => a
Data.Default.def
	}

instance (
	HXT.XmlPickler	column,
	HXT.XmlPickler	row,
	Integral	column,
	Integral	row,
	Show		column,
	Show		row
 ) => HXT.XmlPickler (UIOptions row column) where
	xpickle :: PU (UIOptions row column)
xpickle	= UIOptions row column
-> PU (UIOptions row column) -> PU (UIOptions row column)
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault UIOptions row column
forall a. Default a => a
Data.Default.def (PU (UIOptions row column) -> PU (UIOptions row column))
-> (PU
      (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
       EitherNativeUIOrCECPOptions row column, Verbosity)
    -> PU (UIOptions row column))
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions row column, Verbosity)
-> PU (UIOptions row column)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU (UIOptions row column) -> PU (UIOptions row column)
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU (UIOptions row column) -> PU (UIOptions row column))
-> (PU
      (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
       EitherNativeUIOrCECPOptions row column, Verbosity)
    -> PU (UIOptions row column))
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions row column, Verbosity)
-> PU (UIOptions row column)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
  EitherNativeUIOrCECPOptions row column, Verbosity)
 -> UIOptions row column,
 UIOptions row column
 -> (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
     EitherNativeUIOrCECPOptions row column, Verbosity))
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions row column, Verbosity)
-> PU (UIOptions row column)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(MoveNotation
a, Maybe NDecimalDigits
b, NDecimalDigits
c, EitherNativeUIOrCECPOptions row column
d, Verbosity
e) -> MoveNotation
-> Maybe NDecimalDigits
-> NDecimalDigits
-> EitherNativeUIOrCECPOptions row column
-> Verbosity
-> UIOptions row column
forall row column.
MoveNotation
-> Maybe NDecimalDigits
-> NDecimalDigits
-> EitherNativeUIOrCECPOptions row column
-> Verbosity
-> UIOptions row column
mkUIOptions MoveNotation
a Maybe NDecimalDigits
b NDecimalDigits
c EitherNativeUIOrCECPOptions row column
d Verbosity
e,	-- Construct.
		\MkUIOptions {
			getMoveNotation :: forall row column. UIOptions row column -> MoveNotation
getMoveNotation			= MoveNotation
moveNotation,
			getMaybePrintMoveTree :: forall row column. UIOptions row column -> Maybe NDecimalDigits
getMaybePrintMoveTree		= Maybe NDecimalDigits
maybePrintMoveTree,
			getNDecimalDigits :: forall row column. UIOptions row column -> NDecimalDigits
getNDecimalDigits		= NDecimalDigits
nDecimalDigits,
			getEitherNativeUIOrCECPOptions :: forall row column.
UIOptions row column -> EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions	= EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions,
			getVerbosity :: forall row column. UIOptions row column -> Verbosity
getVerbosity			= Verbosity
verbosity
		} -> (
			MoveNotation
moveNotation,
			Maybe NDecimalDigits
maybePrintMoveTree,
			NDecimalDigits
nDecimalDigits,
			EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions,
			Verbosity
verbosity
		)
	 ) (PU
   (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
    EitherNativeUIOrCECPOptions row column, Verbosity)
 -> PU (UIOptions row column))
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions row column, Verbosity)
-> PU (UIOptions row column)
forall a b. (a -> b) -> a -> b
$ PU MoveNotation
-> PU (Maybe NDecimalDigits)
-> PU NDecimalDigits
-> PU (EitherNativeUIOrCECPOptions row column)
-> PU Verbosity
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions row column, Verbosity)
forall a b c d e.
PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
HXT.xp5Tuple PU MoveNotation
forall a. XmlPickler a => PU a
HXT.xpickle {-MoveNotation-} (
		PU NDecimalDigits -> PU (Maybe NDecimalDigits)
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU NDecimalDigits -> PU (Maybe NDecimalDigits))
-> PU NDecimalDigits -> PU (Maybe NDecimalDigits)
forall a b. (a -> b) -> a -> b
$ String -> PU NDecimalDigits -> PU NDecimalDigits
forall a. String -> PU a -> PU a
HXT.xpAttr String
printMoveTreeTag PU NDecimalDigits
forall a. XmlPickler a => PU a
HXT.xpickle {-Depth-}
	 ) (
		UIOptions row column -> NDecimalDigits
forall row column. UIOptions row column -> NDecimalDigits
getNDecimalDigits UIOptions row column
def NDecimalDigits -> PU NDecimalDigits -> PU NDecimalDigits
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU NDecimalDigits -> PU NDecimalDigits
forall a. String -> PU a -> PU a
HXT.xpAttr String
nDecimalDigitsTag PU NDecimalDigits
forall a. XmlPickler a => PU a
HXT.xpickle {-NDecimalDigits-}
	 ) (
		UIOptions row column -> EitherNativeUIOrCECPOptions row column
forall row column.
UIOptions row column -> EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions UIOptions row column
def EitherNativeUIOrCECPOptions row column
-> PU (EitherNativeUIOrCECPOptions row column)
-> PU (EitherNativeUIOrCECPOptions row column)
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` PU (NativeUIOptions row column)
-> PU CECPOptions -> PU (EitherNativeUIOrCECPOptions row column)
forall l r. PU l -> PU r -> PU (Either l r)
Data.Either.xpickle PU (NativeUIOptions row column)
forall a. XmlPickler a => PU a
HXT.xpickle {-NativeUIOptions-} PU CECPOptions
forall a. XmlPickler a => PU a
HXT.xpickle {-CECPOptions-}
	 ) (
		UIOptions row column -> Verbosity
forall row column. UIOptions row column -> Verbosity
getVerbosity UIOptions row column
def Verbosity -> PU Verbosity -> PU Verbosity
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` PU Verbosity
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) where
		def :: UIOptions row column
def	= UIOptions row column
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkUIOptions
	:: Notation.MoveNotation.MoveNotation	-- ^ The chess-notation used to describe /move/s.
	-> Maybe Property.Tree.Depth
	-> Property.ShowFloat.NDecimalDigits	-- ^ The precision to which fractional auxiliary data is displayed.
	-> EitherNativeUIOrCECPOptions row column
	-> Input.Verbosity.Verbosity		-- ^ Set the threshold for logging.
	-> UIOptions row column
mkUIOptions :: MoveNotation
-> Maybe NDecimalDigits
-> NDecimalDigits
-> EitherNativeUIOrCECPOptions row column
-> Verbosity
-> UIOptions row column
mkUIOptions MoveNotation
moveNotation Maybe NDecimalDigits
maybePrintMoveTree NDecimalDigits
nDecimalDigits EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions Verbosity
verbosity
	| Just NDecimalDigits
depth <- Maybe NDecimalDigits
maybePrintMoveTree
	, NDecimalDigits
depth NDecimalDigits -> NDecimalDigits -> Bool
forall a. Ord a => a -> a -> Bool
<= NDecimalDigits
0				= Exception -> UIOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> UIOptions row column)
-> (String -> Exception) -> String -> UIOptions row column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.UIOptions.mkUIOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
printMoveTreeTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> UIOptions row column) -> String -> UIOptions row column
forall a b. (a -> b) -> a -> b
$ NDecimalDigits -> ShowS
forall a. Show a => a -> ShowS
shows NDecimalDigits
depth String
" must exceed zero."
	| NDecimalDigits
nDecimalDigits NDecimalDigits -> NDecimalDigits -> Bool
forall a. Ord a => a -> a -> Bool
< NDecimalDigits
1			= Exception -> UIOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> UIOptions row column)
-> (String -> Exception) -> String -> UIOptions row column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.UIOptions.mkUIOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
nDecimalDigitsTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> UIOptions row column) -> String -> UIOptions row column
forall a b. (a -> b) -> a -> b
$ NDecimalDigits -> ShowS
forall a. Show a => a -> ShowS
shows NDecimalDigits
nDecimalDigits String
" must exceed zero."
	| NDecimalDigits
nDecimalDigits NDecimalDigits -> NDecimalDigits -> Bool
forall a. Ord a => a -> a -> Bool
> NDecimalDigits
maxNDecimalDigits	= Exception -> UIOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> UIOptions row column)
-> (String -> Exception) -> String -> UIOptions row column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.UIOptions.mkUIOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
nDecimalDigitsTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NDecimalDigits -> ShowS
forall a. Show a => a -> ShowS
shows NDecimalDigits
nDecimalDigits ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" shouldn't exceed " (String -> UIOptions row column) -> String -> UIOptions row column
forall a b. (a -> b) -> a -> b
$ NDecimalDigits -> ShowS
forall a. Show a => a -> ShowS
shows NDecimalDigits
maxNDecimalDigits String
"."
	| (
		Bool -> NativeUIOptions row column -> Bool
forall a b. a -> b -> a
const Bool
False (NativeUIOptions row column -> Bool)
-> (CECPOptions -> Bool)
-> EitherNativeUIOrCECPOptions row column
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
`either` Bool -> CECPOptions -> Bool
forall a b. a -> b -> a
const Bool
True
	) EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions Bool -> Bool -> Bool
&& Bool -> Bool
not (
		MoveNotation -> Bool
Notation.MoveNotation.isCoordinate MoveNotation
moveNotation
	)					= Exception -> UIOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> UIOptions row column)
-> (String -> Exception) -> String -> UIOptions row column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.UIOptions.mkUIOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
Input.CECPOptions.tag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" is incompatible with " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
Notation.MoveNotation.tag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> UIOptions row column) -> String -> UIOptions row column
forall a b. (a -> b) -> a -> b
$ MoveNotation -> ShowS
forall a. Show a => a -> ShowS
shows MoveNotation
moveNotation String
"."
	| Bool
otherwise	= MkUIOptions :: forall row column.
MoveNotation
-> Maybe NDecimalDigits
-> NDecimalDigits
-> EitherNativeUIOrCECPOptions row column
-> Verbosity
-> UIOptions row column
MkUIOptions {
		getMoveNotation :: MoveNotation
getMoveNotation			= MoveNotation
moveNotation,
		getMaybePrintMoveTree :: Maybe NDecimalDigits
getMaybePrintMoveTree		= Maybe NDecimalDigits
maybePrintMoveTree,
		getNDecimalDigits :: NDecimalDigits
getNDecimalDigits		= NDecimalDigits
nDecimalDigits,
		getEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions	= EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions,
		getVerbosity :: Verbosity
getVerbosity			= Verbosity
verbosity
	}

-- | Whether the chess-engine has been temporarily turned-off in order to set-up pieces.
isCECPManualMode :: UIOptions row column -> Bool
isCECPManualMode :: UIOptions row column -> Bool
isCECPManualMode MkUIOptions { getEitherNativeUIOrCECPOptions :: forall row column.
UIOptions row column -> EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions = EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions }	= (
	Bool -> NativeUIOptions row column -> Bool
forall a b. a -> b -> a
const Bool
False (NativeUIOptions row column -> Bool)
-> (CECPOptions -> Bool)
-> EitherNativeUIOrCECPOptions row column
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
`either` (
		(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> (CECPOptions -> (Bool, Bool)) -> CECPOptions -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CECPOptions -> Bool
Input.CECPOptions.getEditMode (CECPOptions -> Bool)
-> (CECPOptions -> Bool) -> CECPOptions -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CECPOptions -> Bool
Input.CECPOptions.getForceMode)
	)
 ) EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions

-- | The type of a function used to transform 'UIOptions'.
type Transformation row column	= UIOptions row column -> UIOptions row column

-- | Mutator.
updateCECPFeature :: Input.CECPFeatures.Feature -> Transformation row column
updateCECPFeature :: Feature -> Transformation row column
updateCECPFeature Feature
feature uiOptions :: UIOptions row column
uiOptions@MkUIOptions { getEitherNativeUIOrCECPOptions :: forall row column.
UIOptions row column -> EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions = EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions }	= UIOptions row column
uiOptions {
	getEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions	= Feature -> Transformation
Input.CECPOptions.updateFeature Feature
feature Transformation
-> EitherNativeUIOrCECPOptions row column
-> EitherNativeUIOrCECPOptions row column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions
}

-- | Mutator.
deleteCECPFeature :: Input.CECPFeatures.Feature -> Transformation row column
deleteCECPFeature :: Feature -> Transformation row column
deleteCECPFeature Feature
feature uiOptions :: UIOptions row column
uiOptions@MkUIOptions { getEitherNativeUIOrCECPOptions :: forall row column.
UIOptions row column -> EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions = EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions }	= UIOptions row column
uiOptions {
	getEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions row column
getEitherNativeUIOrCECPOptions	= Feature -> Transformation
Input.CECPOptions.deleteFeature Feature
feature Transformation
-> EitherNativeUIOrCECPOptions row column
-> EitherNativeUIOrCECPOptions row column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions
}