{-
	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 configurable options related to i/o.
-}

module BishBosh.Input.IOOptions(
-- * Types
-- ** Type-synonyms
--	Transformation,
	MaximumPGNNames,
-- ** Data-types
	IOOptions(
--		MkIOOptions,
		getMaybeOutputConfigFilePath,
		getMaybeMaximumPGNNames,
		getPGNOptionsList,
		getMaybePersistence,
		getUIOptions
	),
-- * Constants
	tag,
	outputConfigFilePathTag,
--	maximumPGNNamesTag,
--	persistenceTag,
--	filePathTag,
--	automaticTag,
-- * Functions
-- ** Constructor
	mkIOOptions,
-- ** Mutators
	setMaybeOutputConfigFilePath,
	setEitherNativeUIOrCECPOptions,
	setMaybePrintMoveTree,
	updateCECPFeature,
	deleteCECPFeature,
	setVerbosity
) where

import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Data.Foldable		as Data.Foldable
import qualified	BishBosh.Input.CECPFeatures	as Input.CECPFeatures
import qualified	BishBosh.Input.PGNOptions	as Input.PGNOptions
import qualified	BishBosh.Input.UIOptions	as Input.UIOptions
import qualified	BishBosh.Input.Verbosity	as Input.Verbosity
import qualified	BishBosh.Property.Arboreal	as Property.Arboreal
import qualified	BishBosh.Text.ShowList		as Text.ShowList
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Default
import qualified	Data.Maybe
import qualified	System.FilePath
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT

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

-- | Used to qualify XML.
maximumPGNNamesTag :: String
maximumPGNNamesTag :: String
maximumPGNNamesTag	= String
"maximumPGNNames"

-- | Used to qualify XML.
outputConfigFilePathTag :: String
outputConfigFilePathTag :: String
outputConfigFilePathTag	= String
"outputConfigFilePath"

-- | Used to qualify XML.
persistenceTag :: String
persistenceTag :: String
persistenceTag		= String
"persistence"

-- | Used to qualify XML.
filePathTag :: String
filePathTag :: String
filePathTag		= String
"filePath"

-- | Used to qualify XML.
automaticTag :: String
automaticTag :: String
automaticTag		= String
"automatic"

-- | The maximum number names, of matching games from the PGN-database, to display.
type MaximumPGNNames	= Int

-- | Defines options related to i/o.
data IOOptions row column	= MkIOOptions {
	IOOptions row column -> Maybe String
getMaybeOutputConfigFilePath	:: Maybe System.FilePath.FilePath,		-- ^ An optional path to a file, into which the unprocessed configuration, formatted as XML, should be written (obliterating any existing file-contents).
	IOOptions row column -> Maybe MaximumPGNNames
getMaybeMaximumPGNNames		:: Maybe MaximumPGNNames,			-- ^ The maximum number names, of matching games from the PGN-database, to display; @Nothing@ implies no maximum.
	IOOptions row column -> [PGNOptions]
getPGNOptionsList		:: [Input.PGNOptions.PGNOptions],		-- ^ How to construct PGN-databases.
	IOOptions row column -> Maybe (String, Bool)
getMaybePersistence		:: Maybe (System.FilePath.FilePath, Bool),	-- ^ Optional path to a file, into which game-state can be persisted (obliterating any existing content), & whether to save this state automatically after each move.
	IOOptions row column -> UIOptions row column
getUIOptions			:: Input.UIOptions.UIOptions row column		-- ^ Options which define the user-interface.
} deriving IOOptions row column -> IOOptions row column -> Bool
(IOOptions row column -> IOOptions row column -> Bool)
-> (IOOptions row column -> IOOptions row column -> Bool)
-> Eq (IOOptions row column)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall row column.
(Eq row, Eq column) =>
IOOptions row column -> IOOptions row column -> Bool
/= :: IOOptions row column -> IOOptions row column -> Bool
$c/= :: forall row column.
(Eq row, Eq column) =>
IOOptions row column -> IOOptions row column -> Bool
== :: IOOptions row column -> IOOptions row column -> Bool
$c== :: forall row column.
(Eq row, Eq column) =>
IOOptions row column -> IOOptions row column -> Bool
Eq

instance (
	Control.DeepSeq.NFData	column,
	Control.DeepSeq.NFData	row
 ) => Control.DeepSeq.NFData (IOOptions row column) where
	rnf :: IOOptions row column -> ()
rnf MkIOOptions {
		getMaybeOutputConfigFilePath :: forall row column. IOOptions row column -> Maybe String
getMaybeOutputConfigFilePath	= Maybe String
maybeOutputConfigFilePath,
		getMaybeMaximumPGNNames :: forall row column. IOOptions row column -> Maybe MaximumPGNNames
getMaybeMaximumPGNNames		= Maybe MaximumPGNNames
maybeMaximumPGNNames,
		getPGNOptionsList :: forall row column. IOOptions row column -> [PGNOptions]
getPGNOptionsList		= [PGNOptions]
pgnOptionsList,
		getMaybePersistence :: forall row column. IOOptions row column -> Maybe (String, Bool)
getMaybePersistence		= Maybe (String, Bool)
maybePersistence,
		getUIOptions :: forall row column. IOOptions row column -> UIOptions row column
getUIOptions			= UIOptions row column
uiOptions
	} = (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
 Maybe (String, Bool), UIOptions row column)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (
		Maybe String
maybeOutputConfigFilePath,
		Maybe MaximumPGNNames
maybeMaximumPGNNames,
		[PGNOptions]
pgnOptionsList,
		Maybe (String, Bool)
maybePersistence,
		UIOptions row column
uiOptions
	 )

instance (Show column, Show row) => Show (IOOptions row column) where
	showsPrec :: MaximumPGNNames -> IOOptions row column -> ShowS
showsPrec MaximumPGNNames
_ MkIOOptions {
		getMaybeOutputConfigFilePath :: forall row column. IOOptions row column -> Maybe String
getMaybeOutputConfigFilePath	= Maybe String
maybeOutputConfigFilePath,
		getMaybeMaximumPGNNames :: forall row column. IOOptions row column -> Maybe MaximumPGNNames
getMaybeMaximumPGNNames		= Maybe MaximumPGNNames
maybeMaximumPGNNames,
		getPGNOptionsList :: forall row column. IOOptions row column -> [PGNOptions]
getPGNOptionsList		= [PGNOptions]
pgnOptionsList,
		getMaybePersistence :: forall row column. IOOptions row column -> Maybe (String, Bool)
getMaybePersistence		= Maybe (String, Bool)
maybePersistence,
		getUIOptions :: forall row column. IOOptions row column -> UIOptions row column
getUIOptions			= UIOptions row column
uiOptions
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS)
-> ([(String, ShowS)] -> [(String, ShowS)])
-> [(String, ShowS)]
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, ShowS)] -> [(String, ShowS)])
-> (String -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe String
-> [(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)])
-> (String -> (String, ShowS))
-> String
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
outputConfigFilePathTag (ShowS -> (String, ShowS))
-> (String -> ShowS) -> String -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe String
maybeOutputConfigFilePath ([(String, ShowS)] -> [(String, ShowS)])
-> ([(String, ShowS)] -> [(String, ShowS)])
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, ShowS)] -> [(String, ShowS)])
-> (MaximumPGNNames -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe MaximumPGNNames
-> [(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)])
-> (MaximumPGNNames -> (String, ShowS))
-> MaximumPGNNames
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
maximumPGNNamesTag (ShowS -> (String, ShowS))
-> (MaximumPGNNames -> ShowS) -> MaximumPGNNames -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaximumPGNNames -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe MaximumPGNNames
maybeMaximumPGNNames ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ ([(String, ShowS)] -> [(String, ShowS)])
-> ((String, Bool) -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe (String, Bool)
-> [(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)])
-> ((String, Bool) -> (String, ShowS))
-> (String, Bool)
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
persistenceTag (ShowS -> (String, ShowS))
-> ((String, Bool) -> ShowS) -> (String, Bool) -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Bool) -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe (String, Bool)
maybePersistence [
		(
			String -> ShowS
showString String
Input.PGNOptions.tag String
"List",
			[PGNOptions] -> ShowS
forall a. Show a => a -> ShowS
shows [PGNOptions]
pgnOptionsList
		), (
			String
Input.UIOptions.tag,
			UIOptions row column -> ShowS
forall a. Show a => a -> ShowS
shows UIOptions row column
uiOptions
		)
	 ]

instance (Num column, Num row) => Data.Default.Default (IOOptions row column) where
	def :: IOOptions row column
def = MkIOOptions :: forall row column.
Maybe String
-> Maybe MaximumPGNNames
-> [PGNOptions]
-> Maybe (String, Bool)
-> UIOptions row column
-> IOOptions row column
MkIOOptions {
		getMaybeOutputConfigFilePath :: Maybe String
getMaybeOutputConfigFilePath	= Maybe String
forall a. Maybe a
Nothing,
		getMaybeMaximumPGNNames :: Maybe MaximumPGNNames
getMaybeMaximumPGNNames		= Maybe MaximumPGNNames
forall a. Maybe a
Nothing,
		getPGNOptionsList :: [PGNOptions]
getPGNOptionsList		= [],
		getMaybePersistence :: Maybe (String, Bool)
getMaybePersistence		= Maybe (String, Bool)
forall a. Maybe a
Nothing,
		getUIOptions :: UIOptions row column
getUIOptions			= UIOptions row column
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 (IOOptions row column) where
	xpickle :: PU (IOOptions row column)
xpickle	= IOOptions row column
-> PU (IOOptions row column) -> PU (IOOptions row column)
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault IOOptions row column
forall a. Default a => a
Data.Default.def (PU (IOOptions row column) -> PU (IOOptions row column))
-> (PU
      (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
       Maybe (String, Bool), UIOptions row column)
    -> PU (IOOptions row column))
-> PU
     (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
      Maybe (String, Bool), UIOptions row column)
-> PU (IOOptions row column)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU (IOOptions row column) -> PU (IOOptions row column)
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU (IOOptions row column) -> PU (IOOptions row column))
-> (PU
      (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
       Maybe (String, Bool), UIOptions row column)
    -> PU (IOOptions row column))
-> PU
     (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
      Maybe (String, Bool), UIOptions row column)
-> PU (IOOptions row column)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe String, Maybe MaximumPGNNames, [PGNOptions],
  Maybe (String, Bool), UIOptions row column)
 -> IOOptions row column,
 IOOptions row column
 -> (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
     Maybe (String, Bool), UIOptions row column))
-> PU
     (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
      Maybe (String, Bool), UIOptions row column)
-> PU (IOOptions row column)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(Maybe String
a, Maybe MaximumPGNNames
b, [PGNOptions]
c, Maybe (String, Bool)
d, UIOptions row column
e) -> Maybe String
-> Maybe MaximumPGNNames
-> [PGNOptions]
-> Maybe (String, Bool)
-> UIOptions row column
-> IOOptions row column
forall row column.
Maybe String
-> Maybe MaximumPGNNames
-> [PGNOptions]
-> Maybe (String, Bool)
-> UIOptions row column
-> IOOptions row column
mkIOOptions Maybe String
a Maybe MaximumPGNNames
b [PGNOptions]
c Maybe (String, Bool)
d UIOptions row column
e,	-- Construct.
		\MkIOOptions {
			getMaybeOutputConfigFilePath :: forall row column. IOOptions row column -> Maybe String
getMaybeOutputConfigFilePath	= Maybe String
maybeOutputConfigFilePath,
			getMaybeMaximumPGNNames :: forall row column. IOOptions row column -> Maybe MaximumPGNNames
getMaybeMaximumPGNNames		= Maybe MaximumPGNNames
maybeMaximumPGNNames,
			getPGNOptionsList :: forall row column. IOOptions row column -> [PGNOptions]
getPGNOptionsList		= [PGNOptions]
pgnOptionsList,
			getMaybePersistence :: forall row column. IOOptions row column -> Maybe (String, Bool)
getMaybePersistence		= Maybe (String, Bool)
maybePersistence,
			getUIOptions :: forall row column. IOOptions row column -> UIOptions row column
getUIOptions			= UIOptions row column
uiOptions
		} -> (
			Maybe String
maybeOutputConfigFilePath,
			Maybe MaximumPGNNames
maybeMaximumPGNNames,
			[PGNOptions]
pgnOptionsList,
			Maybe (String, Bool)
maybePersistence,
			UIOptions row column
uiOptions
		) -- Deconstruct.
	 ) (PU
   (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
    Maybe (String, Bool), UIOptions row column)
 -> PU (IOOptions row column))
-> PU
     (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
      Maybe (String, Bool), UIOptions row column)
-> PU (IOOptions row column)
forall a b. (a -> b) -> a -> b
$ PU (Maybe String)
-> PU (Maybe MaximumPGNNames)
-> PU [PGNOptions]
-> PU (Maybe (String, Bool))
-> PU (UIOptions row column)
-> PU
     (Maybe String, Maybe MaximumPGNNames, [PGNOptions],
      Maybe (String, Bool), UIOptions row column)
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 String -> PU (Maybe String)
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU String -> PU (Maybe String)) -> PU String -> PU (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> PU String
HXT.xpTextAttr String
outputConfigFilePathTag {-can't be null-}
	 ) (
		String -> PU MaximumPGNNames -> PU (Maybe MaximumPGNNames)
forall a. String -> PU a -> PU (Maybe a)
HXT.xpAttrImplied String
maximumPGNNamesTag PU MaximumPGNNames
HXT.xpInt
	 ) PU [PGNOptions]
forall a. XmlPickler a => PU a
HXT.xpickle {-PGNOptions-} (
		PU (String, Bool) -> PU (Maybe (String, Bool))
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU (String, Bool) -> PU (Maybe (String, Bool)))
-> PU (String, Bool) -> PU (Maybe (String, Bool))
forall a b. (a -> b) -> a -> b
$ String -> PU (String, Bool) -> PU (String, Bool)
forall a. String -> PU a -> PU a
HXT.xpElem String
persistenceTag (
			String -> PU String
HXT.xpTextAttr String
filePathTag PU String -> PU Bool -> PU (String, Bool)
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` Bool -> PU Bool -> PU Bool
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault Bool
True (String -> PU Bool -> PU Bool
forall a. String -> PU a -> PU a
HXT.xpAttr String
automaticTag PU Bool
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-})
		)
	 ) PU (UIOptions row column)
forall a. XmlPickler a => PU a
HXT.xpickle {-UIOptions-}

-- | Smart constructor.
mkIOOptions
	:: Maybe System.FilePath.FilePath		-- ^ An optional path to a file, into which the unprocessed configuration, formatted as XML, should be written (obliterating any existing file-contents).
	-> Maybe MaximumPGNNames			-- ^ The optional maximum number of names, of matching PGN-games, to display; @Nothing@ implies unlimited.
	-> [Input.PGNOptions.PGNOptions]		-- ^ How to find & process PGN-databases.
	-> Maybe (System.FilePath.FilePath, Bool)	-- ^ Optional path to a file, into which game-state can be persisted (obliterating any existing content), & whether to save this state automatically after each move.
	-> Input.UIOptions.UIOptions row column
	-> IOOptions row column
mkIOOptions :: Maybe String
-> Maybe MaximumPGNNames
-> [PGNOptions]
-> Maybe (String, Bool)
-> UIOptions row column
-> IOOptions row column
mkIOOptions Maybe String
maybeOutputConfigFilePath Maybe MaximumPGNNames
maybeMaximumPGNNames [PGNOptions]
pgnOptionsList Maybe (String, Bool)
maybePersistence UIOptions row column
uiOptions
	| Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (
		Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
System.FilePath.isValid {-i.e. non-null on POSIX-}
	) Maybe String
maybeOutputConfigFilePath		= Exception -> IOOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions row column)
-> (String -> Exception) -> String -> IOOptions row column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.IOOptions.mkIOOptions:\tinvalid " (String -> IOOptions row column) -> String -> IOOptions row column
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
outputConfigFilePathTag String
"."
	| Maybe MaximumPGNNames -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe MaximumPGNNames
maybeMaximumPGNNames
	, [PGNOptions] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PGNOptions]
pgnOptionsList			= Exception -> IOOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions row column)
-> (String -> Exception) -> String -> IOOptions 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.IOOptions.mkIOOptions:\tSpecification of " (String -> IOOptions row column) -> String -> IOOptions row column
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
maximumPGNNamesTag String
" is only irrelevant when at least one PGN-database has been referenced."
	| Just MaximumPGNNames
maximumPGNNames	<- Maybe MaximumPGNNames
maybeMaximumPGNNames
	, MaximumPGNNames
maximumPGNNames MaximumPGNNames -> MaximumPGNNames -> Bool
forall a. Ord a => a -> a -> Bool
< MaximumPGNNames
0			= Exception -> IOOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions row column)
-> (String -> Exception) -> String -> IOOptions 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.IOOptions.mkIOOptions:\tThe maximum number of names, of matching PGN-games to display, can't be negative; " (String -> IOOptions row column) -> String -> IOOptions row column
forall a b. (a -> b) -> a -> b
$ MaximumPGNNames -> ShowS
forall a. Show a => a -> ShowS
shows MaximumPGNNames
maximumPGNNames String
"."
	| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
duplicateFilePaths		= Exception -> IOOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions row column)
-> (String -> Exception) -> String -> IOOptions row column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.IOOptions.mkIOOptions:\tduplicate " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
Input.PGNOptions.databaseFilePathTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> IOOptions row column) -> String -> IOOptions row column
forall a b. (a -> b) -> a -> b
$ [String] -> ShowS
forall a. Show a => a -> ShowS
shows [String]
duplicateFilePaths String
"."
	| Bool -> ((String, Bool) -> Bool) -> Maybe (String, Bool) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (
		Bool -> Bool
not (Bool -> Bool)
-> ((String, Bool) -> Bool) -> (String, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
System.FilePath.isValid {-i.e. non-null on POSIX-} (String -> Bool)
-> ((String, Bool) -> String) -> (String, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Bool) -> String
forall a b. (a, b) -> a
fst {-file-path-}
	) Maybe (String, Bool)
maybePersistence			= Exception -> IOOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions row column)
-> (String -> Exception) -> String -> IOOptions row column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.IOOptions.mkIOOptions:\tinvalid path for " (String -> IOOptions row column) -> String -> IOOptions row column
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
persistenceTag String
"."
	| Bool
otherwise	= MkIOOptions :: forall row column.
Maybe String
-> Maybe MaximumPGNNames
-> [PGNOptions]
-> Maybe (String, Bool)
-> UIOptions row column
-> IOOptions row column
MkIOOptions {
		getMaybeOutputConfigFilePath :: Maybe String
getMaybeOutputConfigFilePath	= ShowS
System.FilePath.normalise ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
maybeOutputConfigFilePath,
		getMaybeMaximumPGNNames :: Maybe MaximumPGNNames
getMaybeMaximumPGNNames		= Maybe MaximumPGNNames
maybeMaximumPGNNames,
		getPGNOptionsList :: [PGNOptions]
getPGNOptionsList		= [PGNOptions]
pgnOptionsList,
		getMaybePersistence :: Maybe (String, Bool)
getMaybePersistence		= ShowS -> (String, Bool) -> (String, Bool)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ShowS
System.FilePath.normalise ((String, Bool) -> (String, Bool))
-> Maybe (String, Bool) -> Maybe (String, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (String, Bool)
maybePersistence,
		getUIOptions :: UIOptions row column
getUIOptions			= UIOptions row column
uiOptions
	}
	where
		duplicateFilePaths :: [String]
duplicateFilePaths	= [String] -> [String]
forall (foldable :: * -> *) a.
(Foldable foldable, Ord a) =>
foldable a -> [a]
Data.Foldable.findDuplicates ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (PGNOptions -> String) -> [PGNOptions] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
System.FilePath.normalise ShowS -> (PGNOptions -> String) -> PGNOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGNOptions -> String
Input.PGNOptions.getDatabaseFilePath) [PGNOptions]
pgnOptionsList

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

-- | Mutator.
setMaybeOutputConfigFilePath :: Maybe System.FilePath.FilePath -> Transformation row column
setMaybeOutputConfigFilePath :: Maybe String -> Transformation row column
setMaybeOutputConfigFilePath Maybe String
maybeOutputConfigFilePath IOOptions row column
ioOptions
	| Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (
		Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
System.FilePath.isValid {-i.e. non-null on POSIX-}
	) Maybe String
maybeOutputConfigFilePath	= Exception -> IOOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions row column)
-> (String -> Exception) -> String -> IOOptions row column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.IOOptions.setMaybeOutputConfigFilePath:\tinvalid " (String -> IOOptions row column) -> String -> IOOptions row column
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
outputConfigFilePathTag String
"."
	| Bool
otherwise	= IOOptions row column
ioOptions {
		getMaybeOutputConfigFilePath :: Maybe String
getMaybeOutputConfigFilePath	= Maybe String
maybeOutputConfigFilePath
	}

-- | Mutator.
setEitherNativeUIOrCECPOptions :: Input.UIOptions.EitherNativeUIOrCECPOptions row column -> Transformation row column
setEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions row column -> Transformation row column
setEitherNativeUIOrCECPOptions EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions ioOptions :: IOOptions row column
ioOptions@MkIOOptions { getUIOptions :: forall row column. IOOptions row column -> UIOptions row column
getUIOptions = UIOptions row column
uiOptions }	= IOOptions row column
ioOptions {
	getUIOptions :: UIOptions row column
getUIOptions	= UIOptions row column
uiOptions {
		getEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions row column
Input.UIOptions.getEitherNativeUIOrCECPOptions	= EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions
	}
}

-- | Mutator.
setMaybePrintMoveTree :: Maybe Property.Arboreal.Depth -> Transformation row column
setMaybePrintMoveTree :: Maybe MaximumPGNNames -> Transformation row column
setMaybePrintMoveTree Maybe MaximumPGNNames
maybePrintMoveTree ioOptions :: IOOptions row column
ioOptions@MkIOOptions { getUIOptions :: forall row column. IOOptions row column -> UIOptions row column
getUIOptions = UIOptions row column
uiOptions }	= IOOptions row column
ioOptions {
	getUIOptions :: UIOptions row column
getUIOptions	= UIOptions row column
uiOptions {
		getMaybePrintMoveTree :: Maybe MaximumPGNNames
Input.UIOptions.getMaybePrintMoveTree	= Maybe MaximumPGNNames
maybePrintMoveTree
	}
}

-- | Mutator.
updateCECPFeature :: Input.CECPFeatures.Feature -> Transformation row column
updateCECPFeature :: Feature -> Transformation row column
updateCECPFeature Feature
feature ioOptions :: IOOptions row column
ioOptions@MkIOOptions { getUIOptions :: forall row column. IOOptions row column -> UIOptions row column
getUIOptions = UIOptions row column
uiOptions }	= IOOptions row column
ioOptions {
	getUIOptions :: UIOptions row column
getUIOptions	= Feature -> Transformation row column
forall row column. Feature -> Transformation row column
Input.UIOptions.updateCECPFeature Feature
feature UIOptions row column
uiOptions
}

-- | Mutator.
deleteCECPFeature :: Input.CECPFeatures.Feature -> Transformation row column
deleteCECPFeature :: Feature -> Transformation row column
deleteCECPFeature Feature
feature ioOptions :: IOOptions row column
ioOptions@MkIOOptions { getUIOptions :: forall row column. IOOptions row column -> UIOptions row column
getUIOptions = UIOptions row column
uiOptions }	= IOOptions row column
ioOptions {
	getUIOptions :: UIOptions row column
getUIOptions	= Feature -> Transformation row column
forall row column. Feature -> Transformation row column
Input.UIOptions.deleteCECPFeature Feature
feature UIOptions row column
uiOptions
}

-- | Mutator.
setVerbosity :: Input.Verbosity.Verbosity -> Transformation row column
setVerbosity :: Verbosity -> Transformation row column
setVerbosity Verbosity
verbosity ioOptions :: IOOptions row column
ioOptions@MkIOOptions { getUIOptions :: forall row column. IOOptions row column -> UIOptions row column
getUIOptions = UIOptions row column
uiOptions }	= IOOptions row column
ioOptions {
	getUIOptions :: UIOptions row column
getUIOptions	= UIOptions row column
uiOptions {
		getVerbosity :: Verbosity
Input.UIOptions.getVerbosity	= Verbosity
verbosity
	}
}