{-
	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			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.Arboreal	as Property.Arboreal
import qualified	BishBosh.Text.ShowList		as Text.ShowList
import qualified	BishBosh.Type.Count		as Type.Count
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 :: Type.Count.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	= Either Input.NativeUIOptions.NativeUIOptions Input.CECPOptions.CECPOptions

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

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

instance Show UIOptions where
	showsPrec :: NDecimalDigits -> UIOptions -> ShowS
showsPrec NDecimalDigits
_ MkUIOptions {
		getMoveNotation :: UIOptions -> MoveNotation
getMoveNotation			= MoveNotation
moveNotation,
		getMaybePrintMoveTree :: UIOptions -> Maybe NDecimalDigits
getMaybePrintMoveTree		= Maybe NDecimalDigits
maybePrintMoveTree,
		getNDecimalDigits :: UIOptions -> NDecimalDigits
getNDecimalDigits		= NDecimalDigits
nDecimalDigits,
		getEitherNativeUIOrCECPOptions :: UIOptions -> EitherNativeUIOrCECPOptions
getEitherNativeUIOrCECPOptions	= EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions,
		getVerbosity :: UIOptions -> 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
		),
		(,) String
Input.NativeUIOptions.tag (ShowS -> (String, ShowS))
-> (NativeUIOptions -> ShowS) -> NativeUIOptions -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NativeUIOptions -> ShowS
forall a. Show a => a -> ShowS
shows (NativeUIOptions -> (String, ShowS))
-> (CECPOptions -> (String, ShowS))
-> EitherNativeUIOrCECPOptions
-> (String, ShowS)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (,) 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 -> (String, ShowS))
-> EitherNativeUIOrCECPOptions -> (String, ShowS)
forall a b. (a -> b) -> a -> b
$ EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions,
		(
			String
Input.Verbosity.tag,
			Verbosity -> ShowS
forall a. Show a => a -> ShowS
shows Verbosity
verbosity
		)
	 ]

instance Data.Default.Default UIOptions where
	def :: UIOptions
def = MkUIOptions :: MoveNotation
-> Maybe NDecimalDigits
-> NDecimalDigits
-> EitherNativeUIOrCECPOptions
-> Verbosity
-> UIOptions
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
getEitherNativeUIOrCECPOptions	= NativeUIOptions -> EitherNativeUIOrCECPOptions
forall a b. a -> Either a b
Left NativeUIOptions
forall a. Default a => a
Data.Default.def,
		getVerbosity :: Verbosity
getVerbosity			= Verbosity
forall a. Default a => a
Data.Default.def
	}

instance HXT.XmlPickler UIOptions where
	xpickle :: PU UIOptions
xpickle	= UIOptions -> PU UIOptions -> PU UIOptions
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault UIOptions
forall a. Default a => a
Data.Default.def (PU UIOptions -> PU UIOptions)
-> (PU
      (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
       EitherNativeUIOrCECPOptions, Verbosity)
    -> PU UIOptions)
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions, Verbosity)
-> PU UIOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU UIOptions -> PU UIOptions
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU UIOptions -> PU UIOptions)
-> (PU
      (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
       EitherNativeUIOrCECPOptions, Verbosity)
    -> PU UIOptions)
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions, Verbosity)
-> PU UIOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
  EitherNativeUIOrCECPOptions, Verbosity)
 -> UIOptions,
 UIOptions
 -> (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
     EitherNativeUIOrCECPOptions, Verbosity))
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions, Verbosity)
-> PU UIOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(MoveNotation
a, Maybe NDecimalDigits
b, NDecimalDigits
c, EitherNativeUIOrCECPOptions
d, Verbosity
e) -> MoveNotation
-> Maybe NDecimalDigits
-> NDecimalDigits
-> EitherNativeUIOrCECPOptions
-> Verbosity
-> UIOptions
mkUIOptions MoveNotation
a Maybe NDecimalDigits
b NDecimalDigits
c EitherNativeUIOrCECPOptions
d Verbosity
e,	-- Construct.
		\MkUIOptions {
			getMoveNotation :: UIOptions -> MoveNotation
getMoveNotation			= MoveNotation
moveNotation,
			getMaybePrintMoveTree :: UIOptions -> Maybe NDecimalDigits
getMaybePrintMoveTree		= Maybe NDecimalDigits
maybePrintMoveTree,
			getNDecimalDigits :: UIOptions -> NDecimalDigits
getNDecimalDigits		= NDecimalDigits
nDecimalDigits,
			getEitherNativeUIOrCECPOptions :: UIOptions -> EitherNativeUIOrCECPOptions
getEitherNativeUIOrCECPOptions	= EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions,
			getVerbosity :: UIOptions -> Verbosity
getVerbosity			= Verbosity
verbosity
		} -> (
			MoveNotation
moveNotation,
			Maybe NDecimalDigits
maybePrintMoveTree,
			NDecimalDigits
nDecimalDigits,
			EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions,
			Verbosity
verbosity
		)
	 ) (PU
   (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
    EitherNativeUIOrCECPOptions, Verbosity)
 -> PU UIOptions)
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions, Verbosity)
-> PU UIOptions
forall a b. (a -> b) -> a -> b
$ PU MoveNotation
-> PU (Maybe NDecimalDigits)
-> PU NDecimalDigits
-> PU EitherNativeUIOrCECPOptions
-> PU Verbosity
-> PU
     (MoveNotation, Maybe NDecimalDigits, NDecimalDigits,
      EitherNativeUIOrCECPOptions, 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 -> NDecimalDigits
getNDecimalDigits UIOptions
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 -> EitherNativeUIOrCECPOptions
getEitherNativeUIOrCECPOptions UIOptions
def EitherNativeUIOrCECPOptions
-> PU EitherNativeUIOrCECPOptions -> PU EitherNativeUIOrCECPOptions
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` PU NativeUIOptions
-> PU CECPOptions -> PU EitherNativeUIOrCECPOptions
forall l r. PU l -> PU r -> PU (Either l r)
Data.Either.xpickle PU NativeUIOptions
forall a. XmlPickler a => PU a
HXT.xpickle {-NativeUIOptions-} PU CECPOptions
forall a. XmlPickler a => PU a
HXT.xpickle {-CECPOptions-}	-- N.B.: 'hxt-9.3.1.21' includes a pickler for Either.
	 ) (
		UIOptions -> Verbosity
getVerbosity UIOptions
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
def	= UIOptions
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkUIOptions
	:: Notation.MoveNotation.MoveNotation	-- ^ The chess-notation used to describe /move/s.
	-> Maybe Property.Arboreal.Depth
	-> Type.Count.NDecimalDigits		-- ^ The precision to which fractional auxiliary data is displayed.
	-> EitherNativeUIOrCECPOptions
	-> Input.Verbosity.Verbosity		-- ^ Set the threshold for logging.
	-> UIOptions
mkUIOptions :: MoveNotation
-> Maybe NDecimalDigits
-> NDecimalDigits
-> EitherNativeUIOrCECPOptions
-> Verbosity
-> UIOptions
mkUIOptions MoveNotation
moveNotation Maybe NDecimalDigits
maybePrintMoveTree NDecimalDigits
nDecimalDigits EitherNativeUIOrCECPOptions
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> UIOptions)
-> (String -> Exception) -> String -> UIOptions
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) -> String -> UIOptions
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> UIOptions)
-> (String -> Exception) -> String -> UIOptions
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) -> String -> UIOptions
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> UIOptions)
-> (String -> Exception) -> String -> UIOptions
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) -> String -> UIOptions
forall a b. (a -> b) -> a -> b
$ NDecimalDigits -> ShowS
forall a. Show a => a -> ShowS
shows NDecimalDigits
maxNDecimalDigits String
"."
	| (
		Bool -> NativeUIOptions -> Bool
forall a b. a -> b -> a
const Bool
False (NativeUIOptions -> Bool)
-> (CECPOptions -> Bool) -> EitherNativeUIOrCECPOptions -> Bool
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Bool -> CECPOptions -> Bool
forall a b. a -> b -> a
const Bool
True (EitherNativeUIOrCECPOptions -> Bool)
-> EitherNativeUIOrCECPOptions -> Bool
forall a b. (a -> b) -> a -> b
$ EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions
	) Bool -> Bool -> Bool
&& Bool -> Bool
not (
		MoveNotation -> Bool
Notation.MoveNotation.isPureCoordinate MoveNotation
moveNotation
	)					= Exception -> UIOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> UIOptions)
-> (String -> Exception) -> String -> UIOptions
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) -> String -> UIOptions
forall a b. (a -> b) -> a -> b
$ MoveNotation -> ShowS
forall a. Show a => a -> ShowS
shows MoveNotation
moveNotation String
"."
	| Bool
otherwise				= MkUIOptions :: MoveNotation
-> Maybe NDecimalDigits
-> NDecimalDigits
-> EitherNativeUIOrCECPOptions
-> Verbosity
-> UIOptions
MkUIOptions {
		getMoveNotation :: MoveNotation
getMoveNotation			= MoveNotation
moveNotation,
		getMaybePrintMoveTree :: Maybe NDecimalDigits
getMaybePrintMoveTree		= Maybe NDecimalDigits
maybePrintMoveTree,
		getNDecimalDigits :: NDecimalDigits
getNDecimalDigits		= NDecimalDigits
nDecimalDigits,
		getEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions
getEitherNativeUIOrCECPOptions	= EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions,
		getVerbosity :: Verbosity
getVerbosity			= Verbosity
verbosity
	}

-- | Whether the chess-engine has been temporarily turned-off in order to set-up pieces.
isCECPManualMode :: UIOptions -> Bool
isCECPManualMode :: UIOptions -> Bool
isCECPManualMode MkUIOptions { getEitherNativeUIOrCECPOptions :: UIOptions -> EitherNativeUIOrCECPOptions
getEitherNativeUIOrCECPOptions = EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions }	= Bool -> NativeUIOptions -> Bool
forall a b. a -> b -> a
const Bool
False (NativeUIOptions -> Bool)
-> (CECPOptions -> Bool) -> EitherNativeUIOrCECPOptions -> Bool
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (
	(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 -> Bool)
-> EitherNativeUIOrCECPOptions -> Bool
forall a b. (a -> b) -> a -> b
$ EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions

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

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

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