{-
	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
--	PersistenceSpecification,
--	Transformation,
-- ** Data-types
	IOOptions(
--		MkIOOptions,
		getMaybeOutputConfigFilePath,
		getMaybeMaximumPGNNames,
		getPGNOptionsList,
		getMaybePersistence,
		getUIOptions
	),
-- * Constants
	tag,
	outputConfigFilePathTag,
--	maximumPGNNamesTag,
--	persistenceTag,
--	filePathTag,
--	automaticTag,
-- * Functions
	persist,
-- ** 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.ShowColouredPrefix	as Text.ShowColouredPrefix
import qualified	BishBosh.Text.ShowList			as Text.ShowList
import qualified	BishBosh.Text.ShowPrefix		as Text.ShowPrefix
import qualified	BishBosh.Type.Count			as Type.Count
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Control.Monad
import qualified	Data.Default
import qualified	Data.Maybe
import qualified	System.FilePath
import qualified	System.IO
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 path to a file, into which game-state can be persisted (obliterating any existing content), & whether to save this state automatically after each move.
type PersistenceSpecification	= (System.FilePath.FilePath, Bool)

-- | Defines options related to i/o.
data IOOptions	= MkIOOptions {
	IOOptions -> 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 -> Maybe NGames
getMaybeMaximumPGNNames		:: Maybe Type.Count.NGames,		-- ^ The maximum number of names to display, of matching games from the PGN-database; @Nothing@ implies unlimited. CAVEAT: pedantically, it's a number of names not a number of games.
	IOOptions -> [PGNOptions]
getPGNOptionsList		:: [Input.PGNOptions.PGNOptions],	-- ^ How to construct each PGN-database.
	IOOptions -> Maybe PersistenceSpecification
getMaybePersistence		:: Maybe PersistenceSpecification,	-- ^ 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 -> UIOptions
getUIOptions			:: Input.UIOptions.UIOptions		-- ^ Options which define the user-interface.
} deriving IOOptions -> IOOptions -> Bool
(IOOptions -> IOOptions -> Bool)
-> (IOOptions -> IOOptions -> Bool) -> Eq IOOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IOOptions -> IOOptions -> Bool
$c/= :: IOOptions -> IOOptions -> Bool
== :: IOOptions -> IOOptions -> Bool
$c== :: IOOptions -> IOOptions -> Bool
Eq

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

instance Show IOOptions where
	showsPrec :: NGames -> IOOptions -> ShowS
showsPrec NGames
_ MkIOOptions {
		getMaybeOutputConfigFilePath :: IOOptions -> Maybe String
getMaybeOutputConfigFilePath	= Maybe String
maybeOutputConfigFilePath,
		getMaybeMaximumPGNNames :: IOOptions -> Maybe NGames
getMaybeMaximumPGNNames		= Maybe NGames
maybeMaximumPGNNames,
		getPGNOptionsList :: IOOptions -> [PGNOptions]
getPGNOptionsList		= [PGNOptions]
pgnOptionsList,
		getMaybePersistence :: IOOptions -> Maybe PersistenceSpecification
getMaybePersistence		= Maybe PersistenceSpecification
maybePersistence,
		getUIOptions :: IOOptions -> UIOptions
getUIOptions			= UIOptions
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)])
-> (NGames -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe NGames
-> [(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)])
-> (NGames -> (String, ShowS))
-> NGames
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
maximumPGNNamesTag (ShowS -> (String, ShowS))
-> (NGames -> ShowS) -> NGames -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NGames -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe NGames
maybeMaximumPGNNames ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ ([(String, ShowS)] -> [(String, ShowS)])
-> (PersistenceSpecification
    -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe PersistenceSpecification
-> [(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)])
-> (PersistenceSpecification -> (String, ShowS))
-> PersistenceSpecification
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
persistenceTag (ShowS -> (String, ShowS))
-> (PersistenceSpecification -> ShowS)
-> PersistenceSpecification
-> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistenceSpecification -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe PersistenceSpecification
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 -> ShowS
forall a. Show a => a -> ShowS
shows UIOptions
uiOptions
		)
	 ]

instance Data.Default.Default IOOptions where
	def :: IOOptions
def = MkIOOptions :: Maybe String
-> Maybe NGames
-> [PGNOptions]
-> Maybe PersistenceSpecification
-> UIOptions
-> IOOptions
MkIOOptions {
		getMaybeOutputConfigFilePath :: Maybe String
getMaybeOutputConfigFilePath	= Maybe String
forall a. Maybe a
Nothing,
		getMaybeMaximumPGNNames :: Maybe NGames
getMaybeMaximumPGNNames		= Maybe NGames
forall a. Maybe a
Nothing,
		getPGNOptionsList :: [PGNOptions]
getPGNOptionsList		= [],
		getMaybePersistence :: Maybe PersistenceSpecification
getMaybePersistence		= Maybe PersistenceSpecification
forall a. Maybe a
Nothing,
		getUIOptions :: UIOptions
getUIOptions			= UIOptions
forall a. Default a => a
Data.Default.def
	}

instance HXT.XmlPickler IOOptions where
	xpickle :: PU IOOptions
xpickle	= IOOptions -> PU IOOptions -> PU IOOptions
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault IOOptions
forall a. Default a => a
Data.Default.def (PU IOOptions -> PU IOOptions)
-> (PU
      (Maybe String, Maybe NGames, [PGNOptions],
       Maybe PersistenceSpecification, UIOptions)
    -> PU IOOptions)
-> PU
     (Maybe String, Maybe NGames, [PGNOptions],
      Maybe PersistenceSpecification, UIOptions)
-> PU IOOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU IOOptions -> PU IOOptions
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU IOOptions -> PU IOOptions)
-> (PU
      (Maybe String, Maybe NGames, [PGNOptions],
       Maybe PersistenceSpecification, UIOptions)
    -> PU IOOptions)
-> PU
     (Maybe String, Maybe NGames, [PGNOptions],
      Maybe PersistenceSpecification, UIOptions)
-> PU IOOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe String, Maybe NGames, [PGNOptions],
  Maybe PersistenceSpecification, UIOptions)
 -> IOOptions,
 IOOptions
 -> (Maybe String, Maybe NGames, [PGNOptions],
     Maybe PersistenceSpecification, UIOptions))
-> PU
     (Maybe String, Maybe NGames, [PGNOptions],
      Maybe PersistenceSpecification, UIOptions)
-> PU IOOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(Maybe String
a, Maybe NGames
b, [PGNOptions]
c, Maybe PersistenceSpecification
d, UIOptions
e) -> Maybe String
-> Maybe NGames
-> [PGNOptions]
-> Maybe PersistenceSpecification
-> UIOptions
-> IOOptions
mkIOOptions Maybe String
a Maybe NGames
b [PGNOptions]
c Maybe PersistenceSpecification
d UIOptions
e,	-- Construct.
		\MkIOOptions {
			getMaybeOutputConfigFilePath :: IOOptions -> Maybe String
getMaybeOutputConfigFilePath	= Maybe String
maybeOutputConfigFilePath,
			getMaybeMaximumPGNNames :: IOOptions -> Maybe NGames
getMaybeMaximumPGNNames		= Maybe NGames
maybeMaximumPGNNames,
			getPGNOptionsList :: IOOptions -> [PGNOptions]
getPGNOptionsList		= [PGNOptions]
pgnOptionsList,
			getMaybePersistence :: IOOptions -> Maybe PersistenceSpecification
getMaybePersistence		= Maybe PersistenceSpecification
maybePersistence,
			getUIOptions :: IOOptions -> UIOptions
getUIOptions			= UIOptions
uiOptions
		} -> (
			Maybe String
maybeOutputConfigFilePath,
			Maybe NGames
maybeMaximumPGNNames,
			[PGNOptions]
pgnOptionsList,
			Maybe PersistenceSpecification
maybePersistence,
			UIOptions
uiOptions
		) -- Deconstruct.
	 ) (PU
   (Maybe String, Maybe NGames, [PGNOptions],
    Maybe PersistenceSpecification, UIOptions)
 -> PU IOOptions)
-> PU
     (Maybe String, Maybe NGames, [PGNOptions],
      Maybe PersistenceSpecification, UIOptions)
-> PU IOOptions
forall a b. (a -> b) -> a -> b
$ PU (Maybe String)
-> PU (Maybe NGames)
-> PU [PGNOptions]
-> PU (Maybe PersistenceSpecification)
-> PU UIOptions
-> PU
     (Maybe String, Maybe NGames, [PGNOptions],
      Maybe PersistenceSpecification, UIOptions)
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 NGames -> PU (Maybe NGames)
forall a. String -> PU a -> PU (Maybe a)
HXT.xpAttrImplied String
maximumPGNNamesTag PU NGames
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) PU [PGNOptions]
forall a. XmlPickler a => PU a
HXT.xpickle {-PGNOptions-} (
		PU PersistenceSpecification -> PU (Maybe PersistenceSpecification)
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU PersistenceSpecification
 -> PU (Maybe PersistenceSpecification))
-> PU PersistenceSpecification
-> PU (Maybe PersistenceSpecification)
forall a b. (a -> b) -> a -> b
$ String
-> PU PersistenceSpecification -> PU PersistenceSpecification
forall a. String -> PU a -> PU a
HXT.xpElem String
persistenceTag (
			String -> PU String
HXT.xpTextAttr String
filePathTag PU String -> PU Bool -> PU PersistenceSpecification
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
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 Type.Count.NGames		-- ^ 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 PersistenceSpecification	-- ^ 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
	-> IOOptions
mkIOOptions :: Maybe String
-> Maybe NGames
-> [PGNOptions]
-> Maybe PersistenceSpecification
-> UIOptions
-> IOOptions
mkIOOptions Maybe String
maybeOutputConfigFilePath Maybe NGames
maybeMaximumPGNNames [PGNOptions]
pgnOptionsList Maybe PersistenceSpecification
maybePersistence UIOptions
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions)
-> (String -> Exception) -> String -> IOOptions
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) -> String -> IOOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
outputConfigFilePathTag String
"."
	| Maybe NGames -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe NGames
maybeMaximumPGNNames
	, [PGNOptions] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PGNOptions]
pgnOptionsList			= Exception -> IOOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions)
-> (String -> Exception) -> String -> IOOptions
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) -> String -> IOOptions
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 NGames
maximumPGNNames	<- Maybe NGames
maybeMaximumPGNNames
	, NGames
maximumPGNNames NGames -> NGames -> Bool
forall a. Ord a => a -> a -> Bool
< NGames
0			= Exception -> IOOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions)
-> (String -> Exception) -> String -> IOOptions
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) -> String -> IOOptions
forall a b. (a -> b) -> a -> b
$ NGames -> ShowS
forall a. Show a => a -> ShowS
shows NGames
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions)
-> (String -> Exception) -> String -> IOOptions
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) -> String -> IOOptions
forall a b. (a -> b) -> a -> b
$ [String] -> ShowS
forall a. Show a => a -> ShowS
shows [String]
duplicateFilePaths String
"."
	| Bool
-> (PersistenceSpecification -> Bool)
-> Maybe PersistenceSpecification
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (
		Bool -> Bool
not (Bool -> Bool)
-> (PersistenceSpecification -> Bool)
-> PersistenceSpecification
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
System.FilePath.isValid {-i.e. non-null on POSIX-} (String -> Bool)
-> (PersistenceSpecification -> String)
-> PersistenceSpecification
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistenceSpecification -> String
forall a b. (a, b) -> a
fst {-file-path-}
	) Maybe PersistenceSpecification
maybePersistence			= Exception -> IOOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions)
-> (String -> Exception) -> String -> IOOptions
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) -> String -> IOOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
persistenceTag String
"."
	| Bool
otherwise	= MkIOOptions :: Maybe String
-> Maybe NGames
-> [PGNOptions]
-> Maybe PersistenceSpecification
-> UIOptions
-> IOOptions
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 NGames
getMaybeMaximumPGNNames		= Maybe NGames
maybeMaximumPGNNames,
		getPGNOptionsList :: [PGNOptions]
getPGNOptionsList		= [PGNOptions]
pgnOptionsList,
		getMaybePersistence :: Maybe PersistenceSpecification
getMaybePersistence		= ShowS -> PersistenceSpecification -> PersistenceSpecification
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ShowS
System.FilePath.normalise (PersistenceSpecification -> PersistenceSpecification)
-> Maybe PersistenceSpecification -> Maybe PersistenceSpecification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PersistenceSpecification
maybePersistence,
		getUIOptions :: UIOptions
getUIOptions			= UIOptions
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

-- | Persist the specified game to file.
persist
	:: Show game
	=> IOOptions
	-> Bool	-- ^ Verbose.
	-> game
	-> IO ()
persist :: IOOptions -> Bool -> game -> IO ()
persist MkIOOptions {
	getMaybePersistence :: IOOptions -> Maybe PersistenceSpecification
getMaybePersistence	= Maybe PersistenceSpecification
maybePersistence
} Bool
verbose game
game = IO ()
-> (PersistenceSpecification -> IO ())
-> Maybe PersistenceSpecification
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
	() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return {-to IO-monad-} ()
 ) (
	\(String
filePath, Bool
automatic) -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when Bool
automatic (IO () -> IO ())
-> ((SomeException -> IO ()) -> IO ())
-> (SomeException -> IO ())
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch (
		do
			String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
System.IO.withFile String
filePath IOMode
System.IO.WriteMode (Handle -> game -> IO ()
forall a. Show a => Handle -> a -> IO ()
`System.IO.hPrint` game
game)

			Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when Bool
verbose (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
System.IO.hPutStrLn Handle
System.IO.stderr (String -> IO ()) -> ShowS -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowColouredPrefix.showsPrefixInfo ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"the game-state has been saved in " (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
filePath String
"."
	) ((SomeException -> IO ()) -> IO ())
-> (SomeException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> Handle -> String -> IO ()
System.IO.hPutStrLn Handle
System.IO.stderr (String -> IO ()) -> ShowS -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowPrefix.showsPrefixError (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: Control.Exception.SomeException)
 ) Maybe PersistenceSpecification
maybePersistence

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

-- | Mutator.
setMaybeOutputConfigFilePath :: Maybe System.FilePath.FilePath -> Transformation
setMaybeOutputConfigFilePath :: Maybe String -> Transformation
setMaybeOutputConfigFilePath Maybe String
maybeOutputConfigFilePath IOOptions
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
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> IOOptions)
-> (String -> Exception) -> String -> IOOptions
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) -> String -> IOOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
outputConfigFilePathTag String
"."
	| Bool
otherwise	= IOOptions
ioOptions {
		getMaybeOutputConfigFilePath :: Maybe String
getMaybeOutputConfigFilePath	= Maybe String
maybeOutputConfigFilePath
	}

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

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

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

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

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